#!/usr/bin/perl -w

# Testing map retrieval
# Last Modified: Waider / 07/04/2003
# April 2003: Did some mucking about with satellite strength and location.
# May 2003: POE conversion

use lib "$ENV{HOME}/src/perl";
use lib "$ENV{HOME}/lib/perl";
use Tk;
use POE;
use POE::Filter::Stream;
use POE::Wheel::Run;
use MapServer;
use GD;
use Device::SerialPort;
use GPS::Satellite;

# Optiony stuff
use Getopt::Long;
use Tk::CmdLine;

# Hash of satellites, keyed on PRN
my %satellites;

my $debug = 0;

my $online = 0;
my $mag = 8;
my $server = "MapQuest";
my $port;
my $device;

GetOptions( "online!" => \$online,
			"mag=i" => \$mag,
			"server=s" => \$server,
			"device=s" => \$device,
			"debug!" => \$debug );

$device ||= "ttyS0";
$device =~ s|/dev/||;

# Create the map server object
my $mapsrv;

eval qq(
    use MapServer::$server;
    \$mapsrv = new MapServer::$server;
);

if ( $@ ) {
    die "$@";
}

$mapsrv->online( $online );
$mapsrv->mag( $mag );

my $main = $poe_main_window;
$main->title( "Map Widget" );
my $canvas = $main->Canvas(	-width => '640', -height => '480',
                            -relief => 'groove',
                            -borderwidth => '2' );
my ( $cwidth, $cheight ) = ( 640, 480 );
my %imageFiles;
my @imageFiles;
$canvas->pack();

# I hate Tk.
my ( $maxx, $maxy, $minx, $miny );

my $nmeafile = "$ENV{'HOME'}/tmp/gps/nmea-live.dump";
-d "$ENV{'HOME'}/tmp/gps" || `mkdir -p $ENV{'HOME'}/tmp/gps`;
open( NMEAFILE, ">>$ENV{'HOME'}/tmp/gps/nmea-live.dump" );


# Quit binding
$main->bind( '<q>', sub { exit(); });

my $live = 0;
my $gga = "";
my $runit = 0;

# This is our status text
my $log = "READY";

my $frame = $main->Frame()->pack( -side => "bottom", -fill => "x", -expand => "yes" );

$frame->Button( -text => 'Live',
				-command => \&livegps
			  )->pack( -side=>"left");

my $frame2 = $main->Frame()->pack( -side => "top", -fill => "x", -expand => "yes" );

my $canvas2 = $frame2->Canvas()->pack(-fill=>"both", -expand=>"yes");

sub CreateGUI {
  my $session = $_[ SESSION ];
  $poe_kernel->alias_set( "thing" );
  $frame->Button(
				 -text => 'Read one line',
				 -command => $session->postback( "readline" ),
			  )->pack( -side=>"right");
  $main->bind( '<r>', sub { $poe_kernel->post( thing => "readline" )} );
  $main->bind( '<l>', \&livegps );

  $frame->Entry(-textvariable=>\$log)->pack( -side=>"bottom", -fill=>'x', -expand=>'yes');
}

POE::Session->create(
					 inline_states => {
									   _start => \&CreateGUI,
									   readline => \&readfile,
									  },
					);
$poe_kernel->run();

