Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
GNOME
GIMP
Commits
8b0cef83
Commit
8b0cef83
authored
Jul 28, 1999
by
Marc Lehmann
Browse files
see plug-ins/perl/Changes
parent
fcb24402
Changes
22
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
)
{