mirror of https://github.com/GNOME/gimp.git
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
0a4686ed96
commit
5aa638392c
|
|
@ -1,5 +1,12 @@
|
|||
Revision history for Gimp-Perl extension.
|
||||
|
||||
1.09
|
||||
- corrected PDL version check to work with version 2.001.
|
||||
- new file Net.xs, containing protocol serializer
|
||||
- new, faster and leaner protocol (bumped protocol version number).
|
||||
- added SvPV_nolen to ppport.h and made use of it everywhere.
|
||||
- renamed nolib => Module.
|
||||
|
||||
1.089 Tue May 18 19:55:25 CEST 1999
|
||||
- added colourtoalpha.
|
||||
- made all internal C functions static -> less namespace bloat.
|
||||
|
|
@ -14,8 +21,6 @@ Revision history for Gimp-Perl extension.
|
|||
- made my first attempt at implementing XS-PDL support.
|
||||
- transform obnjects ids of -1 into undef and vice versa.
|
||||
- Gimp::Fu did not properly supply a default value for PF_COLOUR.
|
||||
- :auto is NO LONGER the default for the import method(!).
|
||||
(NOT YET).
|
||||
|
||||
1.083 Wed May 12 03:36:10 CEST 1999
|
||||
- took a modified enums.pl to autogenerate constants. Some constants
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ use subs qw(init end lock unlock canonicalize_color);
|
|||
require DynaLoader;
|
||||
|
||||
@ISA=qw(DynaLoader);
|
||||
$VERSION = 1.089;
|
||||
$VERSION = 1.09;
|
||||
|
||||
@_param = qw(
|
||||
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
|
||||
|
|
@ -93,7 +93,7 @@ sub BLACK (){ 2 }
|
|||
sub _PS_FLAG_QUIET { 0000000001 }; # do not output messages
|
||||
sub _PS_FLAG_BATCH { 0000000002 }; # started via Gimp::Net, extra = filehandle
|
||||
|
||||
$_PROT_VERSION = "2"; # protocol version
|
||||
$_PROT_VERSION = "3"; # protocol version
|
||||
|
||||
# we really abuse the import facility..
|
||||
sub import($;@) {
|
||||
|
|
|
|||
|
|
@ -28,8 +28,10 @@
|
|||
# define GIMP_PARASITE 1
|
||||
#endif
|
||||
|
||||
#ifndef HAVE_EXIT
|
||||
/* expect iso-c here. */
|
||||
#include <signal.h>
|
||||
# include <signal.h>
|
||||
#endif
|
||||
|
||||
MODULE = Gimp PACKAGE = Gimp
|
||||
|
||||
|
|
|
|||
|
|
@ -55,6 +55,8 @@
|
|||
#define PKG_REGION GIMP_PKG "Region"
|
||||
#if GIMP_PARASITE
|
||||
# define PKG_PARASITE GIMP_PKG "Parasite"
|
||||
#else
|
||||
# define PKG_PARASITE ((char *)0)
|
||||
#endif
|
||||
|
||||
#define PKG_GDRAWABLE GIMP_PKG "GDrawable"
|
||||
|
|
@ -88,6 +90,7 @@ static void need_pdl (void)
|
|||
/* 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");
|
||||
|
||||
PDL = (Core*) SvIV(CoreSV);
|
||||
}
|
||||
}
|
||||
|
|
@ -254,8 +257,7 @@ static GTile *old_tile (SV *sv)
|
|||
/* magic stuff. literally. */
|
||||
static int gpixelrgn_free (SV *obj, MAGIC *mg)
|
||||
{
|
||||
STRLEN dc;
|
||||
GPixelRgn *pr = (GPixelRgn *)SvPV(obj,dc);
|
||||
GPixelRgn *pr = (GPixelRgn *)SvPV_nolen(obj);
|
||||
|
||||
/* automatically done on detach */
|
||||
/* if (pr->dirty)
|
||||
|
|
@ -269,10 +271,9 @@ MGVTBL vtbl_gpixelrgn = {0, 0, 0, 0, gpixelrgn_free};
|
|||
static SV *new_gpixelrgn (SV *gdrawable, int x, int y, int width, int height, int dirty, int shadow)
|
||||
{
|
||||
static HV *stash;
|
||||
STRLEN dc;
|
||||
MAGIC *mg;
|
||||
SV *sv = newSVn (sizeof (GPixelRgn));
|
||||
GPixelRgn *pr = (GPixelRgn *)SvPV(sv,dc);
|
||||
GPixelRgn *pr = (GPixelRgn *)SvPV_nolen(sv);
|
||||
|
||||
if (!(sv_derived_from (gdrawable, PKG_GDRAWABLE)))
|
||||
{
|
||||
|
|
@ -297,12 +298,10 @@ static SV *new_gpixelrgn (SV *gdrawable, int x, int y, int width, int height, in
|
|||
|
||||
static GPixelRgn *old_pixelrgn (SV *sv)
|
||||
{
|
||||
STRLEN dc;
|
||||
|
||||
if (!sv_derived_from (sv, PKG_PIXELRGN))
|
||||
croak ("argument is not of type " PKG_PIXELRGN);
|
||||
|
||||
return (GPixelRgn *)SvPV(SvRV(sv),dc);
|
||||
return (GPixelRgn *)SvPV_nolen(SvRV(sv));
|
||||
}
|
||||
|
||||
/* tracing stuff. */
|
||||
|
|
@ -540,7 +539,6 @@ dump_params (int nparams, GParam *args, GParamDef *params)
|
|||
static int
|
||||
convert_array2paramdef (AV *av, GParamDef **res)
|
||||
{
|
||||
STRLEN dc;
|
||||
int count = 0;
|
||||
GParamDef *def = 0;
|
||||
|
||||
|
|
@ -581,8 +579,8 @@ convert_array2paramdef (AV *av, GParamDef **res)
|
|||
}
|
||||
|
||||
def->type = SvIV (type);
|
||||
def->name = name ? SvPV (name, dc) : 0;
|
||||
def->description = help ? SvPV (help, dc) : 0;
|
||||
def->name = name ? SvPV_nolen (name) : 0;
|
||||
def->description = help ? SvPV_nolen (help) : 0;
|
||||
def++;
|
||||
}
|
||||
else
|
||||
|
|
@ -612,10 +610,7 @@ param_stash (GParamType type)
|
|||
0 , 0 , 0 , 0 , 0 ,
|
||||
PKG_COLOR , PKG_REGION , PKG_DISPLAY , PKG_IMAGE , PKG_LAYER ,
|
||||
PKG_CHANNEL , PKG_DRAWABLE , PKG_SELECTION , 0 , 0 ,
|
||||
#if GIMP_PARASITE
|
||||
PKG_PARASITE,
|
||||
#endif
|
||||
0
|
||||
PKG_PARASITE, 0
|
||||
};
|
||||
|
||||
if (bless [type] && !bless_hv [type])
|
||||
|
|
@ -634,6 +629,9 @@ autobless (SV *sv, int type)
|
|||
if (stash)
|
||||
sv = sv_bless (newRV_noinc (sv), stash);
|
||||
|
||||
if (stash && !SvOBJECT(SvRV(sv)))
|
||||
croak ("jupp\n");
|
||||
|
||||
return sv;
|
||||
}
|
||||
|
||||
|
|
@ -744,8 +742,7 @@ static int check_int (char *croak_str, SV *sv)
|
|||
{
|
||||
if (SvTYPE (sv) == SVt_PV && !SvIOKp(sv))
|
||||
{
|
||||
STRLEN dc;
|
||||
char *p = SvPV (sv, dc);
|
||||
char *p = SvPV_nolen (sv);
|
||||
|
||||
if (*p
|
||||
&& *p != '0' && *p != '1' && *p != '2' && *p != '3' && *p != '4'
|
||||
|
|
@ -875,7 +872,7 @@ push_gimp_sv (GParam *arg, int array_as_ref)
|
|||
PUTBACK;
|
||||
}
|
||||
|
||||
#define SvPv(sv) SvPV((sv), dc)
|
||||
#define SvPv(sv) SvPV_nolen(sv)
|
||||
#define Sv32(sv) unbless ((sv), PKG_ANY, croak_str)
|
||||
|
||||
#define av2gimp(arg,sv,datatype,type,svxv) { \
|
||||
|
|
@ -907,8 +904,6 @@ push_gimp_sv (GParam *arg, int array_as_ref)
|
|||
static int
|
||||
convert_sv2gimp (char *croak_str, GParam *arg, SV *sv)
|
||||
{
|
||||
STRLEN dc;
|
||||
|
||||
switch (arg->type)
|
||||
{
|
||||
case PARAM_INT32: check_int (croak_str, sv);
|
||||
|
|
@ -1104,7 +1099,6 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
|||
static int nreturn_vals;
|
||||
|
||||
dSP;
|
||||
STRLEN dc;
|
||||
|
||||
int i, count;
|
||||
char *err_msg = 0;
|
||||
|
|
@ -1174,7 +1168,7 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
|||
|
||||
if (SvTRUE (ERRSV))
|
||||
{
|
||||
if (strEQ ("IGNORE THIS MESSAGE\n", SvPV (ERRSV, dc)))
|
||||
if (strEQ ("IGNORE THIS MESSAGE\n", SvPV_nolen (ERRSV)))
|
||||
{
|
||||
nreturn_vals = 0;
|
||||
return_vals = g_new (GParam, 1);
|
||||
|
|
@ -1184,7 +1178,7 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
|||
*xreturn_vals = return_vals;
|
||||
}
|
||||
else
|
||||
err_msg = g_strdup (SvPV (ERRSV, dc));
|
||||
err_msg = g_strdup (SvPV_nolen (ERRSV));
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -1314,7 +1308,6 @@ int
|
|||
gimp_main(...)
|
||||
PREINIT:
|
||||
CODE:
|
||||
STRLEN dc;
|
||||
SV *sv;
|
||||
|
||||
if ((sv = perl_get_sv ("Gimp::help", FALSE)) && SvTRUE (sv))
|
||||
|
|
@ -1328,11 +1321,11 @@ gimp_main(...)
|
|||
{
|
||||
AV *av = perl_get_av ("ARGV", FALSE);
|
||||
|
||||
argv [argc++] = SvPV (perl_get_sv ("0", FALSE), dc);
|
||||
argv [argc++] = SvPV_nolen (perl_get_sv ("0", FALSE));
|
||||
if (av && av_len (av) < 10-1)
|
||||
{
|
||||
while (argc-1 <= av_len (av))
|
||||
argv [argc] = SvPV (*av_fetch (av, argc-1, 0), dc),
|
||||
argv [argc] = SvPV_nolen (*av_fetch (av, argc-1, 0)),
|
||||
argc++;
|
||||
}
|
||||
else
|
||||
|
|
@ -1629,12 +1622,11 @@ gimp_set_data(id, data)
|
|||
CODE:
|
||||
{
|
||||
STRLEN dlen;
|
||||
STRLEN dc;
|
||||
void *dta;
|
||||
|
||||
dta = SvPV (data, dlen);
|
||||
|
||||
gimp_set_data (SvPV (id, dc), dta, dlen);
|
||||
gimp_set_data (SvPV_nolen (id), dta, dlen);
|
||||
}
|
||||
|
||||
void
|
||||
|
|
@ -1644,14 +1636,13 @@ gimp_get_data(id)
|
|||
{
|
||||
SV *data;
|
||||
STRLEN dlen;
|
||||
STRLEN dc;
|
||||
|
||||
dlen = get_data_size (SvPV (id, dc));
|
||||
dlen = get_data_size (SvPV_nolen (id));
|
||||
/* I count on dlen being zero if "id" doesn't exist. */
|
||||
data = newSVpv ("", 0);
|
||||
gimp_get_data (SvPV (id, dc), SvGROW (data, dlen+1));
|
||||
gimp_get_data (SvPV_nolen (id), SvGROW (data, dlen+1));
|
||||
SvCUR_set (data, dlen);
|
||||
*((char *)SvPV (data, dc) + dlen) = 0;
|
||||
*((char *)SvPV_nolen (data) + dlen) = 0;
|
||||
XPUSHs (sv_2mortal (data));
|
||||
}
|
||||
|
||||
|
|
@ -1695,12 +1686,6 @@ gimp_tile_width()
|
|||
guint
|
||||
gimp_tile_height()
|
||||
|
||||
#if HAVE_PDL
|
||||
|
||||
void
|
||||
gimp_tile_flush(tile)
|
||||
GTile * tile
|
||||
|
||||
void
|
||||
gimp_tile_cache_size(kilobytes)
|
||||
gulong kilobytes
|
||||
|
|
@ -1709,6 +1694,8 @@ void
|
|||
gimp_tile_cache_ntiles(ntiles)
|
||||
gulong ntiles
|
||||
|
||||
#if HAVE_PDL
|
||||
|
||||
SV *
|
||||
gimp_drawable_get(drawable_ID)
|
||||
DRAWABLE drawable_ID
|
||||
|
|
@ -1743,19 +1730,6 @@ gimp_drawable_get_tile2(gdrawable, shadow, x, y)
|
|||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
void
|
||||
gimp_tile_ref(tile)
|
||||
GTile * tile
|
||||
|
||||
void
|
||||
gimp_tile_ref_zero(tile)
|
||||
GTile * tile
|
||||
|
||||
void
|
||||
gimp_tile_unref(tile, dirty)
|
||||
GTile * tile
|
||||
int dirty
|
||||
|
||||
SV *
|
||||
gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
|
||||
SV * gdrawable
|
||||
|
|
@ -2100,7 +2074,7 @@ gimp_tile_dirty(tile)
|
|||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
gint32
|
||||
DRAWABLE
|
||||
gimp_tile_drawable(tile)
|
||||
GTile *tile
|
||||
CODE:
|
||||
|
|
@ -2155,13 +2129,12 @@ gimp_patterns_get_pattern_data(name)
|
|||
SV * name
|
||||
PPCODE:
|
||||
{
|
||||
STRLEN dc;
|
||||
GParam *return_vals;
|
||||
int nreturn_vals;
|
||||
|
||||
return_vals = gimp_run_procedure ("gimp_patterns_get_pattern_data",
|
||||
&nreturn_vals,
|
||||
PARAM_STRING, SvPV (name, dc),
|
||||
PARAM_STRING, SvPV_nolen (name),
|
||||
PARAM_END);
|
||||
|
||||
if (nreturn_vals == 7
|
||||
|
|
|
|||
|
|
@ -12,7 +12,15 @@ use vars qw(
|
|||
$server_fh $trace_level $trace_res $auth $gimp_pid
|
||||
);
|
||||
use subs qw(gimp_call_procedure);
|
||||
use Socket; # IO::Socket is _really_ slow
|
||||
use base qw(DynaLoader);
|
||||
|
||||
use Socket; # IO::Socket is _really_ slow, so don't use it!
|
||||
|
||||
require DynaLoader;
|
||||
|
||||
$VERSION = $Gimp::VERSION;
|
||||
|
||||
bootstrap Gimp::Net $VERSION;
|
||||
|
||||
$default_tcp_port = 10009;
|
||||
$default_unix_dir = "/tmp/gimp-perl-serv-uid-$>/";
|
||||
|
|
@ -38,31 +46,6 @@ sub import {
|
|||
};
|
||||
}
|
||||
|
||||
# network to array
|
||||
sub net2args($) {
|
||||
no strict 'subs';
|
||||
sub b($$) { bless \(my $x=$_[0]),$_[1] }
|
||||
eval "($_[0])";
|
||||
}
|
||||
|
||||
sub args2net {
|
||||
my($res,$v);
|
||||
for $v (@_) {
|
||||
if(ref($v)) {
|
||||
if(ref($v) eq "ARRAY" or ref($v) eq Gimp::Color or ref($v) eq Gimp::Parasite) {
|
||||
$res.="[".join(",",map { "qq[".quotemeta($_)."]" } @$v)."],";
|
||||
} else {
|
||||
$res.="b(".$$v.",".ref($v)."),";
|
||||
}
|
||||
} elsif(defined $v) {
|
||||
$res.="qq[".quotemeta($v)."],";
|
||||
} else {
|
||||
$res.="undef,";
|
||||
}
|
||||
}
|
||||
substr($res,0,-1); # may not be worth the effort
|
||||
}
|
||||
|
||||
sub _gimp_procedure_available {
|
||||
my $req="TEST".$_[0];
|
||||
print $server_fh pack("N",length($req)).$req;
|
||||
|
|
|
|||
|
|
@ -96,3 +96,4 @@ examples/mirrorsplit
|
|||
examples/oneliners
|
||||
examples/randomart1
|
||||
examples/colourtoalpha
|
||||
|
||||
|
|
|
|||
|
|
@ -253,7 +253,7 @@ close C;
|
|||
print "ok\n";
|
||||
|
||||
$GIMP_INC_NOUI = "-I../../ $GIMP_INC_NOUI" if $IN_GIMP;
|
||||
@DIRS= 'Gimp';
|
||||
@DIRS= qw/Gimp Net/;
|
||||
|
||||
$build_module = $IN_GIMP || $ENV{GIMP_PERL_MODULE_INC};
|
||||
# temporarily disabled because of politics
|
||||
|
|
@ -263,7 +263,7 @@ print "building embedded perl module... ";
|
|||
if ($build_module) {
|
||||
print "yes\n";
|
||||
$dont_embed = "false";
|
||||
push(@DIRS,'nolib');
|
||||
push(@DIRS,'Module');
|
||||
print "configuring in embed/Makefile...\n";
|
||||
system("cd embed && perl Makefile.PL");
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,20 @@
|
|||
use ExtUtils::MakeMaker;
|
||||
|
||||
do '../config.pl';
|
||||
|
||||
sub MY::postamble {
|
||||
<<"EOF";
|
||||
clean ::
|
||||
test -f Makefile || mv -f Makefile.old Makefile
|
||||
EOF
|
||||
}
|
||||
|
||||
$GIMP_INC_NOUI = "-I../../.. $GIMP_INC_NOUI" if $IN_GIMP;
|
||||
|
||||
WriteMakefile(
|
||||
'NAME' => 'Gimp::Net',
|
||||
'VERSION_FROM' => '../Gimp.pm',
|
||||
'INC' => "$INC1 $CPPFLAGS $pdl_inc $CFLAGS",
|
||||
'DEFINE' => "$DEFINE1 $DEFS",
|
||||
'TYPEMAPS' => ["$topdir/typemap",@pdl_typemaps],
|
||||
);
|
||||
|
|
@ -0,0 +1,190 @@
|
|||
#include "config.h"
|
||||
|
||||
/* dunno where this comes from */
|
||||
#undef VOIDUSED
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#define NEED_newCONSTSUB
|
||||
#include "ppport.h"
|
||||
|
||||
#if HAVE_PDL
|
||||
|
||||
# include <pdlcore.h>
|
||||
# undef croak
|
||||
# define croak Perl_croak
|
||||
|
||||
/* hack, undocumented, argh! */
|
||||
static Core* PDL; /* Structure hold core C functions */
|
||||
|
||||
/* get pointer to PDL structure. */
|
||||
static void need_pdl (void)
|
||||
{
|
||||
SV *CoreSV;
|
||||
|
||||
if (!PDL)
|
||||
{
|
||||
/* 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");
|
||||
|
||||
PDL = (Core*) SvIV(CoreSV);
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* allocate this much as initial length */
|
||||
#define INITIAL_PV 256
|
||||
/* and increment in these steps */
|
||||
#define PV_INC 512
|
||||
|
||||
/* types
|
||||
*
|
||||
* u undef
|
||||
* a num sv* array
|
||||
* p len cont pv
|
||||
* i int iv
|
||||
* b stash sv blessed reference
|
||||
* r simple reference
|
||||
* h len (key sv)* hash (not yet supported!)
|
||||
* p piddle (not yet supported!)
|
||||
*
|
||||
*/
|
||||
|
||||
static void sv2net (SV *s, SV *sv)
|
||||
{
|
||||
if (SvLEN(sv)-SvCUR(sv) < 96)
|
||||
SvGROW (sv, SvLEN(sv) + PV_INC);
|
||||
|
||||
if (SvROK(sv))
|
||||
{
|
||||
SV *rv = SvRV(sv);
|
||||
if (SvOBJECT (rv))
|
||||
{
|
||||
char *name = HvNAME (SvSTASH (rv));
|
||||
|
||||
sv_catpvf (s, "b%x:%s", strlen (name), name);
|
||||
}
|
||||
else
|
||||
sv_catpvn (s, "r", 1);
|
||||
|
||||
if (SvTYPE(rv) == SVt_PVAV)
|
||||
{
|
||||
AV *av = (AV*)rv;
|
||||
int i;
|
||||
|
||||
sv_catpvf (s, "a%x:", (int)av_len(av));
|
||||
for (i = 0; i <= av_len(av); i++)
|
||||
sv2net (s, *av_fetch(av,i,0));
|
||||
}
|
||||
else if (SvTYPE(rv) == SVt_PVMG)
|
||||
sv2net (s, rv);
|
||||
else
|
||||
croak ("Internal error: unable to convert reference in sv2net, please report!");
|
||||
}
|
||||
else if (SvOK(sv))
|
||||
{
|
||||
if (SvTYPE(sv) == SVt_IV)
|
||||
sv_catpvf (s,"i%ld:", (long)SvIV(sv));
|
||||
else
|
||||
{
|
||||
char *str;
|
||||
STRLEN len;
|
||||
|
||||
/* slower than necessary, just make it an pv */
|
||||
str = SvPV(sv,len);
|
||||
sv_catpvf (s, "p%x:", (int)len);
|
||||
sv_catpvn (s, str, len);
|
||||
}
|
||||
}
|
||||
else
|
||||
sv_catpvn (s, "u", 1);
|
||||
}
|
||||
|
||||
static SV *net2sv (char **_s)
|
||||
{
|
||||
char *s = *_s;
|
||||
SV *sv;
|
||||
AV *av;
|
||||
unsigned int ui, n;
|
||||
long l;
|
||||
char str[64];
|
||||
|
||||
switch (*s++)
|
||||
{
|
||||
case 'u':
|
||||
sv = newSVsv (&PL_sv_undef);
|
||||
break;
|
||||
|
||||
case 'i':
|
||||
sscanf (s, "%ld:%n", &l, &n); s += n;
|
||||
sv = newSViv ((IV)l);
|
||||
break;
|
||||
|
||||
case 'p':
|
||||
sscanf (s, "%x:%n", &ui, &n); s += n;
|
||||
sv = newSVpvn (s, (STRLEN)ui);
|
||||
s += ui;
|
||||
break;
|
||||
|
||||
case 'r':
|
||||
sv = newRV_noinc (net2sv (&s));
|
||||
break;
|
||||
|
||||
case 'b':
|
||||
sscanf (s, "%x:%n", &ui, &n); s += n;
|
||||
if (ui >= sizeof str)
|
||||
croak ("Internal error: stashname too long, please report!");
|
||||
|
||||
memcpy (str, s, ui); s += ui;
|
||||
str[ui] = 0;
|
||||
sv = sv_bless (newRV_noinc (net2sv (&s)), gv_stashpv (str, 1));
|
||||
break;
|
||||
|
||||
case 'a':
|
||||
sscanf (s, "%x:%n", &ui, &n); s += n;
|
||||
av = newAV ();
|
||||
av_extend (av, ui);
|
||||
for (n = 0; n <= ui; n++)
|
||||
av_store (av, n, net2sv (&s));
|
||||
|
||||
sv = (SV*)av;
|
||||
break;
|
||||
|
||||
default:
|
||||
croak ("Internal error: unable to handle argtype '%c' in net2sv, please report!", s[-1]);
|
||||
}
|
||||
|
||||
*_s = s;
|
||||
return sv;
|
||||
}
|
||||
|
||||
MODULE = Gimp::Net PACKAGE = Gimp::Net
|
||||
|
||||
PROTOTYPES: ENABLE
|
||||
|
||||
SV *
|
||||
args2net(...)
|
||||
CODE:
|
||||
int index;
|
||||
|
||||
RETVAL = newSVpv ("", 0);
|
||||
(void) SvUPGRADE (RETVAL, SVt_PV);
|
||||
SvGROW (RETVAL, INITIAL_PV);
|
||||
|
||||
for (index = 0; index < items; index++)
|
||||
sv2net (RETVAL, ST(index));
|
||||
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
void
|
||||
net2args(s)
|
||||
char * s
|
||||
PPCODE:
|
||||
/* this depends on a trailing zero! */
|
||||
while (*s)
|
||||
XPUSHs (sv_2mortal (net2sv (&s)));
|
||||
|
||||
|
|
@ -10,6 +10,10 @@ make test TEST_VERBOSE=1
|
|||
|
||||
bugs
|
||||
|
||||
* KILL :auto from default(!)
|
||||
* gimp-piddle must be written back automatically on destroy, if changed
|
||||
* possibly rename "Brush Selection" to "Paint Settings"
|
||||
* gimp-tile set dirty automatically(!)
|
||||
* fatal errors in config.pl (!)
|
||||
* disable module build (EMBEDMYALLOC)
|
||||
[DONE] * turn -1 into undef and vice versa.
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ sub MY::const_loadlibs {
|
|||
sub MY::install {
|
||||
<<EOF;
|
||||
install :: all \$(INST_DYNAMIC)
|
||||
\$(RM_F) \$(gimpplugindir)/modules/\$(DLBASE).\$(DLEXT)
|
||||
\$(CP) \$(INST_DYNAMIC) \$(gimpplugindir)/modules/\$(DLBASE).\$(DLEXT)
|
||||
\$(CHMOD) 755 \$(gimpplugindir)/modules/\$(DLBASE).\$(DLEXT)
|
||||
|
||||
|
|
|
|||
|
|
@ -82,8 +82,9 @@ $cfg{_DEFS} = $DEFS;
|
|||
$INC1 = "-I$topdir";
|
||||
$DEFINE1 = $IN_GIMP ? "-DIN_GIMP" : "";
|
||||
|
||||
eval "use PDL;";
|
||||
eval "use PDL";
|
||||
if (!$@) {
|
||||
require PDL::Version;
|
||||
if ($PDL::Version::VERSION > 1.99) {
|
||||
require PDL::Core::Dev;
|
||||
if (!$@) {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,80 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use Gimp::Feature 'pdl';
|
||||
use Gimp 1.084;
|
||||
use Gimp::Fu;
|
||||
use Gimp::Util;
|
||||
use PDL::LiteF;
|
||||
|
||||
register "colour_to_alpha",
|
||||
"Converts the specified colour to alpha",
|
||||
"This replaces as much as possible of the specified colour in each pixel by a corresponding "
|
||||
."amount of alpha, then readjusts the colour accordingly.",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"19990517",
|
||||
"<Image>/Filters/Colors/Colour To Alpha",
|
||||
"RGB*",
|
||||
[
|
||||
[PF_COLOR, "colour", , "The colour to replace"],
|
||||
],
|
||||
sub { # es folgt das eigentliche Skript...
|
||||
my($image,$drawable,$colour)=@_;
|
||||
|
||||
$drawable->layer or die "colour_to_alpha only works with layers\n";
|
||||
$drawable->add_alpha unless $drawable->has_alpha;
|
||||
|
||||
Gimp->progress_init ("Replacing colour...");
|
||||
|
||||
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);
|
||||
|
||||
$iter = Gimp->pixel_rgns_register ($src, $dst);
|
||||
|
||||
do {
|
||||
# get the pixels ($pixels will be modified in-place!)
|
||||
$pixels = $src->data;
|
||||
|
||||
# extract the rgb portion only
|
||||
$rgb = $pixels->slice("0:2");
|
||||
|
||||
# calculate difference to destination colour
|
||||
$diff = 255 + minimum $rgb - pdl $colour;
|
||||
|
||||
# adjust alpha part
|
||||
my $alpha = $pixels->slice("(3)");
|
||||
$alpha .= 255-$diff;
|
||||
|
||||
# adjust the colour
|
||||
my $a = ($diff/(255**2))->slice("*3") * pdl $colour;
|
||||
$rgb .= 255-(255-$rgb) / (1-$a);
|
||||
|
||||
# write the pixels into dst
|
||||
$dst->data($pixels);
|
||||
|
||||
Gimp->progress_update (($src->y-$bounds[1])/$bounds[2]);
|
||||
} while (Gimp->pixel_rgns_process ($iter));
|
||||
}
|
||||
Gimp->progress_update (1);
|
||||
|
||||
$drawable->merge_shadow (1);
|
||||
$drawable->update ($drawable->mask);
|
||||
|
||||
(); # wir haben kein neues Bild erzeugt
|
||||
};
|
||||
|
||||
exit main;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
Makefile
|
||||
pm_to_blib
|
||||
Module.c
|
||||
Module.bs
|
||||
|
|
@ -2,7 +2,7 @@
|
|||
#ifndef _P_P_PORTABILITY_H_
|
||||
#define _P_P_PORTABILITY_H_
|
||||
|
||||
/* Perl/Pollution/Portability Version 1.0007 */
|
||||
/* Perl/Pollution/Portability Version 1.0007-gimp-1 */
|
||||
|
||||
/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
|
||||
distributed under the same license as any version of Perl. */
|
||||
|
|
@ -283,5 +283,9 @@ SV *sv;
|
|||
|
||||
#endif /* newCONSTSUB */
|
||||
|
||||
/*GIMP*/
|
||||
#ifndef SvPV_nolen
|
||||
# define SvPV_nolen(b) SvPV((b),PL_na)
|
||||
#endif
|
||||
|
||||
#endif /* _P_P_PORTABILITY_H_ */
|
||||
|
|
|
|||
|
|
@ -52,5 +52,8 @@ OUTPUT
|
|||
T_PREF
|
||||
$arg = autobless (newSViv($var), PARAM_$ntype);
|
||||
|
||||
T_PREF_ANY
|
||||
$arg = autobless (newSViv($var), PARAM_$ntype);
|
||||
|
||||
T_GDRAWABLE
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue