#!/usr/bin/env perl
# Copyright (C) 2006 Nikolas Coukouma
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
# Installation tips:
# 1) Make sure your server has FastCGI setup and configured to handle .fcgi
# extensions. If you're using Apache, I recommend mod_fcgid over mod_fastcgi.
# 1a) Again for Apache folk, you need both ExecCGI and FollowSymLinks enabled
# for the director with the script
# 2) This file's name should end in .fcgi, or whatever's appropriate for your
# server's configuration.
# 3) The FCGI module from CPAN.
# For Debian:
# apt-get install libfcgi-perl libcgi-fast-perl
# For Gentoo:
# emerge dev-libs/fcgi dev-perl/FASTCGI
use strict;
use CGI::Fast qw(:standard start_ul;);
sub cmppoint {
my ($a, $b) = @_;
if($a->[0] == $b->[0]) {
return $a->[1] <=> $b->[1];
} else {
return $a->[0] <=> $b->[0];
}
}
# Amusing story:
# I initially wrote this to use a sorted list, but did
# stepping instead of a binary search. However, that
# approach got complicated because I would have to move
# both forwards and backwards. I got annoyed and wrote a
# kd-tree implementation, but that was really overkill.
# Now it's back to the array, but with a tail-recursive
# binary search. Simple, and got rid of about 25 lines of
# code. Both solutions guarantee O(k*n*log(n)) running time,
# of course. (Where k is the number of constellations
# and n is the number of stars).
# can be generalized if needed ...
sub binsearch {
my ($a, $arr) = @_;
my $len = scalar(@$arr);
if(0 == $len) {
return -1;
} elsif(1 == $len) {
return cmppoint($a, @$arr[0])? -1 : 0;
} else {
my $mid = $len / 2;
my $leg = cmppoint($a, @$arr[$mid]);
if(0 == $leg) {
return $mid;
} elsif(0 < $leg) {
return binsearch($a, [@$arr[($mid+1) .. ($len-1)]]);
} else {
return binsearch($a, [@$arr[0 .. ($mid-1) ]]);
}
}
}
sub starstr {
my $star = shift @_;
return $star->[0] . ", " . $star->[1];
}
sub my_footer {
print '
Source code for the interested';
print end_html;
}
sub error {
my $str = shift;
print "$str
";
print my_footer;
}
my @constellations = (
# The following patterns are based on the coords given by
# Stooder's constellation finder. However, the constellations
# are unreleased so I can't verify their accuracy. Until they
# are, they will remain commented out.
#
{'name' =>'Protector',
'deltas' =>[
[60, -90],
[70, -70],
[0, 70],
[0, 70],
[70, -70] ], },
{'name' =>'Gatherer',
'deltas' =>[
[30, 140],
[10, -200],
[30, 130],
[70, -100],
[10, 80] ], },
{'name' =>'Thief',
'deltas' =>[
[10, -130],
[50, 10],
[20, -40],
[20, -40],
[0, 120] ], },
{'name' =>'Collector',
'deltas' =>[
[10, -50],
[90, -80],
[0, 140],
[90, -60],
[10, 50] ], },
{'name' =>'Gladiator',
'deltas' =>[
[40, -120],
[30, -20],
[0, 170],
[30, -150],
[40, 120] ], },
{'name' =>'Wave',
'deltas' =>[
[50, 70],
[90, -80],
[30, 50],
[20, -130],
[10, 90] ], },
{'name' =>'Dancer',
'deltas' =>[
[60, 30],
[60, -30],
[-120, -140],
[60, -30],
[60, 30] ], },
{'name' =>'Farmer',
'deltas' =>[
[10, -80],
[70, 140],
[40, -120],
[20, 30],
[20, -40] ], },
{'name' =>'First to Rise',
'deltas' =>[
[20, 60],
[60, 20],
[0, -160],
[60, 20],
[20, 60] ], },
{'name' =>'Dreamer',
'deltas' =>[
[60, -20],
[50, -70],
[10, 90],
[10, 40],
[60, 20] ], },
{'name' =>'Sleeper',
'deltas' =>[
[40, -30],
[40, -30],
[40, 0],
[40, 30],
[40, 30] ], },
);
my $title = 'Altador Constellation Finder';
while (my $q = new CGI::Fast) {
print header(-type, 'text/html; charset=utf8');
print start_html(-title=>$title);
print h3($title);
print 'Get your star data and paste it below';
print start_form;
print textarea('star_data', '', 4, 80);
print '
';
print submit('Look for constellations');
print end_form;
my $star_data = $q->param('star_data');
$star_data =~ s/^\s+//;
$star_data =~ s/\s+$//;
unless($star_data) {
my_footer;
next;
}
my @parts = split(':', $star_data);
if($#parts < 1) {
error('bad star data?');
next;
}
my @stars = split('\\|', $parts[0]);
@stars = map {
my @tmp = split('\\,');
[ $tmp[0]+0, $tmp[1]+0 ];
} @stars;
if($#stars < 10) {
error('Got stars?');
next;
}
my @stars = sort { cmppoint($a, $b); } @stars;
my $found_one = 0;
foreach my $const (@constellations) {
foreach my $s (@stars) {
my $sol = 1;
my $x = $s->[0];
my $y = $s->[1];
foreach my $diffs (@{$const->{'deltas'}}) {
$x += $diffs->[0];
$y += $diffs->[1];
$sol = -1 != binsearch([$x, $y], \@stars);
last unless $sol;
}
if($sol) {
$found_one = 1;
my $x = $s->[0];
my $y = $s->[1];
print "Found the $const->{'name'}!";
print start_ul;
print li(starstr($s));
foreach my $diffs (@{$const->{'deltas'}}) {
$x += $diffs->[0];
$y += $diffs->[1];
print li(starstr([$x, $y]));
}
print end_ul;
last;
}
}
}
print 'No constellations found. Are you sure you\'ve started the plot?' unless $found_one;
my_footer;
}