File Coverage

blib/lib/Math/Polygon/Surface.pm
Criterion Covered Total %
statement 34 61 55.7
branch 5 18 27.7
condition 1 3 33.3
subroutine 8 14 57.1
pod 9 10 90.0
total 57 106 53.7


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