3 # This file is part of Language::Befunge::Vector::XS.
4 # Copyright (c) 2008 Jerome Quelin, all rights reserved.
6 # This program is free software; you can redistribute it and/or modify
7 # it under the same terms as Perl itself.
17 #define NEED_newRV_noinc
21 /* used for constructor new() */
23 void* intArrayPtr(int num) {
25 mortal = sv_2mortal( NEWSV(0, num * sizeof(intArray)) );
31 MODULE = Language::Befunge::Vector::XS PACKAGE = Language::Befunge::Vector::XS
37 # my $vec = LB::Vector->new( $x [, $y, ...] );
39 # Create a new vector. The arguments are the actual vector data; one
40 # integer per dimension.
43 new( class, array, ... )
55 croak("Usage: %s->new($x,...)", class);
57 /* create the object and populate it */
59 for ( i=0; i<ix_array; i++ ) {
60 val = newSViv( array[i] );
61 av_push(my_array, val);
64 /* Return a blessed reference to the AV */
65 self = newRV_noinc( (SV*)my_array );
66 stash = gv_stashpv( class, TRUE );
67 sv_bless( (SV*)self, stash );
74 # my $vec = Language::Befunge::Vector::XS->new_zeroes( $dims );
76 # Create a new vector of dimension $dims, set to the origin (all
77 # zeroes). LBVXS->new_zeroes(2) is exactly equivalent to LBVXS->new(0, 0).
80 new_zeroes( class, dim )
92 croak("Usage: %s->new_zeroes($dims)", class);
94 /* create the object and populate it */
96 for ( i=0; i<dim; i++ ) {
98 av_push(my_array, zero);
101 /* return a blessed reference to the AV */
102 self = newRV_noinc( (SV*)my_array );
103 stash = gv_stashpv( class, TRUE );
104 sv_bless( (SV*)self, stash );
111 # my $vec = $v->copy;
113 # Return a new LBVXS object, which has the same dimensions and
127 /* fetch the underlying array of the object */
128 vec_array = (AV*)SvRV(vec);
130 /* create the object and populate it */
132 for ( i=0; i<=av_len(vec_array); i++ ) {
133 val = newSViv( SvIV(*av_fetch(vec_array, i, 0)) );
134 av_push(my_array, val);
137 /* return a blessed reference to the AV */
138 self = newRV_noinc( (SV*)my_array );
139 stash = SvSTASH( (SV*)vec_array );
140 sv_bless( (SV*)self, stash );
151 # my $dims = $vec->get_dims;
153 # Return the number of dimensions, an integer.
161 /* fetch the underlying array of the object */
162 my_array = (AV*)SvRV(self);
164 RETVAL = av_len(my_array) + 1;
170 # my $val = $vec->get_component($dim);
172 # Return the value for dimension $dim.
175 get_component( self, dim )
181 /* fetch the underlying array of the object */
182 my_array = (AV*)SvRV(self);
185 if ( dim < 0 || dim > av_len(my_array) )
186 croak( "No such dimension!" );
188 RETVAL = SvIV( *av_fetch(my_array, dim, 0) );
194 # my @vals = $vec->get_all_components;
196 # Get the values for all dimensions, in order from 0..N.
199 get_all_components( self )
205 /* fetch the underlying array of the object */
206 my_array = (AV*)SvRV(self);
207 dim = av_len(my_array);
209 /* extend the return stack and populate it */
211 for ( i=0; i<=dim; i++ ) {
212 val = SvIV( *av_fetch(my_array, i, 0) );
213 PUSHs( sv_2mortal( newSViv(val) ) );
222 # Set the vector back to the origin, all 0's.
232 /* fetch the underlying array of the object */
233 my_array = (AV*)SvRV(self);
234 dim = av_len(my_array);
236 /* clear each slot */
237 for ( i=0; i<=dim; i++ ) {
239 av_store(my_array, i, zero);
244 # my $val = $vec->set_component( $dim, $value );
246 # Set the value for dimension $dim to $value.
249 set_component( self, dim, value )
256 /* fetch the underlying array of the object */
257 my_array = (AV*)SvRV(self);
260 if ( dim < 0 || dim > av_len(my_array) )
261 croak( "No such dimension!" );
263 /* storing new value */
264 av_store(my_array, dim, newSViv(value));
270 # my $is_within = $vec->bounds_check($begin, $end);
272 # Check whether $vec is within the box defined by $begin and $end.
273 # Return 1 if vector is contained within the box, and 0 otherwise.
276 bounds_check( self, v1, v2 )
281 IV i, mydim, dimv1, dimv2, myval, val1, val2;
286 /* fetch the underlying array of the object */
287 my_array = (AV*)SvRV(self);
288 v1_array = (AV*)SvRV(v1);
289 v2_array = (AV*)SvRV(v2);
290 mydim = av_len(my_array);
291 dimv1 = av_len(v1_array);
292 dimv2 = av_len(v2_array);
295 if ( mydim != dimv1 || mydim != dimv2 )
296 croak("uneven dimensions in bounds check!");
298 /* compare the arrays */
300 for ( i=0 ; i<=dimv1; i++ ) {
301 myval = SvIV( *av_fetch(my_array, i, 0) );
302 val1 = SvIV( *av_fetch(v1_array, i, 0) );
303 val2 = SvIV( *av_fetch(v2_array, i, 0) );
304 if ( myval < val1 || myval > val2 ) {
319 # my $vec = $v1->_add($v2);
320 # my $vec = $v1 + $v2;
322 # Return a new LBVXS object, which is the result of $v1 plus $v2.
325 _add( v1, v2, variant )
330 IV dimv1, dimv2, i, val1, val2;
337 /* fetch the underlying array of the object */
338 v1_array = (AV*)SvRV(v1);
339 v2_array = (AV*)SvRV(v2);
340 dimv1 = av_len(v1_array);
341 dimv2 = av_len(v2_array);
344 if ( dimv1 != dimv2 )
345 croak("uneven dimensions in vector addition!");
347 /* create the new array and populate it */
349 for ( i=0 ; i<=dimv1; i++ ) {
350 val1 = SvIV( *av_fetch(v1_array, i, 0) );
351 val2 = SvIV( *av_fetch(v2_array, i, 0) );
352 av_push( my_array, newSViv(val1+val2) );
355 /* return a blessed reference to the AV */
356 self = newRV_noinc( (SV*)my_array );
357 stash = SvSTASH( (SV*)v1_array );
358 sv_bless( (SV*)self, stash );
365 # my $vec = $v1->_substract($v2);
366 # my $vec = $v1 - $v2;
368 # Return a new LBVXS object, which is the result of $v1 minus $v2.
371 _substract( v1, v2, variant )
376 IV dimv1, dimv2, i, val1, val2;
383 /* fetch the underlying array of the object */
384 v1_array = (AV*)SvRV(v1);
385 v2_array = (AV*)SvRV(v2);
386 dimv1 = av_len(v1_array);
387 dimv2 = av_len(v2_array);
390 if ( dimv1 != dimv2 )
391 croak("uneven dimensions in vector addition!");
393 /* create the new array and populate it */
395 for ( i=0 ; i<=dimv1; i++ ) {
396 val1 = SvIV( *av_fetch(v1_array, i, 0) );
397 val2 = SvIV( *av_fetch(v2_array, i, 0) );
398 av_push( my_array, newSViv(val1-val2) );
401 /* return a blessed reference to the AV */
402 self = newRV_noinc( (SV*)my_array );
403 stash = SvSTASH( (SV*)v1_array );
404 sv_bless( (SV*)self, stash );
411 # my $vec = $v1->_invert;
414 # Subtract $v1 from the origin. Effectively, gives the inverse of the
415 # original vector. The new vector is the same distance from the origin,
416 # in the opposite direction.
419 _invert( v1, v2, variant )
430 /* fetch the underlying array of the object */
431 v1_array = (AV*)SvRV(v1);
432 dim = av_len(v1_array);
434 /* create the new array and populate it */
436 for ( i=0 ; i<=dim; i++ ) {
437 val = SvIV( *av_fetch(v1_array, i, 0) );
438 av_push( my_array, newSViv(-val) );
441 /* return a blessed reference to the AV */
442 self = newRV_noinc( (SV*)my_array );
443 stash = SvSTASH( (SV*)v1_array );
444 sv_bless( (SV*)self, stash );
454 # $v1->_add_inplace($v2);
457 # Adds $v2 to $v1, and stores the result back into $v1.
460 _add_inplace( v1, v2, variant )
465 IV dimv1, dimv2, i, val1, val2;
469 /* fetch the underlying array of the object */
470 v1_array = (AV*)SvRV(v1);
471 v2_array = (AV*)SvRV(v2);
472 dimv1 = av_len(v1_array);
473 dimv2 = av_len(v2_array);
476 if ( dimv1 != dimv2 )
477 croak("uneven dimensions in vector addition!");
479 /* update the array slots */
480 for ( i=0 ; i<=dimv1; i++ ) {
481 val1 = SvIV( *av_fetch(v1_array, i, 0) );
482 val2 = SvIV( *av_fetch(v2_array, i, 0) );
483 av_store( v1_array, i, newSViv(val1+val2) );
490 # $v1->_substract_inplace($v2);
493 # Substract $v2 to $v1, and stores the result back into $v1.
496 _substract_inplace( v1, v2, variant )
501 IV dimv1, dimv2, i, val1, val2;
505 /* fetch the underlying array of the object */
506 v1_array = (AV*)SvRV(v1);
507 v2_array = (AV*)SvRV(v2);
508 dimv1 = av_len(v1_array);
509 dimv2 = av_len(v2_array);
512 if ( dimv1 != dimv2 )
513 croak("uneven dimensions in vector addition!");
515 /* update the array slots */
516 for ( i=0 ; i<=dimv1; i++ ) {
517 val1 = SvIV( *av_fetch(v1_array, i, 0) );
518 val2 = SvIV( *av_fetch(v2_array, i, 0) );
519 av_store( v1_array, i, newSViv(val1-val2) );
528 # my $bool = $v1->_compare($v2);
529 # my $bool = $v1 <=> $v2;
531 # Check whether the vectors both point at the same spot. Return 0 if they
532 # do, 1 if they don't.
535 _compare( v1, v2, variant )
541 IV dimv1, dimv2, i, val1, val2;
545 /* fetch the underlying array of the object */
546 v1_array = (AV*)SvRV(v1);
547 v2_array = (AV*)SvRV(v2);
548 dimv1 = av_len(v1_array);
549 dimv2 = av_len(v2_array);
552 if ( dimv1 != dimv2 )
553 croak("uneven dimensions in bounds check!");
555 /* compare the arrays */
557 for ( i=0 ; i<=dimv1; i++ ) {
558 val1 = SvIV( *av_fetch(v1_array, i, 0) );
559 val2 = SvIV( *av_fetch(v2_array, i, 0) );
560 if ( val1 != val2 ) {