← Back to branch summary

~ubuntu-branches/ubuntu/utopic/libmath-polygon-perl/utopic

« back to all changes in this revision

Viewing changes to lib/Math/Polygon/Surface.pm

  • Committer: Bazaar Package Importer
  • Author(s): Martin Zobel-Helas
  • Date: 2010-04-09 09:10:33 UTC
  • Revision ID: james.westby@ubuntu.com-20100409091033-gr0lwyteczhwqj6e
Tags: upstream-1.01
Import upstream version 1.01

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Math/Polygon/Surface.pm
 
1
# Copyrights 2004,2006-2009 by Mark Overmeer.
 
2
#  For other contributors see ChangeLog.
 
3
# See the manual pages for details on the licensing terms.
 
4
# Pod stripped from pm file by OODoc 1.06.
 
5
use strict;
 
6
use warnings;
 
7
 
 
8
package Math::Polygon::Surface;
 
9
use vars '$VERSION';
 
10
$VERSION = '1.01';
 
11
 
 
12
use Math::Polygon;
 
13
 
 
14
 
 
15
sub new(@)
 
16
{   my $thing = shift;
 
17
    my $class = ref $thing || $thing;
 
18
 
 
19
    my @poly;
 
20
    my %options;
 
21
 
 
22
    while(@_)
 
23
    {   if(!ref $_[0]) { my $k = shift; $options{$k} = shift }
 
24
        elsif(ref $_[0] eq 'ARRAY')        {push @poly, shift}
 
25
        elsif($_[0]->isa('Math::Polygon')) {push @poly, shift}
 
26
        else { die "Illegal argument $_[0]" }
 
27
    }
 
28
 
 
29
    $options{_poly} = \@poly if @poly;
 
30
    (bless {}, $class)->init(\%options);
 
31
}
 
32
 
 
33
sub init($$)
 
34
{   my ($self, $args)  = @_;
 
35
    my ($outer, @inner);
 
36
 
 
37
    if($args->{_poly})
 
38
    {   ($outer, @inner) = @{$args->{_poly}};
 
39
    }
 
40
    else
 
41
    {   $outer = $args->{outer}
 
42
            or die "ERROR: surface requires outer polygon\n";
 
43
 
 
44
        @inner = @{$args->{inner}} if defined $args->{inner};
 
45
    }
 
46
 
 
47
    foreach ($outer, @inner)
 
48
    {  next unless ref $_ eq 'ARRAY';
 
49
       $_ = Math::Polygon->new(points => $_);
 
50
    }
 
51
 
 
52
    $self->{MS_outer} = $outer;
 
53
    $self->{MS_inner} = \@inner;
 
54
    $self;
 
55
}
 
56
 
 
57
 
 
58
sub outer() { shift->{MS_outer} }
 
59
 
 
60
 
 
61
sub inner() { @{shift->{MS_inner}} }
 
62
 
 
63
 
 
64
sub bbox() { shift->outer->bbox }
 
65
 
 
66
 
 
67
sub area()
 
68
{   my $self = shift;
 
69
    my $area = $self->outer->area;
 
70
    $area   -= $_->area for $self->inner;
 
71
    $area;
 
72
}
 
73
 
 
74
 
 
75
sub perimeter()
 
76
{   my $self = shift;
 
77
    my $per  = $self->outer->perimeter;
 
78
    $per    += $_->perimeter for $self->inner;
 
79
    $per;
 
80
}
 
81
 
 
82
 
 
83
sub lineClip($$$$)
 
84
{   my ($self, @bbox) = @_;
 
85
    map { $_->lineClip(@bbox) } $self->outer, $self->inner;
 
86
}
 
87
 
 
88
 
 
89
sub fillClip1($$$$)
 
90
{   my ($self, @bbox) = @_;
 
91
    my $outer = $self->outer->fillClip1(@bbox);
 
92
    return () unless defined $outer;
 
93
 
 
94
    $self->new
 
95
      ( outer => $outer
 
96
      , inner => [ map {$_->fillClip1(@bbox)} $self->inner ]
 
97
      );
 
98
}
 
99
 
 
100
 
 
101
sub string()
 
102
{   my $self = shift;
 
103
      "["
 
104
    . join( "]\n-["
 
105
          , $self->outer->string
 
106
          , map {$_->string } $self->inner)
 
107
    . "]";
 
108
}
 
109
 
 
110
1;