Generated: Sun Apr 15 11:46:13 2012 from fg_test.pl 2011/09/30 8.7 KB.
#!/usr/bin/perl -w # NAME: fg_test.pl # AIM: Just a test module # 24/09/2011 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; use Term::ReadKey; use Time::HiRes qw( usleep gettimeofday tv_interval ); use GeoCoord; # ================================== my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; require 'lib_fgio.pl' or die "Unable to load 'lib_fgio.pl'! Chech paths in \@INC...\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; require "Bucket2.pm" or die "Unable to load Bucket2.pm ...\n"; require "Bucket.pm" or die "Unable to load Bucket.pm ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2011-09-26"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $debug_on = 0; my $def_file = 'def_file'; my $add_old_bucket_code = 0; # constants my $MPS2KNOT = 1.9438444924406; # Knots my $FG_FEET_TO_METER = 0.3048; my $FG_METER_TO_FEET = 3.28083989501312335958; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { ### prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; fgfs_disconnect(); if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub prtt($) { my $txt = shift; prt(lu_get_hhmmss_UTC(time()).": $txt"); } sub local_got_keyboard($) { my ($rc) = shift; if (defined (my $char = ReadKey(-1)) ) { # input was waiting and it was $char ${$rc} = $char; return 1; } return 0; } sub get_lat_y_lon_x($) { my $index = shift; my ($lon, $lat, $x, $y); $lon = $index >> 14; $index -= $lon << 14; $lon -= 180; $lat = $index >> 6; $index -= $lat << 6; $lat -= 90; $y = $index >> 3; $index -= $y << 3; $x = $index; return ($lon,$lat,$y,$x); } sub run_test() { my $lat = 20; #-33.916294; my $lon = 30; #151.251097; my $alt = 17 * $FG_METER_TO_FEET; # feet my $cp = GeoCoord->new(); $cp->lat($lat); $cp->lon($lon); $cp->alt($alt); my $mets = $alt * $FG_FEET_TO_METER; my @expect = (5192560.45994985, 2997926.17933545, 2167702.60217119); my @sgtest = (5192560.45994985, 2997926.17933545, 2167702.60217119); my $x = $cp->get_x(); my $y = $cp->get_y(); my $z = $cp->get_z(); prt( "$lat $lon $mets = $x $y $z\n"); prt( "$lat $lon $mets = $expect[0] $expect[1] $expect[2] EXPECTED\n"); my @cart = ($x, $y, $z); my @geod = (0,0,0); my ($ilon,$ilat,$iy,$ix); my $cp2 = GeoCoord->new(); $cp2->set_x($x); $cp2->set_y($y); $cp2->set_z($z); my ($lat2,$lon2,$alt2,$met2); $lat2 = $cp2->lat(); $lon2 = $cp2->lon(); $alt2 = $cp2->alt(); $met2 = $alt2 * $FG_FEET_TO_METER; prt( "$lat2 $lon2 $met2 from $x $y $z\n"); my $course = 90; my $dist = 70000; $cp2->apply_course_distance($course,$dist); $lat2 = $cp2->lat(); $lon2 = $cp2->lon(); $alt2 = $cp2->alt(); $met2 = $alt2 * $FG_FEET_TO_METER; prt( "course $course, for $dist meters = $lat2 $lon2 $met2\n"); $cp->apply_course_distance2($course,$dist); $lat2 = $cp->lat(); $lon2 = $cp->lon(); $alt2 = $cp->alt(); $met2 = $alt2 * $FG_FEET_TO_METER; prt( "course $course, for $dist meters = $lat2 $lon2 $met2\n"); $lat2 = $cp2->lat(); $lon2 = $cp2->lon(); $alt2 = $cp2->alt(); prt("Bucket information for $lat2,$lon2...\n"); my ($b,$ind1,$ind2,$clat1,$clon1,$clat2,$clon2); $b = Bucket2->new(); $b->set_bucket($lon2,$lat2); # NOTE lon,lat order ;=() $ind1 = $b->gen_index(); $ind2 = $cp->tile_index($lat2,$lon2); prt("Bucket index: Bucket2 $ind1 GeoCoord $ind2 for $lat2 $lon2"); if ($ind1 == $ind2) { prt(" SAME.\n"); } else { prt(" DIFFERENT.\n"); $b->set_bucket_per_index($ind1); $clat1 = $b->get_center_lat(); $clon1 = $b->get_center_lon(); $b->set_bucket_per_index($ind2); $clat2 = $b->get_center_lat(); $clon2 = $b->get_center_lon(); prt("Index [$ind1] $clat1 $clon1 [$ind2] $clat2 $clon2\n"); } $lon2 *= -1; $lat2 *= -1; $b->set_bucket($lon2,$lat2); # NOTE lon,lat order ;=() $ind1 = $b->gen_index(); $ind2 = $cp->tile_index($lat2,$lon2); prt("Bucket index: Bucket2 $ind1 GeoCoord $ind2 for $lat2 $lon2"); if ($ind1 == $ind2) { prt(" SAME.\n"); } else { prt(" DIFFERENT.\n"); $b->set_bucket_per_index($ind1); $clat1 = $b->get_center_lat(); $clon1 = $b->get_center_lon(); $b->set_bucket_per_index($ind2); $clat2 = $b->get_center_lat(); $clon2 = $b->get_center_lon(); prt("Index [$ind1] $clat1 $clon1 [$ind2] $clat2 $clon2\n"); } $lon2 = -20; $lat2 = -20; $b->set_bucket($lon2,$lat2); # NOTE lon,lat order ;=() $ind1 = $b->gen_index(); $ind2 = $cp->tile_index($lat2,$lon2); prt("Bucket index: Bucket2 $ind1 GeoCoord $ind2 for $lat2 $lon2"); if ($ind1 == $ind2) { prt(" SAME.\n"); } else { prt(" DIFFERENT.\n"); $b->set_bucket_per_index($ind1); $clat1 = $b->get_center_lat(); $clon1 = $b->get_center_lon(); $b->set_bucket_per_index($ind2); $clat2 = $b->get_center_lat(); $clon2 = $b->get_center_lon(); prt("Index [$ind1] $clat1 $clon1 [$ind2] $clat2 $clon2\n"); } if ($add_old_bucket_code) { my $ob = Bucket->new(); $ob->set_bucket($lon2,$lat2); $ind1 = $ob->gen_index(); $ind2 = $cp->tile_index($lat2,$lon2); prt("Bucket index: Bucket $ind1 GeoCoord $ind2 for $lat2 $lon2"); if ($ind1 == $ind2) { prt(" SAME.\n"); } else { prt(" DIFFERENT.\n"); $ob->set_bucket_per_index($ind1); $clat1 = $ob->get_center_lat(); $clon1 = $ob->get_center_lon(); $ob->set_bucket_per_index($ind2); $clat2 = $ob->get_center_lat(); $clon2 = $ob->get_center_lon(); prt("Index [$ind1] $clat1 $clon1 [$ind2] $clat2 $clon2\n"); } } } ######################################### ### MAIN ### ###parse_args(@ARGV); run_test(); pgm_exit(0,""); ######################################## sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /v/) { if ($sarg =~ /v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } shift @av; } } # eof - fg_f14b.pl