mirror of
https://gitlab.gnome.org/GNOME/gimp
synced 2024-10-20 11:37:14 +00:00
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
165c69ffba
commit
bad20ffc0a
|
|
@ -6,8 +6,18 @@ Revision history for Gimp-Perl extension.
|
|||
- preliminary <Load> and <Save> support (arguments are automatically
|
||||
supplied).
|
||||
- enabled limited pixel access functions even when PDL was not found.
|
||||
- added examples/miff (a save filter for miff images).
|
||||
- implemented and added examples/miff (a save filter for miff images).
|
||||
- close DATA in Gimp unconditionally, saves one open filehandle.
|
||||
- fixed the longstanding preview bug in Gimp::UI by reversing the
|
||||
order of calls to draw_row. => something in gtk+ is really broken.
|
||||
- fixed a longstanding (but never seen ;) bug in old_pdl: pdls that
|
||||
were not sever'ed created garbage.
|
||||
- allow dummy dimension in grayscale pdls, i.e. pdl(1,width,height)
|
||||
instead of pdl(width,height).
|
||||
- improved gimpdoc.
|
||||
- removed debugging code from gouge. ouch!
|
||||
- bug fixed: PDL::Core was not automatically required when not
|
||||
already loaded.
|
||||
|
||||
1.0981 Wed Jul 28 00:09:50 CEST 1999
|
||||
- improved gouge ;) In a sense, it's actually pretty code now!
|
||||
|
|
|
|||
|
|
@ -328,15 +328,15 @@ unless ($no_SIG) {
|
|||
die_msg $_[0];
|
||||
initialized() ? &quiet_die : exit quiet_main();
|
||||
} else {
|
||||
die $_[0];
|
||||
die $_[0];
|
||||
}
|
||||
};
|
||||
|
||||
$SIG{__WARN__} = sub {
|
||||
unless ($in_quit) {
|
||||
warn $_[0];
|
||||
warn $_[0];
|
||||
} else {
|
||||
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARNING');
|
||||
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARNING');
|
||||
}
|
||||
};
|
||||
}
|
||||
|
|
@ -465,7 +465,7 @@ sub AUTOLOAD {
|
|||
my $ref = \&{"Gimp::Util::$sub"};
|
||||
*{$AUTOLOAD} = sub {
|
||||
shift unless ref $_[0];
|
||||
goto &$ref; # does not always work, PERLBUG! #FIXME
|
||||
#goto &$ref; # does not always work, PERLBUG! #FIXME
|
||||
my @r = eval { &$ref };
|
||||
_croak $@ if $@;
|
||||
wantarray ? @r : $r[0];
|
||||
|
|
@ -475,7 +475,7 @@ sub AUTOLOAD {
|
|||
my $ref = \&{"$interface_pkg\::$sub"};
|
||||
*{$AUTOLOAD} = sub {
|
||||
shift unless ref $_[0];
|
||||
goto &$ref; # does not always work, PERLBUG! #FIXME
|
||||
#goto &$ref; # does not always work, PERLBUG! #FIXME
|
||||
my @r = eval { &$ref };
|
||||
_croak $@ if $@;
|
||||
wantarray ? @r : $r[0];
|
||||
|
|
|
|||
|
|
@ -22,12 +22,8 @@
|
|||
#define PDL_clean_namespace
|
||||
#include <pdlcore.h>
|
||||
#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
|
||||
|
|
@ -77,6 +73,8 @@ static int trace = TRACE_NONE;
|
|||
|
||||
#if HAVE_PDL
|
||||
|
||||
typedef GPixelRgn GPixelRgn_PDL;
|
||||
|
||||
/* hack, undocumented, argh! */
|
||||
static Core* PDL; /* Structure hold core C functions */
|
||||
|
||||
|
|
@ -88,11 +86,12 @@ static void need_pdl (void)
|
|||
if (!PDL)
|
||||
{
|
||||
/* the perl-server can't be bothered to do this itself! */
|
||||
perl_require_pv ("PDL::Core");
|
||||
perl_eval_pv ("require PDL::Core", TRUE);
|
||||
|
||||
/* Get pointer to structure of core shared C routines */
|
||||
if (!(CoreSV = perl_get_sv("PDL::SHARE",FALSE)))
|
||||
Perl_croak("gimp-perl-pixel functions require the PDL::Core module");
|
||||
CoreSV = perl_get_sv("PDL::SHARE", FALSE);
|
||||
if (!CoreSV)
|
||||
croak("gimp-perl-pixel functions require the PDL::Core module, which was not found");
|
||||
|
||||
PDL = (Core*) SvIV(CoreSV);
|
||||
}
|
||||
|
|
@ -117,14 +116,17 @@ static pdl *new_pdl (int a, int b, int c)
|
|||
|
||||
static void old_pdl (pdl **p, short ndims, int dim0)
|
||||
{
|
||||
PDL->converttype (p, PDL_B, PDL_PERM);
|
||||
PDL->make_physical (*p);
|
||||
PDL->converttype (p, PDL_B, PDL_PERM);
|
||||
|
||||
if ((*p)->ndims != ndims + (dim0 > 1))
|
||||
croak ("dimension mismatch, pdl has dimension %d but %d dimensions required", (*p)->ndims, ndims + (dim0 > 1));
|
||||
if ((*p)->ndims < ndims + (dim0 > 1))
|
||||
croak ("dimension mismatch, pdl has dimension %d but at least %d dimensions allowed", (*p)->ndims, ndims + (dim0 > 1));
|
||||
|
||||
if (dim0 > 1 && (*p)->dims[0] != dim0)
|
||||
croak ("pixel size mismatch, pdl has %d byte pixels but %d bytes are required", (*p)->dims[0], dim0);
|
||||
if ((*p)->ndims > ndims + 1)
|
||||
croak ("dimension mismatch, pdl has dimension %d but at most %d dimensions required", (*p)->ndims, ndims + 1);
|
||||
|
||||
if ((*p)->ndims > ndims && (*p)->dims[0] != dim0)
|
||||
croak ("pixel size mismatch, pdl has %d channel pixels but %d channels are required", (*p)->dims[0], dim0);
|
||||
}
|
||||
|
||||
static void pixel_rgn_pdl_delete_data (pdl *p, int param)
|
||||
|
|
@ -216,12 +218,6 @@ static SV *new_gdrawable (gint32 id)
|
|||
if (!gdr)
|
||||
croak ("unable to convert Gimp::Drawable into Gimp::GDrawable (id %d)", id);
|
||||
|
||||
#if HAVE_PDL
|
||||
/* this needs to be called once before ANY pdl functions can be called. */
|
||||
/* placing this here will suffice. */
|
||||
need_pdl ();
|
||||
#endif
|
||||
|
||||
if (!stash)
|
||||
stash = gv_stashpv (PKG_GDRAWABLE, 1);
|
||||
|
||||
|
|
@ -315,6 +311,14 @@ static GPixelRgn *old_pixelrgn (SV *sv)
|
|||
return (GPixelRgn *)SvPV_nolen(SvRV(sv));
|
||||
}
|
||||
|
||||
static GPixelRgn *old_pixelrgn_pdl (SV *sv)
|
||||
{
|
||||
#if HAVE_PDL
|
||||
need_pdl ();
|
||||
#endif
|
||||
return old_pixelrgn (sv);
|
||||
}
|
||||
|
||||
/* tracing stuff. */
|
||||
static SV *trace_var = 0;
|
||||
static PerlIO *trace_file = 0; /* FIXME: unportable. */
|
||||
|
|
@ -2008,6 +2012,7 @@ gimp_drawable_get_tile(gdrawable, shadow, row, col)
|
|||
gint row
|
||||
gint col
|
||||
CODE:
|
||||
need_pdl ();
|
||||
RETVAL = new_tile (gimp_drawable_get_tile (old_gdrawable (gdrawable), shadow, row, col), gdrawable);
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
|
@ -2019,13 +2024,14 @@ gimp_drawable_get_tile2(gdrawable, shadow, x, y)
|
|||
gint x
|
||||
gint y
|
||||
CODE:
|
||||
need_pdl ();
|
||||
RETVAL = new_tile (gimp_drawable_get_tile2 (old_gdrawable (gdrawable), shadow, x, y), gdrawable);
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
pdl *
|
||||
gimp_pixel_rgn_get_pixel(pr, x, y)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
int x
|
||||
int y
|
||||
CODE:
|
||||
|
|
@ -2036,7 +2042,7 @@ gimp_pixel_rgn_get_pixel(pr, x, y)
|
|||
|
||||
pdl *
|
||||
gimp_pixel_rgn_get_row(pr, x, y, width)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
int x
|
||||
int y
|
||||
int width
|
||||
|
|
@ -2048,7 +2054,7 @@ gimp_pixel_rgn_get_row(pr, x, y, width)
|
|||
|
||||
pdl *
|
||||
gimp_pixel_rgn_get_col(pr, x, y, height)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
int x
|
||||
int y
|
||||
int height
|
||||
|
|
@ -2060,7 +2066,7 @@ gimp_pixel_rgn_get_col(pr, x, y, height)
|
|||
|
||||
pdl *
|
||||
gimp_pixel_rgn_get_rect(pr, x, y, width, height)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
int x
|
||||
int y
|
||||
int width
|
||||
|
|
@ -2073,7 +2079,7 @@ gimp_pixel_rgn_get_rect(pr, x, y, width, height)
|
|||
|
||||
void
|
||||
gimp_pixel_rgn_set_pixel(pr, pdl, x, y)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
pdl * pdl
|
||||
int x
|
||||
int y
|
||||
|
|
@ -2083,7 +2089,7 @@ gimp_pixel_rgn_set_pixel(pr, pdl, x, y)
|
|||
|
||||
void
|
||||
gimp_pixel_rgn_set_row(pr, pdl, x, y)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
pdl * pdl
|
||||
int x
|
||||
int y
|
||||
|
|
@ -2093,7 +2099,7 @@ gimp_pixel_rgn_set_row(pr, pdl, x, y)
|
|||
|
||||
void
|
||||
gimp_pixel_rgn_set_col(pr, pdl, x, y)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
pdl * pdl
|
||||
int x
|
||||
int y
|
||||
|
|
@ -2103,7 +2109,7 @@ gimp_pixel_rgn_set_col(pr, pdl, x, y)
|
|||
|
||||
void
|
||||
gimp_pixel_rgn_set_rect(pr, pdl, x, y)
|
||||
GPixelRgn * pr
|
||||
GPixelRgn_PDL * pr
|
||||
pdl * pdl
|
||||
int x
|
||||
int y
|
||||
|
|
@ -2113,8 +2119,8 @@ gimp_pixel_rgn_set_rect(pr, pdl, x, y)
|
|||
|
||||
pdl *
|
||||
gimp_pixel_rgn_data(pr,newdata=0)
|
||||
GPixelRgn * pr
|
||||
pdl * newdata
|
||||
GPixelRgn_PDL * pr
|
||||
pdl * newdata
|
||||
CODE:
|
||||
if (newdata)
|
||||
{
|
||||
|
|
@ -2167,6 +2173,7 @@ SV *
|
|||
gimp_tile_get_data(tile)
|
||||
GTile * tile
|
||||
CODE:
|
||||
need_pdl;
|
||||
croak ("gimp_tile_get_data is not yet implemented\n");
|
||||
gimp_tile_ref (tile);
|
||||
gimp_tile_unref (tile, 0);
|
||||
|
|
|
|||
|
|
@ -176,18 +176,6 @@ that are checked are shown as well (the null prefix "" is implicit).
|
|||
|
||||
gimp_brushes_
|
||||
|
||||
=item Edit
|
||||
|
||||
gimp_edit_
|
||||
|
||||
=item Gradients
|
||||
|
||||
gimp_gradients_
|
||||
|
||||
=item Selection
|
||||
|
||||
gimp_selection_
|
||||
|
||||
=item Patterns
|
||||
|
||||
gimp_patterns_
|
||||
|
|
|
|||
|
|
@ -185,6 +185,7 @@ sub GTK_OBJECT_INIT {
|
|||
$button = new Gtk::Button "Cancel";
|
||||
signal_connect $button "clicked", sub {hide $w};
|
||||
$w->action_area->pack_start($button,1,1,0);
|
||||
can_default $button 1;
|
||||
show $button;
|
||||
|
||||
$self->signal_connect("clicked",sub {show $w});
|
||||
|
|
@ -223,12 +224,12 @@ sub set_preview {
|
|||
hide $cp;
|
||||
hide $gp;
|
||||
my $p = $bpp == 1 ? $gp : $cp;
|
||||
show $p;
|
||||
$p->size ($w, $h);
|
||||
while(--$h) {
|
||||
$p->draw_row (substr ($mask, $w*$bpp*$h), 0, $h, $w);
|
||||
for(0..$h-1) {
|
||||
$p->draw_row (substr ($mask, $w*$bpp*$_), 0, $_, $w);
|
||||
}
|
||||
$p->draw(undef);
|
||||
show $p;
|
||||
|
||||
$name;
|
||||
}
|
||||
|
|
@ -267,8 +268,8 @@ sub set_preview {
|
|||
hide $p;
|
||||
my $l=length($mask);
|
||||
$p->size ($w, $h);
|
||||
while(--$h) {
|
||||
$p->draw_row (substr ($mask, $w*$h) ^ $xor, 0, $h, $w);
|
||||
for(0..$h-1) {
|
||||
$p->draw_row (substr ($mask, $w*$_) ^ $xor, 0, $_, $w);
|
||||
}
|
||||
$p->draw(undef);
|
||||
show $p;
|
||||
|
|
|
|||
|
|
@ -15,12 +15,15 @@ Gimp.xs
|
|||
scm2perl
|
||||
scm2scm
|
||||
gimpdoc
|
||||
t/load.t
|
||||
t/loadlib.t
|
||||
t/run.t
|
||||
xcftopnm
|
||||
embedxpm
|
||||
logo.xpm
|
||||
extradefs.h
|
||||
gppport.h
|
||||
Perl-Server
|
||||
t/load.t
|
||||
t/loadlib.t
|
||||
t/run.t
|
||||
etc/configure
|
||||
etc/configure.in
|
||||
etc/aclocal.m4
|
||||
|
|
@ -100,8 +103,6 @@ examples/oneliners
|
|||
examples/randomart1
|
||||
examples/colourtoalpha
|
||||
examples/pixelmap
|
||||
embedxpm
|
||||
logo.xpm
|
||||
examples/frame_reshuffle
|
||||
examples/frame_filter
|
||||
examples/gouge
|
||||
|
|
|
|||
|
|
@ -16,6 +16,9 @@ script-fu 4.9 vs. 3.3
|
|||
|
||||
bugs
|
||||
|
||||
* perl_require_pv with _59?
|
||||
* scroll behaviour, use clist instead of list?
|
||||
[DONE] * can_Default for oter OK-buttons
|
||||
* document Gimp::PDL and rect2, ...2 functions!
|
||||
[DONE] * MJH: glib-config(!!!)
|
||||
[KILL] * empty desfiption -> no display in PDB?`
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ register "border_average",
|
|||
"calulcates the average border colour",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann",
|
||||
"0.2.1",
|
||||
"0.2.2",
|
||||
"<Image>/Filters/Misc/Border Average",
|
||||
"RGB",
|
||||
[
|
||||
|
|
@ -58,13 +58,13 @@ register "border_average",
|
|||
};
|
||||
|
||||
Gimp->progress_init("Border Average", 0);
|
||||
add_new_colour ($drawable->get->pixel_rgn ($bounds[0] ,$bounds[1] , $thickness,$height, 0, 0)
|
||||
add_new_colour ($drawable->pixel_rgn ($bounds[0] ,$bounds[1] , $thickness,$height, 0, 0)
|
||||
->get_rect(0,0, $thickness,$height));
|
||||
add_new_colour ($drawable->get->pixel_rgn ($bounds[2]-$thickness,$bounds[1] , $thickness,$height, 0, 0)
|
||||
add_new_colour ($drawable->pixel_rgn ($bounds[2]-$thickness,$bounds[1] , $thickness,$height, 0, 0)
|
||||
->get_rect(0,0, $thickness,$height));
|
||||
add_new_colour ($drawable->get->pixel_rgn ($bounds[0] ,$bounds[1] , $width ,$thickness, 0, 0)
|
||||
add_new_colour ($drawable->pixel_rgn ($bounds[0] ,$bounds[1] , $width ,$thickness, 0, 0)
|
||||
->get_rect(0,0, $width, $thickness));
|
||||
add_new_colour ($drawable->get->pixel_rgn ($bounds[0] ,$bounds[3]-$thickness, $width ,$thickness, 0, 0)
|
||||
add_new_colour ($drawable->pixel_rgn ($bounds[0] ,$bounds[3]-$thickness, $width ,$thickness, 0, 0)
|
||||
->get_rect(0,0, $width, $thickness));
|
||||
|
||||
# now find the colour
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ register "colour_to_alpha",
|
|||
."amount of alpha, then readjusts the colour accordingly.",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"19990517",
|
||||
"19990729",
|
||||
"<Image>/Filters/Colors/Colour To Alpha",
|
||||
"RGB*",
|
||||
[
|
||||
|
|
@ -30,8 +30,8 @@ register "colour_to_alpha",
|
|||
{
|
||||
# $src and $dst must either be scoped or explicitly undef'ed
|
||||
# before merge_shadow.
|
||||
my $src = new PixelRgn ($drawable->get,@bounds,0,0);
|
||||
my $dst = new PixelRgn ($drawable->get,@bounds,1,1);
|
||||
my $src = new PixelRgn $drawable,@bounds,0,0;
|
||||
my $dst = new PixelRgn $drawable,@bounds,1,1;
|
||||
|
||||
$iter = Gimp->pixel_rgns_register ($src, $dst);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ use Gimp::Fu;
|
|||
use Gtk;
|
||||
BEGIN { eval "use Image::Magick 1.45"; $@ and Gimp::Feature::missing ("Image::Magick version 1.45 or higher") };
|
||||
|
||||
$VERSION = '0.1';
|
||||
$VERSION = '0.2';
|
||||
|
||||
$preview_size = 160; # max. size for image preview
|
||||
|
||||
|
|
@ -115,7 +115,7 @@ sub read_pixels {
|
|||
open TEMP,">$temp\0" or die "unable to open temporary file '$temp' for writing\n";
|
||||
my ($empty,$x1,$y1,$x2,$y2) = $drawable->mask_bounds;
|
||||
$x2-=$x1; $y2-=$y1;
|
||||
my $region = $drawable->get->pixel_rgn ($x1, $y1, $x2, $y2, 0, 0);
|
||||
my $region = $drawable->pixel_rgn ($x1, $y1, $x2, $y2, 0, 0);
|
||||
|
||||
Gimp->progress_init ("transferring image data");
|
||||
for(my $y=0; $y<$y2; $y+=$th) {
|
||||
|
|
|
|||
|
|
@ -21,8 +21,8 @@ sub iterate {
|
|||
$bounds[2]-- if $bounds[0]+$bounds[2] >= ($drawable->offsets)[0]+$drawable->width;
|
||||
$bounds[3]-- if $bounds[1]+$bounds[3] >= ($drawable->offsets)[1]+$drawable->height;
|
||||
{
|
||||
my $src = new PixelRgn ($drawable->get,@bounds[0,1],$bounds[2]+1,$bounds[3]+1,0,0);
|
||||
my $dst = new PixelRgn ($drawable->get,@bounds,1,1);
|
||||
my $src = new PixelRgn ($drawable,@bounds[0,1],$bounds[2]+1,$bounds[3]+1,0,0);
|
||||
my $dst = new PixelRgn ($drawable,@bounds,1,1);
|
||||
|
||||
my $bpp = $src->bpp > 1 ? ":," : "";
|
||||
|
||||
|
|
@ -30,15 +30,12 @@ sub iterate {
|
|||
my $area = $bounds[2]*$bounds[3];
|
||||
my $progress = 0;
|
||||
|
||||
use Time::HiRes 'time';
|
||||
$s=time;
|
||||
do {
|
||||
my ($x,$y,$w,$h)=($dst->x,$dst->y,$dst->w,$dst->h);
|
||||
$dst->data($kernel->($bpp,$src->get_rect($x,$y,$w+1,$h+1)->convert(short)));
|
||||
$progress += $w*$h/$area;
|
||||
Gimp->progress_update ($progress);
|
||||
} while (Gimp->pixel_rgns_process ($iter));
|
||||
print time-$s;
|
||||
}
|
||||
Gimp->progress_update (1);
|
||||
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@ sub gimp_text_fontname {
|
|||
my $newlay;
|
||||
if ($layer == -1) {
|
||||
$newlay=$image->layer_new($global_drawable->width,$global_drawable->height,
|
||||
$image->layertype(1), $text, 100, NORMAL_MODE);
|
||||
$image->layertype(1), $text || "--text--", 100, NORMAL_MODE);
|
||||
$newlay->drawable_fill(TRANS_IMAGE_FILL);
|
||||
$newlay->add_layer(0);
|
||||
$newlay->edit_paste(0)->floating_sel_anchor;
|
||||
|
|
|
|||
|
|
@ -26,12 +26,13 @@ register "file_miff_save",
|
|||
"Saves images in the miff (Magick Interchange File Format) format used by the ImageMagick package",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"1999-07-27",
|
||||
"1999-07-29",
|
||||
"<Save>/MIFF",
|
||||
"RGB, RGBA, GRAY, INDEXED-NOT-YET", # weird, but no matte for !DirectColour
|
||||
[],
|
||||
sub {
|
||||
my($img,$drawable,$filename) =@_;
|
||||
my @layers = $img->get_layers;
|
||||
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;
|
||||
|
|
@ -41,14 +42,16 @@ id=ImageMagick
|
|||
CREATOR: file_miff_save gimp plug-in, see http://www.gimp.org/
|
||||
$hdr}
|
||||
EOF
|
||||
init Progress "Saving '$filename' as MIFF...";
|
||||
my $scene = 0;
|
||||
for ($img->get_layers) {
|
||||
for (@layers) {
|
||||
print FILE $hdr,
|
||||
"scene=$scene\n",
|
||||
"class=", $_->color ? "DirectClass" : "PseudoClass", "\n";
|
||||
#"gamma=", Gimp->gamma, "\n";
|
||||
write_layer(*FILE,$_);
|
||||
$scene++;
|
||||
update Progress $scene/@layers;
|
||||
}
|
||||
close FILE;
|
||||
();
|
||||
|
|
|
|||
|
|
@ -6,50 +6,54 @@ use Gimp::Fu;
|
|||
use Gimp::Util;
|
||||
use PDL;
|
||||
|
||||
use constant PI => 4 * atan2 1,1;
|
||||
|
||||
register "pixelmap",
|
||||
"Maps Pixel values and coordinates through general Perl expressions",
|
||||
"=pod(DESCRIPTION)",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"19990528",
|
||||
"19990729",
|
||||
"<Image>/Filters/Map/Pixelmap",
|
||||
"*",
|
||||
[
|
||||
[PF_TEXT, "expression" , "The perl expression to use", '$p=outer($x,$y)->slice("*$bpp")']
|
||||
[PF_TEXT, "expression" , "The perl expression to use", "outer(\$x*0.1,\$y*0.2)\n->slice(\"*\$bpp\")"]
|
||||
],
|
||||
sub { # es folgt das eigentliche Skript...
|
||||
my($image,$drawable,$expr)=@_;
|
||||
my($image,$drawable,$_expr)=@_;
|
||||
|
||||
Gimp->progress_init ("Mapping pixels...");
|
||||
|
||||
my $init="";
|
||||
|
||||
$expr =~ /\$p/ and $init.='$p = $src->data;';
|
||||
$expr =~ /\$x/ and $init.='$x = sequence(byte,$src->w); $x+=$src->x;';
|
||||
$expr =~ /\$y/ and $init.='$y = sequence(byte,$src->h); $y+=$src->y;';
|
||||
$expr =~ /\$bpp/ and $init.='$bpp = $src->bpp;';
|
||||
$_expr =~ /\$p/ and $init.='$p = $src->data;';
|
||||
$_expr =~ /\$x/ and $init.='$x = sequence(long,$w); $x+=$_dst->x;';
|
||||
$_expr =~ /\$y/ and $init.='$y = sequence(long,$h); $y+=$_dst->y;';
|
||||
$_expr =~ /\$bpp/ and $init.='$bpp = $_dst->bpp;';
|
||||
|
||||
$expr = "sub{$init\n#line 1\n$expr;\n\$p}";
|
||||
my($p,$x,$y,$bpp,$w,$h);
|
||||
|
||||
my @bounds = $drawable->mask;
|
||||
$_expr = "sub{$init\n#line 1\n$_expr\n;}";
|
||||
|
||||
my @_bounds = $drawable->mask;
|
||||
{
|
||||
# $src and $dst must either be scoped or explicitly undef'ed
|
||||
# before merge_shadow.
|
||||
my $src = new PixelRgn ($drawable->get,@bounds,0,0);
|
||||
my $dst = new PixelRgn ($drawable->get,@bounds,1,1);
|
||||
my($p,$x,$y,$bpp);
|
||||
my $src = new PixelRgn $drawable,@_bounds,0,0;
|
||||
my $_dst = new PixelRgn $drawable,@_bounds,1,1;
|
||||
|
||||
$expr = eval $expr; die "$@" if $@;
|
||||
$_expr = eval $_expr; die "$@" if $@;
|
||||
|
||||
$iter = Gimp->pixel_rgns_register ($src, $dst);
|
||||
$_iter = Gimp->pixel_rgns_register ($src, $_dst);
|
||||
my $_area = 0;
|
||||
|
||||
do {
|
||||
$dst->data(&$expr);
|
||||
|
||||
Gimp->progress_update (($src->y-$bounds[1])/$bounds[2]);
|
||||
} while (Gimp->pixel_rgns_process ($iter));
|
||||
($w,$h)=($src->w,$src->h);
|
||||
$_area += $w*$h/($_bounds[2]*$_bounds[3]);
|
||||
$_dst->data(&$_expr);
|
||||
Gimp->progress_update ($_area);
|
||||
} while (Gimp->pixel_rgns_process ($_iter));
|
||||
}
|
||||
Gimp->progress_update (1);
|
||||
|
||||
$drawable->merge_shadow (1);
|
||||
$drawable->update ($drawable->mask);
|
||||
|
|
|
|||
|
|
@ -85,29 +85,122 @@ lw20 lw20 lw60.
|
|||
TYPE NAME DESCRIPTION
|
||||
EOF
|
||||
|
||||
sub gen_va(\@\@) {
|
||||
my @vals = @{+shift};
|
||||
my @args = @{+shift};
|
||||
my($vals,$args);
|
||||
|
||||
if (@vals == 0) {
|
||||
$vals = "";
|
||||
} elsif (@vals == 1) {
|
||||
$vals = "$vals[0][1]\\ =\\ ";
|
||||
} else {
|
||||
$vals = "(".join(",",map $_->[1],@vals).")\\ =\\ ";
|
||||
}
|
||||
|
||||
if (@args == 0) {
|
||||
$args = "";
|
||||
} else {
|
||||
$args = "\\ (".join(",",map $_->[1],@args).")";
|
||||
}
|
||||
|
||||
($vals,$args);
|
||||
}
|
||||
|
||||
sub isarray {
|
||||
return 1 if $_[0] == &PARAM_INT8ARRAY;
|
||||
return 1 if $_[0] == &PARAM_INT16ARRAY;
|
||||
return 1 if $_[0] == &PARAM_INT32ARRAY;
|
||||
return 1 if $_[0] == &PARAM_FLOATARRAY;
|
||||
return 1 if $_[0] == &PARAM_STRINGARRAY;
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub killcounts(\@) {
|
||||
my $a = shift;
|
||||
my $roa=0;
|
||||
for(local $_=0; $_<$#$a; $_++) {
|
||||
if (isarray ($a->[$_+1][0]) && $a->[$_][0] == &PARAM_INT32) {
|
||||
splice @$a, $_, 1;
|
||||
$roa=1;
|
||||
}
|
||||
}
|
||||
$roa;
|
||||
}
|
||||
|
||||
sub weight {
|
||||
my ($v,$n,$a)=@$_;
|
||||
my $w = $#$v + $#$a;
|
||||
$w-- if $n =~ s/^\$\w+//;
|
||||
$w += 1-1/(1+length $n);
|
||||
if ($n =~ / ([A-Z][a-z]+)$/) {
|
||||
$w += 1 unless $1 eq ucfirst $a->[0][1];
|
||||
}
|
||||
$w;
|
||||
}
|
||||
|
||||
sub gen_alternatives(\@$\@) {
|
||||
my @new = [@_];
|
||||
my @res;
|
||||
do {
|
||||
my @prev = @new;
|
||||
@new = ();
|
||||
for my $alt (@prev) {
|
||||
my @vals = @{$alt->[0]};
|
||||
my $name = $alt->[1];
|
||||
my @args = @{$alt->[2]};
|
||||
# try to get rid of array counts
|
||||
push @new, [\@vals,$name,\@args] if killcounts(@vals) | killcounts(@args);
|
||||
unless ($name =~ /[$ ]/) {
|
||||
for my $class (qw(
|
||||
Gimp Layer Image Drawable Selection Channel Display
|
||||
Palette Plugin Gradients Edit Progress Region Tile
|
||||
PixelRgn GDrawable Patterns Parasite
|
||||
)) {
|
||||
my @pre = @{$class."::PREFIXES"};
|
||||
for (@pre) {
|
||||
my $n2 = $name;
|
||||
if ($_ && $n2 =~ s/^$_//) {
|
||||
if ($class eq "Drawable" && @args && $args[0][0] == &PARAM_DRAWABLE) {
|
||||
push @new, [\@vals,"\$drawable->$n2",[@args[1..$#args]]];
|
||||
} elsif ($class eq "Layer" && @args && $args[0][0] == &PARAM_LAYER) {
|
||||
push @new, [\@vals,"\$layer->$n2",[@args[1..$#args]]];
|
||||
} elsif ($class eq "Channel" && @args && $args[0][0] == &PARAM_CHANNEL) {
|
||||
push @new, [\@vals,"\$channel->$n2",[@args[1..$#args]]];
|
||||
} elsif ($class eq "Image" && @args && $args[0][0] == &PARAM_IMAGE) {
|
||||
push @new, [\@vals,"\$image->$n2",[@args[1..$#args]]];
|
||||
} else {
|
||||
push @new, [\@vals,"$n2\\ $class",\@args];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (@args && $args[0][0] == &PARAM_INT32 && $args[0][1] eq "run_mode") {
|
||||
push @new, [\@vals,,$name,[@args[1..$#args]]];
|
||||
}
|
||||
if (@args>1 && $args[0][0] == &PARAM_IMAGE && $args[1][0] == &PARAM_DRAWABLE) {
|
||||
push @new, [\@vals,,$name,[@args[1..$#args]]];
|
||||
}
|
||||
}
|
||||
push @res, @new;
|
||||
} while @new;
|
||||
map {
|
||||
my($vals,$args)=gen_va(@{$_->[0]},@{$_->[2]});
|
||||
"$vals\\fB$_->[1]\\fR$args";
|
||||
} map $_->[1], sort {
|
||||
$a->[0] <=> $b->[0]
|
||||
} map [weight($_),$_], @res;
|
||||
}
|
||||
|
||||
for $name (@matches) {
|
||||
my ($blurb, $help, $author, $copyright, $date, $type, $nargs, $nvals) =
|
||||
Gimp->procedural_db_proc_info ($name);
|
||||
my @args = map [Gimp->procedural_db_proc_arg ($name, $_)],0..($nargs-1);
|
||||
my @vals = map [Gimp->procedural_db_proc_val ($name, $_)],0..($nvals-1);
|
||||
|
||||
my $args;
|
||||
my $vals;
|
||||
my($vals,$args)=gen_va(@vals,@args);
|
||||
|
||||
if ($nvals == 0) {
|
||||
$vals = "";
|
||||
} elsif ($nvals == 1) {
|
||||
$vals = "$vals[0][1]\\ =\\ ";
|
||||
} else {
|
||||
$vals = "(".join(",",map $_->[1],@vals).")\\ =\\ ";
|
||||
}
|
||||
|
||||
if ($nargs == 0) {
|
||||
$args = "";
|
||||
} else {
|
||||
$args = "\\ (".join(",",map $_->[1],@args).")";
|
||||
}
|
||||
|
||||
print PAGER <<EOF;
|
||||
.TH "$name" "gimpdoc" "$date" "$version"
|
||||
.SH NAME
|
||||
|
|
@ -132,6 +225,11 @@ EOF
|
|||
}
|
||||
print PAGER ".TE\n";
|
||||
}
|
||||
my @alts = gen_alternatives @vals,$name,@args;
|
||||
if (@alts) {
|
||||
@alts = @alts[0..5] if @alts > 6;
|
||||
print PAGER ".SH SOME SYNTAX ALTERNATIVES\n", join("\n.br\n", @alts), "\n";
|
||||
}
|
||||
print PAGER <<EOF;
|
||||
.SH AUTHOR
|
||||
$author
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
|
||||
if 0; # not running under some shell
|
||||
|
||||
use 5.005;
|
||||
|
||||
$VERSION = 1.0;
|
||||
|
|
|
|||
|
|
@ -10,13 +10,10 @@ gchar * T_PV
|
|||
gint * T_PTROBJ
|
||||
guchar * T_PV
|
||||
|
||||
GLayerMode T_IV
|
||||
GDrawableType T_IV
|
||||
GImageType T_IV
|
||||
|
||||
GDrawable * T_GDRAWABLE
|
||||
GTile * T_TILE
|
||||
GPixelRgn * T_PIXELRGN
|
||||
GPixelRgn_PDL * T_PIXELRGN_PDL
|
||||
|
||||
GtkWidget * T_IV
|
||||
|
||||
|
|
@ -47,6 +44,9 @@ T_TILE
|
|||
T_PIXELRGN
|
||||
$var = old_pixelrgn ($arg)
|
||||
|
||||
T_PIXELRGN_PDL
|
||||
$var = old_pixelrgn_pdl ($arg)
|
||||
|
||||
OUTPUT
|
||||
|
||||
T_PREF
|
||||
|
|
|
|||
62
plug-ins/perl/xcftopnm
Executable file
62
plug-ins/perl/xcftopnm
Executable file
|
|
@ -0,0 +1,62 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use Gimp;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
xcftopnm - convert xcf files to pnm files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
xcftopnm [-layer N] [xcffile]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a rough and slow implementation of a xcf2pnm filter, to be used
|
||||
by other programs that want to be able to read xcf images. If ussage
|
||||
increases this program will doubtlessly be sped up as well.
|
||||
|
||||
=head2 OPTIONS
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<-layer N>
|
||||
|
||||
Select the C<N>th layer, instead of flattening the whole image.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
$layer=(shift,shift) if $ARGV[0] =~ /^-(l|-?layer)$/;
|
||||
|
||||
if (@ARGV>1) {
|
||||
print "Usage: xcftopnm [-layer N] [xcffile]\n";
|
||||
exit(1);
|
||||
}
|
||||
|
||||
$tmpfile = "xcftopnm$$~";
|
||||
END { unlink $tmpfile }
|
||||
|
||||
if (@ARGV==0) {
|
||||
my $buff;
|
||||
open TMP,">$tmpfile" or die "Unable to open temporary file '$tmpfile' for writing: $!\n";
|
||||
binmode STDIN; binmode TMP;
|
||||
print TMP $buff while sysread STDIN,$buff,16384;
|
||||
close TMP;
|
||||
@ARGV = $tmpfile;
|
||||
}
|
||||
|
||||
Gimp::init("spawn/no-data");
|
||||
|
||||
$image = Gimp->xcf_load(0,($ARGV[0])x2);
|
||||
$layer = defined $layer ? ($image->get_layers)[$layer] : $image->flatten;
|
||||
$layer->file_pnm_save(($tmpfile)x2,1);
|
||||
|
||||
Gimp::deinit;
|
||||
|
||||
open TMP,"<$tmpfile" or die "Unable to open temporary file '$tmpfile' for reading: $!\n";
|
||||
binmode STDOUT; binmode TMP;
|
||||
print STDOUT $buff while sysread TMP,$buff,16384;
|
||||
close TMP;
|
||||
|
||||
Loading…
Reference in a new issue