[gimp-perl] Make Gimp::Net pass PDL objects right.

[Ed J <edj src gnome org>]

commit 8b972c6cd106fdc9bca2a5e91ac3ad5e8b55b2c3
Author: Ed J <edj src gnome org>
Date:   Thu May 15 06:13:44 2014 +0100

    Make Gimp::Net pass PDL objects right.

 Gimp/Lib.xs |   12 ------------
 Net/Net.xs  |   51 ++++++++++++++++++++++++++++++++++++++++-----------
 TODO        |    3 ++-
 t/pdl.t     |   35 ++++++++++++++++++++++++++++++-----
 4 files changed, 72 insertions(+), 29 deletions(-)
---
diff --git a/Gimp/Lib.xs b/Gimp/Lib.xs
index 92a753e..9a40b80 100644
--- a/Gimp/Lib.xs
+++ b/Gimp/Lib.xs
@@ -216,10 +216,8 @@ static GHashTable *gdrawable_cache;
 static int gdrawable_free (pTHX_ SV *obj, MAGIC *mg)
 {
   GimpDrawable *gdr = (GimpDrawable *)SvIV(obj);
-
   g_hash_table_remove (gdrawable_cache, GINT_TO_POINTER(gdr->drawable_id));
   gimp_drawable_detach (gdr);
-
   return 0;
 }
 
@@ -229,30 +227,22 @@ static SV *new_gdrawable (gint32 id)
 {
    static HV *stash;
    SV *sv;
-
    if (!gdrawable_cache)
      gdrawable_cache = g_hash_table_new (g_direct_hash, g_direct_equal);
-
    assert (sizeof (gpointer) >= sizeof (id));
-
    if ((sv = (SV*)g_hash_table_lookup (gdrawable_cache, GINT_TO_POINTER(id)))) {
      SvREFCNT_inc (sv);
    } else {
      GimpDrawable *gdr = gimp_drawable_get (id);
-
      if (!gdr)
        croak (__("unable to convert Gimp::Drawable into Gimp::GimpDrawable (id %d)"), id);
-
      if (!stash)
        stash = gv_stashpv (PKG_GDRAWABLE, 1);
-
      sv = newSViv ((IV) gdr);
      sv_magic (sv, 0, '~', 0, 0);
      mg_find (sv, '~')->mg_virtual = &vtbl_gdrawable;
-
      g_hash_table_insert (gdrawable_cache, GINT_TO_POINTER(id), (void *)sv);
    }
-
    return sv_bless (newRV_noinc (sv), stash);
 }
 
@@ -2083,7 +2073,6 @@ gimp_gdrawable_get_tile(gdrawable, shadow, row, col)
        gint    row
        gint    col
        CODE:
-       need_pdl ();
        RETVAL = new_tile (gimp_drawable_get_tile (old_gdrawable (gdrawable), shadow, row, col), gdrawable);
        OUTPUT:
        RETVAL
@@ -2095,7 +2084,6 @@ gimp_gdrawable_get_tile2(gdrawable, shadow, x, y)
        gint    x
        gint    y
        CODE:
-       need_pdl ();
        RETVAL = new_tile (gimp_drawable_get_tile2 (old_gdrawable (gdrawable), shadow, x, y), gdrawable);
        OUTPUT:
        RETVAL
diff --git a/Net/Net.xs b/Net/Net.xs
index 33fcb69..08fb102 100644
--- a/Net/Net.xs
+++ b/Net/Net.xs
@@ -1,8 +1,5 @@
 #include "config.h"
 
-/* dunno where this comes from */
-#undef VOIDUSED
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -10,13 +7,6 @@
 
 #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
 # undef printf
-#endif
-
-#if 0 /* optimized away ;) */
-#include <glib.h>
-#endif
-
-#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
 # define printf PerlIO_stdoutf
 #endif
 
@@ -57,7 +47,7 @@ static void destroy_object (SV *sv)
  * b stash sv          blessed reference
  * r                   simple reference
  * h len (key sv)*     hash (not yet supported!)
- * p                   piddle (not yet supported!)
+ * P pv                        passed as a string which has been PDL::IO::Dumper-ed
  *
  */
 
