show-bucket.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:58 2016 from show-bucket.pl 2015/04/07 23.5 KB. text copy

# Testing my Bucket.pm
# 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;
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 "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.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 $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 = ();

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 show_bucket($) {
   my ($b) = shift;
   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();
   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" );
    }
}

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));
}

#// 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);
}

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();
    } 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");
               }
            }
        }
    }
}

# =================================================
# 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");

}

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;
   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());
          } 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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional