dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

This commit is contained in:
Marc Lehmann 1999-09-14 19:03:00 +00:00
parent c36d8e2b3b
commit 21a8854aa3
15 changed files with 1349 additions and 1031 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
plug-ins/perl/Changes
View File

@ -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!

5
plug-ins/perl/Gimp.pm
View File

@ -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"};

114
plug-ins/perl/Gimp.xs
View File

@ -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

2
plug-ins/perl/Gimp/Fu.pm
View File

@ -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;

10
plug-ins/perl/Gimp/Lib.xs
View File

@ -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 ();

1
plug-ins/perl/MANIFEST
View File

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

2
plug-ins/perl/Makefile.PL
View File

@ -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") {

74
plug-ins/perl/configure vendored
View File

@ -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=
MSGFMT=:
INTLLIBS=-lintl
MSGFMT=msgfmt

8
plug-ins/perl/configure.in
View File

@ -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=
MSGFMT=:
INTLLIBS=-lintl
MSGFMT=msgfmt
AC_SUBST(INTLLIBS)
AC_SUBST(MSGFMT)

268
plug-ins/perl/examples/avi Executable file
View File

@ -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;

52
plug-ins/perl/examples/logulator
View File

@ -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"],

7
plug-ins/perl/examples/miff
View File

@ -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;
};

31
plug-ins/perl/examples/parasite-editor
View File

@ -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) {
my $item = new Gtk::ListItem $para;
$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);
for (@list) {
$clist->append($_);
}
#$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);

994
plug-ins/perl/po/de.po
View File

File diff suppressed because it is too large Load Diff

810
plug-ins/perl/po/gimp-perl.pot
View File

File diff suppressed because it is too large Load Diff