#!/usr/bin/perl -w
# make_grid - make shapefile of 6 character Maidenhead locators
# created by scruss/VA3PID on 02011/04/03
# RCS/CVS: $Id: make_grid.pl,v 1.3 2011/04/03 17:06:38 scruss Exp $

use strict;
use Geo::Shapelib qw/:all/;
sub maidenhead2latlongbbox;

my $field = uc( $ARGV[0] );
unless ( $field =~ /^[A-R][A-R]$/ ) {
  print 'Usage: ', $0, ' [A-R][A-R]', "\n";
  exit;
}

my $shapefile = new Geo::Shapelib {
  Name       => $field . '-maidenhead_grid',
  Shapetype  => POLYGON,
  FieldNames => [ 'Name', 'Field', 'Square', 'Subsquare' ],
  FieldTypes => [ 'String:6', 'String:2', 'String:2', 'String:2' ]
};

# field, square, subsquare : eg FN03ir
foreach my $long_square ( "0" .. "9" ) {
  foreach my $lat_square ( "0" .. "9" ) {
    my $square = join( '', $long_square, $lat_square );
    foreach my $long_subsquare ( "a" .. "x" ) {
      foreach my $lat_subsquare ( "a" .. "x" ) {
        my $subsquare = join( '', $long_subsquare, $lat_subsquare );
        my $locator = join( '', $field, $square, $subsquare );
        my ( $llx, $lly, $urx, $ury ) =
          maidenhead2latlongbbox($locator);
        print $locator, "\n";
        push @{ $shapefile->{Shapes} },
          {
          Vertices => [
            [ $lly, $llx, 0, 0 ],
            [ $lly, $urx, 0, 0 ],
            [ $ury, $urx, 0, 0 ],
            [ $ury, $llx, 0, 0 ],
            [ $lly, $llx, 0, 0 ]
          ]
          };
        push @{ $shapefile->{ShapeRecords} },
          [ $locator, $field, $square, $subsquare ];
      }
    }
  }
}

$shapefile->save();

# now fudge a projection file, since it helps and is easy
open( PRJ, ">$field-maidenhead_grid.prj" )
  or die "$!: cannot create $field-maidenhead_grid.prj\n";
print PRJ
'GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137,298.257223563]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]]';
close(PRJ);
exit;

# #################################

sub maidenhead2latlongbbox {

  # convert a Maidenhead Grid location (eg FN03ir)
  #  to its WGS84 bounding box
  # this code could be cleaner/shorter/clearer
  my @locator =
    split( //, uc(shift) );    # convert arg to upper case array
  my $lat      = 0;
  my $long     = 0;
  my $latdiv   = 0;
  my $longdiv  = 0;
  my @divisors = ( 72000, 36000, 7200, 3600, 300, 150 )
    ;                          # long,lat field size in seconds
  my $max = ( $#locator > $#divisors ) ? $#divisors : $#locator;

  for ( my $i = 0 ; $i <= $max ; $i++ ) {
    if ( int( $i / 2 ) % 2 ) {    # numeric
      if ( $i % 2 ) {             # lat
        $latdiv = $divisors[$i];    # save for later
        $lat += $locator[$i] * $latdiv;
      }
      else {                        # long
        $longdiv = $divisors[$i];
        $long += $locator[$i] * $longdiv;
      }
    }
    else {                          # alpha
      my $val = ord( $locator[$i] ) - ord('A');
      if ( $i % 2 ) {               # lat
        $latdiv = $divisors[$i];    # save for later
        $lat += $val * $latdiv;
      }
      else {                        # long
        $longdiv = $divisors[$i];
        $long += $val * $longdiv;
      }
    }
  }

  #  $lat  += ( $latdiv / 2 );         # location of centre of square
  #  $long += ( $longdiv / 2 );
  return (
    ( $lat / 3600 ) - 90,
    ( $long / 3600 ) - 180,
    ( ( $lat + $latdiv ) / 3600 ) - 90,
    ( ( $long + $longdiv ) / 3600 ) - 180
  );
}