mirror of https://github.com/GNOME/gimp.git
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
98dcea4838
commit
0aaaba09c5
|
|
@ -10,7 +10,7 @@ Revision history for Gimp-Perl extension.
|
|||
- fixed pager bug in gimpdoc.
|
||||
- cleaned filehandle handling in Gimp/Net.pm.
|
||||
- streamlined config code again.
|
||||
- updated examples/parasite-editor.
|
||||
- updated examples/parasite-editor and examples/mirrorsplit.
|
||||
|
||||
1.091 Sun May 23 13:21:34 CEST 1999
|
||||
- include a fake typemap.pdl.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,45 @@
|
|||
package Gimp::Config;
|
||||
|
||||
=cut
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Gimp::Config - config options found during configure time.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The Gimp::Config module creates a tied hash %Gimp::Config which contains
|
||||
all the definitions the configure script and perl deduced from the system
|
||||
configuration at configure time. You can access these values just like you
|
||||
access any other values, i.e. C<$Gimp::Config{KEY}>. Some important keys are:
|
||||
|
||||
IN_GIMP => true when gimp-perl was part of the Gimp distribution.
|
||||
GIMP => the path of the gimp executable
|
||||
prefix => the installation prefix
|
||||
libdir => the gimp systemwide libdir
|
||||
bindir => paths where gimp binaries are installed
|
||||
gimpplugindir => the gimp plug-in directory (without the /plug-ins-suffix)
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Gimp>.
|
||||
|
||||
=cut
|
||||
|
||||
sub TIEHASH {
|
||||
my $pkg = shift;
|
||||
my $self;
|
||||
|
||||
bless \$self, $pkg;
|
||||
}
|
||||
|
||||
sub FETCH {
|
||||
$cfg{$_[1]};
|
||||
}
|
||||
|
||||
tie %Gimp::Config, 'Gimp::Config';
|
||||
|
||||
%cfg = (
|
||||
#CFG#);
|
||||
|
||||
1;
|
||||
|
|
@ -502,6 +502,7 @@ sub interact($$$$@) {
|
|||
$button = new Gtk::Button "Cancel";
|
||||
signal_connect $button "clicked", sub {hide $w; main_quit Gtk};
|
||||
$w->action_area->pack_start($button,1,1,0);
|
||||
can_default $button 1;
|
||||
|
||||
$res=0;
|
||||
|
||||
|
|
|
|||
|
|
@ -224,8 +224,6 @@ static SV *new_gdrawable (gint32 id)
|
|||
|
||||
static GDrawable *old_gdrawable (SV *sv)
|
||||
{
|
||||
MAGIC *mg;
|
||||
|
||||
if (!(sv_derived_from (sv, PKG_GDRAWABLE)))
|
||||
croak ("argument is not of type " PKG_GDRAWABLE);
|
||||
|
||||
|
|
@ -259,8 +257,7 @@ static GTile *old_tile (SV *sv)
|
|||
/* magic stuff. literally. */
|
||||
static int gpixelrgn_free (SV *obj, MAGIC *mg)
|
||||
{
|
||||
GPixelRgn *pr = (GPixelRgn *)SvPV_nolen(obj);
|
||||
|
||||
/* GPixelRgn *pr = (GPixelRgn *)SvPV_nolen(obj); */
|
||||
/* automatically done on detach */
|
||||
/* if (pr->dirty)
|
||||
gimp_drawable_flush (pr->drawable);*/
|
||||
|
|
@ -273,7 +270,6 @@ 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;
|
||||
MAGIC *mg;
|
||||
SV *sv = newSVn (sizeof (GPixelRgn));
|
||||
GPixelRgn *pr = (GPixelRgn *)SvPV_nolen(sv);
|
||||
|
||||
|
|
@ -1747,19 +1743,14 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
|
|||
RETVAL
|
||||
|
||||
void
|
||||
gimp_pixel_rgn_resize(sv, x, y, width, height)
|
||||
SV * sv
|
||||
gimp_pixel_rgn_resize(pr, x, y, width, height)
|
||||
GPixelRgn * pr
|
||||
int x
|
||||
int y
|
||||
int width
|
||||
int height
|
||||
CODE:
|
||||
{
|
||||
GPixelRgn *pr = old_pixelrgn (sv);
|
||||
HV *hv = (HV*)SvRV(sv);
|
||||
|
||||
gimp_pixel_rgn_resize (pr, x, y, width, height);
|
||||
}
|
||||
|
||||
pdl *
|
||||
gimp_pixel_rgn_get_pixel(pr, x, y)
|
||||
|
|
@ -2102,7 +2093,7 @@ gimp_tile_set_data(tile,data)
|
|||
GTile * tile
|
||||
SV * data
|
||||
CODE:
|
||||
croak ("gimp_tile_set_data is not yet implemented\n");
|
||||
croak ("gimp_tile_set_data is not yet implemented\n"); (void *)data;
|
||||
gimp_tile_ref_zero (tile);
|
||||
gimp_tile_unref (tile, 1);
|
||||
|
||||
|
|
|
|||
|
|
@ -138,15 +138,14 @@ sub start_server {
|
|||
my $opt = shift;
|
||||
$opt = $Gimp::spawn_opts unless $opt;
|
||||
print "trying to start gimp with options \"$opt\"\n" if $Gimp::verbose;
|
||||
$server_fh=local *FH;
|
||||
my $gimp_fh=local *FH;
|
||||
$server_fh=local *SERVER_FH;
|
||||
my $gimp_fh=local *CLIENT_FH;
|
||||
socketpair $server_fh,$gimp_fh,PF_UNIX,SOCK_STREAM,AF_UNIX
|
||||
or socketpair $server_fh,$gimp_fh,PF_UNIX,SOCK_STREAM,PF_UNSPEC
|
||||
or croak "unable to create socketpair for gimp communications: $!";
|
||||
$gimp_pid = fork;
|
||||
if ($gimp_pid > 0) {
|
||||
Gimp::ignore_functions(@Gimp::gimp_gui_functions);
|
||||
close $gimp_fh;
|
||||
Gimp::ignore_functions(@Gimp::gimp_gui_functions) unless $opt=~s/(^|:)gui//;
|
||||
return $server_fh;
|
||||
} elsif ($gimp_pid == 0) {
|
||||
close $server_fh;
|
||||
|
|
@ -250,7 +249,7 @@ sub gimp_init {
|
|||
sub gimp_end {
|
||||
$initialized = 0;
|
||||
|
||||
close $server_fh if $server_fh;
|
||||
#close $server_fh if $server_fh;
|
||||
undef $server_fh;
|
||||
kill 'KILL',$gimp_pid if $gimp_pid;
|
||||
undef $gimp_pid;
|
||||
|
|
|
|||
|
|
@ -43,6 +43,7 @@ Gimp/Feature.pm
|
|||
Gimp/Pod.pm
|
||||
Gimp/Module.pm
|
||||
Gimp/Compat.pm
|
||||
Gimp/Config.pm.in
|
||||
embed/Makefile.PL
|
||||
embed/perlmod.c
|
||||
Module/Makefile.PL
|
||||
|
|
@ -98,4 +99,5 @@ examples/mirrorsplit
|
|||
examples/oneliners
|
||||
examples/randomart1
|
||||
examples/colourtoalpha
|
||||
examples/pixelmap
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ $|=1;
|
|||
sethspin.pl animate_cells image_tile yinyang stamps font_table
|
||||
perlotine randomblends innerbevel fit-text guidegrid roundrectsel
|
||||
repdup centerguide stampify goldenmean triangle billboard mirrorsplit
|
||||
oneliners randomart1
|
||||
oneliners randomart1 pixelmap
|
||||
);
|
||||
@shebang = (map("examples/$_",@examples),
|
||||
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
|
||||
|
|
@ -35,6 +35,7 @@ if ($ARGV[0] ne "--writemakefile") {
|
|||
$ENV{IN_GIMP}=0;
|
||||
exit system("./etc/configure",@ARGV)>>8;
|
||||
} else {
|
||||
shift;
|
||||
local $do_config_msg = 1;
|
||||
do './config.pl'; die $@ if $@;
|
||||
}
|
||||
|
|
@ -177,62 +178,6 @@ install-plugins ::
|
|||
";
|
||||
}
|
||||
|
||||
print "writing Gimp/Config.pm...";
|
||||
|
||||
open C,">Gimp/Config.pm" or die "Gimp/Config.pm: $!\n";
|
||||
print C <<'EOF';
|
||||
package Gimp::Config;
|
||||
|
||||
=cut
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Gimp::Config - config options found during configure time.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The Gimp::Config module creates a tied hash %Gimp::Config which contains
|
||||
all the definitions the configure script and perl deduced from the system
|
||||
configuration at configure time. You can access these values just like you
|
||||
access any other values, i.e. C<$Gimp::Config{KEY}>. Some important keys are:
|
||||
|
||||
IN_GIMP => true when gimp-perl was part of the Gimp distribution.
|
||||
GIMP => the path of the gimp executable
|
||||
prefix => the installation prefix
|
||||
libdir => the gimp systemwide libdir
|
||||
bindir => paths where gimp binaries are installed
|
||||
gimpplugindir => the gimp plug-in directory (without the /plug-ins-suffix)
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Gimp>.
|
||||
|
||||
=cut
|
||||
|
||||
sub TIEHASH {
|
||||
my $pkg = shift;
|
||||
my $self;
|
||||
|
||||
bless \$self, $pkg;
|
||||
}
|
||||
|
||||
sub FETCH {
|
||||
$cfg{$_[1]};
|
||||
}
|
||||
|
||||
tie %Gimp::Config, 'Gimp::Config';
|
||||
|
||||
%cfg = (
|
||||
EOF
|
||||
for $k (keys(%cfg)) {
|
||||
$v = $cfg{$k};
|
||||
print C " $k => \"",quotemeta(expand($v)),"\",\n";
|
||||
}
|
||||
print C ");\n\n1;\n";
|
||||
close C;
|
||||
|
||||
print "ok\n";
|
||||
|
||||
$GIMP_INC_NOUI = "-I../../ $GIMP_INC_NOUI" if $IN_GIMP;
|
||||
@DIRS= qw/Gimp Net/;
|
||||
|
||||
|
|
@ -252,6 +197,24 @@ if ($build_module) {
|
|||
$dont_embed = "true";
|
||||
}
|
||||
|
||||
print "writing Gimp/Config.pm... ";
|
||||
{
|
||||
sub conf_eval {
|
||||
my $v = expand($cfg{$_[0]});
|
||||
$v =~ s/([\\\]])/\\$1/g;
|
||||
$v;
|
||||
}
|
||||
local $/,*FH;
|
||||
open FH,"<Gimp/Config.pm.in" or die "Gimp/Config.pm.in: $!\n";
|
||||
my $cfg = <FH>;
|
||||
$cfg =~ s/#CFG#/join "",
|
||||
map sprintf(" %-20s => q[%s],\n",$_,conf_eval $_),
|
||||
keys %cfg/e;
|
||||
open FH,">Gimp/Config.pm" or die "Gimp/Config.pm: $!\n";
|
||||
print(FH $cfg)>0 or die "Gimp/Config.pm: $!\n";
|
||||
}
|
||||
print "ok\n";
|
||||
|
||||
WriteMakefile(
|
||||
'dist' => {
|
||||
PREOP => 'chmod -R u=rwX,go=rX . ;',
|
||||
|
|
@ -285,7 +248,7 @@ WriteMakefile(
|
|||
'DEFINE' => "$DEFINE1 $DEFS",
|
||||
'EXE_FILES' => ['scm2perl','scm2scm','gimpdoc'],
|
||||
'macro' => \%cfg,
|
||||
'realclean' => { FILES => "config.status config.cache config.log config.pl config.h Gimp/Config.pm" },
|
||||
'realclean' => { FILES => "config.status config.cache config.pl config.log config.h Gimp/Config.pm" },
|
||||
'clean' => { FILES => "Makefile.old stamp-h" },
|
||||
);
|
||||
|
||||
|
|
@ -297,6 +260,7 @@ Hopefully, Gimp is now correctly configured. you can now enter "make",
|
|||
|
||||
EOF
|
||||
|
||||
__END__
|
||||
# write an empty makefile (the last chance to stop)
|
||||
# and warn the user.
|
||||
sub not_halt {
|
||||
|
|
@ -308,8 +272,9 @@ all install check:
|
|||
clean mostlyclean objclean:
|
||||
|
||||
distclean maintainer-clean realclean clobber: clean
|
||||
rm -f Makefile config.cache config.pl config.log config.h config.status stamp-h Makefile.old
|
||||
rm -rf test-dir inst-temp Gimp/Config.pm
|
||||
\$(RM_F) Makefile config.cache config.pl config.log
|
||||
\$(RM_F) config.h config.status stamp-h Makefile.old Gimp/Config.pm
|
||||
\$(RM_RF) test-dir inst-temp
|
||||
EOF
|
||||
close MAKEFILE;
|
||||
exit;
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ make test TEST_VERBOSE=1
|
|||
|
||||
bugs
|
||||
|
||||
* --enable-perl=/tmp/leckmich
|
||||
* Kommandozeilenmodus(!).
|
||||
* don't start gimp in cmdline mode and error.
|
||||
* KILL :auto from default(!)
|
||||
|
|
|
|||
|
|
@ -16,8 +16,6 @@ $^W=0;
|
|||
libdir => q[@libdir@],
|
||||
bindir => q[@bindir@],
|
||||
|
||||
IN_GIMP => q[@IN_GIMP@],
|
||||
|
||||
_PERL => q[@PERL@],
|
||||
GIMP => q[@GIMP@],
|
||||
|
||||
|
|
@ -32,6 +30,14 @@ $^W=0;
|
|||
gimpplugindir => q[@gimpplugindir@],
|
||||
|
||||
_EXTENSIVE_TESTS => q[@EXTENSIVE_TESTS@],
|
||||
|
||||
IN_GIMP => q[@IN_GIMP@],
|
||||
top_builddir => q[@top_builddir@],
|
||||
|
||||
pdl_inc => '',
|
||||
pdl_typemaps => '',
|
||||
INC1 => '',
|
||||
DEFINE1 => '',
|
||||
);
|
||||
|
||||
sub expand {
|
||||
|
|
@ -50,34 +56,25 @@ while (($k,$v)=each(%cfg)) {
|
|||
$$k=$v;
|
||||
}
|
||||
|
||||
$GIMP = $bindir."/gimp" if $IN_GIMP;
|
||||
|
||||
$GIMP = expand($GIMP);
|
||||
$GIMPTOOL = expand($GIMPTOOL);
|
||||
|
||||
if ($IN_GIMP) {
|
||||
$GIMP = $bindir."/gimp" if $IN_GIMP;
|
||||
$GIMP_PREFIX=expand($prefix);
|
||||
} else {
|
||||
chomp ($GIMP_PREFIX = `$GIMPTOOL --prefix`);
|
||||
$gimpplugindir = `$GIMPTOOL -n --install-admin-bin /bin/sh`;
|
||||
$gimpplugindir =~ s{^.*\s(.*?)(?:/+bin/sh)\r?\n?$}{$1} &&
|
||||
$gimpplugindir =~ s{/plug-ins$}{} or die "\nFATAL: unable to deduce plugindir from gimptool script\n\n";
|
||||
$GIMP = expand($GIMP);
|
||||
}
|
||||
|
||||
|
||||
$GIMP_INC =~ s%\$topdir%$topdir%g;
|
||||
$GIMP_INC_NOUI =~ s%\$topdir%$topdir%g;
|
||||
$GIMP_LIBS =~ s%\$topdir%$topdir%g;
|
||||
$GIMP_LIBS_NOUI =~ s%\$topdir%$topdir%g;
|
||||
|
||||
if ($IN_GIMP) {
|
||||
$GIMP_PREFIX=expand($prefix);
|
||||
} else {
|
||||
$GIMP_PREFIX = `$GIMPTOOL --prefix`;
|
||||
chomp $GIMP_PREFIX;
|
||||
}
|
||||
|
||||
$cfg{GIMP_PREFIX}=$GIMP_PREFIX;
|
||||
$cfg{GIMP_PATH} =$GIMP;
|
||||
|
||||
if (!$IN_GIMP) {
|
||||
$cfg{gimpplugindir} = `$GIMPTOOL -n --install-admin-bin /bin/sh`;
|
||||
$cfg{gimpplugindir} =~ s{^.*\s(.*?)(?:/+bin/sh)\r?\n?$}{$1} &&
|
||||
$cfg{gimpplugindir} =~ s{/plug-ins$}{} or die "\nFATAL: unable to deduce plugindir from gimptool script\n\n";
|
||||
}
|
||||
|
||||
$cfg{_DEFS} = $DEFS;
|
||||
|
||||
# $...1 variables should be put in front of the corresponding MakeMaker values.
|
||||
$INC1 = "-I$topdir";
|
||||
$DEFINE1 = $IN_GIMP ? "-DIN_GIMP" : "";
|
||||
|
|
@ -123,13 +120,23 @@ if ($PDL) {
|
|||
$do_config_msg && print "checking for PDL include path... ",&PDL::Core::Dev::PDL_INCLUDE,"\n";
|
||||
$do_config_msg && print "checking for PDL typemap... ",&PDL::Core::Dev::PDL_TYPEMAP,"\n";
|
||||
|
||||
$cfg{pdl_inc} = $pdl_inc = &PDL::Core::Dev::PDL_INCLUDE;
|
||||
$cfg{pdl_typemaps} = "@{[@pdl_typemaps = &PDL::Core::Dev::PDL_TYPEMAP]}";
|
||||
$pdl_inc = $pdl_inc = &PDL::Core::Dev::PDL_INCLUDE;
|
||||
$pdl_typemaps = "@{[@pdl_typemaps = &PDL::Core::Dev::PDL_TYPEMAP]}";
|
||||
$DEFINE1 .= " -DHAVE_PDL=1";
|
||||
} else {
|
||||
@pdl_typemaps = "$topdir/typemap.pdl";
|
||||
}
|
||||
|
||||
$cfg{INC1} = $INC1;
|
||||
$cfg{DEFINE1} = $DEFINE1;
|
||||
for(keys %cfg) {
|
||||
($k=$_)=~s/^_//;
|
||||
$cfg{$_}=$$k;
|
||||
}
|
||||
|
||||
sub MY::makefile {
|
||||
package MY;
|
||||
my $t = shift->SUPER::makefile(@_);
|
||||
$t =~ s/^ false$/ true/m;
|
||||
$t;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use Gimp::Feature 'pdl';
|
||||
use Gimp 1.084;
|
||||
use Gimp 1.091;
|
||||
use Gimp::Fu;
|
||||
use Gimp::Util;
|
||||
use PDL::LiteF;
|
||||
|
|
@ -16,7 +16,7 @@ register "colour_to_alpha",
|
|||
"<Image>/Filters/Colors/Colour To Alpha",
|
||||
"RGB*",
|
||||
[
|
||||
[PF_COLOR, "colour", , "The colour to replace"],
|
||||
[PF_COLOR, "colour", "The colour to replace"],
|
||||
],
|
||||
sub { # es folgt das eigentliche Skript...
|
||||
my($image,$drawable,$colour)=@_;
|
||||
|
|
|
|||
|
|
@ -2,13 +2,15 @@
|
|||
|
||||
use Gimp qw( :auto );
|
||||
use Gimp::Fu;
|
||||
use strict;
|
||||
# Gimp::set_trace(TRACE_ALL);
|
||||
|
||||
register "mirror_split",
|
||||
"Splits and mirrors half of the image, according to settings.",
|
||||
"Just tick appropriate radio button.",
|
||||
"Claes G Lindblad <claesg\@algonet.se>",
|
||||
"Claes G Lindblad <claesg\@algonet.se>",
|
||||
"990405",
|
||||
"990530",
|
||||
"<Image>/Filters/Distorts/MirrorSplit",
|
||||
"*",
|
||||
[
|
||||
|
|
@ -19,36 +21,37 @@ register "mirror_split",
|
|||
sub {
|
||||
my ($img, $layer, $mirror) = @_;
|
||||
|
||||
$w = $layer->width();
|
||||
$h = $layer->height();
|
||||
$wspan = int ($w / 2 + 0.5);
|
||||
$hspan = int ($h / 2 + 0.5);
|
||||
my $w = $layer->width();
|
||||
my $h = $layer->height();
|
||||
my $wspan = int ($w / 2 + 0.5);
|
||||
my $hspan = int ($h / 2 + 0.5);
|
||||
|
||||
eval { $img->undo_push_group_start };
|
||||
|
||||
my $oldname = gimp_layer_get_name($layer);
|
||||
my $temp1 = gimp_layer_copy($layer, 1);
|
||||
gimp_image_add_layer($img, $temp1, 0);
|
||||
|
||||
if ($mirror == 0) { # upper half
|
||||
$temp2 = gimp_flip($temp1, VERTICAL_FLIP);
|
||||
gimp_rect_select($img, 0, 0, $w, $hspan, SELECTION_REPLACE, 0, 0);
|
||||
};
|
||||
if ($mirror == 1) { # lower half
|
||||
$temp2 = gimp_flip($temp1, VERTICAL_FLIP);
|
||||
$temp1 = gimp_flip($temp1, VERTICAL_FLIP);
|
||||
gimp_rect_select($img, 0, $hspan, $w, $h - $hspan, SELECTION_REPLACE, 0, 0);
|
||||
};
|
||||
if ($mirror == 2) { # left half
|
||||
$temp2 = gimp_flip($temp1, HORIZONTAL_FLIP);
|
||||
gimp_rect_select($img, 0, 0, $wspan, $h, SELECTION_REPLACE, 0, 0);
|
||||
if ($mirror == 1) { # lower half
|
||||
$temp1 = gimp_flip($temp1, VERTICAL_FLIP);
|
||||
gimp_rect_select($img, 0, 0, $w, $hspan, SELECTION_REPLACE, 0, 0);
|
||||
};
|
||||
if ($mirror == 3) { # right half
|
||||
$temp2 = gimp_flip($temp1, HORIZONTAL_FLIP);
|
||||
if ($mirror == 2) { # left half
|
||||
$temp1 = gimp_flip($temp1, HORIZONTAL_FLIP);
|
||||
gimp_rect_select($img, $wspan, 0, $w - $wspan, $h, SELECTION_REPLACE, 0, 0);
|
||||
};
|
||||
if ($mirror == 3) { # right half
|
||||
$temp1 = gimp_flip($temp1, HORIZONTAL_FLIP);
|
||||
gimp_rect_select($img, 0, 0, $wspan, $h, SELECTION_REPLACE, 0, 0);
|
||||
};
|
||||
|
||||
gimp_edit_copy($temp1);
|
||||
my $temp2 = gimp_edit_paste($layer, 1);
|
||||
gimp_floating_sel_anchor($temp2);
|
||||
gimp_selection_none($img);
|
||||
|
||||
gimp_edit_cut($temp2);
|
||||
my $temp3 = gimp_image_merge_down($img, $temp2, 2);
|
||||
gimp_layer_set_name($temp3, $oldname);
|
||||
eval { $img->undo_push_group_end };
|
||||
return $img;
|
||||
};
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ use Gtk;
|
|||
|
||||
Gtk->init;
|
||||
|
||||
$VERSION=0.4;
|
||||
$VERSION=0.9;
|
||||
|
||||
#Gimp::set_trace(TRACE_ALL);
|
||||
|
||||
|
|
@ -63,37 +63,47 @@ sub unformat_flags {
|
|||
}
|
||||
|
||||
sub format_plain {
|
||||
shift;
|
||||
my $x=shift;
|
||||
$x=~s/\r/\\r/g;
|
||||
$x=~s/\n/\\n/g;
|
||||
$x=~s/\t/\\t/g;
|
||||
$x=~s/([\x00-\x1f])/sprintf "\\x%02x",ord($1)/eg;
|
||||
$x=~s/\\n/\n/g;
|
||||
$x;
|
||||
}
|
||||
|
||||
sub unformat_plain {
|
||||
shift;
|
||||
my $x=shift;
|
||||
$x=~s/\\r/\r/g;
|
||||
$x=~s/\\t/\t/g;
|
||||
$x=~s/\\x([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
|
||||
$x;
|
||||
}
|
||||
|
||||
sub format_hex {
|
||||
join (" ", map { sprintf "%02x",ord($_) } split //);
|
||||
join (" ", map { sprintf "%02x",ord($_) } split //,shift);
|
||||
}
|
||||
|
||||
sub unformat_hex {
|
||||
my $x = shift;
|
||||
$x =~ y/0-9a-fA-F//cd;
|
||||
print "X: $x\n";
|
||||
$x=unpack("H*",$x);
|
||||
print "Y: $x\n";
|
||||
$x;#d#
|
||||
$x=pack("H*",$x);
|
||||
$x;
|
||||
}
|
||||
|
||||
sub format_gserialize {
|
||||
format_hex;
|
||||
format_hex(@_);
|
||||
}
|
||||
|
||||
sub unformat_gserialize {
|
||||
unformat_hex;
|
||||
unformat_hex(@_);
|
||||
}
|
||||
|
||||
sub escape($) {
|
||||
my $x=shift;
|
||||
is_binary($x) ? format_hex($x) : format_plain($x);
|
||||
is_gserialize($x) ? format_gserialize($x)
|
||||
: is_binary($x) ? format_hex($x)
|
||||
: format_plain($x);
|
||||
}
|
||||
|
||||
sub refresh_names {
|
||||
|
|
@ -148,7 +158,7 @@ sub create_main {
|
|||
|
||||
$window = $w;
|
||||
|
||||
$w->set_title("Parasite Editor - version $VERSION alpha");
|
||||
$w->set_title("Parasite Editor - version $VERSION");
|
||||
$w->signal_connect("destroy",sub {main_quit Gtk});
|
||||
|
||||
$b = new Gtk::Button "Close";
|
||||
|
|
@ -294,8 +304,16 @@ Gtk::Dialog->register_subtype(ParasiteEditor);
|
|||
|
||||
sub GTK_CLASS_INIT { };
|
||||
|
||||
sub unformat {
|
||||
my $self=shift;
|
||||
$self->{data_} = $self->{unformat}->($self->{-data}->get_chars(0,-1)) if $self->{unformat};
|
||||
$self->{name_} = $self->{-name}->get_text;
|
||||
$self->{flags_} = ::unformat_flags($self->{-flags}->get_text);
|
||||
}
|
||||
|
||||
sub format {
|
||||
my $self=shift;
|
||||
$self->{format}->($self->{data_});
|
||||
}
|
||||
|
||||
sub refresh {
|
||||
|
|
@ -313,8 +331,8 @@ sub undirty {
|
|||
sub GTK_OBJECT_INIT {
|
||||
my $self = shift;
|
||||
@{$self}{qw(find_func attach_func detach_func current parasite)}=@$init;
|
||||
@{$self}{qw(name flags data )}=@{$self->{find_func}->(@{$self}{'current','parasite'})};
|
||||
@{$self}{qw(name_ flags_ data_)}=@{$self->{find_func}->(@{$self}{'current','parasite'})};
|
||||
@{$self}{qw(name flags data)}=
|
||||
@{$self}{qw(name_ flags_ data_)}=@{$self->{find_func}->(@{$self}{qw(current parasite)})};
|
||||
|
||||
my $table = new Gtk::Table (2,3,0);
|
||||
$table->attach(new Gtk::Label("Name") ,0,1,0,1,{},{},0,0);
|
||||
|
|
@ -326,26 +344,47 @@ sub GTK_OBJECT_INIT {
|
|||
$self->{-flags} = new Gtk::Entry;
|
||||
$self->{-data} = new Gtk::Text;
|
||||
|
||||
my $format = new Gtk::HBox 0,5;
|
||||
local *newformat = sub {
|
||||
};
|
||||
$self->{format} = \&::format_plain;
|
||||
$self->refresh;
|
||||
|
||||
newformat("Text",\&::format_text,\&::unformat_text);
|
||||
newformat("Hex",\&::format_text,\&::unformat_text);
|
||||
newformat("GSerialize",\&::format_text,\&::unformat_text);
|
||||
my $format = new Gtk::HBox 0,5;
|
||||
my $radio;
|
||||
local *newformat = sub {
|
||||
my ($label,$in,$out,$enable)=@_;
|
||||
my $r = new Gtk::RadioButton $label,$radio ? $radio : ();
|
||||
$format->add($r);
|
||||
$r->signal_connect(clicked => sub {
|
||||
$self->unformat;
|
||||
$self->{format}=$in;
|
||||
$self->{unformat}=$out;
|
||||
$self->refresh;
|
||||
});
|
||||
$r->signal_emit_by_name("clicked") if $enable;
|
||||
$radio = $r;
|
||||
};
|
||||
|
||||
$table->attach($self->{-name} ,1,2,0,1,{},{},0,0);
|
||||
$table->attach($self->{-flags} ,1,2,1,2,{},{},0,0);
|
||||
$table->attach($format ,1,2,2,3,{},{},0,0);
|
||||
$table->attach($self->{-data} ,1,2,3,4,{},{},0,0);
|
||||
$table->attach($self->{-data} ,1,2,3,4,['fill'],{},0,0);
|
||||
|
||||
$detect = ::is_gserialize($self->{data_}) ? 3
|
||||
: ::is_binary($self->{data_}) ? 2
|
||||
: 1;
|
||||
|
||||
newformat("Text",\&::format_plain,\&::unformat_plain,$detect==1);
|
||||
newformat("Hex",\&::format_hex,\&::unformat_hex,$detect==2);
|
||||
newformat("GSerialize",\&::format_gserialize,\&::unformat_gserialize,$detect==3);
|
||||
|
||||
$self->vbox->add($table);
|
||||
|
||||
$self->refresh;
|
||||
|
||||
$self->{-data}->set_editable(1);
|
||||
|
||||
my $b = new Gtk::Button "OK";
|
||||
$b->signal_connect(clicked => sub {
|
||||
$self->undirty;
|
||||
$self->unformat;
|
||||
$self->{detach_func}->(@{$self}{'current','parasite'});
|
||||
$self->{attach_func}->($self->{'current'},[@{$self}{'name_','flags_','data_'}]);
|
||||
main::refresh_names;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,70 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use Gimp::Feature 'pdl';
|
||||
use Gimp 1.092;
|
||||
use Gimp::Fu;
|
||||
use Gimp::Util;
|
||||
use PDL;
|
||||
|
||||
register "pixelmap",
|
||||
"Maps Pixel values and coordinates through general Perl exprtessions",
|
||||
"=pod(*)",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"19990528",
|
||||
"<Image>/Filters/Map/Pixelmap",
|
||||
"*",
|
||||
[
|
||||
[PF_STRING, "expression" , "The perl expression to use", '$p=outer($x,$y)->slice("*$bpp")']
|
||||
],
|
||||
sub { # es folgt das eigentliche Skript...
|
||||
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 = "sub{$init\n#line 1\n$expr;\n$p}";
|
||||
|
||||
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);
|
||||
|
||||
$expr = eval $expr; die "$@" if $@;
|
||||
|
||||
$iter = Gimp->pixel_rgns_register ($src, $dst);
|
||||
|
||||
do {
|
||||
$dst->data(&$expr);
|
||||
|
||||
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;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -34,7 +34,7 @@ for (@ARGV) {
|
|||
|
||||
@matches = sort @matches;
|
||||
|
||||
$filter = "| tbl | nroff -man | ( eval '$ENV{PAGER}' || less || pg || more )";
|
||||
$filter = "| tbl | nroff -man | ( '$ENV{PAGER}' 2>/dev/null || less || pg || more )";
|
||||
$filter = ">&STDOUT" if $opt_r;
|
||||
|
||||
open PAGER,$filter or die "unable to open pipe to the pager ($filter)\n";
|
||||
|
|
|
|||
|
|
@ -1,16 +1,14 @@
|
|||
# fake typemap used when pdl support isn't available
|
||||
# xsubpp requires valid types even in ifdef'd out code
|
||||
|
||||
TYPEMAP
|
||||
pdl* T_PDL
|
||||
pdl * T_PDL
|
||||
Logical T_IV
|
||||
float T_NV
|
||||
pdl * T_ERROR
|
||||
|
||||
INPUT
|
||||
|
||||
T_PDL
|
||||
$var = PDL->SvPDLV($arg)
|
||||
T_ERROR
|
||||
error no_pdl_support
|
||||
|
||||
|
||||
OUTPUT
|
||||
|
||||
T_PDL
|
||||
PDL->SetSV_PDL($arg,$var);
|
||||
T_ERROR
|
||||
error no_pdl_support
|
||||
|
|
|
|||
Loading…
Reference in New Issue