#!/usr/bin/env perl
use strict;
use warnings; 

use Getopt::Long;
use Digest::MD5 qw(md5_hex);
#use Data::Dumper; # Comes in handy for debugging data structures

my %opthash;
my $TIMEOUT=60;
alarm($TIMEOUT);
$SIG{ALRM} = sub { die "$TIMEOUT second timeout expired!" };

GetOptions(\%opthash, 'x=i', 'y=i', 
	   'xspace=i', 'yspace=i',
	   'bearingoffset=i','n=i',
	   'proximity=i',
	   'min=i','max=i',
	   'format=s',
	   'help');

if (defined($opthash{'help'})) {
    helpmsg($0);
    exit 0;
}

my $X=4;
my $Y=4;
my $XSPACE=50;
my $YSPACE=50;
my $BEARINGOFFSET=0;
my $NUM_POINTS=7;
my $FORMAT="text";
my $PROXIMITY=10;
my $MIN=55;
my $MAX=200;
my $WRDIR = ".";

if (defined($opthash{'x'}) && $opthash{'x'} > 0) {
    $X = $opthash{'x'};
}
if (defined($opthash{'y'}) && $opthash{'y'} > 0) {
    $Y = $opthash{'y'};
}
if (defined($opthash{'xspace'}) && $opthash{'xspace'} > 0) {
    $XSPACE = $opthash{'xspace'};
}
if (defined($opthash{'yspace'}) && $opthash{'yspace'} > 0) {
    $YSPACE = $opthash{'yspace'};
}
if (defined($opthash{'bearingoffset'})) {
    $BEARINGOFFSET  = $opthash{'bearingoffset'} % 360;
}
if (defined($opthash{'proximity'})) {
    $PROXIMITY  = $opthash{'proximity'};
}
if (defined($opthash{'n'}) && $opthash{'n'} > 0) {
    $NUM_POINTS = $opthash{'n'};
}
if (defined($opthash{'max'}) && $opthash{'max'} > 0) {
    $MAX = $opthash{'max'};
}
if (defined($opthash{'min'}) && $opthash{'min'} > 0) {
    $MIN = $opthash{'min'};
}
if (defined($opthash{'format'}) && $opthash{'format'} ) {
    $FORMAT = lc($opthash{'format'});
    $WRDIR = "/tmp" if ($FORMAT eq "html");
}

my $CONSTRAINTFILE = $WRDIR . "/gridconstraints-${X}x${Y}\@${XSPACE}x${YSPACE}\-${BEARINGOFFSET}-${PROXIMITY}-${MIN}\@${MAX}.txt";

my @gridpoints = generategrid($X,$Y,$XSPACE,$YSPACE);

my $pass=1;
while (1) {
    if ( -f $CONSTRAINTFILE ) {
	@gridpoints = readconstraints($CONSTRAINTFILE,\@gridpoints);
	last;
    } else {
	die "Could not read constraints from file!\n" unless $pass;
	$pass = 0;
	calculateconstraints($CONSTRAINTFILE,$PROXIMITY,$MIN,$MAX,\@gridpoints);
    }
}

