#!/usr/bin/perl -w
# Melchior FRANZ <mfranz # aon : at>
# $Id: signs,v 1.37 2005/06/01 15:53:00 m Exp $

use strict;
use IO::Socket;
#use POSIX qw(nice);
use Cwd;
# for WIN32
use Win32::Console::ANSI;

my $def_fg_root = "C:\\FG\\27\\data";
my $def_fg_rt = 'C:\FG\27\bin';

my $fg_binary = 'flightgear';

if (! chdir($def_fg_rt) ) {
    die "ERROR: Unable to change to $def_fg_rt ...\n";
}
my $cwd = cwd();
my $HOME = $ENV{HOME} || ".";
my $FG_HOME = $ENV{FG_HOME} || $HOME . "/.fgfs";
my $FG_ROOT = $ENV{FG_ROOT} || $def_fg_root;
my $BASEDIR = "$FG_ROOT/Local/signs";

my $FGFS = $fg_binary;
my $HOST = "localhost";
my $PORT = 5500;

my $INTERVAL = 1;
my $HOTLISTSIZE = 500;
my $RESORTDIST = 0.00005;
my @COLOR = ("31;1", "31", "32", "", "36;1");
my $USECOLOR = 0;
my $MAXNUMSIGNS;
my $NUMSIGNS;

my $help = <<EOF;
Usage:
	signs [-q] [-v] [[+d|-d] <data-path>] [-o <path>] [-r <range>] [-c|<fgfs options>]

	-h  ... output this help screen
	-q  ... suppress messages
	-v  ... verbose
	-d  ... replace file list with file or all files in a directory
	+d  ... add data source (file or directory) to database file list
	-r  ... keep only locations within this km-range in memory
	-o  ... write list of all locations in memory, sorted by distance
	-c  ... generate textures for all locations and exit

	<data-path> may be just -, which makes -d- just clear the file list


Examples:
	\$ signs -r1000 --aircraft=ufo --airport=LOWL

Environment:
	SIGNS ... options in this variable are prepended to the argument list

Files:
	signsrc

Comments:
	The "signs" program reads all files in the "data" directory. You can accelerate
	the script by loading less locations. This can be done by creating extra
	directories in \$FG_ROOT/Local/signs/ and putting your favorite data files
	there (or links to files in data/), as well as stripped down airport lists.
	signs can then be told to use this directory instead of data/.
	For example, Austrians might want to organize their data like this:

		\$ cd \$FG_ROOT/Local/signs
		\$ mkdir Austria

	# write a selection of airports within 500 km range
	# and add the Austrian location database

		\$ ./signs -r500 -o./Austria/nearby_airports
		\$ cp /download/austria.gz ./Austria/

	# now use these nearby airports and Austrian locations

		\$ ./signs -d Austria --aircraft=b1900d --airport=LOXT

	# You can also put "-d Austria" into the configuration file.
	# Here's how you can create a selection of European airports
	# (including Israel and Turkey):

		\$ zgrep " [EL][A-Z][A-Z][A-Z] " ./data/airports > ./Europe/airports
		\$ gzip ./Europe/airports	# optional
EOF


my $PI = 3.1415926535897932384626433832795029;
my $D2R = $PI / 180;
my $R2D = 180 / $PI;
my $ERAD = 6378138.12;
my $FGFS_IO;

my $ERR = 0;
my $WARN = 1;
my $INFO = 2;
my $BULK = 3;
my $DEBUG = 4;
my $VERBOSITY = $DEBUG;

my @FILES;
my $RANGE;
my $DUMP;
my $FILL = 1;   # build a cache of signs ...
my $CONFIGFILE;
my $APT;
my @APTCONF;
my @FORMAT;
my @LOC;
my @SIGNS;
my $ccnt = 0;
my $mcnt = 0;

