view release on metacpan or  search on metacpan

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

# Copyrights 2005-2021 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Geo-Point.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Geo::Shape;
use vars '$VERSION';
$VERSION = '0.99';


use strict;
use warnings;

use Geo::Proj;      # defines wgs84
use Geo::Point      ();
use Geo::Line       ();
use Geo::Surface    ();
use Geo::Space      ();

use GIS::Distance   ();
use Carp            qw/croak confess/;


use overload '""'     => 'string'
           , bool     => sub {1}
           , fallback => 1;


sub new(@) {
    my ($thing, %args) = @_;
    $args{proj} ||= $thing->proj if ref $thing;
	(bless {}, ref $thing || $thing)->init(\%args);
}

sub init($)
{   my ($self, $args) = @_;
    my $proj = $self->{G_proj}
      = $args->{proj} || Geo::Proj->defaultProjection->nick;

    croak "proj parameter must be a label, not a Geo::Proj object"
        if UNIVERSAL::isa($proj, 'Geo::Proj');

    $self;
}

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

sub proj()  { shift->{G_proj} }
sub proj4() { Geo::Proj->proj4(shift->{G_proj}) }

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

sub in($) { croak "ERROR: in() not implemented for a ".ref(shift) }


sub projectOn($@)
{   # fast check: nothing to be done
    return () if @_<2 || $_[0]->{G_proj} eq $_[1];

    my ($self, $projnew) = (shift, shift);
    my $projold = $self->{G_proj};

    return ($projnew, @_)
        if $projold eq $projnew;

    if($projnew eq 'utm')
    {   my $point = $_[0];
        $point   = Geo::Point->xy(@$point, $projold)
            if ref $point eq 'ARRAY';
        $projnew = Geo::Proj->bestUTMprojection($point, $projold)->nick;
        return ($projnew, @_)
            if $projnew eq $projold;
    }

    my $points = Geo::Proj->to($projold, $projnew, \@_);
    ($projnew, @$points);
}

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

my $gisdist;
sub distance($;$)
{   my ($self, $other, $unit) = (shift, shift, shift);
    $unit ||= 'kilometer';

    $gisdist ||= GIS::Distance->new('Haversine');

    my $proj = $self->proj;
    $other = $other->in($proj)
        if $other->proj ne $proj;

    if($self->isa('Geo::Point') && $other->isa('Geo::Point'))
    {   return $self->distancePointPoint($gisdist, $unit, $other);
    }

    die "ERROR: distance calculation not implemented between a "
      . ref($self) . " and a " . ref($other);
}


sub bboxRing(@)
{   my ($thing, $xmin, $ymin, $xmax, $ymax, $proj) = @_;

    if(@_==1 && ref $_[0])   # instance method without options
    {   $proj  = $thing->proj;
        ($xmin, $ymin, $xmax, $ymax) = $thing->bbox;
    }

    Geo::Line->new   # just a little faster than calling ring()
     ( points    => [ [$xmin,$ymin], [$xmax,$ymin], [$xmax,$ymax]
                    , [$xmin,$ymax], [$xmin,$ymin] ]
     , proj      => $proj
     , ring      => 1