sub livegps {
    POE::Session->new
        (
         _start => sub {
             $poe_kernel->alias_set( 'GPS' );
             opengps( "$device" );
             my $task = new POE::Wheel::Run
               (
                Program => sub {
                    my $acc = "";
                    while ( 1 ) {
                        $acc .= $port->input;
                        while ( $acc =~ /^(.*?\r\n)(.*)/m ) {
                            print ">> $1" if $debug;
                            &parsedata( $1 );
                            $main->update();
                            $acc = $2;
                        }
                    }
                },
                StdoutFilter => POE::Filter::Stream->new(),
                StdoutEvent => 'parsegps',
                StderrEvent => 'error',
                CloseEvent => 'close',
               );
             $_[HEAP]->{task} = $task;
         },


         parsegps => sub {
             my @input = @_[ARG0..$#_];
             print STDERR "parsegps: " . join( " ", @input ) . "\n";
         },

         error => sub {
             print STDERR "gps error\n";
         },

         close => sub {
             print STDERR "gps closed\n";
         },

         _stop => sub {
             closegps();
         },
        );
}

sub readfile {
  while (<>) {
      my $l = $_;
      chomp( $l );
      $log = $l;
      $main->update();
      &parsedata( $_ );
      $main->update();
  }
  print STDERR "Readfile() done\n";
}

sub parseicbm {
  my ( $lat, $long ) = @_;
  my ( $latdeg, $latmin ) = ( substr( $lat, 0, 2 ),
							  substr( $lat, 2 ));
  $lat = $latdeg + ( $latmin / 60 );
  my ( $longdeg, $longmin ) = ( substr( $long, 0, 3 ),
								substr( $long, 3 ));
  $long = $longdeg + ( $longmin / 60 );

  ( $lat, $long );
}


sub parsedata {
  $_ = shift;
  return 0 if !defined( $_ );	# errrrr. can't happen?
  my $error = 0;

  #  $log = $_ if $_;

  # starts with $? -> NMEA file
  if ( /^\$/ ) {
	print NMEAFILE if $live;
	s/^\$//;					# discard header
	return 1 if !s/\r\n$//;		# discard trailer

	# do the checksum thing
	if ( s/\*([0-9A-F][0-9A-F])$// ) {
	  my ( $csum ) = eval( "0x$1" );
	  for my $c ( split( // )) {
		$csum ^= ord( $c );
	  }

	  if ( $csum ) {
		return 1;				# invalid checksum
	  }
	}

	$log = $_;

	# Break it up into fields
	my @fields = split( /,/ );

	# Parse type of data
	shift @fields;				# discard source/command

	# Woop. Check for proprietary sentence:
	if ( m/^P(...)(.*?),/ ) {
	  if ( $1 eq 'GRM' ) {		# GARMIN PROPRIETARY
	  GARMIN:
		{
		  # E - estimated error
		  if ( $2 eq 'E' ) {
			if ( $fields[ 0 ] =~ /[0-9.]/) { # verify that we have data
			  #printf( "HPE: %f %s VPE: %f %s Spherical: %f %s\n",
			  #@fields);
			  $error = $fields[ 0 ];
			  if ( $fields[ 1 ] ne "M" ) {
				print "You'll need to be converting your error...\n";
			  }
			  # the mapquest scale I'm retrieving is 58 pixels = 200m,
			  # or maybe 60 pixels = 200m.
			  # FIXME this should be in the mapsrv class, and should
			  # be determined by reading the scale off the map...
			  $error = $error / 200 * 58;
			}
		  }
		  # Z - altitude. Always in feet.
		  if ( $2 eq 'Z' ) {
			if ( $fields[ 0 ] =~ /[0-9.]/) {
			  #printf( "Altitude (%s): %d %s\n",
			  #$fields[ -1 ] == 2 ? "user" : "GPS",
			  #$fields[ 0 ], $fields[ 1 ] );
			}
		  }
		  last GARMIN;
		}
	  } else {
		# don't know what to do! AIE!
		print "command $2 from $1\n";
	  }
	} else {
	  s/^(..)(.+?),//;
	  my ( $source, $datatype ) = ( $1, $2 );

	  if ( $source eq 'GP' ) {
	  } elsif ( $source eq 'LC' ) {
	  } elsif (  $source eq 'OM' ) {
	  } elsif ($source eq 'II' ) {
	  } else {
		print "$source ???\n";
	  }

	COMMAND:
	  {
		# GGA GPS Fix Data
		if ( $datatype eq 'GGA' ) {
		  my ( $time, $lat, $latd, $long, $longd, $qual, $nsat, $hdil,
			   $alt, $altu, $geo, $geou, $lastdgps, $dgpsid, @leftovers ) =
			     @fields;

		  # Is this good data?
		  if ( $qual && $#fields == 11 ) { # field count drops sometimes.
			( $lat, $long ) = parseicbm( $lat, $long );
			my $line = sprintf( "TP,D, %s%f, %s%f\n",
								$latd eq 'N' ? " " : "-", # N/S indicator
								$lat,
								$longd eq 'E' ? " " : "-", # E/W indicator
								$long
							  );
		  } else {
			print "Something up: F $#fields\n" if $#fields != 11;
		  }
		} elsif ( $datatype eq 'GLL' ) {
		  if ( defined( $fields[ 5 ])) {
			if ( $fields[ 5 ] eq 'A' ) {
			  my ( $lat, $long ) = parseicbm( $fields[ 0 ], $fields[ 2 ]);
			  $lat = -$lat if $fields[ 1 ] eq 'S';
			  $long = -$long if $fields[ 3 ] eq 'W';
			  # $fields[ 4 ] is the date of the fix.
			  $gga = sprintf( "TP,D, %f, %f\n", $lat, $long );
			} else {
			}
		  }
		} elsif ( $datatype eq 'GSA' ) {
		  #print "GPS DOP and active satellites\n";
		  # A/M - auto/manual
		  # 2/3 - 2D/3D fix
		  # 12 spaces for satellite PRNs
		  # PDOP (dilution of precision)
		  # HDOP
		  # VDOP
		  my $i = 0;
		  for my $f ( @fields ) {
			if ( $i == 0 ) {
			  #    print "Auto/Manual: ";
			} elsif ( $i == 1 ) {
			  #    print "2D/3D fix: ";
			} elsif ( $i == $#fields - 2 ) {
			  #    print "PDOP: ";
			} elsif ( $i == $#fields - 1 ) {
			  #    print "HDOP: ";
			} elsif ( $i == $#fields ) {
			  #    print "VDOP: ";
			} else {
			  if ( !defined( $satellites{$f})) {
				my $sat = new GPS::Satellite;
				$sat->PRN( $f );
				$satellites{$f} = $sat;
			  }
			  $i++;
			  next;
			}

			#print $f . ", ";
			$i++;
		  }
		  #print "\n";

		} elsif ( $datatype eq 'GSV' ) {
		  my ( $tot, $n, $nsats, $prn, $elev, $azim, $signal );
		  $tot = shift @fields;
		  $n = shift @fields;
		  $nsats = shift @fields;
		  #print "\n" if $n == 1; # extra blank line for first page
		  #print "  $nsats in view (p $n of $tot)\n";

		  while ( @fields ) {
			$prn = shift @fields;
			$elev = shift @fields;
			$azim = shift @fields;
			$signal = shift @fields;

			#print "  PRN: $prn Location: Elev. $elev deg, Az. $azim deg, Signal: $signal\n";
			my $sat = $satellites{$prn};
			$sat ||= new GPS::Satellite;
			$sat->PRN( $prn );
			$sat->elevation( $elev );
			$sat->azimuth( $azim );
			$sat->signal( $signal );
			$satellites{$prn} = $sat;

			# Draw the satellite power bar
			my ( $x, $y );
			$prn --;			# make it zero based
			$x = sprintf( "%d", $prn / 4 );
			$y = $prn % 4;
			$x *= 50;
			$y *= 19;
			$y++;
			$canvas2->delete( "PRN$prn" );
			$canvas2->createRectangle( $x, $y, $x + 50, $y + 19, "-fill", "white", "-width", "1", "-outline", "black", -tag => "PRN$prn" );
			$canvas2->createRectangle ( $x, $y, $x + ($signal/2), $y + 19, "-fill", "green", "-outline", "black", -tag => "PRN$prn" );

			# Blirj
			if ( !$canvas2->find( "withtag", "oval" )) {
			  $canvas2->createOval( 420, 0, 500, 80, -outline => "black", -tag=>"oval" );
			}
			my $foo = $elev * 40 / 90;
			$azim += 90;
			$azim = $azim * 3.14159 / 180;
			$canvas2->createLine( 460, 40, 460 + sin( $azim + 90 ) * $foo, 40 + cos( $azim + 90 ) * $foo, -fill => "black", -tag => "PRN$prn" );
		  }
		} elsif ( $datatype eq 'RMB' ) {
		  #print "Recommended Minimum Navigation Information\n";
		  # A/V okay/warning
		  # cross track error, nautical miles
		  # directon to steer
		  # origin waypoint ID
		  # destination waypoint ID
		  # dest lat   DDMM.MM,N/S
		  # dest long  DDMM.MM E/W
		  # Range to dest, nautical
		  # true bearing to dest
		  # velocity towards dest
		  # A/V arrival alarm
		} elsif ( $datatype eq 'RMC' ) {
		  $_ = $gga;
		  $runit = 1 if $gga;
		  $gga = "";
		  #print "--\n"; # This is the first thing in a packet. Waypoints is the last, FWIW.
		  #print "Recommended minimum specific GPS/Transit data\n";
		  my ( $time, $valid, $lat, $long, $speed, $coursegood, $coursetrue,
			   $date, $magdist, $magdir, @spare )= @fields;
		  if ( $valid eq "A" ) {
			# time HHMMSS UTC
			# A/V
			# LAT N/S
			# LONG E/W
			# Speed, Knots
			# Course Made Good, True
			# Date of fix DDMMYY
			# Magnetic Variation dist, dir
		  }
		} elsif ( $datatype eq 'RTE' ) {
		  #print "Waypoints in active route\n";
		  # Sentences of data
		  # sentence num
		  # c omplete, w first listed start of current leg
		  # route identifier
		  # Waypoint IDs
		} elsif ( $datatype eq 'BOD' ) {
		  #print "Origin to destination bearing\n";
		  # Bearing, T (true) from STart to Dest
		  # Bearing, M (magnetic)
		  # Dest
		  # Start
		} elsif ( $datatype eq 'WPL' ) {
		  $_ = $gga;
		  $runit = 1 if $gga;
		  $gga = "";
		} else {
		  print "ERROR! Unhandled data $datatype\n";
		  # wPL
		  # After WPL, punt to below
		}
	  }
	}
	return 1 unless $runit;
	$runit = 0;
  }

  # Starts with TP => Waypoint+ file
  if ( /^TP/ ) {
	my @bits = split( /\s*,\s*/ );
	my ( $py, $px ) = ( $bits[ 2 ], $bits[ 3 ]);
	my $altitude = $bits[ 6 ];
	updatewindow( $px, $py, $altitude, $error, undef );
  }

  # GPS Manager file:
  # % => comment
  # Blank line(s)
  # ! => parseable thing, specfically, ! T: NAME\t.* -> Track Log NAME
  if ( /^\!T:\s+(.*?)\t/ ) {
	# print "Mapping $1\n";
  }

  # \t DD-Mon-YYYY => datapoint
  if ( /^\t\d{2}-[a-z]{3}-\d{4}\s+\d{2}:\d{2}:\d{2}\s+(.*)$/i ) {
	my ( $date, $time, $latdeg, $latmin, $latsec, $longdeg, $longmin, $longsec,
	     $alt, $depth )
	  = split;

	( $dir, $lat ) = $latdeg =~ /^(.)(.+)$/;
	$lat = $lat + $latmin / 60;
	$lat = $lat + $latsec / 3600;
	$lat = - $lat if $dir eq 'S';

	( $dir, $long ) = $longdeg =~ /^(.)(.+)$/;
	$long = $long + $longmin / 60;
	$long = $long + $longsec / 3600;
	$long = - $long if $dir eq 'W';

	updatewindow( $long, $lat, $alt, 1, undef );
  }

  # GPSMan also has a track export format:
  # T\tDD-Mon-YYYY HH:MI:SS\tlat\tlong
  if ( /^T\t\d{2}-\w{3}-\d{4}\s\d{2}:\d{2}:\d{2}\t(.*?)\t(.*)/ ) {
	$lat = $1;
	$long = $2;
	updatewindow( $long, $lat, undef, 1, undef );
  }

  return 1;
}

sub updatewindow {
  my ( $px, $py, $ph, $error, $verror ) = @_;
  $ph ||= 0;
  my $filename = $mapsrv->fetchmap( sprintf( "%.4f", $py ), sprintf( "%.4f", $px ));

  # Create the image
  my $img;
  eval {
	if ( defined( $filename )) {
	  if ( !grep /^$filename$/, keys %imageFiles ) {
		$img = $main->Photo( "$filename", -file => "$filename" );
		$imageFiles{$filename} = $img;
        push @imageFiles, $filename;
	  } else {
		$img = $imageFiles{ $filename }->[0];
        @imageFiles = grep !/^$filename$/, @imageFiles;
        $imageFiles{$filename} = $img;
        push @imageFiles, $filename;
	  }

	  # Stop Tk from falling over when you load too many images.
	  while( $#imageFiles  > 10 ) {
          $imageFiles{ $imageFiles[0] }->delete;
          delete $imageFiles{ $imageFiles[0] };
          print STDERR "Nuking image " . $imageFiles[0] . "\n";
          shift @imageFiles;
	  }

	  if ( !($lastmap = $canvas->find( "withtag", "$filename" ))) {
		my ( $scale, $y, $x ) = $filename =~ m/cache_(.*?)_(.*?)_(.*?)\.gif$/;
        if ( !defined( $scale )) {
            ( $y, $x ) = $filename =~ m/cache_(.*?)_(.*?)\.gif$/;
        }
		$x *= $mapsrv->xscale();
		$y *= $mapsrv->yscale();

		$lastmap = $canvas->createImage( $x, $y, -image => "$filename",
										 -tag => "$filename" );
	  } else {
		$canvas->itemconfigure( $lastmap, -state=>'normal');
	  }

      # push it down, down, down
      $canvas->lower( $lastmap );
	} else {
        print STDERR "No image for $px, $py\n";
	}
  };

  # Blob the map to show where we are.
  $px *= $mapsrv->xscale();
  $py *= $mapsrv->yscale();

  my ( $ex, $ey ) = ( 1, 1 );
  if ( $error > 1 ) {
	$ex = ( $error / 2 );
	$ey = ( $error / 2 );
  }

  if ( defined( $lastcreated )) {
	$canvas->itemconfigure( $lastcreated,
							-fill => ( $ph >= 0 ? 'green' : 'blue' ),
							-outline => undef );
  }
  $lastcreated = $canvas->createOval( $px - $ex, $py - $ey, $px + $ex ,
									  $py + $ey, -fill => 'red',
									  -outline => 'red',
									  -tag=>'p' );


  # clean up old crosshairs
#  my @crosshairs =  $canvas->find( "withtag", "crosshairs" );
#  if ( @crosshairs ) {
#      $canvas->delete( @crosshairs );
#  }

#  $canvas->createLine( $px, 0, $px, 480, "-fill", "black", "-width", "1",
#                       "-tag", "crosshairs" );
#  $canvas->createLine( 0, $py, 640, $py, "-fill", "black", "-width", "1",
#                       "-tag", "crosshairs" );

  $minx ||= $px;
  $miny ||= $py;
  $maxx ||= $px;
  $maxy ||= $py;
  $minx = $px - 50 if $px < $minx;
  $miny = $py - 50 if $py < $miny;
  $maxx = $px - 50 if $px > $maxx;
  $maxy = $py - 50 if $py > $maxy;

  # Centre on the current location, regardless
  @bounds = ( $px - ( $cwidth / 2 ), $py - ( $cheight / 2 ),
			  $px + ( $cwidth / 2 ), $py + ( $cheight / 2 ));

  $canvas->configure( -scrollregion => \@bounds );
  $canvas->update;
}

# Find boxes and other black-coloured stuff
sub findboxes {
  my $data = shift;
  my $image = GD::Image->new( $data );
  my ( $width, $height ) = $image->getBounds();

  my @colors;
  my %black;
  for my $x ( 0 .. $width - 1 ) {
	for my $y ( 0 .. $height - 1 ) {
	  my $index = $image->getPixel( $x, $y );
	  if ( !defined( $colors[ $index ])) {
		my ( $r, $g, $b ) = $image->rgb( $index );
		$colors[ $index ] = sprintf( "%02x%02x%02x", $r, $g, $b );
	  }

	  next if $colors[ $index ] ne "000000";
	  my $key = sprintf( "%03d_%03d", $x, $y );
	  $black{$key} = 1;
	}
  }

  # We have all the black spots. Now try and find boxes.
  my @boxes;
  my %save = %black;
  while ( %black ) {
	my $n = (sort ( keys %black ))[0];
	delete $black{ $n };
	my ( $x, $y ) = split( /_/, $n );

	my $tracing = 4;
	my ( $x1, $y1 ) = ( $x + 0, $y + 0 );
	my ( $x2, $y2 ) = ( $x1, $y1 );

	while ( $tracing ) {
	  my ( $ox, $oy ) = ( $x, $y );
	  if ( $tracing == 4 ) {
		$x++;
	  }
	  if ( $tracing == 3 ) {
		$y++;
	  }
	  if ( $tracing == 2 ) {
		$x--;
	  }
	  if ( $tracing == 1 ) {
		$y--;
	  }

	  $n = sprintf( "%03d_%03d", $x, $y );
	  if ( !defined( $black{ $n })) {
		$x = $ox;
		$y = $oy;
		$tracing--;
		next;
	  }

	  delete( $black{ $n });

	  $x1 = $x + 0 if ( $x < $x1 );
	  $x2 = $x + 0 if ( $x > $x2 );
	  $y1 = $y + 0 if ( $y < $y1 );
	  $y2 = $y + 0 if ( $y > $y2 );
	}

	if (( $x2 - $x1 ) * ( $y2 - $y1 ) > 10 ) {
	  push @boxes, [ $x1, $y1, $x2, $y2 ];
	}
  }

  %black = %save;

  [ \@boxes, \%black ];
}

END {
  # make sure this gets flushed
  close( NMEAFILE );
}

sub opengps {
  my $device = shift;

  # FIXME $device should be /dev/foo, and this code should cope
  # accordingly.
  $LOCKFILE = "/var/lock/LCK..$device";

  # stat the lockfile, open it, check the process ID, check if
  # the process is still running, nuke the lockfile if it's not.
  if ( -f $LOCKFILE ) {
	if ( open( LOCKFILE, "<$LOCKFILE" )) {
	  my $pid = <LOCKFILE>;
	  chomp $pid;
	  if ( kill 0, $pid ) {
		# process still running
		die "$origdev is locked by process $pid";
	  }
	  close( LOCKFILE );
	  unlink( $LOCKFILE );
	} else {
	  die "Can't open lockfile for $origdev: $!";
	}
  }

  $port = new Device::SerialPort( "/dev/$device", 1, $LOCKFILE );

  if ( !$port ) {
	die "Failed to open port: $!\n";
  }

  # now set up the port
  $port->baudrate( 4800 );
  $port->parity( "none" );
  $port->databits( 8 );
  $port->stopbits( 1 );
  $port->handshake( "none" );

  $port->alias( "gps" );

  $port;
}

sub closegps {
  if ( ref( $port )) {
	$port->close;
  }
  unlink $LOCKFILE;
  undef $port;
}

# Local Variables: ***
# time-stamp-start:"Last Modified:[     ]+" ***
# time-stamp-end: "$" ***
# time-stamp-format:"Waider / %02d/%02m/%:y" ***
# End: ***