sub main() {
	$NUMSIGNS = $MAXNUMSIGNS = grep /\/sign\d+\.xml$/, ls($BASEDIR);
	read_config();
	@FILES = ls("$BASEDIR/data");
	my @fgfsargs = parse_options();
	&log($INFO, "config file: $CONFIGFILE") if defined $CONFIGFILE;
	read_data(\@FILES);
	&log(@LOC ? $INFO : $WARN, scalar(@LOC) . " locations in data base");
	@LOC or exit 0;

	foreach ("$BASEDIR/cache", "$BASEDIR/cache/A", "$BASEDIR/cache/B", "$BASEDIR/cache/C") {
		-d or mkdir $_ or fatal("can't create directory '$_'");
	}

    $mcnt = scalar @LOC;
	if ($FILL) {
        # 0    1    2    3     4  5  6  7     8       9
    	# typ, lon, lat, elev, x, y, z, name, distsq, filenum
		create_sign(@$_[0, 7, 9]) foreach @LOC;
#        my $cnt = 0;
#        foreach (@LOC) {
#            create_sign(@$_[0, 7, 9]);
#            $cnt++;
#            last if ($cnt > 10);
#        }
		exit 0;
	}

	if (my $pid = fork) {
		# nice(20);
		main_loop();
	} else {
		defined $pid or fatal("cannot fork: $!");
		exec("$FGFS --telnet=$PORT --config=$BASEDIR/signs.xml @fgfsargs");
	}
	exit 0;
} main;


sub read_config() {
	foreach ("$FG_HOME/signsrc", "$HOME/.signsrc", "$BASEDIR/signsrc") {
		$CONFIGFILE = $_ and last if -f $_;
	}
	return unless defined $CONFIGFILE;
	open(C, '<', $CONFIGFILE) || fatal("can't open config file $CONFIGFILE");
	while (<C>) {
		chomp;
		s/\s*#.*//;
		/^\s*$/ and next;
		if (/^([A-Z])\s+(\w+)\s+(\S+)\s+(.*)\s*$/) {
			my ($type, $tag, $regex) = ($1, $2, $3);
			my ($color, $font, $size, $encoding);
			foreach (split /\s+/, $4) {
				if (/^color=(.*)/) {
					$color = $1;
				} elsif (/^font=(.*)/) {
					$font = $1;
				} elsif (/^size=(.*)/) {
					$size = $1;
				} elsif (/^encoding=(.*)/) {
					$encoding = $1;
				} else {
					fatal("config file $CONFIGFILE contains garbage in line $.: '$_'");
				}
			}
			push @FORMAT, [$type, $tag, $regex, $color, $font, $size, $encoding];
		} elsif (/^\s*(\S+)\s*:\s*(.*)\s*$/) {
			push @APTCONF, [$1, split /\s+/, $2];
		} else {
			unshift @ARGV, split;
		}
	}
	close C || fatal("can't close config file $CONFIGFILE");
}


sub parse_options() {
	my @args = ();
	sub argument {
		map { return $_ if defined $_ and $_ ne "" } @_;
		shift @ARGV;
		return $ARGV[0];
	}
	unshift @ARGV, split /\s+/, $ENV{'SIGNS'} if defined $ENV{'SIGNS'};
	while (1) {
		$_ = $ARGV[0];
		if (not defined $_) {
			if (not defined $APT) {
				$_ = "--airport=KSFO";
			} else {
				last;
			}
		}

		if (/^--$/) {
			shift @ARGV;
			push @args, @ARGV;
			@ARGV = ();

		} elsif (/^-o(.*)/) {
			my $path = argument($1);
			defined $path or fatal("-o option lacks <path> argument");
			$path =~ s/^~\//$HOME\//;
			$DUMP = $path;

		} elsif (/^-r(.*)/) {
			$RANGE = argument($1) * 1000;
			defined $RANGE or fatal("-r option lacks number argument (range in km)");

		} elsif (/^([-+])d(.*)/) {
			@FILES = () if $1 eq "-";
			my $path = argument($2);
			defined $path or fatal("-d option lacks <path> argument");
			if ($path eq "-") {
				@FILES = ();
			} else {
				$path =~ s/^~\//$HOME\//;
				$path = "$BASEDIR/$path";
				if (-d $path) {
					push @FILES, ls($path);
				} elsif (-f $path) {
					push @FILES, $path;
				} else {
					fatal("-d: argument '$path' is neither a file, nor a directory");
				}
			}

		} elsif (/^-c$/) {
			$FILL = 1;

		} elsif (/^-(v+)$/) {
			$VERBOSITY += length($1);

		} elsif (/^-q$/) {
			$VERBOSITY = 0;

		} elsif (/^-h$/) {
			print $help;
			exit 0;

		} elsif (/^-V$/) {
			($_ = '$Revision: 1.37 $') =~ s/.*(\d+\.\d+).*/print "$1\n"/e;
			exit 0;

		} elsif (/^(--airport=)(.*)$/) {
			$APT = uc($2);
			push @args, $1 . $APT;
			shift @ARGV;
			foreach (@APTCONF) {
				my ($regex, @x) = @$_;
				unshift @ARGV, @x and last if $2 =~ /$regex/i;
			}
			next;

		} else {
			push @args, $_;
		}
		shift @ARGV;
	}
	return @args;
}


