Commit 09f86317 authored by Marc Lehmann's avatar Marc Lehmann
Browse files

see plug-ins/perl/Changes

parent da5acc39
Revision history for Gimp-Perl extension.
1.055 Mon Feb 22 22:38:44 CET 1999
- applied seth's script changes.
- gimp11ified some plug-ins.
- removed debugging code in Gimp/Lib.xs.
- got rid of a perl5.004 warning.
- removed gimp_{main,init,end}.
1.054 Mon Feb 22 15:23:41 CET 1999
- scm2scm and scm2perl will now be installed in INST_SCRIPT
- fixed a bug in interact/PF_FONT
- fixed a bug in interact/PF_FONT.
- made save_image more 1.1 compatible and automatically index
when saving to gif.
- many, Many, MANY 5.004 compatibility fixes.
1.053 Mon Feb 15 01:35:04 CET 1999
- more errornous argument types are detected now, without
......
......@@ -6,13 +6,13 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
@_consts @_procs $interface_pkg $interface_type @_param @_al_consts
@PREFIXES $_PROT_VERSION
@gimp_gui_functions
$help $verbose $host $gimp_main);
$help $verbose $host);
use base qw(DynaLoader);
require DynaLoader;
$VERSION = 1.054;
$VERSION = 1.055;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
......@@ -57,7 +57,7 @@ $VERSION = 1.054;
));
@_procs = qw(
gimp_main main
main
);
bootstrap Gimp $VERSION;
......@@ -155,7 +155,7 @@ sub import($;@) {
# make a quick but dirty guess ;)
@_=qw(gimp_main main xlfd_size :auto) unless @_;
@_=qw(main xlfd_size :auto) unless @_;
for(@_) {
if ($_ eq ":auto") {
......@@ -277,9 +277,9 @@ for(qw(_gimp_procedure_available gimp_call_procedure set_trace)) {
*$_ = \&{"${interface_pkg}::$_"};
}
*main = *gimp_main = \&{"${interface_pkg}::gimp_main"};
*init = *gimp_init = \&{"${interface_pkg}::gimp_init"};
*end = *gimp_end = \&{"${interface_pkg}::gimp_end" };
*main = \&{"${interface_pkg}::gimp_main"};
*init = \&{"${interface_pkg}::gimp_init"};
*end = \&{"${interface_pkg}::gimp_end" };
*lock = \&{"${interface_pkg}::lock" };
*unlock= \&{"${interface_pkg}::unlock" };
......@@ -484,7 +484,7 @@ All constants from gimpenums.h (BG_IMAGE_FILL, RUN_NONINTERACTIVE, NORMAL_MODE,
=back
The default (unless '' is specified) is C<gimp_main main :auto>.
The default (unless '' is specified) is C<main xlfd_size :auto>.
=head1 GETTING STARTED
......@@ -553,7 +553,7 @@ main eventloop.
=head1 CALLBACKS
If you use the plain Gimp module (as opposed to Gimp::Fu), your program
should only call one function: C<gimp_main>. Everything else is going to be
should only call one function: C<main>. Everything else is going to be
B<called> from The Gimp at a later stage. For this to work, you should
define certain call-backs in the same module you called C<Gimp::main>:
......@@ -641,7 +641,7 @@ speak for you), or just plain interesting functions.
=over 4
=item main(), gimp_main()
=item main(), Gimp::main()
Should be called immediately when perl is initialized. Arguments are not yet
supported. Initializations can later be done in the init function.
......@@ -658,7 +658,7 @@ size (no joke ;). Example:
=item Gimp::init([connection-argument]), Gimp::end()
These is an alternative and experimental interface that replaces the call to
gimp_main and the net callback. At the moment it only works for the Net
Gimp::main and the net callback. At the moment it only works for the Net
interface (L<Gimp::Net>), and not as a native plug-in. Here's an example:
use Gimp;
......
......@@ -55,7 +55,7 @@ newCONSTSUB(stash,name,sv)
curstash = curcop->cop_stash = stash;
newSUB(
MY_start_subparse(FALSE, 0),
start_subparse (FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv(name,0)),
newSVOP(OP_CONST, 0, &sv_no), /* SvPV(&sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
......
......@@ -113,19 +113,19 @@ sub Gimp::RUN_FULLINTERACTIVE (){ Gimp::RUN_INTERACTIVE+100 }; # you don't want
PF_SLIDER PF_INT PF_SPINNER PF_ADJUSTMENT
PF_BRUSH PF_PATTERN PF_GRADIENT);
@EXPORT = (qw(register main gimp_main),@_params);
@EXPORT = (qw(register main),@_params);
@EXPORT_OK = qw(interact $run_mode save_image);
%EXPORT_TAGS = (params => [@_params]);
# the old value of the trace flag
my $old_trace;
sub import {
undef *{caller()."::main"};
undef *{caller()."::gimp_main"};
goto &Exporter::import;
local $^W=0;
shift @_ if $_[0] =~ /::/;
Gimp::Fu->export_to_level(1,@_);
}
# the old value of the trace flag
my $old_trace;
sub _default {
my $d = shift;
my @a = @_;
......@@ -212,7 +212,7 @@ sub interact($$$@) {
} elsif($type == PF_FONT) {
my $fs=new Gtk::FontSelectionDialog "Font Selection Dialog ($desc)";
my $def = "-*-helvetica-o-normal--34-*-*-*-*-*-*-*";
my $def = "-*-helvetica-medium-r-normal-*-*-240-*-*-p-*-iso8859-1";
my $val;
my $l=new Gtk::Label "!error!";
......@@ -893,8 +893,10 @@ sub save_image($$) {
my $layer = $img->get_active_layer;
if ($type eq "JPG" or $type eq "JPEG") {
Gimp->file_jpeg_save(&Gimp::RUN_NONINTERACTIVE,$img,$layer,$path,$path,$quality,$smooth,1);
eval { Gimp->file_jpeg_save(&Gimp::RUN_NONINTERACTIVE,$img,$layer,$path,$path,$quality,$smooth,1) };
Gimp->file_jpeg_save(&Gimp::RUN_NONINTERACTIVE,$img,$layer,$path,$path,$quality,$smooth,1,1,"") if $@;
} elsif ($type eq "GIF") {
$img->convert_indexed (1,256) unless $layer->indexed;
Gimp->file_gif_save(&Gimp::RUN_NONINTERACTIVE,$img,$layer,$path,$path,$interlace,0,0,0);
} elsif ($type eq "PNG") {
Gimp->file_png_save(&Gimp::RUN_NONINTERACTIVE,$img,$layer,$path,$path,$interlace,$compress);
......@@ -915,12 +917,9 @@ sub print_switches {
}
}
*main = *gimp_main = sub {
if (!@scripts) {
# it is now legal to register no scripts (i.e. when PDL is required but not found
#die "well, there are no scripts registered.. what do you expect?\n";
Gimp::main;
} elsif ($Gimp::help) {
sub main {
$old_trace = Gimp::set_trace (0);
if ($Gimp::help) {
my $this=this_script;
print <<EOF;
interface-arguments are
......@@ -929,10 +928,8 @@ sub print_switches {
script-arguments are
EOF
print_switches ($this);
} else {
$old_trace = Gimp::set_trace (0);
Gimp::main;
}
Gimp::main;
};
sub logo {
......
......@@ -24,6 +24,7 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "patchlevel.h"
/* I actually do care a bit about older perls... */
#ifndef ERRSV
......@@ -31,7 +32,10 @@
#endif
/* And also for newer perls... */
#ifndef dTHR
#define dTHR
#define dTHR (void)0
#endif
#if (PATCHLEVEL < 5)
#define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
#endif
#ifndef PL_sv_undef
#define PL_sv_undef sv_undef
......@@ -140,8 +144,8 @@ GTile *old_tile (SV *sv)
GPixelRgn *old_pixelrgn (SV *sv)
{
dTHR;
STRLEN dc;
dTHR;
if (!sv_derived_from (sv, PKG_PIXELRGN))
croak ("argument is not of type " PKG_PIXELRGN);
......@@ -352,10 +356,10 @@ dump_params (int nparams, GParam *args, GParamDef *params)
static int
convert_array2paramdef (AV *av, GParamDef **res)
{
dTHR;
STRLEN dc;
int count = 0;
GParamDef *def = 0;
dTHR;
if (av_len (av) >= 0)
for(;;)
......@@ -454,7 +458,7 @@ autobless (SV *sv, int type)
static gint32
unbless (SV *sv, char *type, char *croak_str)
{
if (SvROK (sv))
if (sv_isobject (sv))
if (type == PKG_ANY
|| (type == PKG_ANYABLE && (sv_derived_from (sv, PKG_DRAWABLE)
|| sv_derived_from (sv, PKG_LAYER)
......@@ -464,19 +468,31 @@ unbless (SV *sv, char *type, char *croak_str)
if (SvTYPE (SvRV (sv)) == SVt_PVMG)
return SvIV (SvRV (sv));
else
croak ("only blessed scalars accepted here");
strcpy (croak_str, "only blessed scalars accepted here");
}
else
if (croak_str)
sprintf (croak_str, "argument type %s expected", type);
else
croak ("argument type %s expected", type);
sprintf (croak_str, "argument type %s expected (not %s)", type, HvNAME(SvSTASH(SvRV(sv))));
else
return SvIV (sv);
return -1;
}
static gint32
unbless_croak (SV *sv, char *type)
{
char croak_str[320];
gint32 r;
croak_str[0] = 0;
r = unbless (sv, type, croak_str);
if (croak_str [0])
croak (croak_str);
return r;
}
static void
canonicalize_colour (char *err, SV *sv, GParamColor *c)
{
......@@ -644,8 +660,8 @@ push_gimp_sv (GParam *arg, int array_as_ref)
static int
convert_sv2gimp (char *croak_str, GParam *arg, SV *sv)
{
dTHR;
STRLEN dc;
dTHR;
switch (arg->type)
{
......@@ -1071,7 +1087,7 @@ gimp_call_procedure (proc_name, ...)
char * proc_name
PPCODE:
{
char croak_str[300] = "";
char croak_str[320] = "";
char *proc_blurb;
char *proc_help;
char *proc_author;
......@@ -1287,7 +1303,7 @@ gimp_set_data(id, data)
dta = SvPV (data, dlen);
/* do not remove this comment */
#ifdef HAVE_GET_DATA_SIZE
#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
gimp_set_data (SvPV (id, dc), dta, dlen);
#else
{
......@@ -1302,10 +1318,10 @@ gimp_set_data(id, data)
#endif
}
SV *
void
gimp_get_data(id)
SV * id;
CODE:
PPCODE:
{
SV *data;
STRLEN dlen;
......@@ -1313,14 +1329,13 @@ gimp_get_data(id)
STRLEN dc;
/* do not remove this comment */
#ifdef HAVE_GET_DATA_SIZE
#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
dlen = gimp_get_data_size (SvPV (id, dc));
/* I count on dlen being zero if "id" doesn't exist. */
data = newSVpv ("", 0);
gimp_get_data (SvPV (id, dc), SvGROW (data, dlen+1));
SvCUR_set (data, dlen);
*((char *)SvPV (data, dc) + dlen) = 0;
RETVAL = data;
#else
{
char str[1024]; /* hack */
......@@ -1332,21 +1347,18 @@ gimp_get_data(id)
dlen = (STRLEN) -1;
str[len] = 'S'; gimp_get_data (str, &dlen);
data = newSVpv ("", 0);
if (dlen != (STRLEN)-1)
{
data = newSVpv ("", 0);
str[len] = 'C'; gimp_get_data (str, SvGROW (data, dlen+1));
SvCUR_set (data, dlen);
*((char *)SvPV (data, dc) + dlen) = 0;
RETVAL = data;
}
else
RETVAL = &PL_sv_undef;
}
#endif
XPUSHs (data);
}
OUTPUT:
RETVAL
void
gimp_register_magic_load_handler(name, extensions, prefixes, magics)
......
......@@ -118,7 +118,8 @@ EOF
qw(windy.pl prep4gif.pl webify.pl PDB alpha2color.pl tex-to-float ditherize.pl
border.pl view3d.pl feedback.pl xachlego.pl xachshadow.pl parasite-editor);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server scm2perl scm2scm examples/example-net.pl));
qw(Perl-Server scm2perl scm2scm examples/example-net.pl examples/homepage-logo.pl
examples/example-fu.pl));
for(@shebang) {
print "updating bangpath in $_\n";
......
......@@ -16,6 +16,7 @@ use strict;
use vars qw($use_unix $use_tcp $trace_res $server_quit $max_pkt $unix $tcp $ps_flags
%object_dynamic $object_uid %objects $auth @authorized $exclusive
$rm $saved_rm);
# the '' might be required (i.e. no ())
use Gimp '';
use Gimp::Net qw(:server);
......
......@@ -18,7 +18,7 @@ $font = "engraver";
$example = 1;
# set trace level to watch functions as they are executed
Gimp::set_trace(TRACE_NAME);
#Gimp::set_trace(TRACE_NAME);
# convert image to indexed
# and automatically save it as interlaced gif.
......@@ -103,5 +103,5 @@ sub net {
extension_create_images;
}
exit gimp_main;
exit main;
......@@ -2,10 +2,9 @@
#BEGIN {$^W=1};
require 5.005;
use Gimp;
use Gimp::Fu;
BEGIN { $] >= 5.005 or exit main }
use Gtk;
use Gtk::Gdk;
......
......@@ -78,11 +78,6 @@ sub alpha2col {
}
$target_layer->set_visible(1);
gimp_palette_set_background($color);
# $newlay = gimp_layer_new ( $img,
# $target_layer->width,
# $target_layer->height,
# 1, "NewLayer", 100, NORMAL);
# $img->add_layer($newlay, scalar(@layers));
$newlay = $target_layer->copy(1);
$img->add_layer($newlay, 0);
$newlay->set_offsets(@offsets);
......@@ -107,8 +102,8 @@ register
"Change the current alpha to a selected color.",
"Seth Burgess",
"Seth Burgess<sjburges\@gimp.org>",
"1998-10-18",
"<Image>/Filters/Misc/Alpha2Color",
"2-15-98",
"<Image>/Image/Colors/Alpha2Color",
"RGBA",
[
[PF_COLOR, "Color", "Color for current alpha", [127,127,127]]
......
......@@ -28,7 +28,6 @@ register "my_first_gimp_fu", # fill in name
# now do sth. useful with the garbage we got ;)
my($width,$height,$text,$font,$fg,$bg,$ignore,$brush,$pattern,$gradient)=@_;
# uncomment the next line to enable tracing
Gimp::set_trace(TRACE_ALL);
my $img=new Image($width,$height,RGB);
......
......@@ -29,7 +29,7 @@ sub net {
# Gimp::Net::server_quit; # kill the gimp-perl-server-extension (ugly name)
}
exit gimp_main;
exit main;
......
......@@ -33,5 +33,5 @@ sub query {
[[PARAM_INT32, "run_mode", "Interactive, [non-interactive]"]], []);
}
exit gimp_main;
exit main;
......@@ -2,6 +2,9 @@
# Revision 1.0: Released it
# 1.1: Marc Lehman added undo capability! <pcg@goof.com>
# 1.2: Added my email, and put it in "Noise" where it belongs
# <sjburges@gimp.org>
use Gimp;
use Gimp::Fu;
......@@ -10,9 +13,9 @@ register "feedback",
"Take an image and feed it back onto itself multiple times",
"This plug-in simulates video feedback. It makes for kinda a neat desktop if you're into that sort of thing",
"Seth Burgess",
"Seth Burgess",
"1.1",
"<Image>/Filters/Misc/feedback",
"Seth Burgess <sjburges\@gimp.org>",
"2-15-99",
"<Image>/Filters/Noise/Feedback",
"RGB, GRAY",
[
[PF_SLIDER, "offset", "the amount the frames will offset", 3, [0, 255, 1]],
......
......@@ -342,7 +342,7 @@ sub delete_images {
}
######################################################################
# Net is where gimp_main continues after it has connected to
# Net is where main continues after it has connected to
# gimp.
######################################################################
sub net {
......@@ -446,4 +446,4 @@ __
}
# Translate background into a color according to the X11 color dbase.
exit gimp_main;
exit main;
......@@ -87,7 +87,7 @@ sub write_logo {
gimp_layer_translate ($shadow, $th*0.1, $th*0.3);
plug_in_gauss_rle ($shadow, 1, 1, 1);
gimp_hue_saturation($img, $bg, ALL_HUES, 0, 0, $active ? 10 : -40);
gimp_hue_saturation($bg, ALL_HUES, 0, 0, $active ? 10 : -40);
plug_in_nova ($bg, $h*0.4, $h*0.5, '#f0a020', 5, 50) if $active;
plug_in_nova ($bg, $w-$h*0.4, $h*0.5, '#f0a020', 5, 50) if $active;
......@@ -96,7 +96,7 @@ sub write_logo {
if ($uc) {
set_fg($active ? "#a00000" : "#000000");
my ($uc,$tw,$th,$ta,$td) = text ($img, "u/c", 1, $font, $h*0.4);
gimp_rotate ($img,$uc,1,0.2);
gimp_rotate ($uc,1,0.2);
gimp_layer_translate ($uc,$w*0.84,($h-$th+$td)/2);
}
......@@ -145,5 +145,5 @@ sub net {
extension_homepage_logo;
}
exit gimp_main;
exit main;
......@@ -2,10 +2,9 @@
#BEGIN {$^W=1};
require 5.005;
use Gimp ();
use Gimp::Fu;
BEGIN { $] >= 5.005 or exit main }
use Gtk;
Gtk->init;
......
......@@ -93,8 +93,8 @@ register
"Prep for gif",
"Make the image a small-cut-out of the intended background, so your transparent text doesn't look blocky.",
"Seth Burgess",
"Seth Burgess",
"1998-09-14",
"Seth Burgess <sjburges\@gimp.org>",
"2-15-98",
"<Image>/Filters/Misc/Prepare for GIF",
"RGB*",
[
......
......@@ -3,7 +3,7 @@
use Gimp;
use Gimp::Fu;
Gimp::set_trace(TRACE_ALL);
#Gimp::set_trace(TRACE_ALL);
register "webify",
"Make an image suitable for the web",
......
#!/usr/bin/perl
# sent to me by Seth Burgess <sjburges@ou.edu>
# sent to me by Seth Burgess <sjburges@gimp.org>
# small changes my Marc Lehmann <pcg@goof.com>
use Gimp;
use Gimp::Fu;
Gimp::set_trace(TRACE_CALL);
#Gimp::set_trace(TRACE_CALL);
sub windify {
my ($img, $drawable, $angle, $density, $distance, $wrap) = @_;
......@@ -49,9 +49,9 @@ register
"Add wind to an image",
"Blow your image all over :)",
"Seth Burgess",
"Seth Burgess (c)",
"Seth Burgess <sjburges\@gimp.org>",
"1998-09-14",
"<Image>/Filters/Artistic/Windify",
"<Image>/Filters/Distorts/Windify",
"*",
[
[PF_INT32, "Angle", "Wind Angle, 0 is left", 120],
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment