Generated: Sat Oct 24 16:35:28 2020 from show-bucket.pl 2018/06/21 25.6 KB. text copy
# Testing my Bucket.pm # 2018-06-10 - Add simple xg output # 2016-11-11 - Add bucket path showing # 08/03/2013 - Change from 'use Bucket', which only searches 'system' fodlers, to 'require Bucket; # 06/08/2011 - Some updates # 23/05/2011 - Allow more input styles # 13/08/2010 - Changed to new idea for UI # 06/06/2010 - some improvement in the UI # 11/03/2009 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; ####require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file and some other utility subs require "Bucket.pm" or die "Unable to load Bucket.pm ...\n"; my $VERS = "0.0.5 - 2018-06-10"; # updated version #my $VERS = "0.0.4 - 2013-03-08"; # updated version #my $VERS = "0.0.3 - 2011-08-06"; # updated version #my $VERS = "0.0.2 - 2010-06-06"; # original version # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_base = 'C:\GTools\perl'; my $outfile = $perl_base."\\temp.$pgmname.txt"; open_log($outfile); # prt( "$pgmname ... Hello, World...\n" ); my $SG_BUCKET_SPAN = 0.125; my $NO_LAT_LON = -1000; my $load_log = 0; my $show_indexes = 0; my $show_all = 0; my $show_all_1x1 = 0; my $show_buckets = 0; my $xg_out = ''; my $MIN_LON = 150; my $MAX_LON = 154; my $MIN_LAT = -37; my $MAX_LAT = -30; my ($b, $b2); my ($ac); my ($item1, $item2, $item3, $item4); my $buck_index = -1; my $buck_lat = $NO_LAT_LON; my $buck_lon = $NO_LAT_LON; my $buck_index2 = -1; my $buck_lat2 = $NO_LAT_LON; my $buck_lon2 = $NO_LAT_LON; my $use_old_UI = 0; my $verbosity = 0; sub VERB1() { return ($verbosity >= 1); } sub VERB2() { return ($verbosity >= 1); } sub VERB5() { return ($verbosity >= 1); } sub VERB9() { return ($verbosity >= 1); } # DEBUG my $debug_on = 0; my $dbg01 = 0; # show arguments... my $dbg02 = 0; # show bucket processing... my $dbg03 = 0; # show NO 2nd bucket ### program variables my @warnings = (); my %bucket_paths = (); my $xg_string = ''; sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { 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 get_bucket_center_txt($) { my ($b) = shift; my $txt = " center: ".$b->get_center_lon().",".$b->get_center_lat(); return $txt; } sub show_bucket_center($) { my ($b) = shift; prt( " ".get_bucket_center_txt($b)."\n" ); } sub add_bucket_xg($) { my ($b) = shift; my ($clon,$clat); $clon = $b->get_center_lon(); $clat = $b->get_center_lat(); my $xg = "# ".$b->bucket_info()."\n"; my $index = $b->gen_index(); #if ($show_buckets) { $xg .= "anno $clon $clat $index\n"; #} else { # $xg .= "anno $clon $clat ".$b->bucket_info()."\n"; #} my $bgn = ''; for (my $i = 0; $i < 4; $i++) { my ($lon,$lat) = $b->get_corner($i); if ($i == 0) { $bgn = "$lon $lat ; BL\n"; $xg .= $bgn; } elsif ($i == 1) { $xg .= "$lon $lat ; BR\n"; } elsif ($i == 2 ) { $xg .= "$lon $lat ; TR\n"; } else { $xg .= "$lon $lat ; TL\n"; } } $xg .= $bgn; $xg .= "NEXT\n"; $xg_string .= $xg; } sub show_bucket($) { my ($b) = shift; add_bucket_xg($b); prt( "lon:lat:x:y:base_path/index = " ); prt( $b->bucket_info() ); show_bucket_center($b); prt( "Corners:" ); for (my $i = 0; $i < 4; $i++) { my ($lon,$lat) = $b->get_corner($i); prt( " $i:" ); if ($i == 0) { prt( "BL" ); } elsif ($i == 1) { prt( "BR" ); } elsif ($i == 2 ) { prt( "TR" ); } else { prt( "TL" ); } prt( ": $lon,$lat" ); } prt("\n"); prt( "Width ".$b->get_width_m().", Height ".$b->get_height_m()." meters. " ); my $path = $b->gen_base_path(); $bucket_paths{$path} = 1; my @arr = split('/',$path); prt( "CHUNK=".$arr[0]."\n" ); } # attempt to get ALL buckets with this SAME BASE PATH sub get_all_buckets_same_1X1($) { my ($b) = shift; my @bucks = (); my ($i, $path, $cnt, $nb, $np, $nb1, $tb, $fnd); $path = $b->gen_base_path(); $cnt = 0; for ($i = 0; $i < 8; $i++) { $nb = $b->get_next_bucket($i); $np = $nb->gen_base_path(); if ($path eq $np) { # in the same relm push(@bucks, $nb); $cnt++; } } # now process all the near bucket found $cnt = scalar @bucks; while ($cnt) { $cnt = 0; # count of NEW buckets foreach $nb1 (@bucks) { for ($i = 0; $i < 8; $i++) { $nb = $nb1->get_next_bucket($i); $np = $nb->gen_base_path(); if ($path eq $np) { # in the same relm if ( ! $b->buckets_equal( $b, $nb ) ) { # not equal to last $fnd = 0; foreach $tb (@bucks) { if ($b->buckets_equal( $nb, $tb ) ) { $fnd = 1; last; } } if ( $fnd == 0 ) { push(@bucks, $nb); $cnt++; } } } } } } $fnd = 0; foreach $tb (@bucks) { if ( $b->buckets_equal( $b, $tb ) ) { $fnd = 1; last; } } if ( $fnd == 0 ) { push(@bucks, $b); $cnt++; } return @bucks; } # Get ALL buckets around this bucket # Next bucket or in letters # 6 | 5 | 4 TL | TC | TR # ---------- ------------ # 7 | RB | 3 CL | RB | CR # ---------- ------------ # 0 | 1 | 2 BL | BC | BR # so order is # 0=BL 1=BC 2=BR 3=CR 4=TR 5=TC 6=TL 7=CL sub get_buckets_around($) { my ($b) = shift; my ($i); my @btl = qw(BL BC BR CR TR TC TL CL); my @bucks = (); for ($i = 0; $i < 8; $i++) { my $nb = $b->get_next_bucket($i); push(@bucks, [ $btl[$i], \$nb ]); } return \@bucks; } sub show_buckets($) { my $b = shift; my $ra = get_buckets_around($b); # 0 1 # pos bucket my $cnt = scalar @{$ra}; my ($i,$pos,$nb); prt("Buckets surrounding the above bucket...\n"); for ($i = 0; $i < $cnt; $i++) { $pos = ${$ra}[$i][0]; $nb = ${$ra}[$i][1]; prt( "$pos: ".${$nb}->bucket_info(). "\n" ); add_bucket_xg(${$nb}); } } sub show_inds($) { my ($br) = shift; my @ind = (); my ($tb,$i,$cnt,$il,$bind,$msg,$max,$tcnt); my %dupes = (); foreach $tb (@{$br}) { $bind = $tb->gen_index(); #prt( $tb->gen_index()." " ); push(@ind, $bind) if (!defined $dupes{$bind}); $dupes{$bind} = 1; } $cnt = 0; $il = -1; $max = 85; $msg = ''; $tcnt = scalar @ind; foreach $i (sort @ind) { if ($cnt == 0) { $msg .= "$i"; $cnt++; } elsif ($i == ($il + 1)) { $cnt++; } else { # new index seq if ($cnt == 1) { $msg .= " $i"; } else { $msg .= "-$il $i"; } $cnt = 1; } $il = $i; # update last if (length($msg) > $max) { prt("$msg\n"); $msg = ''; } } if ($cnt > 1) { $msg .= "-$il"; } prt("$msg $tcnt indexes\n"); # if (length($msg)); @ind = sort @ind; prt("Inds: ".join(" ",@ind)."\n"); } #// calculate the offset between two buckets #void sgBucketDiff( const SGBucket& b1, const SGBucket& b2, int *dx, int *dy ) { sub sgBucketDiff { #( const SGBucket& b1, const SGBucket& b2, int *dx, int *dy ) { my ($b1, $b2) = @_; my ($dy, $dx); #// Latitude difference # double c1_lat = b1.get_center_lat(); # double c2_lat = b2.get_center_lat(); # double diff_lat = c2_lat - c1_lat; my $c1_lat = $b1->get_center_lat(); my $c2_lat = $b2->get_center_lat(); my $diff_lat = $c2_lat - $c1_lat; #ifdef HAVE_RINT # *dy = (int)rint( diff_lat / SG_BUCKET_SPAN ); #else if ( $diff_lat > 0 ) { $dy = int( ($diff_lat / $SG_BUCKET_SPAN) + 0.5 ); } else { $dy = int( ($diff_lat / $SG_BUCKET_SPAN) - 0.5 ); } #endif #// longitude difference #double diff_lon=0.0; #double span=0.0; my $diff_lon = 0.0; my $span = 0.0; #SGBucket tmp_bucket; #// To handle crossing the bucket size boundary #// we need to account for different size buckets. #if ( sg_bucket_span(c1_lat) <= sg_bucket_span(c2_lat) ) if ( $b1->bucket_span($c1_lat) <= $b2->bucket_span($c2_lat) ) { $span = $b1->bucket_span($c1_lat); } else { $span = $b2->bucket_span($c2_lat); } $diff_lon = $b2->get_center_lon() - $b1->get_center_lon(); if ($diff_lon < 0.0) { $diff_lon -= ($b1->get_width()*0.5) + ($b2->get_width()*0.5) - $span; } else { $diff_lon += ($b1->get_width()*0.5) + ($b2->get_width()*0.5) - $span; } #ifdef HAVE_RINT # *dx = (int)rint( diff_lon / span ); #else if ( $diff_lon > 0 ) { $dx = int( ($diff_lon / $span) + 0.5 ); } else { $dx = int( ($diff_lon / $span) - 0.5 ); } #endif return $dy,$dx } #// find the bucket which is offset by the specified tile units in the #// X & Y direction. We need the current lon and lat to resolve #// ambiguities when going from a wider tile to a narrower one above or #// below. This assumes that we are feeding in #SGBucket sgBucketOffset( double dlon, double dlat, int dx, int dy ) { sub sgBucketOffset { my ($dlon, $dlat, $dx, $dy) = @_; my $result = Bucket->new(); # constructor #SGBucket result( dlon, dlat ); $result->set_bucket( $dlon, $dlat ); #double clat = result.get_center_lat() + dy * SG_BUCKET_SPAN; my $clat = $result->get_center_lat() + $dy * $SG_BUCKET_SPAN; #// walk dy units in the lat direction $result->set_bucket( $dlon, $clat ); #// find the lon span for the new latitude my $span = $result->bucket_span( $clat ); #// walk dx units in the lon direction my $tmp = $dlon + $dx * $span; while ( $tmp < -180.0 ) { $tmp += 360.0; } while ( $tmp >= 180.0 ) { $tmp -= 360.0; } $result->set_bucket( $tmp, $clat ); return $result; } sub store_bucket($$$) { my ($ra,$i,$j) = @_; # (\@buckets,$i,$j); my $bn = Bucket->new(); $bn->set_bucket($i,$j); push(@{$ra},$bn); add_bucket_xg($bn); } sub test_diff_offset_functions() { prt("New test show...\n"); my @buckets = (); my ($minlon,$maxlon,$minlat,$maxlat); $minlon = ($buck_lon <= $buck_lon2) ? $buck_lon : $buck_lon2; $maxlon = ($buck_lon > $buck_lon2) ? $buck_lon : $buck_lon2; $minlat = ($buck_lat <= $buck_lat2) ? $buck_lat : $buck_lat2; $maxlat = ($buck_lat > $buck_lat2) ? $buck_lat : $buck_lat2; my $b_min = Bucket->new(); $b_min->set_bucket($minlon,$minlat); my $b_max = Bucket->new(); $b_max->set_bucket($maxlon,$maxlat); my ($dy,$dx) = sgBucketDiff($b_min,$b_max); my ($i,$j,$b_cur); for ($j = 0; $j <= $dy; $j++) { for ($i = 0; $i <= $dx; $i++) { $b_cur = sgBucketOffset( $minlon, $minlat, $i, $j ); #store_bucket(\@buckets,$b_cur->get_center_lon(),$b_cur->get_center_lat()); push(@buckets,$b_cur); } } show_inds(\@buckets); } sub show_buckets_in_bounds($$) { my ($b1,$b2) = @_; # have already shown these buckets my ($tlclon,$tlclat,$brclon,$brclat,$lonspan,$latspan); my ($minlon,$maxlon,$minlat,$maxlat); my ($tlb,$brb,$tb1,$tb2); my ($i,$j,$txt,$wrap,$cnt,$msg,$ind,$bn); my @buckets = (); push(@buckets,$b1); push(@buckets,$b2) if (!$b1->buckets_equal($b1,$b2)); $minlon = ($buck_lon <= $buck_lon2) ? $buck_lon : $buck_lon2; $maxlon = ($buck_lon > $buck_lon2) ? $buck_lon : $buck_lon2; $minlat = ($buck_lat <= $buck_lat2) ? $buck_lat : $buck_lat2; $maxlat = ($buck_lat > $buck_lat2) ? $buck_lat : $buck_lat2; # top left bucket $tlb = Bucket->new(); $tlb->set_bucket($minlon,$maxlat); $tlclon = $tlb->get_center_lon(); $tlclat = $tlb->get_center_lat(); $ind = $tlb->gen_index(); # bottom right bucket $brb = Bucket->new(); $brb->set_bucket($maxlon,$minlat); $brclon = $brb->get_center_lon(); $brclat = $brb->get_center_lat(); $lonspan = $brclon - $tlclon; $latspan = $tlclat - $brclat; # if ($b->buckets_equal( $nb, $tb ) ) { prt("Range: (lon,lat) TL=$minlon,$maxlat, BR=$maxlon,$minlat\n". " Centers TL=$tlclon,$tlclat BR=$brclon,$brclat\n". " Span: lon $lonspan lat $latspan\n"); if ($tlb->buckets_equal($tlb,$b1)) { prt("Top left bucket - same as the first\n"); } elsif ($tlb->buckets_equal($tlb,$b2)) { prt("Top left bucket - same as the second\n"); } else { prt("Top left bucket -\n"); show_bucket($tlb); push(@buckets,$tlb); } if ($brb->buckets_equal($brb,$b1)) { prt("Bottom right bucket - same as the first\n"); } elsif ($brb->buckets_equal($brb,$b2)) { prt("Bottom right bucket - same as the second\n"); } else { prt("Bottom right bucket -\n"); show_bucket($brb); push(@buckets,$brb); } # return if (!$show_all); $tb1 = Bucket->new(); $tb2 = Bucket->new(); $tb1->set_bucket($tlclon,$tlclat); # left top $tb2->set_bucket($brclon,$tlclat); # right top $wrap = 3; $cnt = 0; $msg = ''; for ($i = $tlclon; $i <= $brclon ; $i += $tb1->get_width()) { for ($j = $tlclat; $j >= $brclat; $j -= $tb2->get_height()) { $tb2->set_bucket($i,$j); if (($tb2->buckets_equal($tb2,$tb1))|| ($tb2->buckets_equal($tb2,$b1))|| ($tb2->buckets_equal($tb2,$b2))) { $txt = " Bucket already shown "; } else { #show_bucket($tb2); #show_bucket_center($tb2); $txt = get_bucket_center_txt($tb2); #push(@buckets,$tb2); store_bucket(\@buckets,$i,$j); } $msg .= $txt; $cnt++; if ($cnt > $wrap) { $msg .= "\n"; $cnt = 0; } $tb1->set_bucket($i,$j); } } $msg .= "\n" if ($cnt); $msg .= "Range: (lon,lat) TL=$minlon,$maxlat, BR=$maxlon,$minlat\n". " Centers TL=$tlclon,$tlclat BR=$brclon,$brclat\n". " Span: lon $lonspan lat $latspan\n"; #prt($msg) if ($show_all); my $bcnt = scalar @buckets; prt( "Got $bcnt buckets in bounds... "); if ($show_all || VERB5()) { prt("listed in numeric range order\n" ); show_inds(\@buckets); test_diff_offset_functions(); my @arr = sort keys( %bucket_paths ); $i = scalar @arr; if ($i == 1) { prt("All Buckets on the same path: $arr[0]\n"); } else { prt("$i: Bucket Paths:\n".join("\n",@arr)."\n"); } } else { prt("\n"); } } sub process_input() { my $ok = 0; my $ok2 = 0; if ($buck_index == -1) { # can only try lon,lat if (($buck_lat == $NO_LAT_LON)||($buck_lon == $NO_LAT_LON)) { prt("ERROR: No lon,lat, nor index found! Try -?\n"); exit(1); } prt( "Setting bucket to lon=$buck_lon, lat=$buck_lat...\n" ); $b->set_bucket($buck_lon,$buck_lat); show_bucket($b); show_buckets($b) if ($show_buckets); $ok = 1; } else { prt( "Setting bucket to index [$buck_index]...\n" ); $b->set_bucket_per_index($buck_index); if ($b->gen_index() != $buck_index) { prt( "ERROR: Not a valid index [$buck_index]! Nearest is ".$b->gen_index()."\n" ); exit(1); } show_bucket($b); show_buckets($b) if ($show_buckets); $buck_lat = $b->get_center_lat(); $buck_lon = $b->get_center_lon(); $ok = 1; } if (($buck_lat2 == $NO_LAT_LON)||($buck_lon2 == $NO_LAT_LON)) { # can only try the idex if ($buck_index2 != -1) { $b2 = Bucket->new(); prt("Second bucket index [$buck_index2], lon,lat = [$buck_lon2,$buck_lat2]\n"); $b2->set_bucket_per_index($buck_index2); show_bucket($b2); $buck_lat2 = $b2->get_center_lat(); $buck_lon2 = $b2->get_center_lon(); $ok2 = 1; } else { prt("No second bucket index [$buck_index2], lon,lat = [$buck_lon2,$buck_lat2]\n") if ($dbg03); } } else { $b2 = Bucket->new(); prt( "Second bucket to lon=$buck_lon2, lat=$buck_lat2...\n" ); #prt("Second bucket lon,lat = [$buck_lon2,$buck_lat2]\n"); $b2->set_bucket($buck_lon2,$buck_lat2); show_bucket($b2); $ok2 = 1; } if ($ok && $ok2) { # got TWO lon,lat pairs show_buckets_in_bounds($b,$b2); } else { if ($show_all) { if ($ok) { my @bl = get_all_buckets_same_1X1($b); my $bcnt = scalar @bl; prt( "Got $bcnt buckets around... " ); if ($bcnt && $show_indexes) { prt("listed in numeric range order...\n"); show_inds(\@bl); } else { prt("\n"); } } } } if (length($xg_out) && length($xg_string)) { rename_2_old_bak($xg_out); write2file($xg_string,$xg_out); prt("Written xg $xg_out\n"); } } # ================================================= # MAIN PROGRAM # ============ $b = Bucket->new(); # constructor $ac = scalar @ARGV; parse_args(@ARGV); process_input(); pgm_exit(0,""); ################# sub give_help() { prt("$pgmname: verions $VERS\n"); prt("Usage: $pgmname [options] index or lon lat\n"); prt("Options:\n"); prt(" -h (-?) = This help, and exit 0\n"); prt(" -lon <deg> = Give a longitude.\n"); prt(" -lat <deg> = Give a latitude.\n"); prt(" -index nnnn = Give a bucket index.\n"); prt(" If a 2nd lon2,lat2 or index2 given, show ALL the buckets in that bounding box.\n"); prt(" -lon2 <deg> = Give a longitude.\n"); prt(" -lat2 <deg> = Give a latitude.\n"); prt(" -index2 nnnn = Give a bucket index.\n"); prt(" -rev (-r) = Reverse sense on input to lat lon\n"); prt(" -show-all = Show the buckets indexe in 1x1 degree area of first lat,lon given.\n"); prt(" -buckets (-b) = Show all touching buckets.\n"); prt(" -v[N] = Bump or set verbosity to 'N' (1,2,5,9)\n"); prt(" --xg <file> (-x) = Set xgraph output file.\n"); } sub need_arg { my ($arg,@av) = @_; if (!@av) { prt("ERROR: Argument $arg MUST be followed by degrees!\n"); exit(1); } } sub parse_args { my (@av) = @_; my ($arg, $argc, $sarg,$cnt,$neg); $argc = 0; prt( "parse_args: ".scalar @av."\n" ) if ($dbg01); $cnt = 0; my $rev = 0; my $verb = VERB1(); while(@av) { $arg = $av[0]; $cnt++; prt("Arg$cnt: [$arg]\n") if ($dbg01); $neg = 0; if ($arg =~ /^-(\d|\.)+$/) { $neg = 1; $arg = substr($arg,1); } if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); exit(0); } elsif ($sarg =~ /^b/) { $show_buckets = 1; } elsif ($sarg =~ /^lon$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $buck_lon = $sarg; $argc |= 1; prt("Set lon to [$buck_lon]\n") if ($dbg01); } elsif ($sarg =~ /^lat$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $buck_lat = $sarg; $argc |= 2; prt("Set lat to [$buck_lat]\n") if ($dbg01); } elsif ($sarg =~ /^lon2$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $buck_lon2 = $sarg; $argc |= 4; prt("Set lon2 to [$buck_lon2]\n") if ($dbg01); } elsif ($sarg =~ /^lat2$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $buck_lat2 = $sarg; $argc |= 8; prt("Set lat2 to [$buck_lat2]\n") if ($dbg01); } elsif ($sarg =~ /^r/i) { $rev = 1; prt("Set to reverse input to lat lon, as opposed to lon lat expected.\n"); } elsif ($sarg =~ /^s/i) { $show_all = 1; $show_indexes = 1; } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt( "Set verbosity to [$verbosity]\n") if (VERB1()); $verb = VERB1(); } elsif ($sarg =~ /^x/) { need_arg(@av); shift @av; $sarg = $av[0]; $xg_out = $sarg; prt("Set xgraph out file to [$xg_out].\n") if ($verb); } else { pgm_exit(1,"ERROR:1: Unknown argument [$arg]! Try -?\n"); } } else { # have a bare item my $is_ind = 0; if ($arg =~ /^\d+$/) { # all digits - could be index if ($arg > 999) { # assume it is... if ($buck_index == -1) { $buck_index = $arg; $is_ind = 1; } elsif ($buck_index2 == -1) { $buck_index2 = $arg; $is_ind = 1; } else { prt("Already have index $buck_index, and $buck_index2...\n"); pgm_exit(1,"ERROR:2: Unknown argument [$arg]! Try -?\n"); } } } if (! $is_ind) { if ($arg =~ /^[-\d\.]+$/) { if ( !($argc & 1) ) { # assume LON first $buck_lon = $arg; $buck_lon = -$buck_lon if ($neg); $argc |= 1; prt("Set bucket 1 lon to $buck_lon\n"); } elsif ( !($argc & 2) ) { # assume LAT $buck_lat = $arg; $buck_lat = -$buck_lat if ($neg); $argc |= 2; prt("Set bucket 1 lat to $buck_lat\n"); } elsif ( !($argc & 4) ) { # assume LON2 $buck_lon2 = $arg; $buck_lon2 = -$buck_lon2 if ($neg); $argc |= 4; prt("Set bucket 2 lon to $buck_lon2\n"); } elsif ( !($argc & 8) ) { # assume LAT2 $buck_lat2 = $arg; $buck_lat2 = -$buck_lat2 if ($neg); $argc |= 8; prt("Set bucket 2 lat to $buck_lat2\n"); } else { prt("Got lon=$buck_lon and lat=$buck_lat... and lon2=$buck_lon2 and lat2=$buck_lat2\n"); pgm_exit(1,"ERROR:3: Unknown argument [$arg]! Try -?\n"); } } else { pgm_exit(1,"ERROR:4: Unknown argument [$arg]! Try -?\n"); } } } shift @av; } if ($debug_on) { if ((($buck_lat == $NO_LAT_LON)||($buck_lon == $NO_LAT_LON))&& (($buck_lat2 == $NO_LAT_LON)||($buck_lon2 == $NO_LAT_LON))) { #$buck_lat = -33; #$buck_lon = 150; #$buck_lat2 = -34; #$buck_lon2 = 151; $buck_lat = -89; $buck_lon = -179; $buck_lat2 = 89; $buck_lon2 = 179; while ($verbosity < 5) { $verbosity++; } $load_log = 1; } } if ($rev) { prt("Reversing lon lat input to lat lon input...\n"); $rev = $buck_lat; $buck_lat = $buck_lon; $buck_lon = $rev; $rev = $buck_lat2; $buck_lat2 = $buck_lon2; $buck_lon2 = $rev; } } # eof - show-bucket.pl