line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# This file is part of Language-Befunge |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This software is copyright (c) 2003 by Jerome Quelin. |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# This is free software; you can redistribute it and/or modify it under |
7
|
|
|
|
|
|
|
# the same terms as the Perl 5 programming language system itself. |
8
|
|
|
|
|
|
|
# |
9
|
74
|
|
|
74
|
|
16796
|
use strict; |
|
74
|
|
|
|
|
78
|
|
|
74
|
|
|
|
|
1638
|
|
10
|
74
|
|
|
74
|
|
211
|
use warnings; |
|
74
|
|
|
|
|
73
|
|
|
74
|
|
|
|
|
2519
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Language::Befunge::Vector; |
13
|
|
|
|
|
|
|
# ABSTRACT: an opaque, N-dimensional vector class |
14
|
|
|
|
|
|
|
$Language::Befunge::Vector::VERSION = '5.000'; |
15
|
74
|
|
|
74
|
|
2261
|
use integer; |
|
74
|
|
|
|
|
102
|
|
|
74
|
|
|
|
|
294
|
|
16
|
74
|
|
|
74
|
|
1143
|
use Carp; |
|
74
|
|
|
|
|
95
|
|
|
74
|
|
|
|
|
7569
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use overload |
19
|
74
|
|
|
|
|
748
|
'=' => \©, |
20
|
|
|
|
|
|
|
'+' => \&_add, |
21
|
|
|
|
|
|
|
'-' => \&_substract, |
22
|
|
|
|
|
|
|
'neg' => \&_invert, |
23
|
|
|
|
|
|
|
'+=' => \&_add_inplace, |
24
|
|
|
|
|
|
|
'-=' => \&_substract_inplace, |
25
|
|
|
|
|
|
|
'<=>' => \&_compare, |
26
|
|
|
|
|
|
|
'eq' => \&_compare_string, |
27
|
74
|
|
|
74
|
|
58441
|
'""' => \&as_string; |
|
74
|
|
|
|
|
47609
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# try to load speed-up LBV |
30
|
74
|
|
|
74
|
|
12243
|
eval 'use Language::Befunge::Vector::XS'; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
31
|
|
|
|
|
|
|
if ( defined $Language::Befunge::Vector::XS::VERSION ) { |
32
|
|
|
|
|
|
|
my $xsversion = $Language::Befunge::Vector::XS::VERSION; |
33
|
|
|
|
|
|
|
my @subs = qw[ |
34
|
|
|
|
|
|
|
new new_zeroes copy |
35
|
|
|
|
|
|
|
as_string get_dims get_component get_all_components |
36
|
|
|
|
|
|
|
clear set_component |
37
|
|
|
|
|
|
|
bounds_check |
38
|
|
|
|
|
|
|
_add _substract _invert |
39
|
|
|
|
|
|
|
_add_inplace _substract_inplace |
40
|
|
|
|
|
|
|
_compare |
41
|
|
|
|
|
|
|
]; |
42
|
|
|
|
|
|
|
foreach my $sub ( @subs ) { |
43
|
74
|
|
|
74
|
|
9602
|
no strict 'refs'; |
|
74
|
|
|
|
|
88
|
|
|
74
|
|
|
|
|
1849
|
|
44
|
74
|
|
|
74
|
|
232
|
no warnings 'redefine'; |
|
74
|
|
|
|
|
76
|
|
|
74
|
|
|
|
|
5291
|
|
45
|
|
|
|
|
|
|
my $lbvxs_sub = "Language::Befunge::Vector::XS::$sub"; |
46
|
|
|
|
|
|
|
*$sub = \&$lbvxs_sub; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
# LBV::XS 1.1.0 adds rasterize() |
49
|
|
|
|
|
|
|
@subs = qw[ rasterize _xs_rasterize_ptr ]; |
50
|
|
|
|
|
|
|
if($xsversion gt "1.0.0") { |
51
|
|
|
|
|
|
|
# import the XS functions from LBVXS |
52
|
74
|
|
|
74
|
|
297
|
no strict 'refs'; |
|
74
|
|
|
|
|
73
|
|
|
74
|
|
|
|
|
1649
|
|
53
|
74
|
|
|
74
|
|
207
|
no warnings 'redefine'; |
|
74
|
|
|
|
|
86
|
|
|
74
|
|
|
|
|
4221
|
|
54
|
|
|
|
|
|
|
foreach my $sub (@subs) { |
55
|
|
|
|
|
|
|
my $lbvxs_sub = "Language::Befunge::Vector::XS::$sub"; |
56
|
|
|
|
|
|
|
*$sub = \&$lbvxs_sub; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} else { |
59
|
|
|
|
|
|
|
# export the pure-perl functions to LBVXS |
60
|
74
|
|
|
74
|
|
438
|
no strict 'refs'; |
|
74
|
|
|
|
|
87
|
|
|
74
|
|
|
|
|
1569
|
|
61
|
74
|
|
|
74
|
|
232
|
no warnings 'redefine'; |
|
74
|
|
|
|
|
68
|
|
|
74
|
|
|
|
|
63969
|
|
62
|
|
|
|
|
|
|
foreach my $sub (@subs) { |
63
|
|
|
|
|
|
|
my $lbvxs_sub = "Language::Befunge::Vector::XS::$sub"; |
64
|
|
|
|
|
|
|
*$lbvxs_sub = \&$sub; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# -- CONSTRUCTORS |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# |
73
|
|
|
|
|
|
|
# my $vec = LB::Vector->new( $x [, $y, ...] ); |
74
|
|
|
|
|
|
|
# |
75
|
|
|
|
|
|
|
# Create a new vector. The arguments are the actual vector data; one |
76
|
|
|
|
|
|
|
# integer per dimension. |
77
|
|
|
|
|
|
|
# |
78
|
|
|
|
|
|
|
sub new { |
79
|
32684
|
|
|
32684
|
1
|
32605
|
my $pkg = shift; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# sanity checks |
82
|
32684
|
|
|
|
|
29103
|
my $usage = "Usage: $pkg->new(\$x, ...)"; |
83
|
32684
|
100
|
|
|
|
39467
|
croak $usage unless scalar(@_) > 0; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# regular LBV object |
86
|
32683
|
|
|
|
|
32746
|
my $self = [@_]; |
87
|
32683
|
|
|
|
|
25210
|
bless $self, $pkg; |
88
|
32683
|
|
|
|
|
49258
|
return $self; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# |
93
|
|
|
|
|
|
|
# my $vec = LB::Vector->new_zeroes($dims); |
94
|
|
|
|
|
|
|
# |
95
|
|
|
|
|
|
|
# Create a new vector of dimension $dims, set to the origin (all |
96
|
|
|
|
|
|
|
# zeroes). LBV->new_zeroes(2) is exactly equivalent to LBV->new(0, 0). |
97
|
|
|
|
|
|
|
# |
98
|
|
|
|
|
|
|
sub new_zeroes { |
99
|
1733
|
|
|
1733
|
1
|
1729
|
my ($pkg, $dims) = @_; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# sanity checks |
102
|
1733
|
|
|
|
|
1846
|
my $usage = "Usage: $pkg->new_zeroes(\$dimensions)"; |
103
|
1733
|
100
|
|
|
|
2217
|
croak $usage unless defined $dims; |
104
|
1732
|
100
|
|
|
|
2089
|
croak $usage unless $dims > 0; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# regular LBV object |
107
|
1731
|
|
|
|
|
2150
|
my $self = [ (0) x $dims ]; |
108
|
1731
|
|
|
|
|
1525
|
bless $self, $pkg; |
109
|
1731
|
|
|
|
|
3205
|
return $self; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# |
114
|
|
|
|
|
|
|
# my $vec = $v->copy; |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
# Return a new LBV object, which has the same dimensions and coordinates |
117
|
|
|
|
|
|
|
# as $v. |
118
|
|
|
|
|
|
|
# |
119
|
|
|
|
|
|
|
sub copy { |
120
|
15811
|
|
|
15811
|
1
|
10634
|
my $vec = shift; |
121
|
15811
|
|
|
|
|
29493
|
return bless [@$vec], ref $vec; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# -- PUBLIC METHODS |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#- accessors |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# |
131
|
|
|
|
|
|
|
# my $str = $vec->as_string; |
132
|
|
|
|
|
|
|
# my $str = "$vec"; |
133
|
|
|
|
|
|
|
# |
134
|
|
|
|
|
|
|
# Return the stringified form of $vec. For instance, a Befunge vector |
135
|
|
|
|
|
|
|
# might look like "(1,2)". |
136
|
|
|
|
|
|
|
# |
137
|
|
|
|
|
|
|
sub as_string { |
138
|
11225
|
|
|
11225
|
1
|
7867
|
my $self = shift; |
139
|
11225
|
|
|
|
|
30343
|
return "(" . join(",",@$self) . ")"; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# |
144
|
|
|
|
|
|
|
# my $dims = $vec->get_dims; |
145
|
|
|
|
|
|
|
# |
146
|
|
|
|
|
|
|
# Return the number of dimensions, an integer. |
147
|
|
|
|
|
|
|
# |
148
|
|
|
|
|
|
|
sub get_dims { |
149
|
404346
|
|
|
404346
|
1
|
231169
|
my $self = shift; |
150
|
404346
|
|
|
|
|
639612
|
return scalar(@$self); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# |
155
|
|
|
|
|
|
|
# my $val = $vec->get_component($dim); |
156
|
|
|
|
|
|
|
# |
157
|
|
|
|
|
|
|
# Get the value for dimension $dim. |
158
|
|
|
|
|
|
|
# |
159
|
|
|
|
|
|
|
sub get_component { |
160
|
231171
|
|
|
231171
|
1
|
147898
|
my ($self, $dim) = @_; |
161
|
231171
|
100
|
100
|
|
|
320708
|
croak "No such dimension $dim!" unless $dim >= 0 && $self->get_dims > $dim; |
162
|
231169
|
|
|
|
|
316356
|
return $self->[$dim]; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# |
167
|
|
|
|
|
|
|
# my @vals = $vec->get_all_components; |
168
|
|
|
|
|
|
|
# |
169
|
|
|
|
|
|
|
# Get the values for all dimensions, in order from 0..N. |
170
|
|
|
|
|
|
|
# |
171
|
|
|
|
|
|
|
sub get_all_components { |
172
|
12439
|
|
|
12439
|
1
|
8309
|
my ($self) = @_; |
173
|
12439
|
|
|
|
|
19194
|
return @$self; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# - mutators |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# |
180
|
|
|
|
|
|
|
# $vec->clear; |
181
|
|
|
|
|
|
|
# |
182
|
|
|
|
|
|
|
# Set the vector back to the origin, all 0's. |
183
|
|
|
|
|
|
|
# |
184
|
|
|
|
|
|
|
sub clear { |
185
|
348
|
|
|
348
|
1
|
295
|
my ($self) = @_; |
186
|
348
|
|
|
|
|
424
|
@$self = (0) x $self->get_dims; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# |
191
|
|
|
|
|
|
|
# $vec->set_component($dim, $value); |
192
|
|
|
|
|
|
|
# |
193
|
|
|
|
|
|
|
# Set the value for dimension $dim to $value. |
194
|
|
|
|
|
|
|
# |
195
|
|
|
|
|
|
|
sub set_component { |
196
|
7533
|
|
|
7533
|
1
|
6162
|
my ($self, $dim, $val) = @_; |
197
|
7533
|
100
|
100
|
|
|
12057
|
croak "No such dimension $dim!" unless $dim >= 0 && $self->get_dims > $dim; |
198
|
7531
|
|
|
|
|
9183
|
$self->[$dim] = $val; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
#- other methods |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# |
205
|
|
|
|
|
|
|
# my $is_within = $vec->bounds_check($begin, $end); |
206
|
|
|
|
|
|
|
# |
207
|
|
|
|
|
|
|
# Check whether $vec is within the box defined by $begin and $end. |
208
|
|
|
|
|
|
|
# Return 1 if vector is contained within the box, and 0 otherwise. |
209
|
|
|
|
|
|
|
# |
210
|
|
|
|
|
|
|
sub bounds_check { |
211
|
23470
|
|
|
23470
|
1
|
18672
|
my ($vchk, $begin, $end) = @_; |
212
|
23470
|
100
|
|
|
|
21787
|
croak "uneven dimensions in bounds check!" unless $vchk->get_dims == $begin->get_dims; |
213
|
23468
|
100
|
|
|
|
22427
|
croak "uneven dimensions in bounds check!" unless $vchk->get_dims == $end->get_dims; |
214
|
23467
|
|
|
|
|
26002
|
for (my $d = 0; $d < $vchk->get_dims; $d++) { |
215
|
45753
|
100
|
|
|
|
40720
|
return 0 if $vchk->get_component($d) < $begin->get_component($d); |
216
|
45152
|
100
|
|
|
|
43483
|
return 0 if $vchk->get_component($d) > $end->get_component($d); |
217
|
|
|
|
|
|
|
} |
218
|
21519
|
|
|
|
|
36464
|
return 1; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# |
223
|
|
|
|
|
|
|
# $vec = $vec->rasterize($min, $max); |
224
|
|
|
|
|
|
|
# |
225
|
|
|
|
|
|
|
# Return the next vector in raster order, or undef if the hypercube space |
226
|
|
|
|
|
|
|
# has been fully covered. To enumerate the entire storage area, the caller |
227
|
|
|
|
|
|
|
# should call rasterize on the storage area's "min" value the first time, |
228
|
|
|
|
|
|
|
# and keep looping while the return value is defined. To enumerate a |
229
|
|
|
|
|
|
|
# smaller rectangle, the caller should pass in the min and max vectors |
230
|
|
|
|
|
|
|
# describing the rectangle, and keep looping while the return value is |
231
|
|
|
|
|
|
|
# defined. |
232
|
|
|
|
|
|
|
# |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub rasterize { |
235
|
3956
|
|
|
3956
|
1
|
10499
|
my ($v, $min, $max) = @_; |
236
|
3956
|
100
|
|
|
|
3651
|
return undef unless $v->bounds_check($min, $max); |
237
|
3955
|
|
|
|
|
3906
|
$v = $v->copy; |
238
|
3955
|
|
|
|
|
3714
|
my $nd = $v->get_dims(); |
239
|
3955
|
|
|
|
|
4576
|
for my $d (0..$nd-1) { |
240
|
4252
|
100
|
|
|
|
3863
|
if($v->get_component($d) >= $max->get_component($d)) { |
241
|
|
|
|
|
|
|
# wrap to the next highest dimension, continue loop |
242
|
397
|
|
|
|
|
393
|
$v->set_component($d, $min->get_component($d)); |
243
|
|
|
|
|
|
|
} else { |
244
|
|
|
|
|
|
|
# still have farther to go in this dimension. |
245
|
3855
|
|
|
|
|
3791
|
$v->set_component($d, $v->get_component($d) + 1); |
246
|
3855
|
|
|
|
|
10355
|
return $v; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
# ran out of dimensions! |
250
|
100
|
|
|
|
|
276
|
return undef; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# -- PRIVATE METHODS |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
#- math ops |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# |
260
|
|
|
|
|
|
|
# my $vec = $v1->_add($v2); |
261
|
|
|
|
|
|
|
# my $vec = $v1 + $v2; |
262
|
|
|
|
|
|
|
# |
263
|
|
|
|
|
|
|
# Return a new LBV object, which is the result of $v1 plus $v2. |
264
|
|
|
|
|
|
|
# |
265
|
|
|
|
|
|
|
sub _add { |
266
|
3763
|
|
|
3763
|
|
2660
|
my ($v1, $v2) = @_; |
267
|
3763
|
|
|
|
|
2719
|
my $nd = scalar @$v1; |
268
|
3763
|
100
|
|
|
|
4575
|
croak "uneven dimensions in vector addition!" unless $nd == scalar @$v2; |
269
|
3762
|
|
|
|
|
4170
|
return ref($v1)->new(map { $$v1[$_] + $$v2[$_] } (0..$nd-1)); |
|
7527
|
|
|
|
|
9469
|
|
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# |
274
|
|
|
|
|
|
|
# my $vec = $v1->_substract($v2); |
275
|
|
|
|
|
|
|
# my $vec = $v1 - $v2; |
276
|
|
|
|
|
|
|
# |
277
|
|
|
|
|
|
|
# Return a new LBV object, which is the result of $v1 minus $v2. |
278
|
|
|
|
|
|
|
# |
279
|
|
|
|
|
|
|
sub _substract { |
280
|
7534
|
|
|
7534
|
|
5184
|
my ($v1, $v2) = @_; |
281
|
7534
|
|
|
|
|
5127
|
my $nd = scalar @$v1; |
282
|
7534
|
100
|
|
|
|
9029
|
croak "uneven dimensions in vector subtraction!" unless $nd == scalar @$v2; |
283
|
7533
|
|
|
|
|
6738
|
return ref($v1)->new(map { $$v1[$_] - $$v2[$_] } (0..$nd-1)); |
|
15071
|
|
|
|
|
17084
|
|
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# |
288
|
|
|
|
|
|
|
# my $v2 = $v1->_invert; |
289
|
|
|
|
|
|
|
# my $v2 = -$v1; |
290
|
|
|
|
|
|
|
# |
291
|
|
|
|
|
|
|
# Subtract $v1 from the origin. Effectively, gives the inverse of the |
292
|
|
|
|
|
|
|
# original vector. The new vector is the same distance from the origin, |
293
|
|
|
|
|
|
|
# in the opposite direction. |
294
|
|
|
|
|
|
|
# |
295
|
|
|
|
|
|
|
sub _invert { |
296
|
1602
|
|
|
1602
|
|
1264
|
my ($v1) = @_; |
297
|
1602
|
|
|
|
|
1244
|
my $nd = scalar @$v1; |
298
|
1602
|
|
|
|
|
1753
|
return ref($v1)->new(map { -$_ } (@$v1)); |
|
3210
|
|
|
|
|
3911
|
|
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
#- inplace math ops |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# |
305
|
|
|
|
|
|
|
# $v1->_add_inplace($v2); |
306
|
|
|
|
|
|
|
# $v1 += $v2; |
307
|
|
|
|
|
|
|
# |
308
|
|
|
|
|
|
|
# |
309
|
|
|
|
|
|
|
sub _add_inplace { |
310
|
9401
|
|
|
9401
|
|
7189
|
my ($v1, $v2) = @_; |
311
|
9401
|
|
|
|
|
6578
|
my $nd = scalar @$v1; |
312
|
9401
|
100
|
|
|
|
12316
|
croak "uneven dimensions in vector addition!" unless $nd == scalar @$v2; |
313
|
9400
|
|
|
|
|
10583
|
map { $$v1[$_] += $$v2[$_] } (0..$nd-1); |
|
18843
|
|
|
|
|
18768
|
|
314
|
9400
|
|
|
|
|
13198
|
return $v1; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# |
319
|
|
|
|
|
|
|
# $v1->_substract_inplace($v2); |
320
|
|
|
|
|
|
|
# $v1 -= $v2; |
321
|
|
|
|
|
|
|
# |
322
|
|
|
|
|
|
|
# Substract $v2 to $v1, and stores the result back into $v1. |
323
|
|
|
|
|
|
|
# |
324
|
|
|
|
|
|
|
sub _substract_inplace { |
325
|
4922
|
|
|
4922
|
|
3525
|
my ($v1, $v2) = @_; |
326
|
4922
|
|
|
|
|
3184
|
my $nd = scalar @$v1; |
327
|
4922
|
100
|
|
|
|
5889
|
croak "uneven dimensions in vector substraction!" unless $nd == scalar @$v2; |
328
|
4921
|
|
|
|
|
4319
|
map { $$v1[$_] -= $$v2[$_] } (0..$nd-1); |
|
9865
|
|
|
|
|
9129
|
|
329
|
4921
|
|
|
|
|
7000
|
return $v1; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
#- comparison |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# |
336
|
|
|
|
|
|
|
# my $bool = $v1->_compare($v2); |
337
|
|
|
|
|
|
|
# my $bool = $v1 <=> $v2; |
338
|
|
|
|
|
|
|
# |
339
|
|
|
|
|
|
|
# Check whether the vectors both point at the same spot. Return 0 if they |
340
|
|
|
|
|
|
|
# do, 1 if they don't. |
341
|
|
|
|
|
|
|
# |
342
|
|
|
|
|
|
|
sub _compare { |
343
|
1701
|
|
|
1701
|
|
2062
|
my ($v1, $v2) = @_; |
344
|
1701
|
|
|
|
|
1196
|
my $nd = scalar @$v1; |
345
|
1701
|
100
|
|
|
|
2288
|
croak "uneven dimensions in bounds check!" unless $nd == scalar @$v2; |
346
|
1699
|
|
|
|
|
2442
|
for (my $d = 0; $d < $nd; $d++) { |
347
|
1733
|
100
|
|
|
|
6986
|
return 1 if $$v1[$d] != $$v2[$d]; |
348
|
|
|
|
|
|
|
} |
349
|
7
|
|
|
|
|
24
|
return 0; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# |
354
|
|
|
|
|
|
|
# my $bool = $v->_compare($string); |
355
|
|
|
|
|
|
|
# my $bool = $v eq $string; |
356
|
|
|
|
|
|
|
# |
357
|
|
|
|
|
|
|
# Check whether the vector stringifies to $string. |
358
|
|
|
|
|
|
|
# |
359
|
|
|
|
|
|
|
sub _compare_string { |
360
|
316
|
|
|
316
|
|
6790882
|
my ($self, $str) = @_; |
361
|
316
|
|
|
|
|
596
|
return $self->as_string eq $str; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
#- other private methods |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# |
369
|
|
|
|
|
|
|
# my $ptr = $v1->_xs_rasterize_ptr(); |
370
|
|
|
|
|
|
|
# |
371
|
|
|
|
|
|
|
# Get a pointer to the C "rasterize" function. Returns undef if LBVXS is not |
372
|
|
|
|
|
|
|
# loaded. This is useful for external XS modules, because calling the C |
373
|
|
|
|
|
|
|
# function directly is faster. |
374
|
|
|
|
|
|
|
# |
375
|
|
|
|
|
|
|
# The prototype of the C rasterize function is: |
376
|
|
|
|
|
|
|
# |
377
|
|
|
|
|
|
|
# AV *rasterize(AV *vec_array, AV *min_array, AV *max_array); |
378
|
|
|
|
|
|
|
# |
379
|
|
|
|
|
|
|
# It operates just like the perl rasterize function, and returns NULL when the |
380
|
|
|
|
|
|
|
# end of the loop has been reached. |
381
|
|
|
|
|
|
|
# |
382
|
1
|
|
|
1
|
|
518
|
sub _xs_rasterize_ptr { return undef } |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
1; |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
__END__ |