From 8b0cef8376174cc99981a44dd2fbeb506be8a2b4 Mon Sep 17 00:00:00 2001 From: Marc Lehmann Date: Wed, 28 Jul 1999 21:23:35 +0000 Subject: [PATCH] see plug-ins/perl/Changes --- plug-ins/perl/Changes | 1 + plug-ins/perl/Gimp.pm | 2 +- plug-ins/perl/Gimp/Fu.pm | 41 ++- plug-ins/perl/Gimp/Lib.xs | 376 +++++++++++++----------- plug-ins/perl/Gimp/Net.pm | 2 + plug-ins/perl/Gimp/Pod.pm | 35 ++- plug-ins/perl/MANIFEST | 1 + plug-ins/perl/Makefile.PL | 4 +- plug-ins/perl/TODO | 32 +- plug-ins/perl/etc/config.pl.in | 10 +- plug-ins/perl/examples/ditherize.pl | 2 +- plug-ins/perl/examples/gimpmagick | 2 +- plug-ins/perl/examples/homepage-logo.pl | 2 +- plug-ins/perl/examples/logulator | 14 +- plug-ins/perl/examples/miff | 63 ++++ plug-ins/perl/examples/mirrorsplit | 16 +- plug-ins/perl/examples/pixelmap | 10 +- plug-ins/perl/examples/randomart1 | 2 +- plug-ins/perl/examples/repdup | 2 +- plug-ins/perl/examples/stamps | 4 +- plug-ins/perl/examples/webify.pl | 2 +- plug-ins/perl/gimpdoc | 2 +- 22 files changed, 364 insertions(+), 261 deletions(-) create mode 100755 plug-ins/perl/examples/miff diff --git a/plug-ins/perl/Changes b/plug-ins/perl/Changes index 9ff8d46dae..b4be974bee 100644 --- a/plug-ins/perl/Changes +++ b/plug-ins/perl/Changes @@ -7,6 +7,7 @@ Revision history for Gimp-Perl extension. supplied). - enabled limited pixel access functions even when PDL was not found. - added examples/miff (a save filter for miff images). + - close DATA in Gimp unconditionally, saves one open filehandle. 1.0981 Wed Jul 28 00:09:50 CEST 1999 - improved gouge ;) In a sense, it's actually pretty code now! diff --git a/plug-ins/perl/Gimp.pm b/plug-ins/perl/Gimp.pm index 16a71d2c5e..972f799b77 100644 --- a/plug-ins/perl/Gimp.pm +++ b/plug-ins/perl/Gimp.pm @@ -211,7 +211,7 @@ sub canonicalize_colour { next unless /^\s*(\d+)\s+(\d+)\s+(\d+)\s+(.+?)\s*$/; $rgb_db{lc($4)}=[$1,$2,$3]; } - close RGB_TEXT if defined $rgb_db_path; + close RGB_TEXT; } if ($rgb_db{lc($_[0])}) { return $rgb_db{lc($_[0])}; diff --git a/plug-ins/perl/Gimp/Fu.pm b/plug-ins/perl/Gimp/Fu.pm index 0abb325780..141f00fba8 100644 --- a/plug-ins/perl/Gimp/Fu.pm +++ b/plug-ins/perl/Gimp/Fu.pm @@ -697,7 +697,7 @@ sub mangle_key { $key; } -sub net { +Gimp::on_net { no strict 'refs'; my $this = this_script; my(%map,@args); @@ -746,13 +746,20 @@ sub net { $this->[0]->($interact>0 ? $this->[7]=~/^/ ? (&Gimp::RUN_FULLINTERACTIVE,undef,undef,@args) : (&Gimp::RUN_INTERACTIVE,@args) : (&Gimp::RUN_NONINTERACTIVE,@args)); -} +}; # the arguments @image_params = ([&Gimp::PARAM_IMAGE , "image", "The image to work on"], [&Gimp::PARAM_DRAWABLE , "drawable", "The drawable to work on"]); -sub query { +@load_params = ([&Gimp::PARAM_STRING , "filename", "The name of the file"], + [&Gimp::PARAM_STRING , "raw_filename","The name of the file"]); + +@save_params = (@image_params, @load_params); + +@load_retvals = ([&Gimp::PARAM_IMAGE , "image", "Output image"]); + +Gimp::on_query { my($type); expand_podsections; script: @@ -767,12 +774,20 @@ sub query { if ($menupath=~/^\//) { $type=&Gimp::PROC_PLUG_IN; unshift(@$params,@image_params); + } elsif ($menupath=~/^\//) { + $type=&Gimp::PROC_PLUG_IN; + unshift(@$params,@load_params); + unshift(@$results,@load_retvals); + } elsif ($menupath=~/^\//) { + $type=&Gimp::PROC_PLUG_IN; + unshift(@$params,@save_params); } elsif ($menupath=~/^\//) { $type=&Gimp::PROC_EXTENSION; } elsif ($menupath=~/^/) { $type=&Gimp::PROC_EXTENSION; + $menupath=undef; } else { - die "menupath _must_ start with , or !"; + die "menupath _must_ start with , , , or !"; } unshift(@$params, @@ -798,7 +813,7 @@ sub query { Gimp::logger(message => 'OK', function => $function, fatal => 0); } -} +}; =cut @@ -828,9 +843,10 @@ sub query { The pdb name of the function, i.e. the name under which is will be registered in the Gimp database. If it doesn't start with "perl_fu_", -"plug_in_" or "extension_", it will be prepended. If you don't want this, -prefix your function name with a single "+". The idea here is that every -Gimp::Fu plug-in will be found under the common C-prefix. +"file_", "plug_in_" or "extension_", it will be prepended. If you +don't want this, prefix your function name with a single "+". The idea +here is that every Gimp::Fu plug-in will be found under the common +C-prefix. =item blurb @@ -1057,7 +1073,7 @@ sub register($$$$$$$$$;@) { $function=~/^[0-9a-z_]+(-ALT)?$/ or carp "$function: function name contains unusual characters, good style is to use only 0-9, a-z and _"; - $function="perl_fu_".$function unless $function=~/^(?:perl_fu|extension|plug_in)/ || $function=~s/^\+//; + $function="perl_fu_".$function unless $function=~/^(?:\+|perl_fu_|extension_|plug_in_|file_)/; Gimp::logger message => "function name contains dashes instead of underscores", function => $function, fatal => 0 @@ -1070,10 +1086,13 @@ sub register($$$$$$$$$;@) { if ($menupath=~/^\//) { @_ >= 2 or die " plug-in called without both image and drawable arguments!\n"; @pre = (shift,shift); - } elsif ($menupath=~/^\//) { + } elsif ($menupath=~/^\// or !defined $menupath) { # valid ;) + } elsif ($menupath=~/^<(?:Load|Save)>\//) { + @_ >= 4 or die " plug-in called without the 5 standard arguments!\n"; + @pre = (shift,shift,shift,shift); } else { - die "menupath _must_ start with or !"; + die "menupath _must_ start with , , or !"; } if (@defaults) { diff --git a/plug-ins/perl/Gimp/Lib.xs b/plug-ins/perl/Gimp/Lib.xs index aded339773..e8c116b99d 100644 --- a/plug-ins/perl/Gimp/Lib.xs +++ b/plug-ins/perl/Gimp/Lib.xs @@ -19,10 +19,15 @@ #undef MAX #if HAVE_PDL +#define PDL_clean_namespace #include #undef croak +#ifdef Perl_croak_nocontext +#define croak Perl_croak_nocontext +#else #define croak Perl_croak #endif +#endif /* various functions allocate static buffers, STILL. */ #define MAX_STRING 4096 @@ -926,7 +931,7 @@ push_gimp_sv (GParam *arg, int array_as_ref) #define sv2gimp_extract_noref(fun,str) \ fun(sv); \ if (SvROK(sv)) \ - sprintf (croak_str, "Unable to convert a reference to type '%s'\n", str); \ + sprintf (croak_str, "Unable to convert a reference to type '%s'", str); \ break; /* * convert a perl scalar into a GParam, return true if @@ -1605,7 +1610,7 @@ gimp_call_procedure (proc_name, ...) } error: - + if (values) gimp_destroy_params (values, nreturn_vals); @@ -1701,13 +1706,6 @@ gimp_get_data(id) XPUSHs (sv_2mortal (data)); } -void -gimp_register_magic_load_handler(name, extensions, prefixes, magics) - char * name - char * extensions - char * prefixes - char * magics - gdouble gimp_gamma() @@ -1768,8 +1766,6 @@ void gimp_tile_cache_ntiles(ntiles) gulong ntiles -#if HAVE_PDL - SV * gimp_drawable_get(drawable_ID) DRAWABLE drawable_ID @@ -1782,28 +1778,6 @@ void gimp_drawable_flush(drawable) GDrawable * drawable -SV * -gimp_drawable_get_tile(gdrawable, shadow, row, col) - SV * gdrawable - gint shadow - gint row - gint col - CODE: - RETVAL = new_tile (gimp_drawable_get_tile (old_gdrawable (gdrawable), shadow, row, col), gdrawable); - OUTPUT: - RETVAL - -SV * -gimp_drawable_get_tile2(gdrawable, shadow, x, y) - SV * gdrawable - gint shadow - gint x - gint y - CODE: - RETVAL = new_tile (gimp_drawable_get_tile2 (old_gdrawable (gdrawable), shadow, x, y), gdrawable); - OUTPUT: - RETVAL - SV * gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow) SV * gdrawable @@ -1828,145 +1802,6 @@ gimp_pixel_rgn_resize(pr, x, y, width, height) CODE: gimp_pixel_rgn_resize (pr, x, y, width, height); -pdl * -gimp_pixel_rgn_get_pixel(pr, x, y) - GPixelRgn * pr - int x - int y - CODE: - RETVAL = new_pdl (0, 0, pr->bpp); - gimp_pixel_rgn_get_pixel (pr, RETVAL->data, x, y); - OUTPUT: - RETVAL - -pdl * -gimp_pixel_rgn_get_row(pr, x, y, width) - GPixelRgn * pr - int x - int y - int width - CODE: - RETVAL = new_pdl (0, width, pr->bpp); - gimp_pixel_rgn_get_row (pr, RETVAL->data, x, y, width); - OUTPUT: - RETVAL - -pdl * -gimp_pixel_rgn_get_col(pr, x, y, height) - GPixelRgn * pr - int x - int y - int height - CODE: - RETVAL = new_pdl (height, 0, pr->bpp); - gimp_pixel_rgn_get_col (pr, RETVAL->data, x, y, height); - OUTPUT: - RETVAL - -pdl * -gimp_pixel_rgn_get_rect(pr, x, y, width, height) - GPixelRgn * pr - int x - int y - int width - int height - CODE: - RETVAL = new_pdl (height, width, pr->bpp); - gimp_pixel_rgn_get_rect (pr, RETVAL->data, x, y, width, height); - OUTPUT: - RETVAL - -void -gimp_pixel_rgn_set_pixel(pr, pdl, x, y) - GPixelRgn * pr - pdl * pdl - int x - int y - CODE: - old_pdl (&pdl, 0, pr->bpp); - gimp_pixel_rgn_set_pixel (pr, pdl->data, x, y); - -void -gimp_pixel_rgn_set_row(pr, pdl, x, y) - GPixelRgn * pr - pdl * pdl - int x - int y - CODE: - old_pdl (&pdl, 1, pr->bpp); - gimp_pixel_rgn_set_row (pr, pdl->data, x, y, pdl->dims[pdl->ndims-1]); - -void -gimp_pixel_rgn_set_col(pr, pdl, x, y) - GPixelRgn * pr - pdl * pdl - int x - int y - CODE: - old_pdl (&pdl, 1, pr->bpp); - gimp_pixel_rgn_set_col (pr, pdl->data, x, y, pdl->dims[pdl->ndims-1]); - -void -gimp_pixel_rgn_set_rect(pr, pdl, x, y) - GPixelRgn * pr - pdl * pdl - int x - int y - CODE: - old_pdl (&pdl, 2, pr->bpp); - gimp_pixel_rgn_set_rect (pr, pdl->data, x, y, pdl->dims[pdl->ndims-2], pdl->dims[pdl->ndims-1]); - -pdl * -gimp_pixel_rgn_data(pr,newdata=0) - GPixelRgn * pr - pdl * newdata - CODE: - if (newdata) - { - char *src; - char *dst; - int y, stride; - - old_pdl (&newdata, 2, pr->bpp); - stride = pr->bpp * newdata->dims[newdata->ndims-2]; - - if (pr->h != newdata->dims[newdata->ndims-1]) - croak ("pdl height != region height"); - - for (y = 0, src = newdata->data, dst = pr->data; - y < pr->h; - y++ , src += stride , dst += pr->rowstride) - Copy (src, dst, stride, char); - - RETVAL = newdata; - } - else - { - int ndims = 2 + (pr->bpp > 1); - - pdl *p = PDL->new(); - PDL_Long dims[3]; - - dims[0] = pr->bpp; - dims[ndims-2] = pr->rowstride / pr->bpp; - dims[ndims-1] = pr->h; - - PDL->setdims (p, dims, ndims); - p->datatype = PDL_B; - p->data = pr->data; - p->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED; - PDL->add_deletedata_magic(p, pixel_rgn_pdl_delete_data, 0); - - if (pr->w != dims[ndims-2]) - p = redim_pdl (p, ndims-2, pr->w); - - RETVAL = p; - } - OUTPUT: - RETVAL - -# ??? any possibility to implement these in perl? maybe replacement functions in Gimp.pm? - GPixelRgnIterator gimp_pixel_rgns_register(...) CODE: @@ -2151,6 +1986,180 @@ gimp_tile_drawable(tile) OUTPUT: RETVAL +SV * +gimp_pixel_rgn_get_rect2(pr, x, y, width, height) + GPixelRgn * pr + int x + int y + int width + int height + CODE: + RETVAL = newSVn (width * height * pr->bpp); + gimp_pixel_rgn_get_rect (pr, SvPV_nolen(RETVAL), x, y, width, height); + OUTPUT: + RETVAL + +#if HAVE_PDL + +SV * +gimp_drawable_get_tile(gdrawable, shadow, row, col) + SV * gdrawable + gint shadow + gint row + gint col + CODE: + RETVAL = new_tile (gimp_drawable_get_tile (old_gdrawable (gdrawable), shadow, row, col), gdrawable); + OUTPUT: + RETVAL + +SV * +gimp_drawable_get_tile2(gdrawable, shadow, x, y) + SV * gdrawable + gint shadow + gint x + gint y + CODE: + RETVAL = new_tile (gimp_drawable_get_tile2 (old_gdrawable (gdrawable), shadow, x, y), gdrawable); + OUTPUT: + RETVAL + +pdl * +gimp_pixel_rgn_get_pixel(pr, x, y) + GPixelRgn * pr + int x + int y + CODE: + RETVAL = new_pdl (0, 0, pr->bpp); + gimp_pixel_rgn_get_pixel (pr, RETVAL->data, x, y); + OUTPUT: + RETVAL + +pdl * +gimp_pixel_rgn_get_row(pr, x, y, width) + GPixelRgn * pr + int x + int y + int width + CODE: + RETVAL = new_pdl (0, width, pr->bpp); + gimp_pixel_rgn_get_row (pr, RETVAL->data, x, y, width); + OUTPUT: + RETVAL + +pdl * +gimp_pixel_rgn_get_col(pr, x, y, height) + GPixelRgn * pr + int x + int y + int height + CODE: + RETVAL = new_pdl (height, 0, pr->bpp); + gimp_pixel_rgn_get_col (pr, RETVAL->data, x, y, height); + OUTPUT: + RETVAL + +pdl * +gimp_pixel_rgn_get_rect(pr, x, y, width, height) + GPixelRgn * pr + int x + int y + int width + int height + CODE: + RETVAL = new_pdl (height, width, pr->bpp); + gimp_pixel_rgn_get_rect (pr, RETVAL->data, x, y, width, height); + OUTPUT: + RETVAL + +void +gimp_pixel_rgn_set_pixel(pr, pdl, x, y) + GPixelRgn * pr + pdl * pdl + int x + int y + CODE: + old_pdl (&pdl, 0, pr->bpp); + gimp_pixel_rgn_set_pixel (pr, pdl->data, x, y); + +void +gimp_pixel_rgn_set_row(pr, pdl, x, y) + GPixelRgn * pr + pdl * pdl + int x + int y + CODE: + old_pdl (&pdl, 1, pr->bpp); + gimp_pixel_rgn_set_row (pr, pdl->data, x, y, pdl->dims[pdl->ndims-1]); + +void +gimp_pixel_rgn_set_col(pr, pdl, x, y) + GPixelRgn * pr + pdl * pdl + int x + int y + CODE: + old_pdl (&pdl, 1, pr->bpp); + gimp_pixel_rgn_set_col (pr, pdl->data, x, y, pdl->dims[pdl->ndims-1]); + +void +gimp_pixel_rgn_set_rect(pr, pdl, x, y) + GPixelRgn * pr + pdl * pdl + int x + int y + CODE: + old_pdl (&pdl, 2, pr->bpp); + gimp_pixel_rgn_set_rect (pr, pdl->data, x, y, pdl->dims[pdl->ndims-2], pdl->dims[pdl->ndims-1]); + +pdl * +gimp_pixel_rgn_data(pr,newdata=0) + GPixelRgn * pr + pdl * newdata + CODE: + if (newdata) + { + char *src; + char *dst; + int y, stride; + + old_pdl (&newdata, 2, pr->bpp); + stride = pr->bpp * newdata->dims[newdata->ndims-2]; + + if (pr->h != newdata->dims[newdata->ndims-1]) + croak ("pdl height != region height"); + + for (y = 0, src = newdata->data, dst = pr->data; + y < pr->h; + y++ , src += stride , dst += pr->rowstride) + Copy (src, dst, stride, char); + + RETVAL = newdata; + } + else + { + int ndims = 2 + (pr->bpp > 1); + + pdl *p = PDL->new(); + PDL_Long dims[3]; + + dims[0] = pr->bpp; + dims[ndims-2] = pr->rowstride / pr->bpp; + dims[ndims-1] = pr->h; + + PDL->setdims (p, dims, ndims); + p->datatype = PDL_B; + p->data = pr->data; + p->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED; + PDL->add_deletedata_magic(p, pixel_rgn_pdl_delete_data, 0); + + if (pr->w != dims[ndims-2]) + p = redim_pdl (p, ndims-2, pr->w); + + RETVAL = p; + } + OUTPUT: + RETVAL + # ??? optimize these two functions so tile_*ref will only be called once on # construction/destruction. @@ -2175,15 +2184,24 @@ gimp_tile_set_data(tile,data) #else -PROTOTYPES: DISABLE - void -gimp_drawable_get(...) +gimp_pixel_rgn_data(...) + ALIAS: + gimp_drawable_get_tile = 1 + gimp_drawable_get_tile2 = 2 + gimp_pixel_rgn_get_pixel = 3 + gimp_pixel_rgn_get_row = 4 + gimp_pixel_rgn_get_col = 5 + gimp_pixel_rgn_get_rect = 6 + gimp_pixel_rgn_set_pixel = 7 + gimp_pixel_rgn_set_row = 8 + gimp_pixel_rgn_set_col = 9 + gimp_pixel_rgn_set_rect = 10 + gimp_tile_get_data = 11 + gimp_tile_set_data = 12 CODE: croak ("This module was built without support for PDL."); -PROTOTYPES: ENABLE - #endif BOOT: @@ -2292,6 +2310,7 @@ gimp_default_display() MODULE = Gimp::Lib PACKAGE = Gimp::UI +#if 0 #if UI #if GIMP11 @@ -2299,7 +2318,7 @@ GtkWidget * _new_pattern_select(dname, ipattern, nameref) gchar * dname gchar * ipattern - SV * nameref; + SV * nameref CODE: { if (!SvROK (nameref)) @@ -2316,3 +2335,4 @@ _new_pattern_select(dname, ipattern, nameref) #endif #endif +#endif diff --git a/plug-ins/perl/Gimp/Net.pm b/plug-ins/perl/Gimp/Net.pm index b9208852ad..3a5f295b7e 100644 --- a/plug-ins/perl/Gimp/Net.pm +++ b/plug-ins/perl/Gimp/Net.pm @@ -211,6 +211,7 @@ sub try_connect { } sub gimp_init { + $Gimp::in_top=1; if (@_) { $server_fh = try_connect ($_[0]); } elsif (defined($Gimp::host)) { @@ -260,6 +261,7 @@ sub gimp_end { sub gimp_main { gimp_init; no strict 'refs'; + $Gimp::in_top=0; eval { Gimp::callback("-net") }; if($@ && $@ ne "IGNORE THIS MESSAGE\n") { Gimp::logger(message => substr($@,0,-1), fatal => 1, function => 'DIE'); diff --git a/plug-ins/perl/Gimp/Pod.pm b/plug-ins/perl/Gimp/Pod.pm index 750f3e2732..149f58d5eb 100644 --- a/plug-ins/perl/Gimp/Pod.pm +++ b/plug-ins/perl/Gimp/Pod.pm @@ -1,7 +1,5 @@ package Gimp::Pod; -use Config; - $VERSION=$Gimp::VERSION; sub myqx(&) { @@ -16,13 +14,18 @@ sub myqx(&) { } sub find_converters { - my $path = $Config{installscript}; + my $path = eval 'use Config; $Config{installscript}'; - $converter{text} = sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, $pod) } }; - $converter{texta}= sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, '-a', $pod) } }; + if ($] < 5.00558) { + $converter{text} = sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, $pod) } }; + $converter{texta}= sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, '-a', $pod) } }; + } else { + $converter{text} = sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ; + $converter{texta}= sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ; + } $converter{html} = sub { my $pod=shift; require Pod::Html; myqx { Pod::Html::pod2html ($pod) } }; - $converter{man} = sub { qx($path/pod2man $pod) } if -x "$path/pod2man" ; - $converter{latex}= sub { qx($path/pod2latex $pod) } if -x "$path/pod2latex" ; + $converter{man} = sub { qx($path/pod2man $_[0]) } if -x "$path/pod2man" ; + $converter{latex}= sub { qx($path/pod2latex $_[0]) } if -x "$path/pod2latex" ; } sub find { @@ -64,14 +67,18 @@ sub sections { sub section { my $self = shift; my $doc = $self->_cache('text'); - ($doc) = $$doc =~ /^$_[0]$(.*?)^[A-Z]/sm; - if ($doc) { - $doc =~ y/\r//d; - $doc =~ s/^\s*\n//; - $doc =~ s/[ \t\r\n]+$/\n/; - $doc =~ s/^ //mg; + if (defined $$doc) { + ($doc) = $$doc =~ /^$_[0]$(.*?)(?:^[A-Z]|$)/sm; + if ($doc) { + $doc =~ y/\r//d; + $doc =~ s/^\s*\n//; + $doc =~ s/[ \t\r\n]+$/\n/; + $doc =~ s/^ //mg; + } + $doc; + } else { + (); } - $doc; } sub author { diff --git a/plug-ins/perl/MANIFEST b/plug-ins/perl/MANIFEST index f5cfe8983c..4cf98da1d8 100644 --- a/plug-ins/perl/MANIFEST +++ b/plug-ins/perl/MANIFEST @@ -106,3 +106,4 @@ examples/frame_reshuffle examples/frame_filter examples/gouge examples/logulator +examples/miff diff --git a/plug-ins/perl/Makefile.PL b/plug-ins/perl/Makefile.PL index b5369af559..374d4e3289 100644 --- a/plug-ins/perl/Makefile.PL +++ b/plug-ins/perl/Makefile.PL @@ -13,7 +13,7 @@ $|=1; perlotine randomblends innerbevel fit-text guidegrid roundrectsel repdup centerguide stampify goldenmean triangle billboard mirrorsplit oneliners randomart1 pixelmap glowing_steel frame_reshuffle frame_filter - logulator + logulator miff ); @shebang = (map("examples/$_",@examples), qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl @@ -263,7 +263,7 @@ WriteMakefile( 'LIBS' => [''], 'INC' => "$INC1 $GIMP_INC_NOUI $CPPFLAGS $CFLAGS", 'DEFINE' => "$DEFINE1 $DEFS", - 'EXE_FILES' => ['scm2perl','scm2scm','gimpdoc'], + 'EXE_FILES' => [qw(scm2perl scm2scm gimpdoc xcftopnm)], 'macro' => \%cfg, 'realclean' => { FILES => "config.status config.cache config.pl config.log config.h Gimp/Config.pm" }, 'clean' => { FILES => "Makefile.old stamp-h" }, diff --git a/plug-ins/perl/TODO b/plug-ins/perl/TODO index 28d8d3c949..991cfd8b1e 100644 --- a/plug-ins/perl/TODO +++ b/plug-ins/perl/TODO @@ -8,18 +8,18 @@ gimp ~/pix/ka001.jpg -b "(extension-perl-server 0 0 0)" file:///usr/app/lib/perl5/site_perl/i686-linux/PDL/HtmlDocs/PDL/ make test TEST_VERBOSE=1 - - ADD> +aaron sherman email schicken(!!!!) wegen logulator + +paint_funcs.h convolve.h gimpdrawable.h gimpimage.h lut_funcs.h paint_core.h plug_in.h flip_tool.h + +script-fu 4.9 vs. 3.3 bugs + * document Gimp::PDL and rect2, ...2 functions! [DONE] * MJH: glib-config(!!!) -[DONE] * replöace examples/pixemap pod by (.*) and watch it die! [KILL] * empty desfiption -> no display in PDB?` -[DONE] * make uninstall is actually a concern: make it work * podestions are not expanded in dialog help strings etc.. -{DONE] * Document spawn_options in Gimp::Net. -[KILL] * Selection => To Brush. * Kommandozeilenmodus(!). * don't start gimp in cmdline mode and error. * KILL :auto from default(!) @@ -27,21 +27,18 @@ bugs * gimp-piddle must be written back automatically on destroy, if changed * possibly rename "Brush Selection" to "Paint Settings" * gimp-tile set dirty automatically(!) -[KILL] * fatal errors in config.pl (!) * perl module install dependency -[DONE} * not calling unload -> coredump * $Config{cc} might not understand Gimps CFLAGS (-mpentium). -[KILL} * improve examples/example-*.pl * wait for working gimp_file_load (or do it myself?) * get rid of xs_exit. please please fuck me plenty. * create gimpstyle.pod important issues - * migrate BOOT: into INIT() + * gimpdoc with caching & exampling ;---> + * migrate BOOT: into INIT() (forgot why but important for B) * gimp_progress_done, gimp_progress_close * maybe implement --enable-perl=runtime-only? -[KILL] * --ui and --noui for Gimp::Fu * pdb_proc_renameto * gimp_default_display (...) for libgimp * Gimp::Module for modules (!) @@ -51,7 +48,6 @@ important issues * PF_PREVIEW(!) * change set_usize to something else.. * Gimp::IO (?) -[KILL] * Gimp::Fu import after Gimp? use Gimp::main for Gimp::Fu?? * install scripts in share/ * register dummy function to calm gimp down (really??) * gimp->object_id, drawable_object_id remove! @@ -60,14 +56,9 @@ important issues * allow plug-ins to register with only a drawable argument(!) * gradient button * implement Perl-Server RSET and shared lock(!) -[KILL} * use Gimp qw(GIMP_HOST=jfjf)??? -[DONE] * zero-copy PDL support * weighted movement in drawing tools -[KILL] * -DMIN_PERL_DEFINE * --function localfunc to select one of the registered scripts -[DONE] * brush etc. buttons (maybe use gimp's interface, but only when local(?)) * create working progress when Net and $verbose -[KILL] * require Storable soon(!) * Gimp::Fu::command(?) * default parameters at end(!) * try to deduce default parameters @@ -77,9 +68,4 @@ long term issues and ideas * rewrite interact() in pure C, gets rid of most gtk dependencies. * default function parameters (with hash %defaults?) * gimp_text(text => "hallo", family => "engraver", size => 20); - -[DONE] * do not know how to sensibly convert these => perl is NOT C. -[DONE] -[DONE] gimp_pixel_rgns_register(nrgns, ...) -[DONE] gimp_pixel_rgns_process(pri_ptr) - + diff --git a/plug-ins/perl/etc/config.pl.in b/plug-ins/perl/etc/config.pl.in index a9820b0af1..71a773fa0b 100644 --- a/plug-ins/perl/etc/config.pl.in +++ b/plug-ins/perl/etc/config.pl.in @@ -101,7 +101,7 @@ EOF } else { $do_config_msg && print <selection_save; - $image->rect_select($x1,$y1,$w,$h,SELECTION_REPLACE,0,0); + $image->rect_select($x1,$y1,$w,$h,REPLACE,0,0); $drawable->edit_copy; $sel->selection_load; $sel->remove_channel; diff --git a/plug-ins/perl/examples/gimpmagick b/plug-ins/perl/examples/gimpmagick index 05f268c4ef..e77b9146d7 100644 --- a/plug-ins/perl/examples/gimpmagick +++ b/plug-ins/perl/examples/gimpmagick @@ -121,7 +121,7 @@ sub read_pixels { for(my $y=0; $y<$y2; $y+=$th) { # calling internal function, sorry folks! Gimp->progress_update ($y/$y2*100); - print TEMP Gimp::PixelRgn::_get_rect($region,0,$y,$x2,$y2-$y > $th ? $th : $y2-$y); + print TEMP $region->rect2($region,0,$y,$x2,$y2-$y > $th ? $th : $y2-$y); } close TEMP; $im->Set(size => $x2.'x'.$y2); diff --git a/plug-ins/perl/examples/homepage-logo.pl b/plug-ins/perl/examples/homepage-logo.pl index 72538adf29..57bab0cba1 100755 --- a/plug-ins/perl/examples/homepage-logo.pl +++ b/plug-ins/perl/examples/homepage-logo.pl @@ -82,7 +82,7 @@ sub write_logo { gimp_image_add_layer ($img,$shadow,1); - gimp_shear ($shadow,1,HORIZONTAL_SHEAR,-$th); + gimp_shear ($shadow,1,HORIZONTAL,-$th); gimp_layer_scale ($shadow, $tw, $th*0.3, 1); gimp_layer_translate ($shadow, $th*0.1, $th*0.3); plug_in_gauss_rle ($shadow, 1, 1, 1); diff --git a/plug-ins/perl/examples/logulator b/plug-ins/perl/examples/logulator index 5fa384395e..c12d5209c9 100755 --- a/plug-ins/perl/examples/logulator +++ b/plug-ins/perl/examples/logulator @@ -585,7 +585,7 @@ sub script_fu_chalk_logo { plug_in_ripple ($img, $text_layer, 27, 2, 1, 0, 0, 1, 1); plug_in_sobel ($img, $text_layer, 1, 1, 1); gimp_levels ($text_layer, 0, 0, 120, 3.5, 0, 255); - gimp_rect_select ($img, 0, 0, $width, 1, SELECTION_ADD, 0, 0); + gimp_rect_select ($img, 0, 0, $width, 1, ADD, 0, 0); gimp_edit_clear ($text_layer); gimp_selection_none ($img); gimp_layer_set_preserve_trans ($text_layer, 1); @@ -912,7 +912,7 @@ sub script_fu_cool_metal_logo { gimp_gradients_set_active ("Horizon_1"); } gimp_blend ($text_layer, CUSTOM, NORMAL_MODE, LINEAR, 100, 0, REPEAT_NONE, 0, 0, 0, 0, 0, 0, ($height + 5)); - gimp_rect_select ($img, 0, ($height / 2 - $feather), $img_width, 2 * $feather, SELECTION_REPLACE, 0, 0); + gimp_rect_select ($img, 0, ($height / 2 - $feather), $img_width, 2 * $feather, REPLACE, 0, 0); plug_in_gauss_iir ($img, $text_layer, $smear, 1, 1); gimp_selection_none ($img); plug_in_ripple ($img, $text_layer, $period, $amplitude, 1, 0, 1, 1, 0); @@ -935,7 +935,7 @@ sub script_fu_cool_metal_logo { gimp_perspective ($fs, 0, (5 + 0.15 * $height), ($height - 0.15 * $height), (5 + $width + 0.15 * $height), ($height - 0.15 * $height), 5, $height, (5 + $width), $height); gimp_floating_sel_anchor ($fs); plug_in_gauss_rle ($img, $shadow_layer, $smear, 1, 1); - gimp_rect_select ($img, 5, 5, $width, $height, SELECTION_REPLACE, 0, 0); + gimp_rect_select ($img, 5, 5, $width, $height, REPLACE, 0, 0); gimp_edit_copy ($text_layer); $fs = gimp_edit_paste ($reflect_layer, 0); gimp_floating_sel_anchor ($fs); @@ -2000,8 +2000,8 @@ sub script_fu_sota_chrome_logo { gimp_edit_clear ($shadow); gimp_layer_set_visible ($text_layer, 0); gimp_layer_set_visible ($shadow, 0); - gimp_rect_select ($img, $b_size / 2, $b_size / 2, ($width - $b_size), ($height - $b_size), SELECTION_REPLACE, 0, 0); - gimp_rect_select ($img, $b_size, $b_size, ($width - $b_size * 2), ($height - $b_size * 2), SELECTION_SUB, 0, 0); + gimp_rect_select ($img, $b_size / 2, $b_size / 2, ($width - $b_size), ($height - $b_size), REPLACE, 0, 0); + gimp_rect_select ($img, $b_size, $b_size, ($width - $b_size * 2), ($height - $b_size * 2), SUB, 0, 0); gimp_edit_fill ($text_layer); gimp_selection_layer_alpha ($text_layer); gimp_palette_set_background ([0, 0, 0]); @@ -2502,7 +2502,7 @@ sub script_fu_textured_logo { gimp_edit_clear ($drop_shadow_layer); gimp_palette_set_background ($bg_color); gimp_drawable_fill ($shadow_layer, BG_IMAGE_FILL); - gimp_rect_select ($img, $b_size_2, $b_size_2, ($width - $b_size), ($height - $b_size), SELECTION_REPLACE, 1, $b_size_2); + gimp_rect_select ($img, $b_size_2, $b_size_2, ($width - $b_size), ($height - $b_size), REPLACE, 1, $b_size_2); gimp_palette_set_background ([0, 0, 0]); gimp_edit_fill ($shadow_layer); gimp_selection_layer_alpha ($text_layer); @@ -2665,7 +2665,7 @@ sub script_fu_blended_logo { gimp_edit_fill ($text_layer); gimp_palette_set_background ($bg_color); gimp_drawable_fill ($shadow_layer, BG_IMAGE_FILL); - gimp_rect_select ($img, $b_size_2, $b_size_2, ($width - $b_size), ($height - $b_size), SELECTION_REPLACE, 1, $b_size_2); + gimp_rect_select ($img, $b_size_2, $b_size_2, ($width - $b_size), ($height - $b_size), REPLACE, 1, $b_size_2); gimp_palette_set_background ([0, 0, 0]); gimp_edit_fill ($shadow_layer); gimp_selection_layer_alpha ($text_layer); diff --git a/plug-ins/perl/examples/miff b/plug-ins/perl/examples/miff new file mode 100755 index 0000000000..9821c773d7 --- /dev/null +++ b/plug-ins/perl/examples/miff @@ -0,0 +1,63 @@ +#!/usr/bin/perl +# pcg@goof.com +# a fairly complete miff save filter + +use Gimp; +use Gimp::Fu; +use Fcntl; + +# Gimp::set_trace(TRACE_ALL); + +sub write_layer { + my($fh,$l)=@_; + my($w,$h)=($l->width,$l->height); + my $r = new PixelRgn $l,0,0,$w,$h,0,0; + print $fh "rows=$h columns=$w\n", + "matte=", $r->bpp&1 ? "False" : "True", "\n", + ":\012"; + # inefficient as hell, but "what shells?" ;*> + for my $y (0..$h-1) { + print $fh $r->get_rect2(0,$y,$w,1); + } +} + +register "file_miff_save", + "save images as miff (Magick Interchange File Format)", + "Saves images in the miff (Magick Interchange File Format) format used by the ImageMagick package", + "Marc Lehmann", + "Marc Lehmann ", + "1999-07-27", + "/MIFF", + "RGB, RGBA, GRAY, INDEXED-NOT-YET", # weird, but no matte for !DirectColour + [], + sub { + my($img,$drawable,$filename) =@_; + sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die "Unable to open '$filename' for writing: $!\n"; + my $hdr = eval { $img->find_parasite("gimp-comment")->data }; + $hdr = " COMMENT: $hdr\n" if $hdr; + $hdr = <get_layers) { + print FILE $hdr, + "scene=$scene\n", + "class=", $_->color ? "DirectClass" : "PseudoClass", "\n"; + #"gamma=", Gimp->gamma, "\n"; + write_layer(*FILE,$_); + $scene++; + } + close FILE; + (); +}; + +Gimp::on_query { + ##Gimp->register_magic_load_handler("file_miff_load", "miff", "", "0,string,id=ImageMagick"); + Gimp->register_save_handler("file_miff_save", "miff", ""); +}; + +exit main; + diff --git a/plug-ins/perl/examples/mirrorsplit b/plug-ins/perl/examples/mirrorsplit index c2d4c633b2..d82ede0534 100755 --- a/plug-ins/perl/examples/mirrorsplit +++ b/plug-ins/perl/examples/mirrorsplit @@ -31,20 +31,20 @@ register "mirror_split", my $temp1 = gimp_layer_copy($layer, 1); if ($mirror == 0) { # upper half - $temp1 = gimp_flip($temp1, VERTICAL_FLIP); - gimp_rect_select($img, 0, $hspan, $w, $h - $hspan, SELECTION_REPLACE, 0, 0); + $temp1 = gimp_flip($temp1, VERTICAL); + gimp_rect_select($img, 0, $hspan, $w, $h - $hspan, REPLACE, 0, 0); }; if ($mirror == 1) { # lower half - $temp1 = gimp_flip($temp1, VERTICAL_FLIP); - gimp_rect_select($img, 0, 0, $w, $hspan, SELECTION_REPLACE, 0, 0); + $temp1 = gimp_flip($temp1, VERTICAL); + gimp_rect_select($img, 0, 0, $w, $hspan, REPLACE, 0, 0); }; if ($mirror == 2) { # left half - $temp1 = gimp_flip($temp1, HORIZONTAL_FLIP); - gimp_rect_select($img, $wspan, 0, $w - $wspan, $h, SELECTION_REPLACE, 0, 0); + $temp1 = gimp_flip($temp1, HORIZONTAL); + gimp_rect_select($img, $wspan, 0, $w - $wspan, $h, REPLACE, 0, 0); }; if ($mirror == 3) { # right half - $temp1 = gimp_flip($temp1, HORIZONTAL_FLIP); - gimp_rect_select($img, 0, 0, $wspan, $h, SELECTION_REPLACE, 0, 0); + $temp1 = gimp_flip($temp1, HORIZONTAL); + gimp_rect_select($img, 0, 0, $wspan, $h, REPLACE, 0, 0); }; gimp_edit_copy($temp1); diff --git a/plug-ins/perl/examples/pixelmap b/plug-ins/perl/examples/pixelmap index 7032e8636b..c51e56cf28 100755 --- a/plug-ins/perl/examples/pixelmap +++ b/plug-ins/perl/examples/pixelmap @@ -7,15 +7,15 @@ use Gimp::Util; use PDL; register "pixelmap", - "Maps Pixel values and coordinates through general Perl exprtessions", - "=pod()", + "Maps Pixel values and coordinates through general Perl expressions", + "=pod(DESCRIPTION)", "Marc Lehmann", "Marc Lehmann ", "19990528", "/Filters/Map/Pixelmap", "*", [ - [PF_STRING, "expression" , "The perl expression to use", '$p=outer($x,$y)->slice("*$bpp")'] + [PF_TEXT, "expression" , "The perl expression to use", '$p=outer($x,$y)->slice("*$bpp")'] ], sub { # es folgt das eigentliche Skript... my($image,$drawable,$expr)=@_; @@ -63,6 +63,10 @@ exit main; Not yet written yet, sorry... +=head1 HI + +x + diff --git a/plug-ins/perl/examples/randomart1 b/plug-ins/perl/examples/randomart1 index 9063663dd1..5afea92d7b 100755 --- a/plug-ins/perl/examples/randomart1 +++ b/plug-ins/perl/examples/randomart1 @@ -65,7 +65,7 @@ register "random_art_1", # Funktionsname } # Selektiere die Region - $image->free_select (\@ecken, SELECTION_REPLACE, 1, 1, $feather); + $image->free_select (\@ecken, REPLACE, 1, 1, $feather); # Wähle zufällig zwei Farben aus Palette->set_foreground([rand(256),rand(256),rand(256)]); diff --git a/plug-ins/perl/examples/repdup b/plug-ins/perl/examples/repdup index 49ec882d1d..c62c23acd8 100755 --- a/plug-ins/perl/examples/repdup +++ b/plug-ins/perl/examples/repdup @@ -33,7 +33,7 @@ register "repdup", for ($i = 0; $i < $repeats; $i++) { $b[1] = $b[1] + $xoffset; $b[2] = $b[2] + $yoffset; - gimp_rect_select($img, $b[1], $b[2], $w, $h, SELECTION_REPLACE, 0, 0); + gimp_rect_select($img, $b[1], $b[2], $w, $h, REPLACE, 0, 0); $bit_bucket = gimp_edit_paste($layer, 0); gimp_floating_sel_anchor($bit_bucket); gimp_selection_none($img); diff --git a/plug-ins/perl/examples/stamps b/plug-ins/perl/examples/stamps index 75d37151ce..85de294f9e 100755 --- a/plug-ins/perl/examples/stamps +++ b/plug-ins/perl/examples/stamps @@ -20,11 +20,11 @@ sub stamps { gimp_ellipse_select($img, $x, 0, $diameter, $diameter, - SELECTION_ADD, 1, 0, 0); + ADD, 1, 0, 0); gimp_ellipse_select($img, 0, $x, $diameter, $diameter, - SELECTION_ADD, 1, 0, 0); + ADD, 1, 0, 0); $x = $x + $diameter + $gap; } gimp_palette_set_background($paper); diff --git a/plug-ins/perl/examples/webify.pl b/plug-ins/perl/examples/webify.pl index e9a7ad65cc..51d5234a41 100755 --- a/plug-ins/perl/examples/webify.pl +++ b/plug-ins/perl/examples/webify.pl @@ -32,7 +32,7 @@ register "webify", if ($alpha) { $drawable->add_alpha; - $drawable->by_color_select($bg,$thresh,SELECTION_REPLACE,1,0,0,0); + $drawable->by_color_select($bg,$thresh,REPLACE,1,0,0,0); $drawable->edit_cut if $img->selection_bounds; } Plugin->autocrop($drawable) if $autocrop; diff --git a/plug-ins/perl/gimpdoc b/plug-ins/perl/gimpdoc index 548533913b..52ea8e86df 100755 --- a/plug-ins/perl/gimpdoc +++ b/plug-ins/perl/gimpdoc @@ -1,6 +1,6 @@ #!/usr/bin/perl -# -r print raw format (i.e. suitable for groff -man) +# -r print raw format (i.e. suitable for troff -man) use Gimp qw(:consts spawn_options=no-data); use Getopt::Std;