sub read_data($) {
	my $files = shift;
	my %nodup;
	foreach (@$files) {
		/README|CVS/ and next;
		#/^\// or $_ = "$ENV{PWD}/" . $_;
		#/^\// or $_ = $cwd."/" . $_;
		$nodup{$_} = ":-P";
	}
	@$files = keys %nodup;

	my $i = 0;
	foreach (@$files) {
		##open(N, /\.gz$/ ? "gunzip -c $_|" : "<$_") or fatal("can't open file $_: $!");
		open(N, /\.gz$/ ? "gzip -d -c $_|" : "<$_") or fatal("can't open file $_: $!");
		&log($INFO, "reading data: $_ ($i)");
		foreach (<N>) {
			chomp;
			s/\s*#.*//;
			# type, lon, lat, elev, name
			/^(.)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)/ or next;

            #           0    1    2    3                   4  5  6         7     8       9
			#           typ, lon, lat, elev,               x, y, z,        name, distsq, filenum
			push @LOC, [$1,  $2,  $3, ($4 - 600) / 0.3048, ll2xyz($2, $3), $5,   -1,     $i];
		}
		close N or fatal("can't close file $_: $!");
		$i++;
	}
}


sub main_loop() {
	$FGFS_IO = fgfs_connect($HOST, $PORT, 120) || die " can't open socket\n";
	fgfs_send("data");

	my ($oldlon, $oldlat);
	fgfs_get_coord(\$oldlon, \$oldlat) or return 0;
	my ($oldx, $oldy, $oldz) = ll2xyz($oldlon, $oldlat);
	sort_locations($oldx, $oldy, $oldz, \@LOC);
	if (defined $RANGE) {
		my $i;
		for ($i = 0; $i < @LOC; $i++) {
			#last if $ERAD * sqrt ${@{$LOC[$i]}}[8] >= $RANGE;
			last if ($ERAD * sqrt( $LOC[$i][8] )) >= $RANGE;
		}
		$i = $MAXNUMSIGNS if $i < $MAXNUMSIGNS;
		@LOC = @LOC[0 .. $i - 1];
	}
	if (defined $DUMP) {
		&log($INFO, "dumping data: $DUMP (" . scalar(@LOC) . " entries)");
		open(D, ">$DUMP") || fatal("can't write to file $DUMP: $!");
		print D (join " ", @$_[0, 1, 2, 3, 7]) . "\n" foreach @LOC;
		close D || fatal("can't close file $DUMP: $!");
	}

	$HOTLISTSIZE = @LOC if $HOTLISTSIZE > @LOC;
	my @hotlist = @LOC[0 .. $HOTLISTSIZE - 1];

	fgfs_set("/sim/rendering/signs/signs-max", $MAXNUMSIGNS) or return;
	fgfs_set("/sim/rendering/signs/locations-max", scalar @LOC) or return;

	for (my $i = 0;; $i++) {
		sleep $INTERVAL;
		my ($lon, $lat);
		fgfs_get_coord(\$lon, \$lat) or last;
		my ($x, $y, $z) = ll2xyz($lon, $lat);

		if (coord_dist_sq($x, $y, $z, $oldx, $oldy, $oldz) > $RESORTDIST) {
			&log($INFO, "re-sorting");
			sort_locations($x, $y, $z, \@LOC);
			@hotlist = @LOC[0 .. $HOTLISTSIZE - 1];
			($oldlon, $oldlat, $oldx, $oldy, $oldz) = ($lon, $lat, $x, $y, $z);
			&log($INFO, "done");
		} else {
			my $n;
			fgfs_get("/sim/rendering/signs/number", \$n) or last;
			$n = $MAXNUMSIGNS if $n > $MAXNUMSIGNS;
			if ($n != $NUMSIGNS) {
				@SIGNS = [];
				$NUMSIGNS = $n;
			}
			fgfs_get("/sim/rendering/signs/interval", \$INTERVAL) or last;
			fgfs_get("/sim/rendering/signs/hotlist-size", \$HOTLISTSIZE) or last;
			fgfs_get("/sim/rendering/signs/resort-dist", \$RESORTDIST) or last;
			$INTERVAL = 1 if $INTERVAL < 1;
			$HOTLISTSIZE = 1 if $HOTLISTSIZE < 1;
			$HOTLISTSIZE = @LOC if $HOTLISTSIZE > @LOC;
			$RESORTDIST = 0.000001 if $RESORTDIST < 0.000001;
			$NUMSIGNS = @LOC if $NUMSIGNS > $HOTLISTSIZE;
			sort_locations($x, $y, $z, \@hotlist);
			names_show_next(@hotlist[0 .. $NUMSIGNS - 1]);
		}
	}

	fgfs_send("quit");
	close $FGFS_IO;
	undef $FGFS_IO;
}


