view release on metacpan or  search on metacpan

lib/Geo/Proj.pm  view on Meta::CPAN

    return $name if defined $name;

    my $proj = $self->proj4;
    my $abbrev = $proj->projection
       or return $self->{nick};

    my $def    = $proj->type($abbrev);
    $def->{description};
}


sub proj4(;$)
{   my $thing = shift;
    return $thing->{GP_proj4} unless @_;

    my $proj  = $thing->projection(shift) or return undef;
    $proj->proj4;
}


sub srid() {shift->{GP_srid}}

#-----------------------

sub projection($)
{   my $which = $_[1];
    UNIVERSAL::isa($which, __PACKAGE__) ? $which : $projections{$which};
}


sub defaultProjection(;$)
{   my $thing = shift;
    if(@_)
    {   my $proj = shift;
        $defproj = ref $proj ? $proj : $thing->projection($proj);
    }
    $defproj;
}


sub listProjections() { sort keys %projections }


sub dumpProjections(;$)
{   my $class = shift;
    my $fh    = shift || select;

    my $default = $class->defaultProjection;
    my $defnick = defined $default ? $default->nick : '';

    foreach my $nick ($class->listProjections)
    {   my $proj = $class->projection($nick);
        my $name = $proj->name;
        my $norm = $proj->proj4->normalized;
        $fh->print("$nick: $name".($defnick eq $nick ? ' (default)':'')."\n");
        $fh->print("    $norm\n") if $norm ne $name;
    }
}


sub to($@)
{   my $thing   = shift;
    my $myproj4 = ref $thing ? $thing->proj4 : __PACKAGE__->proj4(shift);
    my $toproj4 = __PACKAGE__->proj4(shift);
    $myproj4->transform($toproj4, shift);
}

#-----------------------

# These methods may have been implemented in Geo::Point, however may get
# supported by any external library later.  Knowledge about projections
# is as much as possible concentrated here.


sub zoneForUTM($)
{   my ($thing, $point) = @_;
    my ($long, $lat) = $point->longlat;

    my $zone
     = ($lat >= 56 && $lat < 64)
     ? ( $long <  3   ? undef
       : $long < 12   ? 32
       :                undef
       )
     : ($lat >= 72 && $lat < 84)
     ? ( $long <  0   ? undef
       : $long <  9   ? 31
       : $long < 21   ? 33
       : $long < 33   ? 35
       : $long < 42   ? 37
       :                undef
       )
     : undef;

    my $meridian = int($long/6)*6 + ($long < 0 ? -3 : +3);
    $zone      ||= int(($meridian+180)/6) +1;
 
    my $letter
     = ($lat < -80 || $lat > 84) ? ''
     : ('C'..'H', 'J'..'N', 'P'..'X', 'X')[ ($lat+80)/8 ];

      wantarray     ? ($zone, $letter, $meridian)
    : defined $zone ? "$zone$letter"
    : undef;
}


sub bestUTMprojection($;$)
{   my ($thing, $point) = (shift, shift);
    my $proj  = @_ ? shift : $point->proj;

    my ($zone, $letter, $meridian) = $thing->zoneForUTM($point);
    $thing->UTMprojection($proj, $zone);
}



sub UTMprojection($$)
{   my ($class, $base, $zone) = @_;

    $base   ||= $class->defaultProjection;