File Coverage

blib/lib/Math/PlanePath/Rows.pm
Criterion Covered Total %
statement 71 111 63.9
branch 16 40 40.0
condition 3 9 33.3
subroutine 15 32 46.8
pod 17 17 100.0
total 122 209 58.3


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 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::Rows;
20 3     3   2909 use 5.004;
  3         17  
21 3     3   17 use strict;
  3         6  
  3         109  
22              
23 3     3   22 use vars '$VERSION', '@ISA';
  3         5  
  3         228  
24             $VERSION = 129;
25 3     3   1518 use Math::PlanePath;
  3         7  
  3         117  
26             @ISA = ('Math::PlanePath');
27              
28             use Math::PlanePath::Base::Generic
29 3         165 'round_nearest',
30 3     3   21 'floor';
  3         6  
31              
32             # uncomment this to run the ### lines
33             #use Smart::Comments;
34              
35              
36 3     3   18 use constant class_x_negative => 0;
  3         6  
  3         184  
37 3     3   20 use constant class_y_negative => 0;
  3         6  
  3         149  
38 3     3   18 use constant n_frac_discontinuity => .5;
  3         7  
  3         160  
39              
40 3         648 use constant parameter_info_array =>
41 3     3   15 [ Math::PlanePath::Base::Generic::parameter_info_nstart1() ];
  3         6  
42              
43             sub x_maximum {
44 0     0 1 0 my ($self) = @_;
45 0         0 return $self->{'width'} - 1;
46             }
47              
48             sub dx_minimum {
49 0     0 1 0 my ($self) = @_;
50 0         0 return - ($self->{'width'}-1);
51             }
52             sub dx_maximum {
53 0     0 1 0 my ($self) = @_;
54 0 0       0 return ($self->{'width'} <= 1
55             ? 0 # single column only
56             : 1);
57             }
58              
59             sub dy_minimum {
60 0     0 1 0 my ($self) = @_;
61 0 0       0 return ($self->{'width'} <= 1
62             ? 1 # single column only
63             : 0);
64             }
65 3     3   20 use constant dy_maximum => 1;
  3         5  
  3         910  
66             sub _UNDOCUMENTED__dxdy_list {
67 0     0   0 my ($self) = @_;
68             return (($self->{'width'} >= 2 ? (1,0) # E too
69             : ()),
70 0 0       0 1-$self->{'width'}, 1);
71             }
72             sub _UNDOCUMENTED__dxdy_list_at_n {
73 0     0   0 my ($self) = @_;
74 0         0 return $self->n_start + $self->{'width'} - 1;
75             }
76              
77             sub absdx_minimum {
78 0     0 1 0 my ($self) = @_;
79 0 0       0 return ($self->{'width'} <= 1 ? 0 : 1);
80             }
81             sub absdy_minimum {
82 0     0 1 0 my ($self) = @_;
83 0 0       0 return ($self->{'width'} <= 1
84             ? 1 # single column only
85             : 0);
86             }
87              
88             sub dsumxy_minimum {
89 0     0 1 0 my ($self) = @_;
90 0         0 return 2 - $self->{'width'}; # dX=-(width-1) dY=+1
91             }
92 3     3   23 use constant dsumxy_maximum => 1;
  3         6  
  3         2485  