sub sort_locations($$$$) {
	my ($x, $y, $z, $list) = @_;
    # 0    1    2    3     4  5  6  7     8       9
  	# typ, lon, lat, elev, x, y, z, name, distsq, filenum
	map { $$_[8] = coord_dist_sq($x, $y, $z, @$_[4], @$_[5], @$_[6]) } @$list;
	### map { $$_[8] = coord_dist_sq($x, $y, $z, @$_[4, 5, 6]) } @$list;
	@$list = sort { $$a[8] <=> $$b[8] } @$list;
}


sub names_show_next(@) {
	my %request;
	map { $request{join ":", @$_[7, 1, 2]} = $_ } @_;
	foreach (0 .. $NUMSIGNS - 1) {
		next unless defined $SIGNS[$_];
		if (exists $request{$SIGNS[$_]}) {
			delete $request{$SIGNS[$_]};
		} else {
			delete $SIGNS[$_];
		}
	}
	sub find_free() { map { defined $SIGNS[$_] or return $_ } (0 .. $NUMSIGNS - 1) };
	foreach (values %request) {
		my ($type, $lon, $lat, $elev, $label, $filenum) = @$_[0, 1, 2, 3, 7, 9];
		my $i = find_free;
		$SIGNS[$i] = "$label:$lon:$lat";

		my $texture = create_sign($type, $label, $filenum);
		fgfs_set("/sim/rendering/signs/sign[$i]/texture", $texture) or return;
		fgfs_set("/sim/rendering/signs/sign[$i]/elevation-ft", $elev) or return;
		fgfs_set("/sim/rendering/signs/sign[$i]/longitude-deg", $lon) or return;
		fgfs_set("/sim/rendering/signs/sign[$i]/latitude-deg", $lat) or return;
	}
}


sub convert($@) {
	my $file = shift;
	system (
		"convert",
		"-size", "1024x128",
		"xc:none",
		"-gravity", "center",
		@_,
		"-compress", "RLE",
		"SGI:$file",
	);
}


sub create_sign($$$) {
	my $type = shift;
	my $location = shift;
	my $filenum = shift;

	my ($color, $font, $size, $encoding);
	my $tag = "";

	foreach (@FORMAT) {
		my @x = @$_;
		if ($type eq $x[0] and $FILES[$filenum] =~ /$x[2]/) {
			($tag, $color, $font, $size, $encoding) = @x[1, 3, 4, 5, 6];
			$tag = '/' . $tag;
			last;
		}
	}

	my $dir = "cache/$type$tag";
	-d "$BASEDIR/$dir" or mkdir "$BASEDIR/$dir" or fatal("can't create directory $BASEDIR/$dir");

	my $file = $location;
	$file =~ y/ /_/;
	$file =~ s/(\W)/"%" . uc(unpack("H2", $1))/ge;
	$file = "$dir/$file.rgb";

	my $path = "$BASEDIR/$file";
	my $db = $FILES[$filenum];
	$db =~ s/.*\/(.*)(\.gz)?/$1/;

    $ccnt++;

	&log($INFO, "$ccnt of $mcnt: \033[32;1mcached:  \033[m $file ($db)") and return $file if -f $path;
	&log($INFO, "$ccnt of $mcnt: \033[31;1mcreating:\033[m $file ($db)");

	defined $font or $font = "Helvetica-Bold";
	defined $encoding or $encoding = "None";

    $font = 'C:\WINDOWS\Fonts\Verdana.TTF';
	$location =~ s/'/\\'/g;
	if ($type eq "A") {		# airport
		my ($id, $name) = split / /, $location, 2;
		defined $color or $color = "green";
		defined $size or $size = "60";
		my $small = $size * 4 / 5;
		my $h = $size / 2;
		convert($path,
			"-encoding", $encoding,
			"-font", $font,
			"-fill", $color,
			"-pointsize", $size,
			"-draw", "text 0,-$h '$name'",
			"-pointsize", $small,
			"-draw", "text 0,$h '($id)'"
		);
	} elsif ($type eq "B") {	# bridge/object
		defined $color or $color = "red";
		defined $size or $size = "50";
		convert($path,
			"-encoding", $encoding,
			"-font", $font,
			"-fill", $color,
			"-pointsize", $size,
			"-draw", "text 0,0 '$location'"
		);
	} elsif ($type eq "C") {	# city/location
		defined $color or $color = "blue";
		defined $size or $size = "50";
		convert($path,
			"-encoding", $encoding,
			"-font", $font,
			"-fill", $color,
			"-pointsize", $size,
			"-draw", "text 0,0 '$location'"
		);
	} else {
		die "unknown type '$type' in database";
	}
	return $file;
}


