line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
######################################################################################### |
2
|
|
|
|
|
|
|
# Package HiPi::Graphics::DrawingContext |
3
|
|
|
|
|
|
|
# Description : Common Monochrome Drawing Context |
4
|
|
|
|
|
|
|
# Copyright : Copyright (c) 2018 Mark Dootson |
5
|
|
|
|
|
|
|
# License : This is free software; you can redistribute it and/or modify it under |
6
|
|
|
|
|
|
|
# the same terms as the Perl 5 programming language system itself. |
7
|
|
|
|
|
|
|
######################################################################################### |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package HiPi::Graphics::DrawingContext; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
######################################################################################### |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
14
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
15
|
1
|
|
|
1
|
|
484
|
use HiPi::Graphics::BitmapFont; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
51
|
|
16
|
|
|
|
|
|
|
|
17
|
1
|
|
|
1
|
|
7
|
use parent qw( HiPi::Class ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION ='0.81'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
__PACKAGE__->create_accessors( qw( contextarray pen_inverted ) ); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use constant { |
24
|
1
|
|
|
|
|
4119
|
TRIG_PI => 3.14159265358979, |
25
|
|
|
|
|
|
|
DEFAULT_FONT => HiPi::Graphics::BitmapFont::MONO_OLED_DEFAULT_FONT, |
26
|
1
|
|
|
1
|
|
84
|
}; |
|
1
|
|
|
|
|
3
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub new { |
29
|
0
|
|
|
0
|
0
|
|
my( $class, %params) = @_; |
30
|
0
|
|
0
|
|
|
|
$params{contextarray} //= []; |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
my $self = $class->SUPER::new( %params ); |
33
|
0
|
|
|
|
|
|
return $self; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub clear_context { |
37
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
38
|
0
|
|
|
|
|
|
$self->contextarray( [] ); |
39
|
0
|
|
|
|
|
|
return; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub get_context_bounds { |
43
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
44
|
|
|
|
|
|
|
|
45
|
0
|
|
|
|
|
|
my ($minx, $miny, $maxx, $maxy); |
46
|
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
|
for my $point ( @{ $self->contextarray } ) { |
|
0
|
|
|
|
|
|
|
48
|
0
|
|
|
|
|
|
my($x,$y,$on) = @$point; |
49
|
0
|
0
|
|
|
|
|
if( $minx ) { |
50
|
0
|
0
|
|
|
|
|
$minx = $x if $x < $minx; |
51
|
0
|
0
|
|
|
|
|
$miny = $y if $y < $miny; |
52
|
0
|
0
|
|
|
|
|
$maxx = $x if $x > $maxx; |
53
|
0
|
0
|
|
|
|
|
$maxy = $y if $y > $maxy; |
54
|
|
|
|
|
|
|
} else { |
55
|
0
|
|
|
|
|
|
$minx = $maxx = $x; |
56
|
0
|
|
|
|
|
|
$miny = $maxy = $y; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
0
|
|
|
|
return( $minx || 0, $miny || 0, $maxx || 0, $maxy || 0 ); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub invert_pen { |
64
|
0
|
|
|
0
|
0
|
|
my ($self, $invert ) = @_; |
65
|
0
|
0
|
|
|
|
|
$invert = ( $invert ) ? 1 : 0; |
66
|
0
|
|
|
|
|
|
$self->pen_inverted( $invert ); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _deg2rad { |
70
|
0
|
|
|
0
|
|
|
my $degrees = shift; |
71
|
0
|
|
|
|
|
|
return ($degrees / 180) * TRIG_PI; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _rad2deg { |
75
|
0
|
|
|
0
|
|
|
my $radians = shift; |
76
|
0
|
|
|
|
|
|
return ($radians / TRIG_PI) * 180; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub rotate { |
80
|
0
|
|
|
0
|
0
|
|
my( $self, $rotation, $rx, $ry ) = @_; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
0
|
|
|
|
$rx //= 0; |
83
|
0
|
|
0
|
|
|
|
$ry //= 0; |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
0
|
|
|
|
$rotation //= 0; |
86
|
0
|
|
|
|
|
|
$rotation = $rotation % 360; |
87
|
|
|
|
|
|
|
|
88
|
0
|
0
|
|
|
|
|
my $radians = ( $rotation ) ? _deg2rad($rotation) : 0; |
89
|
|
|
|
|
|
|
|
90
|
0
|
0
|
|
|
|
|
return unless $radians; |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
my @oldbuffer = @{ $self->contextarray }; |
|
0
|
|
|
|
|
|
|
93
|
0
|
0
|
|
|
|
|
return unless( scalar @oldbuffer ); |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
my @newbuffer = (); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# Common Rotations |
98
|
0
|
0
|
0
|
|
|
|
if( $rotation == 90 || $rotation == -270 ) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
for my $point ( @oldbuffer ) { |
100
|
0
|
|
|
|
|
|
my( $x, $y, $on) = @$point; |
101
|
0
|
|
|
|
|
|
$x -= $rx; |
102
|
0
|
|
|
|
|
|
$y -= $ry; |
103
|
0
|
|
|
|
|
|
push @newbuffer, [ - $y + $rx, $x + $ry, $on ]; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} elsif( abs($rotation) == 180 ) { |
106
|
0
|
|
|
|
|
|
for my $point ( @oldbuffer ) { |
107
|
0
|
|
|
|
|
|
my( $x, $y, $on) = @$point; |
108
|
0
|
|
|
|
|
|
$x -= $rx; |
109
|
0
|
|
|
|
|
|
$y -= $ry; |
110
|
0
|
|
|
|
|
|
push @newbuffer, [ - $x + $rx, - $y + $ry, $on ]; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
} elsif( $rotation == -90 || $rotation == 270 ) { |
113
|
0
|
|
|
|
|
|
for my $point ( @oldbuffer ) { |
114
|
0
|
|
|
|
|
|
my( $x, $y, $on) = @$point; |
115
|
0
|
|
|
|
|
|
$x -= $rx; |
116
|
0
|
|
|
|
|
|
$y -= $ry; |
117
|
0
|
|
|
|
|
|
push @newbuffer, [ $y + $rx, - $x + $ry, $on ]; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
} else { |
120
|
|
|
|
|
|
|
# other |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
|
if( $rotation == 11) { |
123
|
0
|
|
|
|
|
|
$radians = _deg2rad(180); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
my $sin = sin($radians); |
127
|
0
|
|
|
|
|
|
my $cos = cos($radians); |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
for my $point ( @oldbuffer ) { |
130
|
0
|
|
|
|
|
|
my( $x, $y, $on) = @$point; |
131
|
0
|
|
|
|
|
|
$x -= $rx; |
132
|
0
|
|
|
|
|
|
$y -= $ry; |
133
|
0
|
|
|
|
|
|
my $x1 = $rx + int( 0.5 + ($x * $cos) - ($y * $sin) ); |
134
|
0
|
|
|
|
|
|
my $y1 = $ry + int( 0.5 + ($x * $sin) + ($y * $cos) ); |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
push @newbuffer, [ $x1, $y1, $on ]; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
$self->contextarray( \@newbuffer ); |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
return $self; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub rotated_context { |
146
|
0
|
|
|
0
|
0
|
|
my( $self, $rotation, $rx, $ry ) = @_; |
147
|
0
|
|
|
|
|
|
my $ctx = ref($self)->new( contextarray => $self->contextarray ); |
148
|
0
|
|
|
|
|
|
$ctx->rotate( $rotation, $rx, $ry ); |
149
|
0
|
|
|
|
|
|
return $ctx; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub draw_pixel { |
153
|
0
|
|
|
0
|
0
|
|
my($self, $x, $y, $on) = @_; |
154
|
0
|
|
0
|
|
|
|
$on //= 1; |
155
|
0
|
0
|
|
|
|
|
if($self->pen_inverted) { |
156
|
0
|
0
|
|
|
|
|
$on = ( $on ) ? 0 : 1; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
push @{ $self->contextarray }, [ $x, $y, $on ]; |
|
0
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub draw_text { |
163
|
0
|
|
|
0
|
0
|
|
my($self, $x, $y, $text, $font ) = @_; |
164
|
0
|
|
0
|
|
|
|
$x //= 0; |
165
|
0
|
|
0
|
|
|
|
$y //= 0; |
166
|
0
|
|
0
|
|
|
|
$text //= ''; |
167
|
0
|
|
0
|
|
|
|
$font //= DEFAULT_FONT; |
168
|
|
|
|
|
|
|
|
169
|
0
|
0
|
|
|
|
|
if($text eq '') { |
170
|
0
|
0
|
|
|
|
|
return ( wantarray ) ? (0,0) : 0; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
0
|
0
|
|
|
|
|
unless(ref($font)) { |
174
|
|
|
|
|
|
|
# allow string for $font |
175
|
0
|
|
|
|
|
|
$font = $self->get_font($font); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
|
my $textwidth = 0; |
179
|
0
|
|
|
|
|
|
my $textheight = 0; |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
|
if( $font->class eq 'hipi_2' ) { |
182
|
|
|
|
|
|
|
# variable fonts |
183
|
0
|
|
|
|
|
|
( $textwidth, $textheight ) = $self->_draw_hipi_2_text($x,$y,$text,$font); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
0
|
0
|
|
|
|
|
return ( wantarray ) ? ( $textwidth, $textheight ) : $textwidth; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub _draw_hipi_2_text { |
190
|
0
|
|
|
0
|
|
|
my ($self, $x1, $y, $text, $font) = @_; |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
my $prev_char = undef; |
193
|
0
|
|
|
|
|
|
my $prev_width = 0; |
194
|
0
|
|
|
|
|
|
my $prev_advance = 0; |
195
|
0
|
|
|
|
|
|
my $textheight = $font->char_height; |
196
|
0
|
|
|
|
|
|
my $x = $x1; |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
my @points = (); |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
|
my $symbols = $font->symbols; |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
|
|
|
for my $c ( split(//, $text) ) { |
203
|
0
|
|
|
|
|
|
my $this_char = ord($c); |
204
|
0
|
0
|
|
|
|
|
if ( exists( $symbols->{$this_char} ) ) { |
205
|
0
|
|
|
|
|
|
my $symbol = $symbols->{$this_char}; |
206
|
0
|
0
|
|
|
|
|
if ( $prev_char ) { |
207
|
0
|
|
0
|
|
|
|
my $kerning = $font->kerning->{$prev_char}->{$this_char} || 0; |
208
|
0
|
|
|
|
|
|
$x += $prev_advance + $kerning + $symbol->{xoffset} + $font->gap_width; |
209
|
|
|
|
|
|
|
} |
210
|
0
|
|
|
|
|
|
$prev_char = $this_char; |
211
|
0
|
|
|
|
|
|
$prev_width = $symbol->{width}; |
212
|
0
|
|
|
|
|
|
$prev_advance = $symbol->{xadvance} - $symbol->{xoffset}; |
213
|
0
|
|
|
|
|
|
my $bytes_per_row = ($symbol->{width} + 7) >> 3; |
214
|
0
|
|
|
|
|
|
my $offset = 0; |
215
|
0
|
|
|
|
|
|
for ( my $row = 0; $row < $textheight; $row ++ ) { |
216
|
0
|
|
|
|
|
|
my $py = $y + $row; |
217
|
0
|
|
|
|
|
|
my $mask = 0x80; |
218
|
0
|
|
|
|
|
|
my $p = $offset; |
219
|
0
|
|
|
|
|
|
for ( my $col = 0; $col < $symbol->{width}; $col ++ ) { |
220
|
0
|
|
|
|
|
|
my $px = $x + $col; |
221
|
0
|
0
|
|
|
|
|
if ( $symbol->{bitmap}->[$p] & $mask ) { |
222
|
0
|
|
|
|
|
|
push @points, [ $px, $py ]; |
223
|
|
|
|
|
|
|
} |
224
|
0
|
|
|
|
|
|
$mask >>= 1; |
225
|
0
|
0
|
|
|
|
|
if ( $mask == 0 ) { |
226
|
0
|
|
|
|
|
|
$mask = 0x80; |
227
|
0
|
|
|
|
|
|
$p += 1; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
0
|
|
|
|
|
|
$offset += $bytes_per_row; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} else { |
233
|
|
|
|
|
|
|
# space or no char in font |
234
|
0
|
0
|
|
|
|
|
if ($prev_char ) { |
235
|
0
|
|
|
|
|
|
$x += $font->space_width + $font->gap_width + $prev_advance; |
236
|
|
|
|
|
|
|
} |
237
|
0
|
|
|
|
|
|
$prev_char = undef; |
238
|
0
|
|
|
|
|
|
$prev_advance = 0; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
0
|
0
|
|
|
|
|
if ( $prev_char ) { |
243
|
0
|
|
|
|
|
|
$x += $prev_width; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# drawpoints |
247
|
0
|
|
|
|
|
|
for my $point ( @points ) { |
248
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point, 1); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
my $textwidth = $x - $x1; |
252
|
|
|
|
|
|
|
|
253
|
0
|
0
|
|
|
|
|
return ( wantarray ) ? ( $textwidth, $textheight) : $textwidth; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub get_text_extents { |
259
|
0
|
|
|
0
|
0
|
|
my($self, $text, $font) = @_; |
260
|
0
|
|
0
|
|
|
|
$text //= ''; |
261
|
0
|
|
0
|
|
|
|
$font //= DEFAULT_FONT; |
262
|
0
|
0
|
|
|
|
|
unless(ref($font)) { |
263
|
|
|
|
|
|
|
# allow string for $font |
264
|
0
|
|
|
|
|
|
$font = $self->get_font($font); |
265
|
|
|
|
|
|
|
} |
266
|
0
|
0
|
|
|
|
|
if($text eq '') { |
267
|
0
|
0
|
|
|
|
|
return ( wantarray ) ? (0,0) : 0; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
my $textwidth = 0; |
271
|
0
|
|
|
|
|
|
my $textheight = 0; |
272
|
|
|
|
|
|
|
|
273
|
0
|
0
|
|
|
|
|
if( $font->class eq 'hipi_2' ) { |
274
|
0
|
|
|
|
|
|
($textwidth, $textheight) = $self->_get_hipi_2_extents( $text,$font ); |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
0
|
0
|
|
|
|
|
return ( wantarray ) ? ( $textwidth, $textheight ) : $textwidth; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub _get_hipi_2_extents { |
281
|
0
|
|
|
0
|
|
|
my ($self, $text, $font) = @_; |
282
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
|
my $prev_char = undef; |
284
|
0
|
|
|
|
|
|
my $prev_width = 0; |
285
|
0
|
|
|
|
|
|
my $prev_advance = 0; |
286
|
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
my $textheight = $font->char_height; |
288
|
0
|
|
|
|
|
|
my $textwidth = 0; |
289
|
|
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
my $symbols = $font->symbols; |
291
|
|
|
|
|
|
|
|
292
|
0
|
|
|
|
|
|
for my $c ( split(//, $text) ) { |
293
|
0
|
|
|
|
|
|
my $this_char = ord($c); |
294
|
0
|
0
|
|
|
|
|
if ( exists( $symbols->{$this_char} ) ) { |
295
|
0
|
|
|
|
|
|
my $symbol = $symbols->{$this_char}; |
296
|
0
|
0
|
|
|
|
|
if ( $prev_char ) { |
297
|
0
|
|
0
|
|
|
|
my $kerning = $font->kerning->{$prev_char}->{$this_char} || 0; |
298
|
0
|
|
|
|
|
|
$textwidth += $prev_advance + $kerning + $symbol->{xoffset} + $font->gap_width; |
299
|
|
|
|
|
|
|
} |
300
|
0
|
|
|
|
|
|
$prev_char = $this_char; |
301
|
0
|
|
|
|
|
|
$prev_width = $symbol->{width}; |
302
|
0
|
|
|
|
|
|
$prev_advance = $symbol->{xadvance} - $symbol->{xoffset}; |
303
|
|
|
|
|
|
|
} else { |
304
|
|
|
|
|
|
|
# space or no char in font |
305
|
0
|
0
|
|
|
|
|
if ($prev_char ) { |
306
|
0
|
|
|
|
|
|
$textwidth += $font->space_width + $font->gap_width + $prev_advance; |
307
|
|
|
|
|
|
|
} |
308
|
0
|
|
|
|
|
|
$prev_char = undef; |
309
|
0
|
|
|
|
|
|
$prev_advance = 0; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
0
|
0
|
|
|
|
|
if ( $prev_char ) { |
314
|
0
|
|
|
|
|
|
$textwidth += $prev_width; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
0
|
0
|
|
|
|
|
return ( wantarray ) ? ( $textwidth, $textheight) : $textwidth; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub get_font { |
321
|
0
|
|
|
0
|
0
|
|
my($self, $fontname) = @_; |
322
|
0
|
|
|
|
|
|
HiPi::Graphics::BitmapFont->get_font( $fontname ); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub draw_circle { |
326
|
0
|
|
|
0
|
0
|
|
my( $self, $x, $y, $radius, $fill) = @_; |
327
|
|
|
|
|
|
|
|
328
|
0
|
|
|
|
|
|
my $x_pos = -$radius; |
329
|
0
|
|
|
|
|
|
my $y_pos = 0; |
330
|
0
|
|
|
|
|
|
my $err = 2 - 2 * $radius; |
331
|
0
|
|
|
|
|
|
my $e2; |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
my @points = (); |
334
|
|
|
|
|
|
|
|
335
|
0
|
|
|
|
|
|
while(1) { |
336
|
0
|
|
|
|
|
|
push @points, [ $x - $x_pos, $y + $y_pos, 1] ; |
337
|
0
|
|
|
|
|
|
push @points, [ $x + $x_pos, $y + $y_pos, 1] ; |
338
|
0
|
|
|
|
|
|
push @points, [ $x + $x_pos, $y - $y_pos, 1] ; |
339
|
0
|
|
|
|
|
|
push @points, [ $x - $x_pos, $y - $y_pos, 1] ; |
340
|
0
|
0
|
|
|
|
|
if( $fill ) { |
341
|
0
|
|
|
|
|
|
my $nx = $x + $x_pos; |
342
|
0
|
|
|
|
|
|
for (my $i = $nx; $i < $nx + ( 2 * (-$x_pos) + 1 ); $i++) { |
343
|
0
|
|
|
|
|
|
push @points, [ $i, $y + $y_pos, 1 ]; |
344
|
|
|
|
|
|
|
} |
345
|
0
|
|
|
|
|
|
for (my $i = $nx; $i < $nx + ( 2 * (-$x_pos) + 1 ); $i++) { |
346
|
0
|
|
|
|
|
|
push @points, [ $i, $y - $y_pos, 1 ]; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
0
|
|
|
|
|
|
$e2 = $err; |
350
|
0
|
0
|
|
|
|
|
if ($e2 <= $y_pos) { |
351
|
0
|
|
|
|
|
|
$err += ++$y_pos * 2 + 1; |
352
|
0
|
0
|
0
|
|
|
|
if(-$x_pos == $y_pos && $e2 <= $x_pos) { |
353
|
0
|
|
|
|
|
|
$e2 = 0; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
0
|
0
|
|
|
|
|
if ($e2 > $x_pos) { |
357
|
0
|
|
|
|
|
|
$err += ++$x_pos * 2 + 1; |
358
|
|
|
|
|
|
|
} |
359
|
0
|
0
|
|
|
|
|
last if $x_pos > 0; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
for my $point ( @points ) { |
363
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point ); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
sub draw_ellipse { |
368
|
0
|
|
|
0
|
0
|
|
my( $self, $x0, $y0, $rx, $ry, $fill) = @_; |
369
|
0
|
|
|
|
|
|
return $self->draw_arc($x0, $y0, $rx, $ry, 0, 360, 0, $fill); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub draw_arc { |
373
|
0
|
|
|
0
|
0
|
|
my( $self, $x0, $y0, $rx, $ry, $start, $end, $join, $fill) = @_; |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
0
|
|
|
|
$x0 //= 0; |
376
|
0
|
|
0
|
|
|
|
$y0 //= 0; |
377
|
0
|
|
0
|
|
|
|
$rx //= 0; |
378
|
0
|
|
0
|
|
|
|
$ry //= 0; |
379
|
0
|
|
0
|
|
|
|
$start //= 0; |
380
|
0
|
|
0
|
|
|
|
$end //= 360; |
381
|
0
|
|
0
|
|
|
|
$join //= 0; |
382
|
|
|
|
|
|
|
|
383
|
0
|
0
|
|
|
|
|
if( $start > $end ) { |
384
|
0
|
|
|
|
|
|
$start -= 360; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
my ($radius, $h, $v) = ( 0, 0, 0 ); |
388
|
|
|
|
|
|
|
|
389
|
0
|
0
|
|
|
|
|
if( $rx == $ry ) { |
|
|
0
|
|
|
|
|
|
390
|
0
|
|
|
|
|
|
$radius = $rx; |
391
|
|
|
|
|
|
|
} elsif($rx > $ry) { |
392
|
0
|
|
|
|
|
|
$radius = $rx; |
393
|
0
|
|
|
|
|
|
$v = $rx - $ry; |
394
|
|
|
|
|
|
|
} else { |
395
|
0
|
|
|
|
|
|
$radius = $ry; |
396
|
0
|
|
|
|
|
|
$h = $ry - $rx; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
0
|
|
|
|
|
|
my $theta = $start; #// angle that will be increased each loop |
401
|
0
|
|
|
|
|
|
my @points = (); |
402
|
0
|
|
|
|
|
|
while( $theta < $end ) { |
403
|
0
|
|
|
|
|
|
my $radians = _deg2rad($theta); |
404
|
0
|
|
|
|
|
|
my $x = $x0 + ( $radius - $h ) * cos($radians); |
405
|
0
|
|
|
|
|
|
my $y = $y0 + ( $radius - $v ) * sin($radians); |
406
|
0
|
|
|
|
|
|
push @points, [ int($x + 0.5), int($y + 0.5) ]; |
407
|
0
|
|
|
|
|
|
$theta ++; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
my $lastpoint = scalar( @points ) -1; |
411
|
|
|
|
|
|
|
|
412
|
0
|
0
|
|
|
|
|
if( $fill ) { |
413
|
0
|
|
|
|
|
|
push @points, [ $x0, $y0 ]; |
414
|
0
|
|
|
|
|
|
$radius --; |
415
|
0
|
|
|
|
|
|
while( $radius > 0) { |
416
|
0
|
|
|
|
|
|
$theta = $start; |
417
|
0
|
|
|
|
|
|
while( $theta < $end ) { |
418
|
0
|
|
|
|
|
|
my $radians = _deg2rad($theta); |
419
|
0
|
|
|
|
|
|
my $x = $x0 + ( $radius - $h ) * cos($radians); |
420
|
0
|
|
|
|
|
|
my $y = $y0 + ( $radius - $v ) * sin($radians); |
421
|
0
|
|
|
|
|
|
push @points, [ int($x + 0.5), int($y + 0.5) ]; |
422
|
0
|
|
|
|
|
|
$theta ++ |
423
|
|
|
|
|
|
|
} |
424
|
0
|
|
|
|
|
|
$radius --; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
0
|
0
|
|
|
|
|
if( $join ) { |
429
|
0
|
|
|
|
|
|
for my $point ( $points[0], $points[$lastpoint] ) { |
430
|
0
|
|
|
|
|
|
my $linepoints = $self->_get_line_points( $x0, $y0, @$point, 0 ); |
431
|
0
|
|
|
|
|
|
push @points, @$linepoints; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# draw points |
436
|
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
for my $point ( @points ) { |
438
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point, 1); |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
0
|
|
|
|
|
|
return ( $points[0], $points[$lastpoint] ); |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub draw_rectangle { |
445
|
0
|
|
|
0
|
0
|
|
my($self, $x1, $y1, $x2, $y2, $fill) = @_; |
446
|
0
|
|
|
|
|
|
my @points = (); |
447
|
|
|
|
|
|
|
|
448
|
0
|
0
|
|
|
|
|
if($x1 > $x2) { |
449
|
0
|
|
|
|
|
|
my $tmp = $x1; |
450
|
0
|
|
|
|
|
|
$x1 = $x2; |
451
|
0
|
|
|
|
|
|
$x2 = $tmp; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
0
|
0
|
|
|
|
|
if($y1 > $y2) { |
455
|
0
|
|
|
|
|
|
my $tmp = $y1; |
456
|
0
|
|
|
|
|
|
$y1 = $y2; |
457
|
0
|
|
|
|
|
|
$y2 = $tmp; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# Top Horizontal |
461
|
0
|
|
|
|
|
|
my ($x, $y ) = ( $x1, $y1 ); |
462
|
0
|
|
|
|
|
|
while( $x <= $x2 ) { |
463
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
464
|
0
|
|
|
|
|
|
$x++; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# Bottom Horizontal |
468
|
0
|
|
|
|
|
|
($x, $y ) = ( $x1, $y2 ); |
469
|
0
|
|
|
|
|
|
while( $x <= $x2 ) { |
470
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
471
|
0
|
|
|
|
|
|
$x++; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# left vertical |
475
|
0
|
|
|
|
|
|
($x, $y ) = ( $x1, $y1 + 1 ); |
476
|
0
|
|
|
|
|
|
while( $y < $y2 ) { |
477
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
478
|
0
|
|
|
|
|
|
$y++; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
0
|
0
|
|
|
|
|
if( $fill ) { |
482
|
0
|
|
|
|
|
|
$y = $y1 + 1; |
483
|
0
|
|
|
|
|
|
while( $y < $y2) { |
484
|
0
|
|
|
|
|
|
$x = $x1 + 1; |
485
|
0
|
|
|
|
|
|
while( $x < $x2 ) { |
486
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
487
|
0
|
|
|
|
|
|
$x++; |
488
|
|
|
|
|
|
|
} |
489
|
0
|
|
|
|
|
|
$y++; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# right vertical |
494
|
0
|
|
|
|
|
|
($x, $y ) = ( $x2, $y1 + 1 ); |
495
|
0
|
|
|
|
|
|
while( $y < $y2 ) { |
496
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
497
|
0
|
|
|
|
|
|
$y++; |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
# draw the pixels |
501
|
|
|
|
|
|
|
|
502
|
0
|
|
|
|
|
|
for my $point ( @points ) { |
503
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point, 1); |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub draw_rounded_rectangle { |
508
|
0
|
|
|
0
|
0
|
|
my($self, $x1, $y1, $x2, $y2, $r, $fill) = @_; |
509
|
0
|
|
|
|
|
|
my @points = (); |
510
|
|
|
|
|
|
|
|
511
|
0
|
|
0
|
|
|
|
$r //= 4; |
512
|
|
|
|
|
|
|
|
513
|
0
|
0
|
|
|
|
|
if($x1 > $x2) { |
514
|
0
|
|
|
|
|
|
my $tmp = $x1; |
515
|
0
|
|
|
|
|
|
$x1 = $x2; |
516
|
0
|
|
|
|
|
|
$x2 = $tmp; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
0
|
0
|
|
|
|
|
if($y1 > $y2) { |
520
|
0
|
|
|
|
|
|
my $tmp = $y1; |
521
|
0
|
|
|
|
|
|
$y1 = $y2; |
522
|
0
|
|
|
|
|
|
$y2 = $tmp; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# check r |
526
|
|
|
|
|
|
|
{ |
527
|
0
|
|
|
|
|
|
my $maxrx = -1 + $x2 - $x1; |
|
0
|
|
|
|
|
|
|
528
|
0
|
|
|
|
|
|
my $maxry = -1 + $y2 - $y1; |
529
|
0
|
0
|
|
|
|
|
$r = $maxrx if $r > $maxrx; |
530
|
0
|
0
|
|
|
|
|
$r = $maxry if $r > $maxry; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
0
|
0
|
|
|
|
|
if( $fill ) { |
534
|
|
|
|
|
|
|
# simpler to draw 3 filled rectangles + arcs |
535
|
0
|
|
|
|
|
|
$self->draw_rectangle($x1, $y1 + $r, $x1 + $r, $y2 - $r, 1); |
536
|
0
|
|
|
|
|
|
$self->draw_rectangle($x1 + $r, $y1, $x2 - $r, $y2, 1); |
537
|
0
|
|
|
|
|
|
$self->draw_rectangle($x2 - $r, $y1 + $r, $x2, $y2 - $r, 1); |
538
|
|
|
|
|
|
|
} else { |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# Top Horizontal |
541
|
0
|
|
|
|
|
|
my ($x, $y ) = ( $x1 + $r, $y1 ); |
542
|
0
|
|
|
|
|
|
while( $x < $x2 - $r ) { |
543
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
544
|
0
|
|
|
|
|
|
$x++; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# Bottom Horizontal |
548
|
0
|
|
|
|
|
|
($x, $y ) = ( $x1 + $r, $y2 ); |
549
|
0
|
|
|
|
|
|
while( $x < $x2 - $r ) { |
550
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
551
|
0
|
|
|
|
|
|
$x++; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# left vertical |
555
|
0
|
|
|
|
|
|
($x, $y ) = ( $x1, $y1 + $r ); |
556
|
0
|
|
|
|
|
|
while( $y < $y2 - $r ) { |
557
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
558
|
0
|
|
|
|
|
|
$y++; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# right vertical |
562
|
0
|
|
|
|
|
|
($x, $y ) = ( $x2, $y1 + $r ); |
563
|
0
|
|
|
|
|
|
while( $y < $y2 - $r ) { |
564
|
0
|
|
|
|
|
|
push @points, [ $x, $y ]; |
565
|
0
|
|
|
|
|
|
$y++; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# arcs |
570
|
|
|
|
|
|
|
#top left |
571
|
0
|
|
|
|
|
|
$self->draw_arc($x1 + $r, $y1 + $r, $r, $r, 180, 270, 0, $fill ); |
572
|
|
|
|
|
|
|
#top right |
573
|
0
|
|
|
|
|
|
$self->draw_arc($x2 - $r, $y1 + $r, $r, $r, 270, 360, 0, $fill ); |
574
|
|
|
|
|
|
|
#bottom right |
575
|
0
|
|
|
|
|
|
$self->draw_arc($x2 - $r, $y2 - $r, $r, $r, 0, 90, 0, $fill ); |
576
|
|
|
|
|
|
|
#bottom left |
577
|
0
|
|
|
|
|
|
$self->draw_arc($x1 + $r, $y2 - $r, $r, $r, 90, 180, 0, $fill ); |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# draw the pixels |
580
|
|
|
|
|
|
|
|
581
|
0
|
|
|
|
|
|
for my $point ( @points ) { |
582
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point, 1); |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
sub draw_polygon { |
587
|
0
|
|
|
0
|
0
|
|
my ( $self, $inputvertices, $fill ) = @_; |
588
|
|
|
|
|
|
|
|
589
|
0
|
|
|
|
|
|
my @vertices = @$inputvertices; |
590
|
0
|
0
|
|
|
|
|
return unless( scalar(@vertices) > 2 ); |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# Close the polygon if it is not closed |
593
|
0
|
0
|
0
|
|
|
|
if($vertices[0]->[0] != $vertices[-1]->[0] || $vertices[0]->[1] != $vertices[-1]->[1]) { |
594
|
0
|
|
|
|
|
|
push @vertices , [ $vertices[0]->[0], $vertices[0]->[1] ]; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
|
my $lastpoint; |
598
|
0
|
|
|
|
|
|
my @polypoints = (); |
599
|
|
|
|
|
|
|
|
600
|
0
|
|
|
|
|
|
for my $inpoint ( @vertices ) { |
601
|
0
|
0
|
|
|
|
|
if( $lastpoint ) { |
602
|
0
|
|
|
|
|
|
my $linepoints = $self->_get_line_points( @$lastpoint, @$inpoint, 0 ); |
603
|
0
|
|
|
|
|
|
push @polypoints, @$linepoints; |
604
|
|
|
|
|
|
|
} |
605
|
0
|
|
|
|
|
|
$lastpoint = $inpoint; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
0
|
0
|
|
|
|
|
if( $fill ) { |
609
|
0
|
|
|
|
|
|
my($minX, $minY, $maxX, $maxY) = ( $self->buffer_cols, $self->buffer_rows, 0,0 ); |
610
|
0
|
|
|
|
|
|
for my $point ( @polypoints ) { |
611
|
0
|
0
|
|
|
|
|
$maxX = $point->[0] if $point->[0] > $maxX; |
612
|
0
|
0
|
|
|
|
|
$maxY = $point->[1] if $point->[1] > $maxY; |
613
|
0
|
0
|
|
|
|
|
$minX = $point->[0] if $point->[0] < $minX; |
614
|
0
|
0
|
|
|
|
|
$minY = $point->[1] if $point->[1] < $minY; |
615
|
|
|
|
|
|
|
} |
616
|
0
|
|
|
|
|
|
my @newpoints = (); |
617
|
0
|
|
|
|
|
|
for (my $x = $minX; $x < $maxX; $x++) { |
618
|
0
|
|
|
|
|
|
for (my $y = $minY; $y < $maxY; $y++) { |
619
|
0
|
0
|
|
|
|
|
if( _point_in_polygon([$x, $y], @vertices ) ) { |
620
|
0
|
|
|
|
|
|
push @newpoints, [ $x, $y ]; |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
} |
624
|
0
|
|
|
|
|
|
push @polypoints, @newpoints; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
# draw |
628
|
|
|
|
|
|
|
|
629
|
0
|
|
|
|
|
|
for my $point ( @polypoints ) { |
630
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point, 1); |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
# _point_in_polygon |
635
|
|
|
|
|
|
|
# Learned from latest Math::Polygon but that isn't in Raspbian Stretch |
636
|
|
|
|
|
|
|
# and we only want this single function. There are no improvements here. |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
sub _point_in_polygon { |
639
|
0
|
|
|
0
|
|
|
my $point = shift; |
640
|
0
|
0
|
|
|
|
|
return 0 if @_ < 3; |
641
|
|
|
|
|
|
|
|
642
|
0
|
|
|
|
|
|
my ($x, $y) = @$point; |
643
|
0
|
|
|
|
|
|
my $inside = 0; |
644
|
|
|
|
|
|
|
|
645
|
0
|
|
|
|
|
|
my ($px, $py) = @{ (shift) }; |
|
0
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
|
647
|
0
|
|
|
|
|
|
while(@_) { |
648
|
0
|
|
|
|
|
|
my ($nx, $ny) = @{ (shift) }; |
|
0
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
|
650
|
0
|
0
|
0
|
|
|
|
return 1 if $y==$py && $py==$ny |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
651
|
|
|
|
|
|
|
&& ($x >= $px || $x >= $nx) |
652
|
|
|
|
|
|
|
&& ($x <= $px || $x <= $nx); |
653
|
|
|
|
|
|
|
|
654
|
0
|
0
|
0
|
|
|
|
return 1 if $x==$px && $px==$nx |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
655
|
|
|
|
|
|
|
&& ($y >= $py || $y >= $ny) |
656
|
|
|
|
|
|
|
&& ($y <= $py || $y <= $ny); |
657
|
|
|
|
|
|
|
|
658
|
0
|
0
|
0
|
|
|
|
if( $py == $ny |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
659
|
|
|
|
|
|
|
|| ($y <= $py && $y <= $ny) |
660
|
|
|
|
|
|
|
|| ($y > $py && $y > $ny) |
661
|
|
|
|
|
|
|
|| ($x > $px && $x > $nx) |
662
|
|
|
|
|
|
|
) { |
663
|
0
|
|
|
|
|
|
($px, $py) = ($nx, $ny); |
664
|
0
|
|
|
|
|
|
next; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
my $xinters = ($y-$py)*($nx-$px)/($ny-$py)+$px; |
668
|
0
|
0
|
0
|
|
|
|
$inside = !$inside if $px==$nx || $x <= $xinters; |
669
|
0
|
|
|
|
|
|
($px, $py) = ($nx, $ny); |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
0
|
|
|
|
|
|
return $inside; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub draw_line { |
676
|
0
|
|
|
0
|
0
|
|
my( $self, $x1, $y1, $x2, $y2, $ep ) = @_; |
677
|
|
|
|
|
|
|
|
678
|
0
|
|
|
|
|
|
my $linepoints = $self->_get_line_points( $x1, $y1, $x2, $y2, $ep ); |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
# draw the pixels |
681
|
|
|
|
|
|
|
|
682
|
0
|
|
|
|
|
|
for my $point ( @$linepoints ) { |
683
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point, 1); |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub _get_line_points { |
688
|
|
|
|
|
|
|
|
689
|
0
|
|
|
0
|
|
|
my( $self, $x0, $y0, $x1, $y1, $ep ) = @_; |
690
|
|
|
|
|
|
|
|
691
|
0
|
|
0
|
|
|
|
$ep //= 1; |
692
|
|
|
|
|
|
|
|
693
|
0
|
|
|
|
|
|
my @points = (); |
694
|
|
|
|
|
|
|
|
695
|
0
|
0
|
|
|
|
|
my $dx = $x1 - $x0 >= 0 ? $x1 - $x0 : $x0 - $x1; |
696
|
0
|
0
|
|
|
|
|
my $sx = $x0 < $x1 ? 1 : -1; |
697
|
0
|
0
|
|
|
|
|
my $dy = $y1 - $y0 <= 0 ? $y1 - $y0 : $y0 - $y1; |
698
|
0
|
0
|
|
|
|
|
my $sy = $y0 < $y1 ? 1 : -1; |
699
|
0
|
|
|
|
|
|
my $err = $dx + $dy; |
700
|
|
|
|
|
|
|
|
701
|
0
|
|
0
|
|
|
|
while(($x0 != $x1) && ($y0 != $y1)) { |
702
|
0
|
|
|
|
|
|
push(@points, [ $x0, $y0 ] ); |
703
|
0
|
0
|
|
|
|
|
if (2 * $err >= $dy) { |
704
|
0
|
|
|
|
|
|
$err += $dy; |
705
|
0
|
|
|
|
|
|
$x0 += $sx; |
706
|
|
|
|
|
|
|
} |
707
|
0
|
0
|
|
|
|
|
if (2 * $err <= $dx) { |
708
|
0
|
|
|
|
|
|
$err += $dx; |
709
|
0
|
|
|
|
|
|
$y0 += $sy; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
} |
712
|
0
|
0
|
|
|
|
|
if(!$ep) { |
713
|
0
|
|
|
|
|
|
pop @points; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
0
|
|
|
|
|
|
return \@points; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
sub draw_bit_array { |
721
|
0
|
|
|
0
|
0
|
|
my($self, $x1, $y1, $bitarray, $fill) = @_; |
722
|
|
|
|
|
|
|
|
723
|
0
|
|
0
|
|
|
|
$fill //= 0; |
724
|
|
|
|
|
|
|
|
725
|
0
|
|
|
|
|
|
my @points = (); |
726
|
|
|
|
|
|
|
|
727
|
0
|
|
|
|
|
|
for ( my $y = 0; $y < @$bitarray; $y ++) { |
728
|
0
|
|
|
|
|
|
my $line = $bitarray->[$y]; |
729
|
|
|
|
|
|
|
|
730
|
0
|
|
|
|
|
|
for ( my $x = 0; $x < @$line; $x ++) { |
731
|
0
|
0
|
|
|
|
|
if( $bitarray->[$y]->[$x] ) { |
|
|
0
|
|
|
|
|
|
732
|
0
|
|
|
|
|
|
push( @points, [ $x + $x1, $y + $y1, 1 ]); |
733
|
|
|
|
|
|
|
} elsif( $fill ) { |
734
|
0
|
|
|
|
|
|
push( @points, [ $x + $x1, $y + $y1, 0 ]); |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# draw |
740
|
|
|
|
|
|
|
|
741
|
0
|
|
|
|
|
|
for my $point ( @points ) { |
742
|
0
|
|
|
|
|
|
$self->draw_pixel( @$point ); |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
return, |
746
|
0
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
sub draw_context { |
749
|
0
|
|
|
0
|
0
|
|
my($self, $x, $y, $context) = @_; |
750
|
0
|
|
|
|
|
|
for my $point ( @{ $context->contextarray } ) { |
|
0
|
|
|
|
|
|
|
751
|
0
|
|
|
|
|
|
$self->draw_pixel ( $point->[0] + $x, $point->[1] + $y, $point->[2] ); |
752
|
|
|
|
|
|
|
} |
753
|
0
|
|
|
|
|
|
return; |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
1; |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
__END__ |