From f8d01594bddef4175407b51c7eb083f83238a658 Mon Sep 17 00:00:00 2001
From: Mark Glines <mark@glines.org>
Date: Thu, 29 May 2008 21:34:03 -0700
Subject: [PATCH] create rasterize(), and tests for that.

In a separate patch to L::B, I modified LBV to import rasterize from LBVXS
versions 1.0.1 and above, and to export rasterize to LBVXS versions
1.0.0 and below.  Here's an implementation of XS rasterize for 1.0.1.
---
 XS.xs                             | 82 +++++++++++++++++++++++++++++++++++++++
 lib/Language/Befunge/Vector/XS.pm |  2 +
 t/1-vector.t                      | 30 +++++++++++++-
 3 files changed, 113 insertions(+), 1 deletion(-)

diff --git a/XS.xs b/XS.xs
index 0aa0943..5f7c373 100644
--- a/XS.xs
+++ b/XS.xs
@@ -26,6 +26,30 @@ void* intArrayPtr(int num) {
     return SvPVX(mortal);
 }
 
+AV *_rasterize(AV *vec_array, AV *min_array, AV *max_array) {
+    IV i, inc = 1, nd = av_len(vec_array);
+    AV *rv = newAV();
+    for (i = 0; i <= av_len(vec_array); i++) {
+        IV thisval, minval, maxval;
+        thisval = SvIV(*av_fetch(vec_array, i, 0));
+        minval  = SvIV(*av_fetch(min_array, i, 0));
+        maxval  = SvIV(*av_fetch(max_array, i, 0));
+        if(inc) {
+            if(thisval < maxval) {
+                inc = 0;
+                thisval++;
+            } else {
+                if(i == nd) {
+                    SvREFCNT_dec(rv);
+                    return NULL;
+                }
+                thisval = minval;
+            }
+        }
+        av_push(rv, newSViv(thisval));
+    }
+    return rv;
+}
 
 
 MODULE = Language::Befunge::Vector::XS		PACKAGE = Language::Befunge::Vector::XS
@@ -310,6 +334,47 @@ bounds_check( self, v1, v2 )
         RETVAL
 
 
+#
+# for(my $v = $min->copy(); defined $v; $v = $v->rasterize($min, $max))
+#
+# Return the next vector in raster order, or undef if the hypercube space
+# has been fully covered.  To enumerate the entire storage area, the caller
+# should call rasterize on the storage area's "min" value the first time,
+# and keep looping while the return value is defined.  To enumerate a
+# smaller rectangle, the caller should pass in the min and max vectors
+# describing the rectangle, and keep looping while the return value is
+# defined.
+#
+SV*
+rasterize( self, minv, maxv )
+        SV* self;
+        SV* minv;
+        SV* maxv;
+    INIT:
+        SV*  new;
+        AV*  my_array;
+        AV*  vec_array, *min_array, *max_array;
+        HV*  stash;
+    CODE:
+        /* fetch the underlying array of the object */
+        vec_array = (AV*)SvRV(self);
+        min_array = (AV*)SvRV(minv);
+        max_array = (AV*)SvRV(maxv);
+
+        /* create the object and populate it */
+        my_array = _rasterize(vec_array, min_array, max_array);
+        if(!my_array) {
+            XSRETURN_UNDEF;
+        }
+
+        /* return a blessed reference to the AV */
+        RETVAL = newRV_noinc( (SV*)my_array );
+        stash  = SvSTASH( (SV*)vec_array );
+        sv_bless( (SV*)RETVAL, stash );
+    OUTPUT:
+        RETVAL
+
+
 
 # -- PRIVATE METHODS
 
@@ -566,3 +631,20 @@ _compare( v1, v2, variant )
         RETVAL
 
 
+# private
+
+# my $ptr = $LBV->_xs_rasterize_ptr();
+#
+# Get a pointer to the C "rasterize" function, so that other XS modules can
+# call it directly for speed.
+
+SV*
+_xs_rasterize_ptr()
+    INIT:
+        void *ptr = _rasterize;
+        SV *rv;
+    CODE:
+        rv = newSVpvn((const char *)(&ptr), sizeof(ptr));
+        RETVAL = rv;
+    OUTPUT:
+        RETVAL
diff --git a/lib/Language/Befunge/Vector/XS.pm b/lib/Language/Befunge/Vector/XS.pm
index 146d469..0d371f0 100644
--- a/lib/Language/Befunge/Vector/XS.pm
+++ b/lib/Language/Befunge/Vector/XS.pm
@@ -86,6 +86,8 @@ module for more information on the following methods:
 
 =item bounds_check()
 
+=item rasterize()
+
 =item standard mathematical operations
 
 =item inplace mathematical operations
diff --git a/t/1-vector.t b/t/1-vector.t
index 67a3f59..a1d2484 100644
--- a/t/1-vector.t
+++ b/t/1-vector.t
@@ -15,8 +15,9 @@
 
 use strict;
 use warnings;
+use Config;
 
-use Test::More tests => 94;
+use Test::More tests => 151;
 
 use Language::Befunge::Vector::XS;
 
@@ -168,6 +169,28 @@ SKIP: {
 }
 
 
+# rasterize
+$v1 = Language::Befunge::Vector::XS->new(-1, -1, -1);
+$v2 = Language::Befunge::Vector::XS->new(1, 1, 1);
+my @expectations = (
+    [-1, -1, -1], [ 0, -1, -1], [ 1, -1, -1],
+    [-1,  0, -1], [ 0,  0, -1], [ 1,  0, -1],
+    [-1,  1, -1], [ 0,  1, -1], [ 1,  1, -1],
+    [-1, -1,  0], [ 0, -1,  0], [ 1, -1,  0],
+    [-1,  0,  0], [ 0,  0,  0], [ 1,  0,  0],
+    [-1,  1,  0], [ 0,  1,  0], [ 1,  1,  0],
+    [-1, -1,  1], [ 0, -1,  1], [ 1, -1,  1],
+    [-1,  0,  1], [ 0,  0,  1], [ 1,  0,  1],
+    [-1,  1,  1], [ 0,  1,  1], [ 1,  1,  1]);
+for($v3 = $v1->copy(); scalar @expectations; $v3 = $v3->rasterize($v1, $v2)) {
+    my $expect = shift @expectations;
+    $expect = Language::Befunge::Vector::XS->new(@$expect);
+    is($v3, $expect, "next one is $expect");
+    is(ref($v3), "Language::Befunge::Vector::XS", "retval is also a LBVXS");
+}
+is($v3, undef, "rasterize returns undef at end of loop");
+
+
 #- math ops
 
 # addition
@@ -274,3 +297,8 @@ SKIP: {
 		qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
 }
 
+
+# _xs_rasterize_ptr
+my $ptr = Language::Befunge::Vector::XS::_xs_rasterize_ptr();
+ok(defined($ptr), "rasterize pointer is defined");
+is(length($ptr), $Config{ptrsize}, "rasterize pointer is the right size");
-- 
2.11.4.GIT