sub fgfs_get_coord($$) {
	my $lon = shift;
	my $lat = shift;
	fgfs_get("/position/longitude-deg", $lon) or exit -2;
	fgfs_get("/position/latitude-deg", $lat) or exit -2;
	return 1;
}


END {
	if (defined $FGFS_IO) {
		fgfs_send("quit");
		close $FGFS_IO;
	}
}


sub fgfs_connect() {
	my $host = shift;
	my $port = shift;
	my $timeout = (shift || 120);
	my $socket;
	STDOUT->autoflush(1);
	print "connect ";
	while ($timeout--) {
		if ($socket = IO::Socket::INET->new(
				Proto => 'tcp',
				PeerAddr => $host,
				PeerPort => $port)) {
			print ".. done.\n";
			$socket->autoflush(1);
			sleep 1;
			return $socket;
		}	
		print ".";
		sleep(1);
	}
	return 0;
}


sub fgfs_get() {
	fgfs_send("get " . shift);
	eof $FGFS_IO and return 0;
	my $val = shift;
	$$val = <$FGFS_IO>;
	$$val =~ s/\015?\012$//;
	$$val =~ /^-ERR (.*)/ and (&log($WARN, "$1") and return 0);
	return 1;
}


sub fgfs_set() {
	my $prop = shift;
	my $value = shift;
	fgfs_send("set $prop $value");
}


sub fgfs_send() {
	print $FGFS_IO shift, "\015\012";
}


sub ll2xyz($$) {
	my $lon = (shift) * $D2R;
	my $lat = (shift) * $D2R;
	my $cosphi = cos $lat;
	my $di = $cosphi * cos $lon;
	my $dj = $cosphi * sin $lon;
	my $dk = sin $lat;
	return ($di, $dj, $dk);
}


sub xyz2ll($$$) {
	my ($di, $dj, $dk) = @_;
	my $aux = $di * $di + $dj * $dj;
	my $lat = atan2($dk, sqrt $aux) * $R2D;
	my $lon = atan2($dj, $di) * $R2D;
	return ($lon, $lat);
}


sub coord_dist_sq($$$$$$) {
	my ($xa, $ya, $za, $xb, $yb, $zb) = @_;
	my $x = $xb - $xa;
	my $y = $yb - $ya;
	my $z = $zb - $za;
	return $x * $x + $y * $y + $z * $z;
}


sub ls($) {
	my $dir = shift;
	$dir =~ s/\/*$//;
	opendir(D, $dir) || fatal("can't open directory $dir: $!");
	@_ = grep { !/^\./ && -f "$dir/$_" && s,^,$dir/, } readdir D;
	closedir(D) || fatal("can't close directory $dir: $!");
	return @_;
}


sub fatal() {
	&log($ERR, "$0: @_");
	exit -1;
}


sub log() {
	my $v = shift;
	return if $v > $VERBOSITY;
	$v = 4 if $v > 4;
	print "\033[$COLOR[$v]m" if $USECOLOR;
	print "@_";
	print "\033[m" if $USECOLOR;
	print "\n";
}


