Commit 0aaaba09 authored by Marc Lehmann's avatar Marc Lehmann
Browse files

see plug-ins/perl/Changes

parent 98dcea48
......@@ -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.
......
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);
}
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,33 +56,24 @@ while (($k,$v)=each(%cfg)) {
$$k=$v;
}
$GIMP = $bindir."/gimp" if $IN_GIMP;
$GIMP = expand($GIMP);
$GIMPTOOL = expand($GIMPTOOL);
$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;
$GIMPTOOL = expand($GIMPTOOL);
if ($IN_GIMP) {
$GIMP = $bindir."/gimp" if $IN_GIMP;
$GIMP_PREFIX=expand($prefix);
} else {
$GIMP_PREFIX = `$GIMPTOOL --prefix`;
chomp $GIMP_PREFIX;
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);
}
$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;
$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;
# $...1 variables should be put in front of the corresponding MakeMaker values.
$INC1 = "-I$topdir";
......@@ -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;
}
#!/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);
$temp1 = gimp_flip($temp1, VERTICAL_FLIP);
gimp_rect_select($img, 0, $hspan, $w, $h - $hspan, SELECTION_REPLACE, 0, 0);
};
if ($mirror == 1) { # lower half
$temp2 = gimp_flip($temp1, VERTICAL_FLIP);
gimp_rect_select($img, 0, $hspan, $w, $h - $hspan, SELECTION_REPLACE, 0, 0);
$temp1 = gimp_flip($temp1, VERTICAL_FLIP);
gimp_rect_select($img, 0, 0, $w, $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);
$temp1 = gimp_flip($temp1, HORIZONTAL_FLIP);
gimp_rect_select($img, $wspan, 0, $w - $wspan, $h, SELECTION_REPLACE, 0, 0);
};
if ($mirror == 3) { # right half
$temp2 = gimp_flip($temp1, HORIZONTAL_FLIP);
gimp_rect_select($img, $wspan, 0, $w - $wspan, $h, SELECTION_REPLACE, 0, 0);
$temp1 = gimp_flip($temp1, HORIZONTAL_FLIP);
gimp_rect_select($img, 0, 0, $wspan, $h, SELECTION_REPLACE, 0, 0);
};
gimp_edit_cut($temp2);
my $temp3 = gimp_image_merge_down($img, $temp2, 2);
gimp_layer_set_name($temp3, $oldname);
gimp_edit_copy($temp1);
my $temp2 = gimp_edit_paste($layer, 1);
gimp_floating_sel_anchor($temp2);
gimp_selection_none($img);
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;
$self->{format} = \&::format_plain;
$self->refresh;
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;
};