Skip to content

GitLab

Commit 8b0cef83 authored by Marc Lehmann's avatar Marc Lehmann
Browse files

see plug-ins/perl/Changes

parent fcb24402
Hide whitespace changes
Inline Side-by-side
plug-ins/perl/Changes
View file @ 8b0cef83
......@@ -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!
......
plug-ins/perl/Gimp.pm
View file @ 8b0cef83
......@@ -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])};
......
plug-ins/perl/Gimp/Fu.pm
View file @ 8b0cef83
......@@ -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]=~/^<Image>/ ? (&Gimp::RUN_FULLINTERACTIVE,undef,undef,@args)
: (&Gimp::RUN_INTERACTIVE,@args)
: (&Gimp::RUN_NONINTERACTIVE,@args));
}
};
# the <Image> 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=~/^<Image>\//) {
$type=&Gimp::PROC_PLUG_IN;
unshift(@$params,@image_params);
} elsif ($menupath=~/^<Load>\//) {
$type=&Gimp::PROC_PLUG_IN;
unshift(@$params,@load_params);
unshift(@$results,@load_retvals);
} elsif ($menupath=~/^<Save>\//) {
$type=&Gimp::PROC_PLUG_IN;
unshift(@$params,@save_params);
} elsif ($menupath=~/^<Toolbox>\//) {
$type=&Gimp::PROC_EXTENSION;
} elsif ($menupath=~/^<None>/) {
$type=&Gimp::PROC_EXTENSION;
$menupath=undef;
} else {
die "menupath _must_ start with <Image>, <Toolbox> or <None>!";
die "menupath _must_ start with <Image>, <Toolbox>, <Load>, <Save> or <None>!";
}
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<perl_fu_>-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<perl_fu_>-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=~/^<Image>\//) {
@_ >= 2 or die "<Image> plug-in called without both image and drawable arguments!\n";
@pre = (shift,shift);
} elsif ($menupath=~/^<Toolbox>\//) {
} elsif ($menupath=~/^<Toolbox>\// or !defined $menupath) {
# valid ;)
} elsif ($menupath=~/^<(?:Load|Save)>\//) {
@_ >= 4 or die "<Load/Save> plug-in called without the 5 standard arguments!\n";
@pre = (shift,shift,shift,shift);
} else {
die "menupath _must_ start with <Image> or <Toolbox>!";
die "menupath _must_ start with <Image>, <Toolbox>, <Load> or <Save>!";
}
if (@defaults) {
......
plug-ins/perl/Gimp/Lib.xs
View file @ 8b0cef83
......@@ -19,10 +19,15 @@
#undef MAX
#if HAVE_PDL
#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
......@@ -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
plug-ins/perl/Gimp/Net.pm
View file @ 8b0cef83
......@@ -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');
......
plug-ins/perl/Gimp/Pod.pm
View file @ 8b0cef83
package Gimp::Pod;
use Config;
$VERSION=$Gimp::VERSION;
sub myqx(&) {
......@@ -16,13 +14,18 @@ sub myqx(&) {
}
sub find_converters {
my $path = $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) } };
my $path = eval 'use Config; $Config{installscript}';
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//;