see plug-ins/perl/Changes

plug-ins/perl/Changes

@@ -1,5 +1,6 @@
 Revision history for Gimp-Perl extension.
 
+	- added examples/avi (avi load/save plug-in, uncompressed 24 bit).
 	- possible fix for another installation horror problem.
         - fixed a longstanding bug (?): not every class had a DESTROY, so
           the AUTOLOAD tried to resolve DESTROY after gimp_close had been
@@ -8,6 +9,7 @@ Revision history for Gimp-Perl extension.
         - updated PDB Explorer a bit, still broken.
         - almost full i18n of gimp-perl. A de translation is available.
         - save_image was kinda broken for jpeg and gif at least.
+        - implemented more robust DESTROY and Lib:: connection handling.
         - put help window into a scrolledwindow, as to a suggestion by Jens
           Lauterbach. Karlsruhe rules!
 

plug-ins/perl/Gimp.pm

@@ -503,11 +503,14 @@ sub AUTOLOAD {
    croak __"function/macro \"$name\" not found in $class";
 }
 
+# better have a destroy method here, than fall into nirvana later
+sub DESTROY { }
+
 sub _pseudoclass {
   my ($class, @prefixes)= @_;
   unshift(@prefixes,"");
   *{"Gimp::$class\::AUTOLOAD"} = \&AUTOLOAD;
-  *{"Gimp::$class\::DESTROY"}  = sub {};
+  *{"Gimp::$class\::DESTROY"}  = sub { };
   push(@{"$class\::ISA"}		, "Gimp::$class");
   push(@{"Gimp::$class\::PREFIXES"}	, @prefixes); @prefixes=@{"Gimp::$class\::PREFIXES"};
   push(@{"$class\::PREFIXES"}		, @prefixes); @prefixes=@{"$class\::PREFIXES"};

plug-ins/perl/Gimp.xs

@@ -150,3 +150,117 @@ BOOT:
 #endif
 }
 
+MODULE = Gimp	PACKAGE = Gimp::RAW
+
+# some raw byte/bit-manipulation, use PDL instead
+
+void
+reverse_v_inplace (datasv, bpl)
+	SV *	datasv
+        IV	bpl
+        CODE:
+        char *line, *data, *end;
+        STRLEN h;
+
+        data = SvPV (datasv, h); h /= bpl;
+        end = data + (h-1) * bpl;
+
+        New (0, line, bpl, char);
+
+        while (data < end)
+          {
+            Move (data, line, bpl, char);
+            Move (end, data, bpl, char);
+            Move (line, end, bpl, char);
+
+            data += bpl;
+            end -= bpl;
+          }
+
+        Safefree (line);
+
+	OUTPUT:
+        datasv
+
+void
+convert_32_24_inplace (datasv)
+	SV *	datasv
+        CODE:
+        STRLEN dc;
+        char *data, *src, *dst, *end;
+
+        data = SvPV (datasv, dc); end = data + dc;
+
+        for (src = dst = data; src < end; )
+          {
+            *dst++ = *src++;
+            *dst++ = *src++;
+            *dst++ = *src++;
+                     *src++;
+          }
+
+        SvCUR_set (datasv, dst - data);
+	OUTPUT:
+        datasv
+
+void
+convert_24_15_inplace (datasv)
+	SV *	datasv
+        CODE:
+        STRLEN dc;
+        char *data, *src, *dst, *end;
+
+        U16 m31d255[256];
+
+        for (dc = 256; dc--; )
+          m31d255[dc] = (dc*31+15)/255;
+
+        data = SvPV (datasv, dc); end = data + dc;
+
+        for (src = dst = data; src < end; )
+          {
+            unsigned int r = *(U8 *)src++;
+            unsigned int g = *(U8 *)src++;
+            unsigned int b = *(U8 *)src++;
+
+            U16 rgb = m31d255[r]<<10 | m31d255[g]<<5 | m31d255[b];
+            *dst++ = rgb & 0xff;
+            *dst++ = rgb >> 8;
+          }
+
+        SvCUR_set (datasv, dst - data);
+	OUTPUT:
+        datasv
+
+void
+convert_15_24_inplace (datasv)
+	SV *	datasv
+        CODE:
+        STRLEN dc, de;
+        char *data, *src, *dst;
+
+        U8 m255d31[32];
+
+        for (dc = 32; dc--; )
+          m255d31[dc] = (dc*255+127)/31;
+
+        data = SvPV (datasv, dc); dc &= ~1;
+        de = dc + (dc >> 1);
+        SvGROW (datasv, de);
+        SvCUR_set (datasv, de);
+        data = SvPV (datasv, de); src = data + dc;
+
+        dst = data + de;
+
+        while (src != dst)
+          {
+            U16 rgb = *(U8 *)--src << 8 | *(U8 *)--src;
+
+            *(U8 *)--dst = m255d31[ rgb & 0x001f       ];
+            *(U8 *)--dst = m255d31[(rgb & 0x03e0) >>  5];
+            *(U8 *)--dst = m255d31[(rgb & 0x7c00) >> 10];
+          }
+
+	OUTPUT:
+        datasv
+