my @pointlist;
# This could potentially be very slow indeed; in practice it works OK for
#  normal-sized grids with reasonable constraints
while ( ( 1 + $#pointlist ) != $NUM_POINTS ) {
	   @pointlist = getpoints($NUM_POINTS,\@gridpoints);
}

my $uuid;
$uuid=getuuid($X,$Y,\@pointlist,\@gridpoints);

#### Everything below here is output

my %directions=getdirections($BEARINGOFFSET,\@pointlist,\@gridpoints,$FORMAT);

printoutput($uuid,\%directions,$FORMAT);

exit 0;

sub printoutput {
    my $uuid = shift;
    my $dr = shift;
    my $fmt = shift;
    my $html = ($fmt eq "html"?1:0);
    my %directions = %{$dr};
    if ($html) {
	print "<h2><strong>";
    } else { 
	print "\n\n\n\n";
    } 
    print "INSTRUCTOR KEY";
    if ($html) {
	print "</strong>";
    } 
    print " for course ";
    print $uuid;
    if ($html) {
	print "</h2>\n<hr><br>\n<tt><ul>";
    } else {
	print "\n\n";
    }
    for my $p (sort keys %directions) {
	if ($html) {
	    print "<li>";
	}
	print "From map marker ";
	print $directions{$p}{startpoint};
	print " (";
	print $directions{$p}{sx};
	print ",";
	print $directions{$p}{sy};
	print "),";
	print " proceed ";
	print $directions{$p}{distance};
	print " meters at a bearing of ";
	print $directions{$p}{bearing};
	print " degrees to point ";
	print $directions{$p}{endpoint};
	print " (";
	print $directions{$p}{ex};
	print ",";
	print $directions{$p}{ey};
	print ")";
	print ".";
	if ($html) {
	    print "</li>\n";
	} else {
	    print "\n\n";
	}
    }
    if ($html) {
	print "</ul></tt><p><hr><p>\n<h2><strong>";
    } else {
	print "\n\n\n\n\n\n";
	print "---------------------------------------------------------";
	print "\n\n\n\n\n\n";
    }
    print "STUDENT WORKSHEET";
    if ($html) {
	print "</strong>";
    }
    print " for course $uuid:";
    if ($html) { 
	print "</h2>\n<hr><br>\n<tt><ul>";
    } else {
	print "\n\n";
    }
    for my $p (sort keys %directions) {
	if ($html) {
	    print "<li>";
	}
	print "From map marker ";
	if ($p ==0) {
	    if ($html) {
		print "&nbsp;&nbsp;&nbsp;";
	    } else {
		print "   ";
	    }
	    print $directions{$p}{startpoint};
	} else {
	    print "____";
	}
	print ", proceed ____  meters at a bearing of ";
	print $directions{$p}{bearing};
	print " degrees to point ____.";
	if ($html) {
	    print "</li>\n";
	} else {
	    print "\n\n";
	}
    }
    if ($html) {
	print "</ul></tt><p>\n<hr>";
    }
}

sub getuuid {
    my $XNUM=shift;
    my $YNUM=shift;
    my $pr=shift;
    my $gr=shift;
    my @pointlist = @{$pr};
    my @gridpoints=@{$gr};

#  This algorithm uses 2 ** p0 * 3 ** p1 * 5 ** p2 * 7 ** p3 * 11 ** p4, etc.
#  Produces really unusably large numbers
#    my @primes = [2,3,5,7,11,13,17,19,23,29,31]; #extend as necessary
#    my $i=0;
#    my $uuid=1;
#    for my $p (@pointlist) {
#	$uuid *= ($primes[$i++])**$p;
#    }

#  This one relies on having uuidgen on the system
#    my $uuid=`uuidgen`;
#    chomp $uuid;
    
    my $pl=$XNUM . 'x' . $YNUM . '-';
    for my $p (@pointlist) {
	$pl .= $gridpoints[$p]{'label'};
    }

# Yes, $pl is unique but it also gives away the sequence...

# However, its MD5 sum is *also* unique, and doesn't...
#  You can check this with:
#   echo -n {xsize}x{ysize}-{listofpoints} | md5sum | awk '{print $1}'

    my $uuid=md5_hex($pl);
    
    return $uuid;
}

    
sub getdirections {
    my $PI = 3.14159265;
    my $BEARINGOFFSET = shift;
    my $plr = shift;
    my $gpr = shift;
    my $fmt = shift;
    my $html = ($fmt eq "html"?1:0);

    my @pointlist = @{$plr};
    my @gridpoints = @{$gpr};
    my %directions=();

    for (my $i = 0; $i < $#pointlist; $i++) {
	my $startpoint = $gridpoints[($pointlist[$i])]->{label};
	my $endpoint   = $gridpoints[($pointlist[$i+1])]->{label};
	my $sx         = $gridpoints[($pointlist[$i])]->{x};
	my $sy         = $gridpoints[($pointlist[$i])]->{y};
	my $ex         = $gridpoints[($pointlist[$i+1])]->{x};
	my $ey         = $gridpoints[($pointlist[$i+1])]->{y};
	
	my $dx = $ex - $sx;
	my $dy = $ey - $sy;
	my $d  = int(0.5 + sqrt(($dx ** 2) + ($dy ** 2)));
	my $theta = atan2($dy,$dx);
	my $degrees = ((int((($PI - $theta) * 180) / $PI) + 0.5 )+ 270 + $BEARINGOFFSET ) % 360;
	# Fix rounding errors for exact bearings.
	if (($dx == 0) or ($dy == 0) or (abs($dx) == abs($dy))) {
	    $degrees = 45 * ( int (($degrees / 45) + 0.5 ));
	}
	$directions{$i}{startpoint} = $startpoint;
	$directions{$i}{endpoint} = $endpoint;
	$directions{$i}{bearing} = pformat($html,$degrees);
	$directions{$i}{distance} = pformat($html,$d);
	$directions{$i}{sx} = pformat($html,$sx);
	$directions{$i}{sy} = pformat($html,$sy);
	$directions{$i}{ex} = pformat($html,$ex);
	$directions{$i}{ey} = pformat($html,$ey);
	
    }
    return %directions;
}

sub pformat {
    my $html = shift;
    my $value = shift;
    my $retval = sprintf('%3s',$value);
    if ($html) {
	$retval =~ s/ /&nbsp;/;
    }
    return $retval;
}

sub generategrid {
    my $XNUM=shift;
    my $YNUM=shift;
    my $XSPACE=shift;
    my $YSPACE=shift;
    my @gridpoints = ();
    for (my $i = 0 ; $i < ($XNUM * $YNUM); $i++) {
	${gridpoints[$i]} = ();
	${gridpoints[$i]}{x} = ($i % $XNUM) * $XSPACE;
	${gridpoints[$i]}{y} = int ($i / $XNUM) * $YSPACE;
	${gridpoints[$i]}{label} = getlabel($i);
	${gridpoints[$i]}{legal} = [];
    }
    return @gridpoints;
}

sub readconstraints {
    my $CFILE = shift;
    my $gref = shift;
    my @gridpoints = @{$gref};
    open (my $cfh, "<", $CFILE) or die "Could not open $CFILE: $!\n";
    while (<$cfh>) {
	chomp;
	if (m/^(\d+):\s+(.*)$/) {
	    my $p=$1;
	    my @l = split(' ',$2);
	    @{${gridpoints[$p]}{legal}} = @l;
	}
    }
    close $cfh;
    return @gridpoints;
}

sub calculateconstraints {
    my $CFILE = shift;
    my $PROX = shift;
    my $MIN=shift;
    my $MAX=shift;
    my $gref = shift;
    my @gridpoints = @{$gref};
    my %legal = ();
    my $p=0;
    my $q=0;
    for my $pp (@gridpoints) {
	$q=0;
	for my $qp (@gridpoints) {
	    unless (defined($legal{$p}{$q})) {
		my $result = checkpt($p,$q,$PROX,$MIN,$MAX,\@gridpoints);
		$legal{$p}{$q} = $result;
		$legal{$q}{$p} = $result;
	    }
	    $q++;
	}
	$p++;
    }

    open (my $cfh, ">", $CFILE) or die "Could not open $CFILE: $!\n";
    $p=0;
    for my $pp (@gridpoints) {
	print $cfh "$p: ";
	$q=0;
	for my $qp (@gridpoints) {
	    print $cfh "$q " if $legal{$p}{$q};
	    $q++;
	}
	$p++;
	print $cfh "\n";
    }
    close $cfh;
}

sub getpoints {
    my $n = shift;
    my $lr = shift;
    my @l = @{$lr};
    my $i = 0;
    my @r;
    for my $entry (@l) {
	push @{$r[$i]}, @{$entry->{legal}};
	$i++;
    }
    my @result;
    my $lastpoint = -1;
    my $lastlastpoint = -1;
    for ($i = 0; $i < $n; $i++) {
	my @candidates = restrict($i,$lastpoint,$lastlastpoint,$n,\@r,$lr);
	my $nc = @candidates;
	return [] unless $nc;
	$lastlastpoint = $lastpoint;
	$lastpoint = $candidates[(int(rand($nc)))];
	push @result, $lastpoint;
    }
    return @result;
}

sub restrict {
    my $n = shift;
    my $lastpoint = shift;
    my $lastlastpoint = shift;
    my $max = shift;
    my $rr = shift;
    my $lr = shift;
    my @r = @{$rr};
    my @l = @{$lr};
    my @out;
    if ($lastpoint == -1) {
	# First point must be on bottom edge
	for (my $i = 0 ; $i < (1 + $#l) ; $i++) {
	    push @out, $i if $l[$i]->{y} == 0;
	}
    } else {
	my @c = grep { $_ != $lastlastpoint; } @{$r[$lastpoint]}; 
	# No back and forth line segments
	if ($n == $max - 1) {
	    # Last point must be on bottom edge
	    for (my $i = 0 ; $i < (1 + $#c) ; $i++) {
		push @out, $c[$i] if ($l[($c[$i])]->{y} == 0) ;
	    }
	} elsif ($n == ($max - 2)) {
	    # Next-to-last point cannot be on top edge
	    for (my $i = 0 ; $i < (1 + $#c) ; $i++) {
		push @out, $c[$i] unless $l[($c[$i])]->{y} == 200;
	    }
	} else {
	    @out = @c;
	}
    }
    return @out;
}

sub getlabel {
    my $i = shift;
    my @letters = ("A" .. "Z");
    my $nlet = $#letters + 1; # Most likely, 26
    my $label = $letters[($i % $nlet)];
    while ($i > $nlet) {
	$i = int ($i / $nlet) ;
	my $l = $i % $nlet;
	my $c = $letters[$l];
	$label = $c . $label;
    }
    return $label;
}

sub checkpt {
    my $p1 = shift;
    my $p2 = shift;
    my $PROX = shift;
    my $MIND = shift;
    my $MAXD = shift;
    my $gref = shift;

    my @gridpoints = @{$gref};

    return 0 if ($p1 == $p2); # Can't "travel" from one point to itself

    my $p1x = ${gridpoints[$p1]}{x};
    my $p1y = ${gridpoints[$p1]}{y};
    my $p2x = ${gridpoints[$p2]}{x};
    my $p2y = ${gridpoints[$p2]}{y};

    my $xmin=min($p1x,$p2x);
    my $xmax=max($p1x,$p2x);
    my $ymin=min($p1y,$p2y);
    my $ymax=max($p1y,$p2y);

    my $xds = ($p1x - $p2x) * ($p1x - $p2x);
    my $yds = ($p1y - $p2y) * ($p1y - $p2y);
    my $ds  = $xds + $yds;
    
    return 0 if $ds > ($MAXD * $MAXD); # Too far apart
    return 0 if $ds < ($MIND * $MIND); # Too close together

    # Check for proximity to other gridpoints

    for my $g (@gridpoints) {
	# Check to see if it is one of the endpoints
	next if (($g->{x} == $p1x) && ($g->{y} == $p1y)); # an endpoint
	next if (($g->{x} == $p2x) && ($g->{y} == $p2y)); # an endpoint

	# Check to see if it's inside bounding rectangle.
	next if $g->{x} > $xmax;
	next if $g->{x} < $xmin;
	next if $g->{y} > $ymax;
	next if $g->{y} < $ymin;

	# Point is inside the bounding rectangle.
	
	# Recenter coordinates on grid point to test incidence

	my $nx1 = $p1x - $g->{x};
	my $nx2 = $p2x - $g->{x};
	my $ny1 = $p1y - $g->{y};
	my $ny2 = $p2y - $g->{y};

	my $D = ($nx1 * $ny2) - ($nx2 * $ny1);
#	print STDERR "p1': ( $nx1,$ny1 ) / p2': ( $nx2, $ny2 )\n";
#	print STDERR "Discriminant^2 ",$D*$D," d^2 = ", $PROX * $PROX * $ds, "\n";
	if (($PROX * $PROX * $ds) > ($D*$D)) {
#	    print STDERR "p1: ( $p1x,$p1y ) cannot reach ( $p2x,$p2y ) because of ( $g->{x}, $g->{y} )\n";
	    return 0;
	}
    }
    
    return 1;
}

sub min {
    my $a = shift;
    my $b = shift;
    return $a if ($a < $b);
    return $b;
}

sub max {
    my $a = shift;
    my $b = shift;
    return $a if ($a > $b);
    return $b;
}

sub helpmsg {
    my $name = shift;
    print STDERR "$name [ --x number-of-x-points[4] --y number-of-y-points[4]\n";
    print STDERR "      --xspace x-spacing-in-meters[50] --yspace y-spacing-in-meters[50]\n";
    print STDERR "      --bearingoffset degrees[0] --n number-of-points[7] \n";
    print STDERR "      --min minimum-leg-length-in-meters [50] \n";
    print STDERR "      --max maximum-leg-length-in-meters [50] \n";
    print STDERR "      --proximity closest-approach-to-other-grid-point-in-meters [10] \n";
    print STDERR "      --format [text|html] --help ]\n";
}