2 # This file is part of Language::Befunge.
3 # Copyright (c) 2001-2009 Jerome Quelin, all rights reserved.
5 # This program is free software; you can redistribute it and/or modify
6 # it under the same terms as Perl itself.
10 package Language
::Befunge
::Vector
;
22 '+=' => \
&_add_inplace
,
23 '-=' => \
&_substract_inplace
,
25 'eq' => \
&_compare_string
,
28 # try to load speed-up LBV
29 eval 'use Language::Befunge::Vector::XS';
30 if ( defined $Language::Befunge
::Vector
::XS
::VERSION
) {
31 my $xsversion = $Language::Befunge
::Vector
::XS
::VERSION
;
34 as_string get_dims get_component get_all_components
37 _add _substract _invert
38 _add_inplace _substract_inplace
41 foreach my $sub ( @subs ) {
43 no warnings
'redefine';
44 my $lbvxs_sub = "Language::Befunge::Vector::XS::$sub";
47 # LBV::XS 1.1.0 adds rasterize()
48 @subs = qw
[ rasterize _xs_rasterize_ptr
];
49 if($xsversion gt "1.0.0") {
50 # import the XS functions from LBVXS
52 no warnings
'redefine';
53 foreach my $sub (@subs) {
54 my $lbvxs_sub = "Language::Befunge::Vector::XS::$sub";
58 # export the pure-perl functions to LBVXS
60 no warnings
'redefine';
61 foreach my $sub (@subs) {
62 my $lbvxs_sub = "Language::Befunge::Vector::XS::$sub";
72 # my $vec = LB::Vector->new( $x [, $y, ...] );
74 # Create a new vector. The arguments are the actual vector data; one
75 # integer per dimension.
81 my $usage = "Usage: $pkg->new(\$x, ...)";
82 croak
$usage unless scalar(@_) > 0;
92 # my $vec = LB::Vector->new_zeroes($dims);
94 # Create a new vector of dimension $dims, set to the origin (all
95 # zeroes). LBV->new_zeroes(2) is exactly equivalent to LBV->new(0, 0).
98 my ($pkg, $dims) = @_;
101 my $usage = "Usage: $pkg->new_zeroes(\$dimensions)";
102 croak
$usage unless defined $dims;
103 croak
$usage unless $dims > 0;
106 my $self = [ (0) x
$dims ];
113 # my $vec = $v->copy;
115 # Return a new LBV object, which has the same dimensions and coordinates
120 return bless [@
$vec], ref $vec;
130 # my $str = $vec->as_string;
133 # Return the stringified form of $vec. For instance, a Befunge vector
134 # might look like "(1,2)".
138 return "(" . join(",",@
$self) . ")";
143 # my $dims = $vec->get_dims;
145 # Return the number of dimensions, an integer.
149 return scalar(@
$self);
154 # my $val = $vec->get_component($dim);
156 # Get the value for dimension $dim.
159 my ($self, $dim) = @_;
160 croak
"No such dimension $dim!" unless $dim >= 0 && $self->get_dims > $dim;
161 return $self->[$dim];
166 # my @vals = $vec->get_all_components;
168 # Get the values for all dimensions, in order from 0..N.
170 sub get_all_components
{
181 # Set the vector back to the origin, all 0's.
185 @
$self = (0) x
$self->get_dims;
190 # $vec->set_component($dim, $value);
192 # Set the value for dimension $dim to $value.
195 my ($self, $dim, $val) = @_;
196 croak
"No such dimension $dim!" unless $dim >= 0 && $self->get_dims > $dim;
197 $self->[$dim] = $val;
204 # my $is_within = $vec->bounds_check($begin, $end);
206 # Check whether $vec is within the box defined by $begin and $end.
207 # Return 1 if vector is contained within the box, and 0 otherwise.
210 my ($vchk, $begin, $end) = @_;
211 croak
"uneven dimensions in bounds check!" unless $vchk->get_dims == $begin->get_dims;
212 croak
"uneven dimensions in bounds check!" unless $vchk->get_dims == $end->get_dims;
213 for (my $d = 0; $d < $vchk->get_dims; $d++) {
214 return 0 if $vchk->get_component($d) < $begin->get_component($d);
215 return 0 if $vchk->get_component($d) > $end->get_component($d);
222 # $vec = $vec->rasterize($min, $max);
224 # Return the next vector in raster order, or undef if the hypercube space
225 # has been fully covered. To enumerate the entire storage area, the caller
226 # should call rasterize on the storage area's "min" value the first time,
227 # and keep looping while the return value is defined. To enumerate a
228 # smaller rectangle, the caller should pass in the min and max vectors
229 # describing the rectangle, and keep looping while the return value is
234 my ($v, $min, $max) = @_;
235 return undef unless $v->bounds_check($min, $max);
237 my $nd = $v->get_dims();
238 for my $d (0..$nd-1) {
239 if($v->get_component($d) >= $max->get_component($d)) {
240 # wrap to the next highest dimension, continue loop
241 $v->set_component($d, $min->get_component($d));
243 # still have farther to go in this dimension.
244 $v->set_component($d, $v->get_component($d) + 1);
248 # ran out of dimensions!
259 # my $vec = $v1->_add($v2);
260 # my $vec = $v1 + $v2;
262 # Return a new LBV object, which is the result of $v1 plus $v2.
266 my $nd = scalar @
$v1;
267 croak
"uneven dimensions in vector addition!" unless $nd == scalar @
$v2;
268 return ref($v1)->new(map { $$v1[$_] + $$v2[$_] } (0..$nd-1));
273 # my $vec = $v1->_substract($v2);
274 # my $vec = $v1 - $v2;
276 # Return a new LBV object, which is the result of $v1 minus $v2.
280 my $nd = scalar @
$v1;
281 croak
"uneven dimensions in vector subtraction!" unless $nd == scalar @
$v2;
282 return ref($v1)->new(map { $$v1[$_] - $$v2[$_] } (0..$nd-1));
287 # my $v2 = $v1->_invert;
290 # Subtract $v1 from the origin. Effectively, gives the inverse of the
291 # original vector. The new vector is the same distance from the origin,
292 # in the opposite direction.
296 my $nd = scalar @
$v1;
297 return ref($v1)->new(map { -$_ } (@
$v1));
304 # $v1->_add_inplace($v2);
310 my $nd = scalar @
$v1;
311 croak
"uneven dimensions in vector addition!" unless $nd == scalar @
$v2;
312 map { $$v1[$_] += $$v2[$_] } (0..$nd-1);
318 # $v1->_substract_inplace($v2);
321 # Substract $v2 to $v1, and stores the result back into $v1.
323 sub _substract_inplace
{
325 my $nd = scalar @
$v1;
326 croak
"uneven dimensions in vector substraction!" unless $nd == scalar @
$v2;
327 map { $$v1[$_] -= $$v2[$_] } (0..$nd-1);
335 # my $bool = $v1->_compare($v2);
336 # my $bool = $v1 <=> $v2;
338 # Check whether the vectors both point at the same spot. Return 0 if they
339 # do, 1 if they don't.
343 my $nd = scalar @
$v1;
344 croak
"uneven dimensions in bounds check!" unless $nd == scalar @
$v2;
345 for (my $d = 0; $d < $nd; $d++) {
346 return 1 if $$v1[$d] != $$v2[$d];
353 # my $bool = $v->_compare($string);
354 # my $bool = $v eq $string;
356 # Check whether the vector stringifies to $string.
358 sub _compare_string
{
359 my ($self, $str) = @_;
360 return $self->as_string eq $str;
365 #- other private methods
368 # my $ptr = $v1->_xs_rasterize_ptr();
370 # Get a pointer to the C "rasterize" function. Returns undef if LBVXS is not
371 # loaded. This is useful for external XS modules, because calling the C
372 # function directly is faster.
374 # The prototype of the C rasterize function is:
376 # AV *rasterize(AV *vec_array, AV *min_array, AV *max_array);
378 # It operates just like the perl rasterize function, and returns NULL when the
379 # end of the loop has been reached.
381 sub _xs_rasterize_ptr
{ return undef }
389 Language::Befunge::Vector - an opaque, N-dimensional vector class.
395 my $v1 = Language::Befunge::Vector->new($x, $y, ...);
396 my $v2 = Language::Befunge::Vector->new_zeroes($dims);
402 This class abstracts normal vector manipulation. It lets you pass
403 around one argument to your functions, rather than N arguments, one
404 per dimension. This means much of your code doesn't have to care
405 how many dimensions you're working with.
407 You can do vector arithmetic, test for equality, or even stringify
408 the vector to a string like I<"(1,2,3)">.
414 =head2 my $vec = LB::Vector->new( $x [, $y, ...] )
416 Create a new vector. The arguments are the actual vector data; one
417 integer per dimension.
420 =head2 my $vec = LB::Vector->new_zeroes($dims);
422 Create a new vector of dimension C<$dims>, set to the origin (all zeroes). C<<
423 LBV->new_zeroes(2) >> is exactly equivalent to B<< LBV->new(0,0) >>.
426 =head2 my $vec = $v->copy;
428 Return a new LBV object, which has the same dimensions and coordinates
433 =head1 PUBLIC METHODS
435 =head2 my $str = $vec->as_string;
437 Return the stringified form of C<$vec>. For instance, a Befunge vector
438 might look like C<(1,2)>.
440 This method is also applied to stringification, ie when one forces
441 string context (C<"$vec">).
444 =head2 my $dims = $vec->get_dims;
446 Return the number of dimensions, an integer.
449 =head2 my $val = $vec->get_component($dim);
451 Get the value for dimension C<$dim>.
454 =head2 my @vals = $vec->get_all_components;
456 Get the values for all dimensions, in order from 0..N.
461 Set the vector back to the origin, all 0's.
464 =head2 $vec->set_component($dim, $value);
466 Set the value for dimension C<$dim> to C<$value>.
469 =head2 my $is_within = $vec->bounds_check($begin, $end);
471 Check whether C<$vec> is within the box defined by C<$begin> and C<$end>.
472 Return 1 if vector is contained within the box, and 0 otherwise.
475 =head2 $vec->rasterize($min, $max);
477 Return the next vector in raster order, or undef if the hypercube space
478 has been fully covered.
480 To enumerate the entire storage area, the caller should call rasterize
481 on the storage area's "min" value the first time, and keep looping while
482 the return value is defined. To enumerate a smaller rectangle, the
483 caller should pass in the min and max vectors describing the rectangle,
484 and keep looping while the return value is defined.
488 =head1 MATHEMATICAL OPERATIONS
490 =head2 Standard operations
492 One can do some maths on the vectors. Addition and substraction work as
498 Either operation return a new LBV object, which is the result of C<$v1>
501 The inversion is also supported:
504 will subtracts C<$v1> from the origin, and effectively, gives the
505 inverse of the original vector. The new vector is the same distance from
506 the origin, in the opposite direction.
509 =head2 Inplace operations
511 LBV objects also supports inplace mathematical operations:
516 effectively adds / substracts C<$v2> to / from C<$v1>, and stores the
517 result back into C<$v1>.
522 Finally, LBV objects can be tested for equality, ie whether two vectors
523 both point at the same spot.
525 print "same" if $v1 == $v2;
526 print "differ" if $v1 != $v2;
529 =head1 PRIVATE METHODS
531 =head2 _xs_rasterize_ptr
533 my $ptr = $v1->_xs_rasterize_ptr();
535 Get a pointer to the C "rasterize" function. Returns undef if LBVXS is not
536 loaded. This is useful for external XS modules, to allow them to call the
537 C function directly for additional speed.
539 The prototype of the C rasterize function is:
541 AV *rasterize(AV *vec_array, AV *min_array, AV *max_array);
543 It operates just like the perl rasterize function, and returns NULL when the
544 end of the loop has been reached.
554 Jerome Quelin, E<lt>jquelin@cpan.orgE<gt>
556 Development is discussed on E<lt>language-befunge@mongueurs.netE<gt>
559 =head1 COPYRIGHT & LICENSE
561 Copyright (c) 2001-2009 Jerome Quelin, all rights reserved.
563 This program is free software; you can redistribute it and/or modify
564 it under the same terms as Perl itself.