plug-ins/perl/Gimp/Fu.pm

@@ -344,7 +344,7 @@ Gimp::on_query {
          my %x = @_; values %x;
       }
       
-      for(@params) {
+      for(@$params) {
          $_->[0]=Gimp::PARAM_INT32	if $_->[0] == PF_TOGGLE;
          $_->[0]=Gimp::PARAM_STRING	if $_->[0] == PF_FONT;
          $_->[0]=Gimp::PARAM_STRING	if $_->[0] == PF_BRUSH;

plug-ins/perl/Gimp/Lib.xs

@@ -1349,6 +1349,7 @@ gimp_main(...)
 	            gimp_is_initialized = 1;
 		    RETVAL = gimp_main (argc, argv);
 	            gimp_is_initialized = 0;
+                    /*exit (0);*/ /*D*//* shit, some memory problem here, so just exit */
 		  }
 	OUTPUT:
 	RETVAL
@@ -1399,6 +1400,9 @@ _gimp_procedure_available(proc_name)
 		int nreturn_vals;
 		GParamDef *params;
 		GParamDef *return_vals;
+
+                if (!gimp_is_initialized)
+                  croak ("_gimp_procedure_available called without an active connection");
 		
 		if (gimp_query_procedure (proc_name, &proc_blurb, &proc_help, &proc_author,
 		    &proc_copyright, &proc_date, &proc_type, &nparams, &nreturn_vals,
@@ -1438,6 +1442,9 @@ gimp_query_procedure(proc_name)
 		GParamDef *params;
 		GParamDef *return_vals;
 		
+                if (!gimp_is_initialized)
+                  croak ("gimp_query_procedure called without an active connection");
+
 		if (gimp_query_procedure (proc_name, &proc_blurb, &proc_help, &proc_author,
 		    &proc_copyright, &proc_date, &proc_type, &nparams, &nreturn_vals,
 		    &params, &return_vals) == TRUE)
@@ -1475,6 +1482,9 @@ gimp_call_procedure (proc_name, ...)
 		GParamDef *return_vals;
                 int i=0, j=0; /* work around bogus warning.  */
 		
+                if (!gimp_is_initialized)
+                  croak ("gimp_call_procedure(%s,...) called without an active connection", proc_name);
+
 		if (trace)
 		  trace_init ();
 		

plug-ins/perl/MANIFEST

@@ -116,6 +116,7 @@ examples/burst
 examples/map_to_gradient
 examples/fire
 examples/povray
+examples/avi
 pxgettext
 po/gimp-perl.pot
 po/de.po

plug-ins/perl/Makefile.PL

@@ -13,7 +13,7 @@ $|=1;
       repdup centerguide stampify goldenmean triangle billboard mirrorsplit
       oneliners randomart1 pixelmap glowing_steel frame_reshuffle frame_filter
       logulator miff gimpmagick guide_remove guides_to_selection burst map_to_gradient
-      fire povray
+      fire povray avi
    );
 
 if ($ARGV[0] ne "--writemakefile") {

plug-ins/perl/configure

@@ -549,8 +549,10 @@ if test -z "$IN_GIMP"; then
    echo Please do NOT call configure directly, rather run
    echo perl Makefile.PL
    echo as you would do with any other perl extension...
+   echo "This time I'll be doing it for you!"
    echo
-   exit 1
+   perl Makefile.PL
+   exit
 fi
 
 
@@ -589,7 +591,7 @@ do
 # Extract the first word of "$ac_prog", so it can be a program name with args.
 set dummy $ac_prog; ac_word=$2
 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:593: checking for $ac_word" >&5
+echo "configure:595: checking for $ac_word" >&5
 if eval "test \"`echo '$''{'ac_cv_path_GIMP'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
@@ -666,7 +668,7 @@ fi
   # Extract the first word of "gimptool", so it can be a program name with args.
 set dummy gimptool; ac_word=$2
 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:670: checking for $ac_word" >&5
+echo "configure:672: checking for $ac_word" >&5
 if eval "test \"`echo '$''{'ac_cv_path_GIMPTOOL'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
@@ -701,7 +703,7 @@ fi
 
   min_gimp_version=1.0.4
   echo $ac_n "checking for GIMP - version >= $min_gimp_version""... $ac_c" 1>&6
-echo "configure:705: checking for GIMP - version >= $min_gimp_version" >&5
+echo "configure:707: checking for GIMP - version >= $min_gimp_version" >&5
   no_gimp=""
   if test "$GIMPTOOL" = "no" ; then
     no_gimp=yes
@@ -734,7 +736,7 @@ echo "configure:705: checking for GIMP - version >= $min_gimp_version" >&5
   echo $ac_n "cross compiling; assumed OK... $ac_c"
 else
   cat > conftest.$ac_ext <<EOF
-#line 738 "configure"
+#line 740 "configure"
 #include "confdefs.h"
 
 #include <stdio.h>
@@ -783,7 +785,7 @@ int main ()
 
 
 EOF
-if { (eval echo configure:787: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:789: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
 then
   :
 else
@@ -817,7 +819,7 @@ fi
           CFLAGS="$CFLAGS $GIMP_CFLAGS"
           LIBS="$LIBS $GIMP_LIBS"
           cat > conftest.$ac_ext <<EOF
-#line 821 "configure"
+#line 823 "configure"
 #include "confdefs.h"
 
 #include <stdio.h>
@@ -827,7 +829,7 @@ int main() {
  return 0; 
 ; return 0; }
 EOF
-if { (eval echo configure:831: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:833: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
    echo "*** The test program compiled, but did not run. This usually means"
           echo "*** that the run-time linker is not finding GIMP or finding the wrong"
@@ -918,7 +920,7 @@ fi
   # Extract the first word of "glib-config", so it can be a program name with args.
 set dummy glib-config; ac_word=$2
 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:922: checking for $ac_word" >&5
+echo "configure:924: checking for $ac_word" >&5
 if eval "test \"`echo '$''{'ac_cv_path_GLIB_CONFIG'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
@@ -953,7 +955,7 @@ fi
 
   min_glib_version=1.2.0
   echo $ac_n "checking for GLIB - version >= $min_glib_version""... $ac_c" 1>&6
-echo "configure:957: checking for GLIB - version >= $min_glib_version" >&5
+echo "configure:959: checking for GLIB - version >= $min_glib_version" >&5
   no_glib=""
   if test "$GLIB_CONFIG" = "no" ; then
     no_glib=yes
@@ -976,7 +978,7 @@ echo "configure:957: checking for GLIB - version >= $min_glib_version" >&5
   echo $ac_n "cross compiling; assumed OK... $ac_c"
 else
   cat > conftest.$ac_ext <<EOF
-#line 980 "configure"
+#line 982 "configure"
 #include "confdefs.h"
 
 #include <glib.h>
@@ -1052,7 +1054,7 @@ main ()
 }
 
 EOF
-if { (eval echo configure:1056: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:1058: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
 then
   :
 else
@@ -1086,7 +1088,7 @@ fi
           CFLAGS="$CFLAGS $GLIB_CFLAGS"
           LIBS="$LIBS $GLIB_LIBS"
           cat > conftest.$ac_ext <<EOF
-#line 1090 "configure"
+#line 1092 "configure"
 #include "confdefs.h"
 
 #include <glib.h>
@@ -1096,7 +1098,7 @@ int main() {
  return ((glib_major_version) || (glib_minor_version) || (glib_micro_version)); 
 ; return 0; }
 EOF
-if { (eval echo configure:1100: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1102: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
    echo "*** The test program compiled, but did not run. This usually means"
           echo "*** that the run-time linker is not finding GLIB or finding the wrong"
@@ -1138,7 +1140,7 @@ rm -f conftest*
 ac_gimp_save_CPPFLAGS="$CPPFLAGS"
 CPPFLAGS="$CPPFLAGS $GIMP_CFLAGS"
 echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:1142: checking how to run the C preprocessor" >&5
+echo "configure:1144: checking how to run the C preprocessor" >&5
 # On Suns, sometimes $CPP names a directory.
 if test -n "$CPP" && test -d "$CPP"; then
   CPP=
@@ -1153,13 +1155,13 @@ else
   # On the NeXT, cc -E runs the code through the compiler's parser,
   # not just through cpp.
   cat > conftest.$ac_ext <<EOF
-#line 1157 "configure"
+#line 1159 "configure"
 #include "confdefs.h"
 #include <assert.h>
 Syntax Error
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1163: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1165: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   :
@@ -1170,13 +1172,13 @@ else
   rm -rf conftest*
   CPP="${CC-cc} -E -traditional-cpp"
   cat > conftest.$ac_ext <<EOF
-#line 1174 "configure"
+#line 1176 "configure"
 #include "confdefs.h"
 #include <assert.h>
 Syntax Error
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1180: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1182: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   :
@@ -1187,13 +1189,13 @@ else
   rm -rf conftest*
   CPP="${CC-cc} -nologo -E"
   cat > conftest.$ac_ext <<EOF
-#line 1191 "configure"
+#line 1193 "configure"
 #include "confdefs.h"
 #include <assert.h>
 Syntax Error
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1197: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1199: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   :
@@ -1218,7 +1220,7 @@ fi
 echo "$ac_t""$CPP" 1>&6
 
 cat > conftest.$ac_ext <<EOF
-#line 1222 "configure"
+#line 1224 "configure"
 #include "confdefs.h"
 #include <libgimp/gimp.h>
 EOF
@@ -1236,17 +1238,17 @@ for ac_hdr in libgimp/gimpmodule.h libintl.h
 do
 ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
 echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:1240: checking for $ac_hdr" >&5
+echo "configure:1242: checking for $ac_hdr" >&5
 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 1245 "configure"
+#line 1247 "configure"
 #include "confdefs.h"
 #include <$ac_hdr>
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1250: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1252: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   rm -rf conftest*
@@ -1278,17 +1280,17 @@ for ac_hdr in unistd.h
 do
 ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
 echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:1282: checking for $ac_hdr" >&5
+echo "configure:1284: checking for $ac_hdr" >&5
 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 1287 "configure"
+#line 1289 "configure"
 #include "confdefs.h"
 #include <$ac_hdr>
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1292: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1294: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   rm -rf conftest*
@@ -1320,12 +1322,12 @@ CONFIG_H="config.h"
 for ac_func in vsnprintf
 do
 echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1324: checking for $ac_func" >&5
+echo "configure:1326: checking for $ac_func" >&5
 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 1329 "configure"
+#line 1331 "configure"
 #include "confdefs.h"
 /* System header to define __stub macros and hopefully few prototypes,
     which can conflict with char $ac_func(); below.  */
@@ -1348,7 +1350,7 @@ $ac_func();
 
 ; return 0; }
 EOF
-if { (eval echo configure:1352: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1354: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
   eval "ac_cv_func_$ac_func=yes"
 else
@@ -1404,12 +1406,12 @@ fi
 for ac_func in _exit
 do
 echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1408: checking for $ac_func" >&5
+echo "configure:1410: checking for $ac_func" >&5
 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 1413 "configure"
+#line 1415 "configure"
 #include "confdefs.h"
 /* System header to define __stub macros and hopefully few prototypes,
     which can conflict with char $ac_func(); below.  */
@@ -1432,7 +1434,7 @@ $ac_func();
 
 ; return 0; }
 EOF
-if { (eval echo configure:1436: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1438: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
   eval "ac_cv_func_$ac_func=yes"
 else
@@ -1460,8 +1462,8 @@ done
 
 
 
-INTLLIBS=
+INTLLIBS=-lintl
-MSGFMT=:
+MSGFMT=msgfmt
 
 
 

plug-ins/perl/configure.in

@@ -6,8 +6,10 @@ if test -z "$IN_GIMP"; then
    echo Please do NOT call configure directly, rather run
    echo perl Makefile.PL
    echo as you would do with any other perl extension...
+   echo "This time I'll be doing it for you!"
    echo
-   exit 1
+   perl Makefile.PL
+   exit
 fi
 
 AC_PREFIX_DEFAULT($prefix)dnl from Makefile.PL
@@ -50,8 +52,8 @@ CONFIG_H="config.h"
 
 sinclude(configure.frag)
 
-INTLLIBS=
+INTLLIBS=-lintl
-MSGFMT=:
+MSGFMT=msgfmt
 AC_SUBST(INTLLIBS)
 AC_SUBST(MSGFMT)
 

plug-ins/perl/examples/avi

@@ -0,0 +1,268 @@
+#!/usr/bin/perl
+# pcg@goof.com
+# a simpleminded uncompressed avi load/save plug-in
+
+use Gimp 1.14;
+use Gimp::Fu;
+use Fcntl;
+
+# Gimp::set_trace(TRACE_ALL);
+
+# start a hunk
+sub push_hunk($) {
+   print FILE $_[0], "\xff\xff\xff\xff";
+   push @hunks, tell FILE;
+}
+
+# fixup latest hunk
+sub pop_hunk {
+   my $end = tell FILE;
+   my $len = pop @hunks;
+   seek FILE,$len-4,0;
+   print FILE pack "V", $end-$len;
+   seek FILE,$end,0;
+}
+
+register "file_avi_save",
+         "save image as uncompressed avi",
+         "Saves images in the 24 bit uncompressed AVI format used by windows software",
+         "Marc Lehmann",
+         "Marc Lehmann <pcg\@goof.com>",
+         "1999-09-15",
+         "<Save>/AVI",
+         "RGB",
+         [
+          [PF_RADIO,	"depth",	"format (currently always 0)", 24, ["24bpp" => 24, "15bpp" => 15]],
+          [PF_RADIO,	"compression",	"compression (currently always 0)", 0, [none => 0]],
+          [PF_BOOL,	"index",	"write an index hunk (required by some software)", 1],
+         ],
+         sub {
+   my($img,$drawable,$filename,$raw_filename,$depth,$compression,$index) = @_;
+   sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die "Unable to open '$filename' for writing: $!\n";
+   my $us_frame = eval { $img->find_parasite("gimp-interframe-delay")->data } || 100000;
+   #Gimp->tile_cache_ntiles($img->width / Gimp->tile_width + 3); coredumps!
+
+   my ($width, $height) = ($img->width, $img->height);
+   my @layers = $img->get_layers;
+   for (@layers) {
+      die "all layers must have the same size as the image\n" if $width != $_->width or $height != $_->height;
+   }
+
+   $depth = 16 if $depth == 15;
+
+   $img->selection_all;
+   my $framesize = ($width*$height*$depth) >> 3;
+
+   my $idx1;
+
+   init Progress "Saving '$filename' as AVI...";
+
+   push_hunk "RIFF"; print FILE "AVI ";
+      push_hunk "LIST"; print FILE "hdrl";
+         push_hunk "avih";
+            print FILE pack "V*",
+                            $us_frame,
+                            $framesize*1_000_000/$us_frame,
+                            0,
+                            0,
+                            scalar@layers,
+                            0,
+                            1,
+                            $framesize,
+                            $width,
+                            $height,
+                            0,
+                            0,
+                            0,
+                            0;
+         pop_hunk;
+         push_hunk "LIST"; print FILE "strl";
+            push_hunk "strh";
+               print FILE pack "A4 V11 V2",
+                               "vids",
+                               0,
+                               0,
+                               0,
+                               0,
+                               $us_frame,
+                               1_000_000,
+                               0,
+                               scalar@layers,
+                               $framesize,
+                               0,
+                               0,
+                                
+                               0,
+                               0;
+            pop_hunk;
+            push_hunk "strf";
+               print FILE pack "V3 v2 V6",
+                               40, # ??
+                               $width,
+                               $height,
+                               1,
+                               $depth,
+                               0,
+                               $framesize,
+                               0,
+                               0,
+                               0,
+                               0;
+            pop_hunk;
+         pop_hunk;
+      pop_hunk;
+      push_hunk "LIST"; print FILE "movi";
+         for (0..$#layers) {
+            my $r = new PixelRgn $layers[-1-$_],0,0,$width,$height,0,0;
+            my $d = $r->get_rect2(0,0,$width,$height);
+            Gimp::RAW::convert_32_24_inplace $d if $r->bpp == 4;
+            Gimp::RAW::reverse_v_inplace $d, $width*3;
+            Gimp::RAW::convert_24_15_inplace $d if $depth == 16;
+
+            $idx1 .= "00db" . pack "V*", 16, tell FILE, $framesize if $index;
+
+
+            print FILE "00db",
+                       (pack "V", $framesize),
+                       $d;
+
+            update Progress $_ / @layers;
+         }
+      pop_hunk;
+      if ($index) {
+         push_hunk "idx1";
+         print FILE $idx1;
+         pop_hunk;
+      }
+   pop_hunk;
+   close FILE;
+   ();
+};
+
+# a generic iff/riff parser. LIST's are simply flattened out,
+# JUNK is just skipped. 
+sub parse_iff {
+   my $size = shift;
+   my $default = pop;
+   my %action = @_;
+   my($hunk,$len);
+   while ($size > 0) {
+      read FILE,$hunk,4; $size -= 4;
+      $size >= 4 or die "AVI hunk $hunk ends unexpectedly\n";
+      read FILE,$len,4; $size -= 4;
+      $len = unpack "V", $len;
+      $size >= $len or die "hunk $hunk too long\n";
+      $size -= $len;
+      if ($hunk eq "LIST") {
+         read FILE,$hunk,4;
+         parse_iff ($len-4, %action, $default);
+      } elsif ($hunk eq "JUNK") {
+         seek FILE,$len,1;
+      } elsif ($action{$hunk}) {
+         $action{$hunk}->($len);
+      } else {
+         $default->($hunk,$len);
+      }
+   }
+}
+
+sub skip_hunk {
+   seek FILE,$_[0],1;
+}
+
+register "file_avi_load",
+         "load uncompressed avi movie",
+         "Loads images that were saved in 24 bit uncompressed RGB AVI format used mainly by windows",
+         "Marc Lehmann",
+         "Marc Lehmann <pcg\@goof.com>",
+         "1999-09-14",
+         "<Load>/AVI",
+         undef,
+         [],
+         sub {
+   my($filename) = @_;
+   sysopen FILE,$filename,O_RDONLY or die "Unable to open '$filename' for reading: $!\n";
+   my $image;
+   my $comment;
+
+   seek FILE, 0, 2; my $filesize = tell FILE; seek FILE, 0, 0;
+   init Progress "Loading AVI image from '$filename'...";
+
+   $filesize > 12 or die "File too small to be an AVI\n";
+   read FILE,$comment,4; $filesize -= 4;
+   die "File is not a RIFF file\n" unless $comment eq "RIFF";
+   read FILE,$comment,4; $filesize -= 4;
+   $comment = unpack "V", $comment;
+   die "RIFF hunk too short\n" unless $comment <= $filesize;
+   $filesize = $comment;
+   read FILE,$comment,4;
+   die "RIFF file is not an AVI\n" unless $comment eq "AVI ";
+
+   my $frame = 0;
+   my ($us_frame,$frames,$width,$height);
+   my $type;
+   my ($size,$planes,$depth,$compression,$image_size);
+
+   parse_iff ($filesize-4,
+      "avih" => sub {
+         read FILE,$comment,$_[0];
+         die "avih header too short\n" unless $_[0] >= 14*4;
+         ($us_frame,undef,undef,undef,$frames,undef,undef,undef,$width,$height)
+            = unpack "V10", $comment;
+      },
+      "strh" => sub {
+         read FILE,$comment,$_[0];
+         die "strh header too short\n" unless $_[0] >= 4;
+         ($type)
+            = unpack "A4", $comment;
+      },
+      "strf" => sub {
+         read FILE,$comment,$_[0];
+         if ($type eq "vids") {
+            die "strh(vids)/strf header too short\n" unless $_[0] >= 7*4;
+            ($size,$width,$height,$planes,$depth,$compression,$image_size)
+               = unpack "V3 v2 V3", $comment;
+            $depth == 24 or $depth == 16 or die "unsupported bit depth $depth (only 16/24 bit supported)\n";
+            $compression == 0 or die "compressed streams not supported\n";
+            $planes == 1 or die "incompatible frameformat ($planes)\n";
+            ($width * $height * $depth) >> 3 == $image_size or die "strh(vids)/strf header format error\n";
+            
+            $image = new Image($width,$height,RGB);
+            $image->disable_undo;
+            $image->set_filename($filename);
+            $image->attach_parasite(new Parasite "gimp-interframe-delay", PARASITE_PERSISTENT, $us_frame);
+         }
+      },
+      "00db" => sub { # 00dw is 15 bit
+         $_[0] == ($width * $height * $depth) >> 3 or die "frame has incorrect size\n";
+         read FILE,$comment,$_[0];
+         my $layer = $image->layer_new($width,$height,RGB_IMAGE,
+                                       sprintf("(%.2fs)",$us_frame*$frame/1_000_000),
+                                       100,NORMAL_MODE);
+
+         Gimp::RAW::convert_15_24_inplace $comment if $depth == 16;
+         Gimp::RAW::reverse_v_inplace $comment,$width*3;
+         (new PixelRgn $layer,0,0,$width,$height,1,0)->set_rect2($comment,0,0);
+         $layer->add_layer(0);
+         $frame++;
+         update Progress $frame/$frames;
+      },
+      "00dc" => sub { die "compressed data not handled\n" },
+      "01wb" => \&skip_hunk,  # audio data
+      "idx1" => \&skip_hunk,  # hunk index
+      sub {
+         warn "skipping hunk (@_), please report!\n";
+      }
+   );
+
+   $image->enable_undo;
+   return $image;
+};
+
+Gimp::on_query {
+   Gimp->register_magic_load_handler("file_avi_load", "avi", "", "0,string,RIFF,&8,string,AVI ");
+   Gimp->register_save_handler("file_avi_save", "avi", "");
+};
+
+exit main;
+

plug-ins/perl/examples/logulator

@@ -185,7 +185,7 @@ register "perl_fu_3d_outline_logo",
    "Hrvoje Horvat (hhorvat\@open.hr)",
    "Hrvoje Horvat",
    "07 April, 1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/3D Outline",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/3D Outline",
    "",
    [
       [PF_PATTERN,   'pattern',          "Pattern", "Parque #1"],
@@ -247,7 +247,7 @@ register "perl_fu_alien_glow_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Alien Glow",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Alien Glow",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "ALIEN"],
@@ -301,7 +301,7 @@ register "perl_fu_basic1_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1996",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Basic I",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Basic I",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "The Gimp"],
@@ -377,7 +377,7 @@ register "perl_fu_basic2_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1996",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Basic II",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Basic II",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "SCRIPT-FU"],
@@ -547,7 +547,7 @@ register "perl_fu_carved_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Carved",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Carved",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Marble"],
@@ -603,7 +603,7 @@ register "perl_fu_chalk_logo",
    "Manish Singh <msingh\@uclink4.berkeley.edu>",
    "Manish Singh",
    "October 1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Chalk",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Chalk",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "CHALK"],
@@ -690,7 +690,7 @@ register "perl_fu_logo_chip_away",
    "Adrian Likins <adrian\@gimp.org>",
    "Adrian Likins <adrian\@gimp.org>",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Chip Away",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Chip Away",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Sloth"],
@@ -784,7 +784,7 @@ register "perl_fu_chrome_logo",
    "Spencer Kimball",
    "Spencer Kimball & Peter Mattis",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Chrome",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Chrome",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "The GIMP"],
@@ -859,7 +859,7 @@ register "perl_fu_comic_logo",
    "Brian McFee <keebler\@wco.com>",
    "Brian McFee",
    "April 1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Comic Book",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Comic Book",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Moo"],
@@ -963,7 +963,7 @@ register "perl_fu_cool_metal_logo",
    "Spencer Kimball & Rob Malda",
    "Spencer Kimball & Rob Malda",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Cool Metal",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Cool Metal",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Cool Metal"],
@@ -1184,7 +1184,7 @@ register "perl_fu_crystal_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Crystal",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Crystal",
    "",
    [
       [PF_VALUE,     'chrome_factor',    "Chrome Factor", "1.0"],
@@ -1278,7 +1278,7 @@ register "perl_fu_frosty_logo",
    "Spencer Kimball & Ed Mackey",
    "Spencer Kimball & Ed Mackey",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Frosty",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Frosty",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "The GIMP"],
@@ -1380,7 +1380,7 @@ register "perl_fu_glossy_logo",
    "Hrvoje Horvat (hhorvat\@open.hr)",
    "Hrvoje Horvat",
    "14/04/1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Glossy",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Glossy",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Galaxy"],
@@ -1463,7 +1463,7 @@ register "perl_fu_glowing_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Glowing Hot",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Glowing Hot",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "GLOWING"],
@@ -1532,7 +1532,7 @@ register "perl_fu_gradient_bevel_logo",
    "Brian McFee <keebler\@wco.com>",
    "Brian McFee",
    "April 1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Gradient Bevel",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Gradient Bevel",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Moo"],
@@ -1611,7 +1611,7 @@ register "perl_fu_i26_gunya2",
    "Shuji Narazaki",
    "Shuji Narazaki",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Imigre-26",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Imigre-26",
    "",
    [
       [PF_STRING,    'text_string',      "Text", "The GIMP"],
@@ -1803,7 +1803,7 @@ register "perl_fu_neon_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Neon",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Neon",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "NEON"],
@@ -1853,7 +1853,7 @@ register "perl_fu_newsprint_text",
    "Austin Donnelly",
    "Austin Donnelly",
    "1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Newsprint text",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Newsprint text",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Newsprint"],
@@ -2074,7 +2074,7 @@ register "perl_fu_sota_chrome_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/SOTA Chrome",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/SOTA Chrome",
    "",
    [
       [PF_ADJUSTMENT,'chrome_saturation',"Chrome Saturation", [-80, -100, 100, 1, 10, 0, 0]],
@@ -2142,7 +2142,7 @@ register "perl_fu_speed_text",
    "Austin Donnelly",
    "Austin Donnelly",
    "1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Speed text",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Speed text",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Speed!"],
@@ -2219,7 +2219,7 @@ register "perl_fu_starburst_logo",
    "Spencer Kimball & Xach Beane",
    "Spencer Kimball & Xach Beane",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Starburst",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Starburst",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "GIMP"],
@@ -2350,7 +2350,7 @@ register "perl_fu_starscape_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Starscape",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Starscape",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Nova"],
@@ -2447,7 +2447,7 @@ register "perl_fu_t_o_p_logo",
    "Shuji Narazaki (narazaki\@InetQ.or.jp)",
    "Shuji Narazaki",
    "1997",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Particle Trace",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Particle Trace",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "The GIMP"],
@@ -2545,7 +2545,7 @@ register "perl_fu_textured_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1996",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Textured",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Textured",
    "",
    [
       [PF_PATTERN,   'text_pattern',     "Text Pattern", "Fibers"],
@@ -2616,7 +2616,7 @@ register "perl_fu_bovinated_logo",
    "Brian McFee <keebler\@wco.com>",
    "Brian McFee",
    "April 1998",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Bovination",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Bovination",
    "",
    [
       [PF_STRING,    'text_string',      "Text String", "Fear the Cow"],
@@ -2707,7 +2707,7 @@ register "perl_fu_blended_logo",
    "Spencer Kimball",
    "Spencer Kimball",
    "1996",
-   __"<Toolbox>/Xtns/Perl-Fu/Logos/Blended",
+   "<Toolbox>/Xtns/Perl-Fu/Logos/Blended",
    "",
    [
       [PF_VALUE,     'blend_mode',       "Blend Mode", "FG_BG_HSV"],

plug-ins/perl/examples/miff

@@ -28,7 +28,7 @@ register "file_miff_save",
          "Marc Lehmann <pcg\@goof.com>",
          "1999-07-29",
          "<Save>/MIFF",
-         "RGB, RGBA, GRAY, INDEXED-NOT-YET",	# weird, but no matte for !DirectColour
+         "RGB, RGBA, GRAY",	# weird, but no matte for !DirectColour
          [],
          sub {
    my($img,$drawable,$filename) = @_;
@@ -94,7 +94,7 @@ register "file_miff_load",
          "Loads images that were saved in the miff (Magick Interchange File Format) format used by the ImageMagick package",
          "Marc Lehmann",
          "Marc Lehmann <pcg\@goof.com>",
-         "1999-07-30",
+         "1999-09-14",
          "<Load>/MIFF",
          undef,
          [],
@@ -149,6 +149,8 @@ register "file_miff_load",
    }
 
    my $img = new Image $w, $h, $d >= 3 ? RGB : GRAY;
+   $img->set_filename($filename);
+   $img->disable_undo;
 
    if ($comment) {
       $comment =~ s/^\s+//s;
@@ -165,6 +167,7 @@ register "file_miff_load",
       update Progress tell()/$filesize*0.8 + 0.2;
    }
 
+   $img->enable_undo;
    $img;
 };
 

plug-ins/perl/examples/parasite-editor

@@ -9,7 +9,7 @@ use Gtk;
 
 Gtk->init;
 
-$VERSION=0.9;
+$VERSION=0.91;
 
 #Gimp::set_trace(TRACE_ALL);
 
@@ -111,21 +111,14 @@ sub refresh_names {
    $name->set_text ("");
    $flags->set_text ("");
    $data->set_text ("");
-   $clist->clear_items(0,99999);
+   $clist->freeze;
+   $clist->clear;
    my @list = &$list_func($current);
-   for my $para (@list) {
+   for (@list) {
-      my $item = new Gtk::ListItem $para;
+      $clist->append($_);
-      $item->signal_connect ("select" => sub {
-         my ($par) = &$find_func($current,$para);
-         $name->set_text ($par->[0]);
-         $flags->set_text (sprintf "0x%08x", $par->[1]);
-         $data->set_text (escape $par->[2]);
-         $parasite = $para;
-      });
-      $clist->add($item);
    }
-   #$clist->select_item(0);
    $clist->show_all;
+   $clist->thaw;
 }
 
 sub new_Entry {
@@ -177,11 +170,19 @@ sub create_main {
 
    $top->set_usize (-1, $eX+5);
 
-   $clist = new Gtk::List;
+   $clist = new Gtk::CList (1);
+   $clist->set_selection_mode (-single);
+   $clist->signal_connect ("select_row" => sub {
+      $parasite = $_[0]->get_text($_[1],$_[2]);
+      my ($par) = &$find_func($current,$parasite);
+      $name->set_text ($par->[0]);
+      $flags->set_text (sprintf "0x%08x", $par->[1]);
+      $data->set_text (escape $par->[2]);
+   });
 
    my $cs = new Gtk::ScrolledWindow undef,undef;
    $cs->set_policy(-automatic,-automatic);
-   $cs->add_with_viewport ($clist);
+   $cs->add ($clist);
    $bot->add ($cs);
 
    my $parbox = new Gtk::VBox (0,5);