File Coverage

blib/lib/Math/PlanePath/Columns.pm
Criterion Covered Total %
statement 73 115 63.4
branch 17 42 40.4
condition 3 9 33.3
subroutine 16 33 48.4
pod 18 18 100.0
total 127 217 58.5


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath. If not, see .
17              
18              
19             package Math::PlanePath::Columns;
20 2     2   1597 use 5.004;
  2         14  
21 2     2   15 use strict;
  2         3  
  2         58  
22              
23 2     2   11 use vars '$VERSION', '@ISA';
  2         4  
  2         144  
24             $VERSION = 127;
25 2     2   1392 use Math::PlanePath;
  2         5  
  2         85  
26             @ISA = ('Math::PlanePath');
27              
28             use Math::PlanePath::Base::Generic
29 2         89 'round_nearest',
30 2     2   13 'floor';
  2         4  
31              
32             # uncomment this to run the ### lines
33             #use Devel::Comments;
34              
35 2     2   10 use constant class_x_negative => 0;
  2         4  
  2         95  
36 2     2   12 use constant class_y_negative => 0;
  2         2  
  2         80  
37 2     2   10 use constant n_frac_discontinuity => .5;
  2         4  
  2         91  
38              
39 2         312 use constant parameter_info_array =>
40 2     2   11 [ Math::PlanePath::Base::Generic::parameter_info_nstart1() ];
  2         3  
41              
42             sub y_maximum {
43 0     0 1 0 my ($self) = @_;
44 0         0 return $self->{'height'} - 1;
45             }
46              
47             sub diffxy_minimum {
48 0     0 1 0 my ($self) = @_;
49 0 0       0 if ($self->{'height'} == 0) {
50 0         0 return 0; # at X=0,Y=0
51             } else {
52 0         0 return 1 - $self->{'height'}; # at X=0,Y=height-1
53             }
54             }
55              
56             sub dx_minimum {
57 0     0 1 0 my ($self) = @_;
58 0 0       0 return ($self->{'height'} <= 1
59             ? 1 # single row only
60             : 0);
61             }
62 2     2   14 use constant dx_maximum => 1;
  2         4  
  2         611  
63             sub _UNDOCUMENTED__dxdy_list {
64 0     0   0 my ($self) = @_;
65             return (($self->{'height'} >= 2 ? (0,1) # N too
66             : ()),
67 0 0       0 1, 1-$self->{'height'});
68             }
69             sub _UNDOCUMENTED__dxdy_list_at_n {
70 0     0   0 my ($self) = @_;
71 0         0 return $self->n_start + $self->{'height'} - 1;
72             }
73              
74             sub dy_minimum {
75 0     0 1 0 my ($self) = @_;
76 0         0 return - ($self->{'height'}-1);
77             }
78             sub dy_maximum {
79 0     0 1 0 my ($self) = @_;
80 0 0       0 return ($self->{'height'} <= 1
81             ? 0 # single row only
82             : 1);
83             }
84              
85             sub absdx_minimum {
86 0     0 1 0 my ($self) = @_;
87 0 0       0 return ($self->{'height'} <= 1
88             ? 1 # single row only
89             : 0);
90             }
91             sub absdy_minimum {
92 0     0 1 0 my ($self) = @_;
93 0 0       0 return ($self->{'height'} <= 1 ? 0 : 1);
94             }
95              
96             sub dsumxy_minimum {
97 0     0 1 0 my ($self) = @_;
98 0         0 return 2 - $self->{'height'}; # dX=+1 dY=-(height-1)
99             }
100 2     2   14 use constant dsumxy_maximum => 1;
  2         3  
  2         1623  
