From: Tony Cook <tony@develop-help.com>
Date: Mon, 30 Jan 2012 12:06:49 +0000 (+1100)
Subject: initial XS interfaces to i_psamp()/i_psampf()
X-Git-Tag: v0.88~3^2~13
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/48b9a7bf500eecabfbf6a689c7c4bdcf83cc8d0b?ds=sidebyside

initial XS interfaces to i_psamp()/i_psampf()
---

diff --git a/Imager.xs b/Imager.xs
index edc5e4b1..db1182ea 100644
--- a/Imager.xs
+++ b/Imager.xs
@@ -35,6 +35,16 @@ typedef struct i_channel_list_tag {
   int count;
 } i_channel_list;
 
+typedef struct {
+  size_t count;
+  const i_sample_t *samples;
+} i_sample_list;
+
+typedef struct {
+  size_t count;
+  const i_fsample_t *samples;
+} i_fsample_list;
+
 /*
 
 Allocate memory that will be discarded when mortals are discarded.
@@ -3325,6 +3335,44 @@ i_psamp_bits(im, l, y, bits, channels, data_av, data_offset = 0, pixel_count = -
       OUTPUT:
 	RETVAL
 
+undef_neg_int
+i_psamp(im, x, y, channels, data)
+	Imager::ImgRaw im
+	i_img_dim x
+	i_img_dim y
+	i_channel_list channels
+        i_sample_list data
+    PREINIT:
+	i_img_dim r;
+    CODE:
+	if (data.count % channels.count) {
+	  croak("channel count and data sample counts don't match");
+	}
+	r = x + data.count / channels.count;
+	i_clear_error();
+	RETVAL = i_psamp(im, x, r, y, data.samples, channels.channels, channels.count);
+    OUTPUT:
+	RETVAL
+
+undef_neg_int
+i_psampf(im, x, y, channels, data)
+	Imager::ImgRaw im
+	i_img_dim x
+	i_img_dim y
+	i_channel_list channels
+        i_fsample_list data
+    PREINIT:
+	i_img_dim r;
+    CODE:
+	if (data.count % channels.count) {
+	  croak("channel count and data sample counts don't match");
+	}
+	r = x + data.count / channels.count;
+	i_clear_error();
+	RETVAL = i_psampf(im, x, r, y, data.samples, channels.channels, channels.count);
+    OUTPUT:
+	RETVAL
+
 Imager::ImgRaw
 i_img_masked_new(targ, mask, x, y, w, h)
         Imager::ImgRaw targ
diff --git a/typemap b/typemap
index 20980004..56e8cc77 100644
--- a/typemap
+++ b/typemap
@@ -30,7 +30,10 @@ off_t			T_OFF_T
 # STRLEN isn't in the default typemap in older perls
 STRLEN	       	      	T_UV
 
+# internal types used in Imager.xs
 i_channel_list	 	T_IM_CHANNEL_LIST
+i_sample_list		T_IM_SAMPLE_LIST
+i_fsample_list		T_IM_FSAMPLE_LIST
 
 #############################################################################
 INPUT
@@ -119,6 +122,64 @@ T_IM_CHANNEL_LIST
 	  $var.channels = NULL;
 	}
 
+T_IM_SAMPLE_LIST
+	SvGETMAGIC($arg);
+	if (!SvOK($arg))
+	  croak(\"$var must be a scalar or an arrayref\");
+	if (SvROK($arg)) {
+	  i_img_dim i;
+	  AV *av;
+	  i_sample_t *s;
+	  if (SvTYPE(SvRV($arg)) != SVt_PVAV)
+	    croak(\"$var must be a scalar or an arrayref\");
+	  av = (AV *)SvRV($arg);
+          $var.count = av_len(av) + 1;
+          if ($var.count < 1)
+	    croak(\"$pname: no samples provided in $var\");
+	  s = malloc_temp(aTHX_ sizeof(i_sample_t) * $var.count);
+ 	  for (i = 0; i < $var.count; ++i) {
+	    SV **entry = av_fetch(av, i, 0);
+ 	    s[i] = entry ? SvIV(*entry) : 0;
+	  }
+          $var.samples = s;
+	}
+	else {
+	  /* non-magic would be preferable here */
+	  $var.samples = (const i_sample_t *)SvPVbyte($arg, $var.count);
+	  if ($var.count == 0)
+	    croak(\"$pname: no samples provided in $var\");
+	}
+
+T_IM_FSAMPLE_LIST
+	SvGETMAGIC($arg);
+	if (!SvOK($arg))
+	  croak(\"$var must be a scalar or an arrayref\");
+	if (SvROK($arg)) {
+	  i_img_dim i;
+	  AV *av;
+	  i_fsample_t *s;
+	  if (SvTYPE(SvRV($arg)) != SVt_PVAV)
+	    croak(\"$var must be a scalar or an arrayref\");
+	  av = (AV *)SvRV($arg);
+          $var.count = av_len(av) + 1;
+          if ($var.count < 1)
+	    croak(\"$pname: no samples provided in $var\");
+	  s = malloc_temp(aTHX_ sizeof(i_fsample_t) * $var.count);
+ 	  for (i = 0; i < $var.count; ++i) {
+	    SV **entry = av_fetch(av, i, 0);
+ 	    s[i] = entry ? SvNV(*entry) : 0;
+	  }
+          $var.samples = s;
+	}
+	else {
+	  /* non-magic would be preferable here */
+	  $var.samples = (const i_fsample_t *)SvPVbyte($arg, $var.count);
+	  if ($var.count % sizeof(double))
+	    croak(\"$pname: $var doesn't not contain a integer number of samples\");
+          $var.count /= sizeof(double);
+	  if ($var.count == 0)
+	    croak(\"$pname: no samples provided in $var\");
+	}
 
 #############################################################################
 OUTPUT