@@ -73,6 +63,30 @@ static void sv2net (int deobjectify, SV *s, SV *sv)
         {
           char *name = HvNAME (SvSTASH (rv));
 
+         if (strEQ (name, "PDL"))
+           {
+             char *str;
+             STRLEN len;
+             require_pv ("PDL/IO/Dumper.pm");
+             dSP;
+             ENTER;
+             SAVETMPS;
+             PUSHMARK(SP);
+             XPUSHs(sv);
+             PUTBACK;
+             if (perl_call_pv ("PDL::IO::Dumper::sdump", G_SCALAR) != 1)
+               croak (__("Failed to sdump PDL object"));
+             SPAGAIN;
+             sv = POPs;
+             str = SvPV(sv,len);
+             sv_catpvf (s, "P%x:", (int)len);
+             sv_catpvn (s, str, len);
+             PUTBACK;
+             FREETMPS;
+             LEAVE;
+              return;
+           }
+
           sv_catpvf (s, "b%x:%s", (unsigned int)strlen (name), name);
 
           if (deobjectify && is_dynamic (name))
@@ -149,6 +163,21 @@ static SV *net2sv (int objectify, char **_s)
         s += ui;
         break;
 
+      case 'P':
+       {
+         char *tmp;
+         sscanf (s, "%x:%n", &ui, &n); s += n;
+         tmp = strndup (s, ui);
+         s += ui;
+         require_pv ("PDL.pm");
+         require_pv ("PDL/IO/Dumper.pm");
+         (void)eval_pv ("import PDL;", G_VOID);
+         sv = eval_pv (tmp, G_SCALAR);
+         SvREFCNT_inc (sv);
+         free (tmp);
+         break;
+       }
+
       case 'r':
         sv = newRV_noinc (net2sv (objectify, &s));
         break;
diff --git a/TODO b/TODO
index 72a6559..d93435f 100644
--- a/TODO
+++ b/TODO
@@ -12,7 +12,8 @@ Items as of 2014-04-29 (by Ed J)
   way to pass GIMP data back and forth directly via typemap system. May
   involve a gimp-perl "wrapper" data structure that pairs an SV with its
   GimpParam counterpart - Gimp::Lib::Data?
-* Get gimp PDL objects working right over Gimp::Net - infrastructure is there
+* use Glib array for above
+* unify typemaps and C INCs, for more accurate EU::D support
 * Restructure dirs so all libs under lib/ using ExtUtils::MakeMaker::BigHelper
 * http://search.cpan.org/dist/Glib-Object-Introspection/
 * Add a gtk2 gimp-perl console - cf http://registry.gimp.org/node/29348
diff --git a/t/pdl.t b/t/pdl.t
index 04dccc5..5b5c185 100644
--- a/t/pdl.t
+++ b/t/pdl.t
@@ -35,8 +35,7 @@ sub iterate {
     my $dst = Gimp::PixelRgn->new($l,@bounds,1,1);
     my $iter = Gimp->pixel_rgns_register($dst);
     do {
-      my ($x,$y,$w,$h)=($dst->x,$dst->y,$dst->w,$dst->h);
-      my $pdl = $src->get_rect($x,$y,$w,$h);
+      my $pdl = $src->get_rect($dst->x,$dst->y,$dst->w,$dst->h);
       $pdl += $inc;
       $dst->data($pdl);
     } while (Gimp->pixel_rgns_process($iter));
@@ -115,12 +114,12 @@ ok(
 ok(!$i->insert_layer($l,0,0), 'insert layer');
 
 my $fgcolour = [ 255, 128, 0 ];
+my @setcoords = (1, 1);
+my $setcolour = [ 16, 16, 16 ];
 Gimp::Context->push;
 Gimp::Context->set_foreground($fgcolour);
-$l->fill(FOREGROUND_FILL);
 
-my @setcoords = (1, 1);
-my $setcolour = [ 16, 16, 16 ];
+$l->fill(FOREGROUND_FILL);
 is_deeply(
   [ @{$l->test_pdl_getpixel(@setcoords)}[0..2] ],
   Gimp::canonicalize_color($fgcolour),
@@ -143,6 +142,32 @@ is_deeply(
   Gimp::canonicalize_color([ map { $_+3 } @$setcolour ]),
   'getpixel colour after iterate'
 );
+
+eval $pdl_operations;
+$l->fill(FOREGROUND_FILL);
+is_deeply(
+  Gimp::canonicalize_color(getpixel($i, $l, @setcoords)),
+  Gimp::canonicalize_color($fgcolour),
+  'net getpixel initial colour'
+);
+setpixel($i, $l, @setcoords, Gimp::canonicalize_color($setcolour));
+is_deeply(
+  Gimp::canonicalize_color(getpixel($i, $l, @setcoords)),
+  Gimp::canonicalize_color($setcolour),
+  'net getpixel colour after setpixel'
+);
+is_deeply(
+  Gimp::canonicalize_color(getpixel($i, $l, map { $_+1 } @setcoords)),
+  Gimp::canonicalize_color($fgcolour),
+  'net getpixel other pixel after setpixel'
+);
+iterate($i, $l, 3);
+is_deeply(
+  Gimp::canonicalize_color(getpixel($i, $l, @setcoords)),
+  Gimp::canonicalize_color([ map { $_+3 } @$setcolour ]),
+  'net getpixel colour after iterate'
+);
+
 Gimp::Context->pop;
 
 Gimp::Net::server_quit;