101              
102             sub ddiffxy_minimum {
103 0     0 1 0 my ($self) = @_;
104 0 0       0 return ($self->{'height'} == 1
105             ? 1 # constant dX=1,dY=0
106             : -1); # straight N
107             }
108             sub ddiffxy_maximum {
109 0     0 1 0 my ($self) = @_;
110 0         0 return $self->{'height'}; # dX=+1 dY=-(height-1)
111             }
112              
113             sub dir_minimum_dxdy {
114 0     0 1 0 my ($self) = @_;
115 0 0       0 return ($self->{'height'} == 1
116             ? (1,0) # height=1 East only
117             : (0,1)); # height>1 North
118             }
119             sub dir_maximum_dxdy {
120 0     0 1 0 my ($self) = @_;
121 0         0 return (1, $self->dy_minimum);
122             }
123              
124             sub turn_any_left {
125 0     0 1 0 my ($self) = @_;
126 0         0 return ($self->{'height'} != 1); # height=1 only straight ahead
127             }
128             sub _UNDOCUMENTED__turn_any_left_at_n {
129 0     0   0 my ($self) = @_;
130             return ($self->{'height'} == 1 ? undef
131 0 0       0 : $self->n_start + $self->{'height'});
132             }
133              
134             *turn_any_right = \&turn_any_left;
135             sub _UNDOCUMENTED__turn_any_right_at_n {
136 1     1   6 my ($self) = @_;
137             return ($self->{'height'} == 1 ? undef
138 1 50       5 : $self->n_start + $self->{'height'} - 1);
139             }
140              
141             sub turn_any_straight {
142 0     0 1 0 my ($self) = @_;
143 0         0 return ($self->{'height'} != 2); # height=2 never straight
144             }
145              
146              
147             #------------------------------------------------------------------------------
148              
149             sub new {
150 10     10 1 1144 my $self = shift->SUPER::new (@_);
151 10 100       41 if (! exists $self->{'height'}) {
152 1         2 $self->{'height'} = 1;
153             }
154 10 50       22 if (! defined $self->{'n_start'}) {
155 10         35 $self->{'n_start'} = $self->default_n_start;
156             }
157 10         23 return $self;
158             }
159              
160             sub n_to_xy {
161 8     8 1 665 my ($self, $n) = @_;
162              
163             # no division by zero, and negatives not meaningful for now
164 8         13 my $height;
165 8 50       22 if (($height = $self->{'height'}) <= 0) {
166             ### no points for height<=0
167 0         0 return;
168             }
169              
170 8         15 $n = $n - $self->{'n_start'}; # zero based
171              
172 8         15 my $int = int($n); # BigFloat int() gives BigInt, use that
173 8         12 $n -= $int; # fraction part, preserve any BigFloat
174              
175 8 100       22 if (2*$n >= 1) { # if $n >= 0.5, but BigInt friendly
176 2         4 $n -= 1;
177 2         2 $int += 1;
178             }
179             ### $n
180             ### $int
181             ### assert: $n >= -0.5
182             ### assert: $n < 0.5
183              
184 8         19 my $x = int ($int / $height);
185 8         11 $int -= $x*$height;
186 8 50       19 if ($int < 0) { # ensure round down when $int negative
187 0         0 $int += $height;
188 0         0 $x -= 1;
189             }
190             ### floor x: $x
191             ### remainder: $int
192              
193 8         20 return ($x,
194             $n + $int);
195             }
196              
197             sub xy_to_n {
198 6     6 1 678 my ($self, $x, $y) = @_;
199              
200 6         18 $y = round_nearest ($y);
201 6 50 33     33 if ($y < 0 || $y >= $self->{'height'}) {
202 0         0 return undef; # outside the oblong
203             }
204 6         13 $x = round_nearest ($x);
205 6         18 return $x * $self->{'height'} + $y + $self->{'n_start'};
206             }
207              
208             # exact
209             sub rect_to_n_range {
210 6     6 1 24 my ($self, $x1,$y1, $x2,$y2) = @_;
211 6         14 my $height = $self->{'height'};
212              
213 6         14 $y1 = round_nearest ($y1);
214 6         13 $y2 = round_nearest ($y2);
215 6 100       16 if ($y2 < $y1) { ($y1,$y2) = ($y2,$y1) } # swap to y1
  1         3  
216             ### assert: $y1<=$y2
217              
218 6 50 33     44 if ($height<=0 || $y1 >= $height || $y2 < 0) {
      33        
219             ### completely outside 0 to height-1, or height<=0 ...
220 0         0 return (1,0);
221             }
222              
223 6         15 $x1 = round_nearest ($x1);
224 6         13 $x2 = round_nearest ($x2);
225 6 50       15 if ($x2 < $x1) { ($x1,$x2) = ($x2,$x1) } # swap to x1
  0         0  
226             ### assert: $x1<=$x2
227              
228 6 100       13 if ($y1 < 0) { $y1 *= 0; } # preserve bignum
  1         2  
229 6 100       12 if ($y2 >= $height) { $y2 = ($y2*0) + $height-1; } # preserve bignum
  1         3  
230              
231             # exact range bottom left to top right
232             return ($x1*$height + $y1 + $self->{'n_start'},
233 6         19 $x2*$height + $y2 + $self->{'n_start'});
234             }
235              
236             1;
237             __END__