line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Algorithm::Line::Bresenham - simple pixellated line-drawing algorithm |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Algorithm::Line::Bresenham qw/line/; |
8
|
|
|
|
|
|
|
my @points = line(3,3 => 5,0); |
9
|
|
|
|
|
|
|
# returns the list: [3,3], [4,2], [4,1], [5,0] |
10
|
|
|
|
|
|
|
my @points = circle(30,30,5); |
11
|
|
|
|
|
|
|
# returns the points to draw a circle centered at 30,30, radius 5 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 DESCRIPTION |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Bresenham is one of the canonical line drawing algorithms for pixellated grids. |
16
|
|
|
|
|
|
|
Given a start and an end-point, Bresenham calculates which points on the grid |
17
|
|
|
|
|
|
|
need to be filled to generate the line between them. This module has been extended |
18
|
|
|
|
|
|
|
to include cureves crcles ellipses and thick licnes, variable thickness lines. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
package Algorithm::Line::Bresenham; |
25
|
1
|
|
|
1
|
|
54184
|
use strict; use warnings; |
|
1
|
|
|
1
|
|
3
|
|
|
1
|
|
|
|
|
23
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
33
|
|
26
|
|
|
|
|
|
|
our $VERSION = 0.151; |
27
|
1
|
|
|
1
|
|
4
|
use base 'Exporter'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
150
|
|
28
|
|
|
|
|
|
|
our @EXPORT_OK = qw/line circle ellipse_rect quad_bezier polyline varthick_line thick_line/; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head2 C |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
line ($from_x, $from_y => $to_x, $to_y); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Generates a list of all the intermediate points. This is returned as a list |
36
|
|
|
|
|
|
|
of array references. Previous versions used to include a callback parameter |
37
|
|
|
|
|
|
|
as a CODE ref to act on each point in turn. This version omits that for |
38
|
|
|
|
|
|
|
performance reasons |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=cut |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub line { # ported from https://gist.github.com/bert/1085538 |
43
|
1
|
|
|
1
|
|
424
|
use integer; |
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
3
|
|
44
|
6
|
|
|
6
|
1
|
90
|
my ($x0, $y0, $x1, $y1,$callback,$cbArgs)=@_; |
45
|
1
|
|
|
1
|
|
38
|
use integer; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
46
|
6
|
|
|
|
|
8
|
my $dx = abs ($x1 - $x0); |
47
|
6
|
100
|
|
|
|
13
|
my $sx = $x0 < $x1 ? 1 : -1; |
48
|
6
|
|
|
|
|
10
|
my $dy = -abs ($y1 - $y0); |
49
|
6
|
100
|
|
|
|
8
|
my $sy = $y0 < $y1 ? 1 : -1; |
50
|
6
|
|
|
|
|
10
|
my $err = $dx + $dy; |
51
|
6
|
|
|
|
|
8
|
my $e2; #/* error value e_xy */ |
52
|
|
|
|
|
|
|
my @points; |
53
|
|
|
|
|
|
|
|
54
|
6
|
|
|
|
|
6
|
while(1){ #/* loop */ |
55
|
21
|
50
|
|
|
|
31
|
if ($callback){ |
56
|
0
|
|
|
|
|
0
|
$callback->($x0,$y0,$cbArgs); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
else{ |
59
|
21
|
|
|
|
|
29
|
push @points,[$x0,$y0]; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
21
|
100
|
100
|
|
|
49
|
last if ($x0 == $x1 && $y0 == $y1); |
63
|
15
|
|
|
|
|
19
|
$e2 = 2 * $err; |
64
|
15
|
100
|
|
|
|
21
|
if ($e2 >= $dy) { $err += $dy; $x0 += $sx; } #/* e_xy+e_x > 0 */ |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
17
|
|
65
|
15
|
100
|
|
|
|
21
|
if ($e2 <= $dx) { $err += $dx; $y0 += $sy; } #/* e_xy+e_y < 0 */ |
|
10
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
12
|
|
66
|
|
|
|
|
|
|
} |
67
|
6
|
|
|
|
|
22
|
return @points; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 C |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my @points = circle ($x, $y, $radius) |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Returns the points to draw a circle centered on C<$x,$y> with |
76
|
|
|
|
|
|
|
radius C<$radius> |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub circle { # ported from https://gist.github.com/bert/1085538 |
81
|
1
|
|
|
1
|
1
|
4
|
my ($xm, $ym, $r)=@_; |
82
|
1
|
|
|
1
|
|
144
|
use integer; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
83
|
1
|
|
|
|
|
2
|
my $x = -$r; |
84
|
1
|
|
|
|
|
2
|
my $y = 0; |
85
|
1
|
|
|
|
|
2
|
my $err = 2-2*$r; #/* II. Quadrant */ |
86
|
1
|
|
|
|
|
1
|
my @points; |
87
|
1
|
|
|
|
|
2
|
do { |
88
|
1
|
|
|
|
|
3
|
push @points,[$xm-$x, $ym+$y];# /* I. Quadrant */ |
89
|
1
|
|
|
|
|
2
|
push @points,[$xm-$y, $ym-$x];# /* II. Quadrant */ |
90
|
1
|
|
|
|
|
2
|
push @points,[$xm+$x, $ym-$y];# /* III. Quadrant */ |
91
|
1
|
|
|
|
|
2
|
push @points,[$xm+$y, $ym+$x];# /* IV. Quadrant */ |
92
|
1
|
|
|
|
|
10
|
$r = $err; |
93
|
1
|
50
|
|
|
|
5
|
$err += ++$x*2+1 if ($r > $x); #/* e_xy+e_x > 0 */ |
94
|
1
|
50
|
|
|
|
4
|
$err += ++$y*2+1 if ($r <= $y); #/* e_xy+e_y < 0 */ |
95
|
|
|
|
|
|
|
} while ($x < 0); |
96
|
1
|
|
|
|
|
5
|
return @points; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 C |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
my @points = ellipse_rect ($x0, $y0, $x1, $y1) |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Returns the points to an ellipse bound within a rectangle defined by |
104
|
|
|
|
|
|
|
the two coordinate pairs passed. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub ellipse_rect{ # ported from https://gist.github.com/bert/1085538 |
110
|
1
|
|
|
1
|
|
117
|
use integer; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
3
|
|
111
|
1
|
|
|
1
|
1
|
3
|
my ($x0, $y0, $x1, $y1)=@_; |
112
|
1
|
|
|
|
|
2
|
my $a = abs ($x1 - $x0); |
113
|
1
|
|
|
|
|
2
|
my $b = abs ($y1 - $y0); |
114
|
1
|
|
|
|
|
2
|
my $b1 = $b & 1; #/* values of diameter */ |
115
|
1
|
|
|
|
|
2
|
my $dx = 4 * (1 - $a) * $b * $b; |
116
|
1
|
|
|
|
|
9
|
my $dy = 4 * ($b1 + 1) * $a * $a; #/* error increment */ |
117
|
1
|
|
|
|
|
3
|
my $err = $dx + $dy + $b1 * $a * $a; |
118
|
1
|
|
|
|
|
1
|
my $e2; #/* error of 1.step */ |
119
|
|
|
|
|
|
|
|
120
|
1
|
50
|
|
|
|
4
|
if ($x0 > $x1) { $x0 = $x1; $x1 += $a; } #/* if called with swapped points */ |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
121
|
1
|
50
|
|
|
|
2
|
$y0 = $y1 if ($y0 >$y1);# /* .. exchange them */ |
122
|
1
|
|
|
|
|
2
|
$y0 += ($b + 1) / 2; |
123
|
1
|
|
|
|
|
1
|
$y1 = $y0-$b1; #/* starting pixel */ |
124
|
1
|
|
|
|
|
2
|
$a *= 8 * $a; $b1 = 8 * $b * $b; |
|
1
|
|
|
|
|
2
|
|
125
|
1
|
|
|
|
|
1
|
my @points; |
126
|
|
|
|
|
|
|
do |
127
|
1
|
|
|
|
|
2
|
{ |
128
|
3
|
|
|
|
|
5
|
push @points,[$x1, $y0];# /* I. Quadrant */ |
129
|
3
|
|
|
|
|
5
|
push @points,[$x0, $y0];# /* II. Quadrant */ |
130
|
3
|
|
|
|
|
6
|
push @points,[$x0, $y1];# /* III. Quadrant */ |
131
|
3
|
|
|
|
|
4
|
push @points,[$x1, $y1];# /* IV. Quadrant */ |
132
|
3
|
|
|
|
|
4
|
$e2 = 2 * $err; |
133
|
3
|
50
|
|
|
|
5
|
if ($e2 >= $dx) |
134
|
|
|
|
|
|
|
{ |
135
|
3
|
|
|
|
|
4
|
$x0++; |
136
|
3
|
|
|
|
|
3
|
$x1--; |
137
|
3
|
|
|
|
|
3
|
$err += $dx += $b1; # does this translate into perl |
138
|
|
|
|
|
|
|
} #/* x step */ |
139
|
3
|
50
|
|
|
|
10
|
if ($e2 <= $dy) |
140
|
|
|
|
|
|
|
{ |
141
|
0
|
|
|
|
|
0
|
$y0++; |
142
|
0
|
|
|
|
|
0
|
$y1--; |
143
|
0
|
|
|
|
|
0
|
$err += $dy += $a; |
144
|
|
|
|
|
|
|
} #/* y step */ |
145
|
|
|
|
|
|
|
} while ($x0 <= $x1); |
146
|
1
|
|
|
|
|
3
|
while ($y0-$y1 < $b) |
147
|
|
|
|
|
|
|
{ #/* too early stop of flat ellipses a=1 */ |
148
|
0
|
|
|
|
|
0
|
push @points,[$x0-1, $y0]; #/* -> finish tip of ellipse */ |
149
|
0
|
|
|
|
|
0
|
push @points,[$x1+1, $y0++]; |
150
|
0
|
|
|
|
|
0
|
push @points,[$x0-1, $y1]; |
151
|
0
|
|
|
|
|
0
|
push @points,[$x1+1, $y1--]; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
1
|
|
|
|
|
10
|
return @points; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 C |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my @points = basic_bezier ($x0, $y0, $x1, $y1, $x2, $y2) |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
This is not usefull on its own. Iteturns the points to segment of a |
162
|
|
|
|
|
|
|
bezier curve without a gradient sign change. It is a companion to |
163
|
|
|
|
|
|
|
the C function that splits a bezier into segments |
164
|
|
|
|
|
|
|
with each gradient direction and these segments are computed in |
165
|
|
|
|
|
|
|
C |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=cut |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub basic_bezier{ # without gradient changes adapted from https://gist.github.com/bert/1085538 |
171
|
2
|
|
|
2
|
1
|
4
|
my ($x0, $y0, $x1, $y1, $x2, $y2)=@_; |
172
|
2
|
50
|
|
|
|
6
|
my $sx = $x0 < $x2 ? 1 : -1; |
173
|
2
|
100
|
|
|
|
5
|
my $sy = $y0 < $y2 ? 1 : -1; #/* step direction */ |
174
|
2
|
|
|
|
|
3
|
my $cur = $sx * $sy *(($x0 - $x1) * ($y2 - $y1) - ($x2 - $x1) * ($y0 - $y1)); #/* curvature */ |
175
|
2
|
|
|
|
|
3
|
my $x = $x0 - 2 * $x1 + $x2; |
176
|
2
|
|
|
|
|
4
|
my $y = $y0 - 2 * $y1 +$y2; |
177
|
2
|
|
|
|
|
3
|
my $xy = 2 * $x * $y * $sx * $sy; |
178
|
|
|
|
|
|
|
# /* compute error increments of P0 */ |
179
|
2
|
|
|
|
|
6
|
my $dx = (1 - 2 * abs ($x0 - $x1)) * $y * $y + abs ($y0 - $y1) * $xy - 2 * $cur * abs ($y0 - $y2); |
180
|
2
|
|
|
|
|
4
|
my $dy = (1 - 2 * abs ($y0 - $y1)) * $x * $x + abs ($x0 - $x1) * $xy + 2 * $cur * abs ($x0 - $x2); |
181
|
|
|
|
|
|
|
#/* compute error increments of P2 */ |
182
|
2
|
|
|
|
|
5
|
my $ex = (1 - 2 * abs ($x2 - $x1)) * $y * $y + abs ($y2 - $y1) * $xy + 2 * $cur * abs ($y0 - $y2); |
183
|
2
|
|
|
|
|
5
|
my $ey = (1 - 2 * abs ($y2 - $y1)) * $x * $x + abs ($x2 - $x1) * $xy - 2 * $cur * abs ($x0 - $x2); |
184
|
|
|
|
|
|
|
# /* sign of gradient must not change */ |
185
|
2
|
50
|
33
|
|
|
17
|
warn "gradient change detected" unless (($x0 - $x1) * ($x2 - $x1) <= 0 && ($y0 - $y1) * ($y2 - $y1) <= 0); |
186
|
2
|
50
|
|
|
|
5
|
if ($cur == 0) |
187
|
|
|
|
|
|
|
{ #/* straight line */ |
188
|
0
|
|
|
|
|
0
|
return line ($x0, $y0, $x2, $y2); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
} |
191
|
2
|
|
|
|
|
3
|
$x *= 2 * $x; |
192
|
2
|
|
|
|
|
3
|
$y *= 2 * $y; |
193
|
2
|
100
|
|
|
|
5
|
if ($cur < 0) |
194
|
|
|
|
|
|
|
{ #/* negated curvature */ |
195
|
1
|
|
|
|
|
1
|
$x = -$x; |
196
|
1
|
|
|
|
|
1
|
$dx = -$dx; |
197
|
1
|
|
|
|
|
2
|
$ex = -$ex; |
198
|
1
|
|
|
|
|
1
|
$xy = -$xy; |
199
|
1
|
|
|
|
|
2
|
$y = -$y; |
200
|
1
|
|
|
|
|
1
|
$dy = -$dy; |
201
|
1
|
|
|
|
|
1
|
$ey = -$ey; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
#/* algorithm fails for almost straight line, check error values */ |
204
|
2
|
50
|
33
|
|
|
20
|
if ($dx >= -$y || $dy <= -$x || $ex <= -$y || $ey >= -$x) |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
205
|
|
|
|
|
|
|
{ |
206
|
0
|
|
|
|
|
0
|
return (line ($x0, $y0, $x1, $y1), line ($x1, $y1, $x2, $y2)); #/* simple approximation */ |
207
|
|
|
|
|
|
|
} |
208
|
2
|
|
|
|
|
3
|
$dx -= $xy; |
209
|
2
|
|
|
|
|
3
|
$ex = $dx + $dy; |
210
|
2
|
|
|
|
|
2
|
$dy -= $xy; #/* error of 1.step */ |
211
|
2
|
|
|
|
|
3
|
my @points; |
212
|
2
|
|
|
|
|
4
|
while(1) |
213
|
|
|
|
|
|
|
{ #/* plot curve */ |
214
|
7
|
|
|
|
|
10
|
push @points,[$x0, $y0]; |
215
|
7
|
|
|
|
|
10
|
$ey = 2 * $ex - $dy; #/* save value for test of y step */ |
216
|
7
|
50
|
|
|
|
9
|
if (2 * $ex >= $dx) |
217
|
|
|
|
|
|
|
{ #/* x step */ |
218
|
7
|
100
|
|
|
|
14
|
last if ($x0 == $x2); |
219
|
5
|
|
|
|
|
6
|
$x0 += $sx; |
220
|
5
|
|
|
|
|
5
|
$dy -= $xy; |
221
|
5
|
|
|
|
|
6
|
$ex += $dx += $y; |
222
|
|
|
|
|
|
|
} |
223
|
5
|
100
|
|
|
|
8
|
if ($ey <= 0) |
224
|
|
|
|
|
|
|
{ #/* y step */ |
225
|
2
|
50
|
|
|
|
4
|
last if ($y0 == $y2); |
226
|
2
|
|
|
|
|
3
|
$y0 += $sy; |
227
|
2
|
|
|
|
|
2
|
$dx -= $xy; |
228
|
2
|
|
|
|
|
3
|
$ex += $dy += $x; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
2
|
|
|
|
|
6
|
return @points; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head2 C |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
my @points = quad_bezier ($x0, $y0, $x1, $y1, $x2, $y2) |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Draws a Bezier curve from C<($x0,$y0)> to C<($x2,$y2)> using control |
240
|
|
|
|
|
|
|
point C<($x1,$y1)> |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
sub quad_bezier{ # adapted from http://members.chello.at/easyfilter/bresenham.html |
246
|
1
|
|
|
1
|
1
|
3
|
my ($x0, $y0, $x1, $y1, $x2, $y2)=@_;# /* plot any quadratic Bezier curve */ |
247
|
1
|
|
|
|
|
2
|
my $x = $x0-$x1; |
248
|
1
|
|
|
|
|
2
|
my $y = $y0-$y1; |
249
|
1
|
|
|
|
|
3
|
my $t = $x0-2*$x1+$x2; |
250
|
1
|
|
|
|
|
2
|
my $r; |
251
|
|
|
|
|
|
|
my @points; |
252
|
1
|
50
|
|
|
|
4
|
if ($x*($x2-$x1) > 0) { #/* horizontal cut at P4? */ |
253
|
0
|
0
|
|
|
|
0
|
if ($y*($y2-$y1) > 0){ #/* vertical cut at P6 too? */ |
254
|
0
|
0
|
|
|
|
0
|
if (abs(($y0-2*$y1+$y2)/$t*$x) > abs($y)) { #/* which first? */ |
255
|
0
|
|
|
|
|
0
|
$x0 = $x2; $x2 = $x+$x1; $y0 = $y2; $y2 = $y+$y1;# /* swap points */ |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
256
|
|
|
|
|
|
|
} #/* now horizontal cut at P4 comes first */ |
257
|
|
|
|
|
|
|
} |
258
|
0
|
|
|
|
|
0
|
$t = ($x0-$x1)/$t; |
259
|
0
|
|
|
|
|
0
|
$r = (1-$t)*((1-$t)*$y0+2.0*$t*$y1)+$t*$t*$y2;# /* By(t=P4) */ |
260
|
0
|
|
|
|
|
0
|
$t = ($x0*$x2-$x1*$x1)*$t/($x0-$x1); #/* gradient dP4/dx=0 */ |
261
|
0
|
|
|
|
|
0
|
$x = int($t+0.5); $y = int($r+0.5); |
|
0
|
|
|
|
|
0
|
|
262
|
0
|
|
|
|
|
0
|
$r = ($y1-$y0)*($t-$x0)/($x1-$x0)+$y0; #/* intersect P3 | P0 P1 */ |
263
|
0
|
|
|
|
|
0
|
push @points, basic_bezier($x0,$y0, $x,int($r+0.5), $x,$y); |
264
|
0
|
|
|
|
|
0
|
$r = ($y1-$y2)*($t-$x2)/($x1-$x2)+$y2; #/* intersect P4 | P1 P2 */ |
265
|
0
|
|
|
|
|
0
|
$x0 = $x1 = $x; $y0 = $y; $y1 = int($r+0.5);# /* P0 = P4, P1 = P8 */ |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
266
|
|
|
|
|
|
|
} |
267
|
1
|
50
|
|
|
|
4
|
if (($y0-$y1)*($y2-$y1) > 0) { #/* vertical cut at P6? */ |
268
|
1
|
|
|
|
|
3
|
$t = $y0-2*$y1+$y2; $t = ($y0-$y1)/$t; |
|
1
|
|
|
|
|
2
|
|
269
|
1
|
|
|
|
|
5
|
$r = (1-$t)*((1-$t)*$x0+2.0*$t*$x1)+$t*$t*$x2; # /* Bx(t=P6) */ |
270
|
1
|
|
|
|
|
3
|
$t = ($y0*$y2-$y1*$y1)*$t/($y0-$y1); #/* gradient dP6/dy=0 */ |
271
|
1
|
|
|
|
|
2
|
$x = int($r+0.5); $y = int($t+0.5); |
|
1
|
|
|
|
|
2
|
|
272
|
1
|
|
|
|
|
3
|
$r = ($x1-$x0)*($t-$y0)/($y1-$y0)+$x0; #/* intersect P6 | P0 P1 */ |
273
|
1
|
|
|
|
|
4
|
push @points, basic_bezier($x0,$y0, int($r+0.5),$y, $x,$y); |
274
|
1
|
|
|
|
|
8
|
$r = ($x1-$x2)*($t-$y2)/($y1-$y2)+$x2; #/* intersect P7 | P1 P2 */ |
275
|
1
|
|
|
|
|
2
|
$x0 = $x; $x1 = int($r+0.5); $y0 = $y1 = $y;# /* P0 = P6, P1 = P7 */ |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
276
|
|
|
|
|
|
|
} |
277
|
1
|
|
|
|
|
3
|
push @points, basic_bezier($x0,$y0, $x1,$y1, $x2,$y2); #/* remaining part */ |
278
|
1
|
|
|
|
|
4
|
return @points; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head2 C |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
my @points = polyline ($x0, $y0, $x1, $y1, $x2, $y2) |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Draws a polyline between points served as a list of x,y pairs |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub polyline{ |
290
|
1
|
|
|
1
|
1
|
2
|
my @vertices; |
291
|
1
|
|
|
|
|
7
|
push @vertices,[shift,shift] while (@_>1); |
292
|
1
|
|
|
|
|
2
|
my @points; |
293
|
1
|
|
|
|
|
3
|
foreach my $vertex(0..(@vertices-2)){ |
294
|
2
|
|
|
|
|
3
|
push @points,line(@{$vertices[$vertex]},@{$vertices[$vertex+1]}); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
5
|
|
295
|
2
|
100
|
|
|
|
6
|
pop @points if ($vertex < (@vertices-2)); # remove duplicated points |
296
|
|
|
|
|
|
|
} |
297
|
1
|
|
|
|
|
4
|
return @points; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 C |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
my @points = thick_line ($x0, $y0, $x1, $y1,$thickness) |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Draws a line thickened using Murphy's modication of Bresenham'salgorithm |
305
|
|
|
|
|
|
|
between two points of x,y pairs. This routine was further enahnced to |
306
|
|
|
|
|
|
|
provide variable thickness lines and uses multiple helper subroutines. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head2 C |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
my @points= varthick_line($x0,$y0,$x1,$y1,$leftFn,$argL,$rightFn,$argR) |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
Variable thickness lines are implemented as described in |
313
|
|
|
|
|
|
|
http://kt8216.unixcab.org/murphy/index.html ; This allows passing of |
314
|
|
|
|
|
|
|
two subroutine references (so the left side and the right sides of the |
315
|
|
|
|
|
|
|
line can have differently varying thicknesses) along with a |
316
|
|
|
|
|
|
|
user originated parameter. The subroutine reference example is shown below: |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
my $leftFn=sub{ |
319
|
|
|
|
|
|
|
my ($arg,$p,$l)=@_; |
320
|
|
|
|
|
|
|
# C<$arg> is passed by calling routine, |
321
|
|
|
|
|
|
|
# C<$p> is point on line |
322
|
|
|
|
|
|
|
# C<$l> is length of line |
323
|
|
|
|
|
|
|
return $p % $arg; |
324
|
|
|
|
|
|
|
}; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=cut |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
## Variable thickness lines using Murphy's Modification of Bresenham Line Algorithm** |
329
|
|
|
|
|
|
|
## Codes ported from C in http://kt8216.unixcab.org/murphy/index.html |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
#* X BASED LINES * |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub x_perpendicular{ |
334
|
0
|
|
|
0
|
0
|
0
|
my ($x0,$y0,$dx,$dy,$xstep,$ystep,$einit,$w_left,$w_right,$winit)=@_; |
335
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
0
|
my @pts; |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
0
|
my $threshold = $dx - 2*$dy; |
339
|
0
|
|
|
|
|
0
|
my $E_diag= -2*$dx; |
340
|
0
|
|
|
|
|
0
|
my $E_square= 2*$dy; |
341
|
0
|
|
|
|
|
0
|
my $p=my $q=0; |
342
|
|
|
|
|
|
|
|
343
|
0
|
|
|
|
|
0
|
my $y= $y0; |
344
|
0
|
|
|
|
|
0
|
my $x= $x0; |
345
|
0
|
|
|
|
|
0
|
my $error= $einit; |
346
|
0
|
|
|
|
|
0
|
my $tk= $dx+$dy-$winit; |
347
|
|
|
|
|
|
|
|
348
|
0
|
|
|
|
|
0
|
while($tk<=$w_left) |
349
|
|
|
|
|
|
|
{ |
350
|
0
|
|
|
|
|
0
|
push (@pts,[$x,$y]); |
351
|
0
|
0
|
|
|
|
0
|
if ($error>=$threshold) |
352
|
|
|
|
|
|
|
{ |
353
|
0
|
|
|
|
|
0
|
$x= $x + $xstep; |
354
|
0
|
|
|
|
|
0
|
$error = $error + $E_diag; |
355
|
0
|
|
|
|
|
0
|
$tk= $tk + 2*$dy; |
356
|
|
|
|
|
|
|
} |
357
|
0
|
|
|
|
|
0
|
$error = $error + $E_square; |
358
|
0
|
|
|
|
|
0
|
$y= $y + $ystep; |
359
|
0
|
|
|
|
|
0
|
$tk= $tk + 2*$dx; |
360
|
0
|
|
|
|
|
0
|
$q++; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
0
|
|
|
|
|
0
|
$y= $y0; |
364
|
0
|
|
|
|
|
0
|
$x= $x0; |
365
|
0
|
|
|
|
|
0
|
$error= -$einit; |
366
|
0
|
|
|
|
|
0
|
$tk= $dx+$dy+$winit; |
367
|
|
|
|
|
|
|
|
368
|
0
|
|
|
|
|
0
|
while($tk<=$w_right) |
369
|
|
|
|
|
|
|
{ |
370
|
0
|
0
|
|
|
|
0
|
push (@pts,[$x,$y]) if ($p); |
371
|
0
|
0
|
|
|
|
0
|
if ($error>$threshold) |
372
|
|
|
|
|
|
|
{ |
373
|
0
|
|
|
|
|
0
|
$x= $x - $xstep; |
374
|
0
|
|
|
|
|
0
|
$error = $error + $E_diag; |
375
|
0
|
|
|
|
|
0
|
$tk= $tk + 2*$dy; |
376
|
|
|
|
|
|
|
} |
377
|
0
|
|
|
|
|
0
|
$error = $error + $E_square; |
378
|
0
|
|
|
|
|
0
|
$y= $y - $ystep; |
379
|
0
|
|
|
|
|
0
|
$tk= $tk + 2*$dx; |
380
|
0
|
|
|
|
|
0
|
$p++; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
0
|
0
|
0
|
|
|
0
|
push (@pts,[$x,$y]) if ($q==0 && $p<2); # we need this for very thin lines |
384
|
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
0
|
return @pts; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub x_varthick_line{ |
390
|
0
|
|
|
0
|
0
|
0
|
my ($x0,$y0,$dx,$dy,$xstep,$ystep, |
391
|
|
|
|
|
|
|
$left, $argL, #left thickness function |
392
|
|
|
|
|
|
|
$right,$argR, #right thickness function |
393
|
|
|
|
|
|
|
$pxstep,$pystep)=@_; |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
0
|
my @xPoints; |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
0
|
my $p_error= 0; |
398
|
0
|
|
|
|
|
0
|
my $error= 0; |
399
|
0
|
|
|
|
|
0
|
my $y= $y0; |
400
|
0
|
|
|
|
|
0
|
my $x= $x0; |
401
|
0
|
|
|
|
|
0
|
my $threshold = $dx - 2*$dy; |
402
|
0
|
|
|
|
|
0
|
my $E_diag= -2*$dx; |
403
|
0
|
|
|
|
|
0
|
my $E_square= 2*$dy; |
404
|
0
|
|
|
|
|
0
|
my $length = $dx+1; |
405
|
0
|
|
|
|
|
0
|
my $D= sqrt($dx*$dx+$dy*$dy); |
406
|
|
|
|
|
|
|
|
407
|
0
|
|
|
|
|
0
|
for(my $p=0;$p<$length;$p++) |
408
|
|
|
|
|
|
|
{ |
409
|
0
|
|
|
|
|
0
|
my $w_left= $left->($argL, $p, $length)*2*$D; |
410
|
0
|
|
|
|
|
0
|
my $w_right= $right->($argR,$p, $length)*2*$D; |
411
|
0
|
|
|
|
|
0
|
push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep, |
412
|
|
|
|
|
|
|
$p_error,$w_left,$w_right,$error); |
413
|
0
|
0
|
|
|
|
0
|
if ($error>=$threshold) |
414
|
|
|
|
|
|
|
{ |
415
|
0
|
|
|
|
|
0
|
$y= $y + $ystep; |
416
|
0
|
|
|
|
|
0
|
$error = $error + $E_diag; |
417
|
0
|
0
|
|
|
|
0
|
if ($p_error>=$threshold) |
418
|
|
|
|
|
|
|
{ |
419
|
0
|
|
|
|
|
0
|
push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep, |
420
|
|
|
|
|
|
|
($p_error+$E_diag+$E_square), |
421
|
|
|
|
|
|
|
$w_left,$w_right,$error); |
422
|
0
|
|
|
|
|
0
|
$p_error= $p_error + $E_diag; |
423
|
|
|
|
|
|
|
} |
424
|
0
|
|
|
|
|
0
|
$p_error= $p_error + $E_square; |
425
|
|
|
|
|
|
|
} |
426
|
0
|
|
|
|
|
0
|
$error = $error + $E_square; |
427
|
0
|
|
|
|
|
0
|
$x= $x + $xstep; |
428
|
|
|
|
|
|
|
} |
429
|
0
|
|
|
|
|
0
|
return @xPoints; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
#* Y BASED LINES * |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub y_perpendicular{ |
435
|
23
|
|
|
23
|
0
|
35
|
my ($x0,$y0,$dx,$dy,$xstep,$ystep, |
436
|
|
|
|
|
|
|
$einit,$w_left, $w_right,$winit)=@_; |
437
|
|
|
|
|
|
|
|
438
|
23
|
|
|
|
|
26
|
my @pts; |
439
|
|
|
|
|
|
|
|
440
|
23
|
|
|
|
|
30
|
my $threshold = $dy - 2*$dx; |
441
|
23
|
|
|
|
|
46
|
my $E_diag= -2*$dy; |
442
|
23
|
|
|
|
|
27
|
my $E_square= 2*$dx; |
443
|
23
|
|
|
|
|
24
|
my $p=my $q=0; |
444
|
|
|
|
|
|
|
|
445
|
23
|
|
|
|
|
24
|
my $y= $y0; |
446
|
23
|
|
|
|
|
24
|
my $x= $x0; |
447
|
23
|
|
|
|
|
25
|
my $error= -$einit; |
448
|
23
|
|
|
|
|
28
|
my $tk= $dx+$dy+$winit; |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
|
451
|
23
|
|
|
|
|
39
|
while($tk<=$w_left) |
452
|
|
|
|
|
|
|
{ |
453
|
31
|
|
|
|
|
43
|
push @pts,[$x,$y]; |
454
|
31
|
100
|
|
|
|
49
|
if ($error>$threshold) |
455
|
|
|
|
|
|
|
{ |
456
|
16
|
|
|
|
|
19
|
$y= $y + $ystep; |
457
|
16
|
|
|
|
|
16
|
$error = $error + $E_diag; |
458
|
16
|
|
|
|
|
20
|
$tk= $tk + 2*$dx; |
459
|
|
|
|
|
|
|
} |
460
|
31
|
|
|
|
|
34
|
$error = $error + $E_square; |
461
|
31
|
|
|
|
|
33
|
$x= $x + $xstep; |
462
|
31
|
|
|
|
|
32
|
$tk= $tk + 2*$dy; |
463
|
31
|
|
|
|
|
44
|
$q++; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
|
467
|
23
|
|
|
|
|
34
|
$y= $y0; |
468
|
23
|
|
|
|
|
25
|
$x= $x0; |
469
|
23
|
|
|
|
|
24
|
$error= $einit; |
470
|
23
|
|
|
|
|
26
|
$tk= $dx+$dy-$winit; |
471
|
|
|
|
|
|
|
|
472
|
23
|
|
|
|
|
34
|
while($tk<=$w_right) |
473
|
|
|
|
|
|
|
{ |
474
|
27
|
100
|
|
|
|
43
|
push (@pts,[$x,$y]) if ($p); |
475
|
27
|
100
|
|
|
|
42
|
if ($error>=$threshold) |
476
|
|
|
|
|
|
|
{ |
477
|
12
|
|
|
|
|
13
|
$y= $y - $ystep; |
478
|
12
|
|
|
|
|
13
|
$error = $error + $E_diag; |
479
|
12
|
|
|
|
|
13
|
$tk= $tk + 2*$dx; |
480
|
|
|
|
|
|
|
} |
481
|
27
|
|
|
|
|
30
|
$error = $error + $E_square; |
482
|
27
|
|
|
|
|
30
|
$x= $x - $xstep; |
483
|
27
|
|
|
|
|
28
|
$tk= $tk + 2*$dy; |
484
|
27
|
|
|
|
|
38
|
$p++; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
23
|
50
|
33
|
|
|
37
|
push (@pts,[$x,$y]) if ($q==0 && $p<2); # we need this for very thin lines |
488
|
23
|
|
|
|
|
38
|
return @pts; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
sub y_varthick_line { |
493
|
1
|
|
|
1
|
0
|
4
|
my ($x0,$y0,$dx,$dy,$xstep,$ystep, |
494
|
|
|
|
|
|
|
$left, $argL, #left thickness function |
495
|
|
|
|
|
|
|
$right,$argR, #right thickness function |
496
|
|
|
|
|
|
|
$pxstep,$pystep)=@_; |
497
|
|
|
|
|
|
|
|
498
|
1
|
|
|
|
|
1
|
my @yPoints; |
499
|
1
|
|
|
|
|
2
|
my $p_error= 0; |
500
|
1
|
|
|
|
|
1
|
my $error= 0; |
501
|
1
|
|
|
|
|
2
|
my $y= $y0; |
502
|
1
|
|
|
|
|
1
|
my $x= $x0; |
503
|
1
|
|
|
|
|
2
|
my $threshold = $dy - 2*$dx; |
504
|
1
|
|
|
|
|
2
|
my $E_diag= -2*$dy; |
505
|
1
|
|
|
|
|
2
|
my $E_square= 2*$dx; |
506
|
1
|
|
|
|
|
1
|
my $length = $dy+1; |
507
|
1
|
|
|
|
|
3
|
my $D= sqrt($dx*$dx+$dy*$dy); |
508
|
|
|
|
|
|
|
|
509
|
1
|
|
|
|
|
3
|
for(my $p=0;$p<$length;$p++) |
510
|
|
|
|
|
|
|
{ |
511
|
19
|
|
|
|
|
27
|
my $w_left= $left->($argL, $p, $length)*2*$D; |
512
|
19
|
|
|
|
|
26
|
my $w_right= $right->($argR,$p, $length)*2*$D; |
513
|
19
|
|
|
|
|
26
|
push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep, |
514
|
|
|
|
|
|
|
$p_error,$w_left,$w_right,$error); |
515
|
19
|
100
|
|
|
|
30
|
if ($error>=$threshold) |
516
|
|
|
|
|
|
|
{ |
517
|
8
|
|
|
|
|
8
|
$x= $x + $xstep; |
518
|
8
|
|
|
|
|
9
|
$error = $error + $E_diag; |
519
|
8
|
100
|
|
|
|
12
|
if ($p_error>=$threshold) |
520
|
|
|
|
|
|
|
{ |
521
|
4
|
|
|
|
|
14
|
push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep, |
522
|
|
|
|
|
|
|
($p_error+$E_diag+$E_square),$w_left,$w_right,$error); |
523
|
4
|
|
|
|
|
4
|
$p_error= $p_error + $E_diag; |
524
|
|
|
|
|
|
|
} |
525
|
8
|
|
|
|
|
9
|
$p_error= $p_error + $E_square; |
526
|
|
|
|
|
|
|
} |
527
|
19
|
|
|
|
|
21
|
$error = $error + $E_square; |
528
|
19
|
|
|
|
|
31
|
$y= $y + $ystep; |
529
|
|
|
|
|
|
|
} |
530
|
1
|
|
|
|
|
14
|
return @yPoints; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
#* ENTRY * |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
sub thick_line{ |
536
|
1
|
|
|
1
|
1
|
3
|
my ($x0,$y0,$x1,$y1,$thickness)=@_; |
537
|
19
|
|
|
19
|
|
28
|
return varthick_line($x0,$y0,$x1,$y1,sub{return (1+$thickness)/2},undef,sub{return (1+$thickness)/2},undef) |
|
19
|
|
|
|
|
28
|
|
538
|
1
|
|
|
|
|
7
|
}; |
539
|
|
|
|
|
|
|
sub varthick_line{ |
540
|
1
|
|
|
1
|
1
|
3
|
my ($x0,$y0,$x1,$y1, |
541
|
|
|
|
|
|
|
$left,$argL, |
542
|
|
|
|
|
|
|
$right,$argR)=@_; |
543
|
|
|
|
|
|
|
|
544
|
1
|
|
|
|
|
2
|
my $dx= $x1-$x0; |
545
|
1
|
|
|
|
|
2
|
my $dy= $y1-$y0; |
546
|
1
|
|
|
|
|
2
|
my $xstep= my $ystep= 1; |
547
|
|
|
|
|
|
|
|
548
|
1
|
50
|
|
|
|
3
|
if ($dx<0) { $dx= -$dx; $xstep= -1; } |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
549
|
1
|
50
|
|
|
|
27
|
if ($dy<0) { $dy= -$dy; $ystep= -1; } |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
1
|
|
550
|
|
|
|
|
|
|
|
551
|
1
|
50
|
|
|
|
4
|
$xstep= 0 if ($dx==0); |
552
|
1
|
50
|
|
|
|
2
|
$ystep= 0 if ($dy==0); |
553
|
1
|
|
|
|
|
2
|
my $pxstep; my $pystep; |
554
|
|
|
|
|
|
|
|
555
|
1
|
|
|
|
|
1
|
my $xch= 0; |
556
|
1
|
|
|
|
|
4
|
for($xstep + $ystep*4){ |
557
|
1
|
50
|
|
|
|
3
|
($_==-1 + -1*4) && do {$pystep= -1; $pxstep= 1; $xch= 1; last;}; # -5 |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
558
|
0
|
0
|
|
|
|
0
|
($_==-1 + 0*4) && do {$pystep= -1; $pxstep= 0; $xch= 1; last;}; # -1 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
559
|
0
|
0
|
|
|
|
0
|
($_==-1 + 1*4) && do {$pystep= 1; $pxstep= 1; last;}; # 3 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
560
|
0
|
0
|
|
|
|
0
|
($_== 0 + -1*4) && do {$pystep= 0; $pxstep= -1; last;}; # -4 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
561
|
0
|
0
|
|
|
|
0
|
($_== 0 + 0*4) && do {$pystep= 0; $pxstep= 0; last;}; # 0 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
562
|
0
|
0
|
|
|
|
0
|
($_== 0 + 1*4) && do {$pystep= 0; $pxstep= 1; last;}; # 4 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
563
|
0
|
0
|
|
|
|
0
|
($_== 1 + -1*4) && do {$pystep= -1; $pxstep= -1; last;}; # -3 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
564
|
0
|
0
|
|
|
|
0
|
($_== 1 + 0*4) && do {$pystep= -1; $pxstep= 0; last;}; # 1 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
565
|
0
|
0
|
|
|
|
0
|
($_== 1 + 1*4) && do {$pystep= 1; $pxstep= -1; $xch=1; last;}; # 5 |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
1
|
50
|
|
|
|
2
|
if ($xch){ |
569
|
1
|
|
|
|
|
1
|
my $K; |
570
|
1
|
|
|
|
|
2
|
$K= $argL; $argL= $argR; $argR= $K; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
2
|
|
571
|
1
|
|
|
|
|
1
|
$K= $left; $left= $right; $right= $K; } |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
2
|
|
572
|
|
|
|
|
|
|
|
573
|
1
|
50
|
|
|
|
8
|
if ($dx>$dy){ |
574
|
0
|
|
|
|
|
0
|
return x_varthick_line($x0,$y0,$dx,$dy,$xstep,$ystep, |
575
|
|
|
|
|
|
|
$left,$argL,$right,$argR, |
576
|
|
|
|
|
|
|
$pxstep,$pystep); |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
else{ |
579
|
1
|
|
|
|
|
3
|
return y_varthick_line($x0,$y0,$dx,$dy,$xstep,$ystep, |
580
|
|
|
|
|
|
|
$left,$argL,$right,$argR, |
581
|
|
|
|
|
|
|
$pxstep,$pystep); |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
1; |
589
|
|
|
|
|
|
|
__END__ |