93             sub ddiffxy_minimum {
94 0     0 1 0 my ($self) = @_;
95             # dX=-(width-1) dY=+1 gives dDiffXY=-width+1-1=-width
96 0         0 return - $self->{'width'};
97             }
98             sub ddiffxy_maximum {
99 0     0 1 0 my ($self) = @_;
100 0 0       0 return ($self->{'width'} == 1
101             ? -1 # constant dY=-1
102             : 1); # straight E
103             }
104              
105             sub dir_minimum_dxdy {
106 0     0 1 0 my ($self) = @_;
107 0 0       0 return ($self->{'width'} == 1
108             ? (0,1) # width=1 North only
109             : (1,0)); # width>1 East
110             }
111             sub dir_maximum_dxdy {
112 0     0 1 0 my ($self) = @_;
113 0         0 return (1-$self->{'width'}, 1);
114             }
115              
116             sub turn_any_left {
117 0     0 1 0 my ($self) = @_;
118 0         0 return ($self->{'width'} > 1); # width==1 only straight ahead
119             }
120             sub _UNDOCUMENTED__turn_any_left_at_n {
121 0     0   0 my ($self) = @_;
122             return ($self->{'width'} == 1 ? undef
123 0 0       0 : $self->n_start + $self->{'width'} - 1);
124             }
125              
126             *turn_any_right = \&turn_any_left;
127             sub _UNDOCUMENTED__turn_any_right_at_n {
128 0     0   0 my ($self) = @_;
129             return ($self->{'width'} == 1 ? undef
130 0 0       0 : $self->n_start + $self->{'width'});
131             }
132              
133             sub turn_any_straight {
134 0     0 1 0 my ($self) = @_;
135 0         0 return ($self->{'width'} != 2); # width=2 never straight
136             }
137              
138              
139             #------------------------------------------------------------------------------
140              
141             sub new {
142 10     10 1 1169 my $self = shift->SUPER::new (@_);
143 10 100       45 if (! exists $self->{'width'}) {
144 2         4 $self->{'width'} = 1;
145             }
146 10 50       26 if (! defined $self->{'n_start'}) {
147 10         37 $self->{'n_start'} = $self->default_n_start;
148             }
149             ### width: $self->{'width'}
150 10         23 return $self;
151             }
152              
153             sub n_to_xy {
154 11     11 1 7002 my ($self, $n) = @_;
155             ### Rows n_to_xy(): "$n"
156              
157             # no division by width=0, and width<0 not meaningful for now
158 11         16 my $width;
159 11 50       41 if (($width = $self->{'width'}) <= 0) {
160             ### no points for width<=0
161 0         0 return;
162             }
163              
164 11         25 $n = $n - $self->{'n_start'}; # zero based
165              
166 11         1575 my $int = int($n); # BigFloat int() gives BigInt, use that
167 11         418 $n -= $int; # fraction part, preserve any BigFloat
168              
169 11 100       628 if (2*$n >= 1) { # if $n >= 0.5, but BigInt friendly
170 4         1654 $n -= 1;
171 4         989 $int += 1;
172             }
173             ### $n
174             ### $int
175             ### assert: $n >= -0.5
176             ### assert: $n < 0.5
177              
178 11         1314 my $y = int ($int / $width);
179 11         2940 $int -= $y*$width;
180 11 50       1933 if ($int < 0) { # ensure round down when $int negative
181 0         0 $int += $width;
182 0         0 $y -= 1;
183             }
184             ### floor y: $y
185             ### remainder: $int
186              
187 11         747 return ($n + $int,
188             $y);
189             }
190              
191             sub xy_to_n {
192 7     7 1 1293 my ($self, $x, $y) = @_;
193              
194 7         24 $x = round_nearest ($x);
195 7 50 33     40 if ($x < 0 || $x >= $self->{'width'}) {
196 0         0 return undef; # outside the column
197             }
198 7         19 $y = round_nearest ($y);
199 7         20 return $x + $y * $self->{'width'} + $self->{'n_start'};
200             }
201              
202             # exact
203             sub rect_to_n_range {
204 6     6 1 25 my ($self, $x1,$y1, $x2,$y2) = @_;
205             ### rect_to_n_range: "$x1,$y1 $x2,$y2"
206 6         14 my $width = $self->{'width'};
207              
208 6         19 $x1 = round_nearest ($x1);
209 6         13 $x2 = round_nearest ($x2);
210 6 100       15 if ($x2 < $x1) { ($x1,$x2) = ($x2,$x1) } # swap to x1
  1         3  
211              
212             ### x range: "$x1 to $x2"
213             ### assert: $x1<=$x2
214 6 50 33     50 if ($width <= 0 || $x1 >= $width || $x2 < 0) {
      33        
215             ### completely outside 0 to width, or width<=0
216 0         0 return (1,0);
217             }
218              
219 6         15 $y1 = round_nearest ($y1);
220 6         12 $y2 = round_nearest ($y2);
221 6 50       14 if ($y2 < $y1) { ($y1,$y2) = ($y2,$y1) } # swap to y1
  0         0  
222             ### assert: $y1<=$y2
223              
224 6 100       12 if ($x1 < 0) { $x1 *= 0; } # preserve bignum
  1         2  
225 6 100       13 if ($x2 >= $width) { $x2 = ($x2 * 0) + $width-1; } # preserve bignum
  1         3  
226              
227             ### rect exact on: "$x1,$y1 $x2,$y2"
228              
229             # exact range bottom left to top right
230             return ($x1 + $y1 * $width + $self->{'n_start'},
231 6         18 $x2 + $y2 * $width + $self->{'n_start'});
232             }
233              
234             1;
235             __END__