Skip to content
GitLab
Commit bad20ffc authored by Marc Lehmann's avatar Marc Lehmann
Browse files

see plug-ins/perl/Changes

parent 165c69ff
Hide whitespace changes
Inline Side-by-side
plug-ins/perl/Changes
View file @ bad20ffc
......@@ -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!
......
plug-ins/perl/Gimp.pm
View file @ bad20ffc
......@@ -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];
......
plug-ins/perl/Gimp/Lib.xs
View file @ bad20ffc
......@@ -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 at least %d dimensions allowed", (*p)->ndims, ndims + (dim0 > 1));
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 + 1)
croak ("dimension mismatch, pdl has dimension %d but at most %d dimensions required", (*p)->ndims, ndims + 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 && (*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);
......
plug-ins/perl/Gimp/OO.pod
View file @ bad20ffc
......@@ -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_
......
plug-ins/perl/Gimp/UI.pm
View file @ bad20ffc
......@@ -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;
......
plug-ins/perl/MANIFEST
View file @ bad20ffc
......@@ -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
......
plug-ins/perl/TODO
View file @ bad20ffc
......@@ -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?`
......
plug-ins/perl/examples/border.pl
View file @ bad20ffc
......@@ -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
......
plug-ins/perl/examples/colourtoalpha
View file @ bad20ffc
......@@ -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);
......
plug-ins/perl/examples/gimpmagick
View file @ bad20ffc
......@@ -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) {
......
plug-ins/perl/examples/gouge
View file @ bad20ffc
......@@ -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);
......
plug-ins/perl/examples/logulator
View file @ bad20ffc
......@@ -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;
......
plug-ins/perl/examples/miff
View file @ bad20ffc
......@@ -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;
();
......
plug-ins/perl/examples/pixelmap
View file @ bad20ffc
......@@ -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;';
my($p,$x,$y,$bpp,$w,$h);
$expr = "sub{$init\n#line 1\n$expr;\n\$p}";
$_expr = "sub{$init\n#line 1\n$_expr\n;}";
my @bounds = $drawable->mask;
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);
......
plug-ins/perl/gimpdoc
View file @ bad20ffc
......@@ -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);