callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

Browse Source
This commit is contained in:
Marc Lehmann
1999-12-20 20:02:20 +00:00
parent 220b3463a7
commit e802d2c492
28 changed files with 2566 additions and 1137 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
plug-ins/perl/Changes
View File

@ -34,6 +34,10 @@ Revision history for Gimp-Perl extension.
- use XSLoader instead of DynaLoader where available.
- use perl_require_pv instead of perl_eval_pv.
- updated COPYING.GNU to version 2.
- removed .pl suffix from all examples.
- deprecate use of included scripts with gimp-1.0 in configure.in.
- fix the ColorSelectButton ro work with newer versions of Gtk.
- updated logulator from scheme sources. oh yeah :(
1.17 Wed Nov 24 21:25:19 CET 1999
- re-fitted i18n translation for most plug-ins.

2
plug-ins/perl/Gimp/Lib.xs
View File

@ -460,7 +460,7 @@ dump_params (int nparams, GParam *args, GParamDef *params)
case PARAM_INT16: trace_printf ("%d", args[i].data.d_int16); break;
case PARAM_INT8: trace_printf ("%d", (guint8) args[i].data.d_int8); break;
case PARAM_FLOAT: trace_printf ("%f", args[i].data.d_float); break;
case PARAM_STRING: trace_printf ("\"%s\"", args[i].data.d_string); break;
case PARAM_STRING: trace_printf ("\"%s\"", args[i].data.d_string ? args[i].data.d_string : "[null]"); break;
case PARAM_DISPLAY: trace_printf ("%d", args[i].data.d_display); break;
case PARAM_IMAGE: trace_printf ("%d", args[i].data.d_image); break;
case PARAM_LAYER: trace_printf ("%d", args[i].data.d_layer); break;

34
plug-ins/perl/MANIFEST
View File

@ -58,30 +58,30 @@ UI/UI.pm
UI/UI.xs
UI/basewidget.pm
examples/PDB
examples/alpha2color.pl
examples/alpha2color
examples/tex-to-float
examples/README
examples/webify.pl
examples/border.pl
examples/webify
examples/border
examples/Create_Images
examples/image_list
examples/example-oo.pl
examples/example-fu.pl
examples/example-net.pl
examples/example-oo
examples/example-fu
examples/example-net
examples/gimp-make-img-map
examples/homepage-logo.pl
examples/windify.pl
examples/prep4gif.pl
examples/ditherize.pl
examples/view3d.pl
examples/feedback.pl
examples/xachlego.pl
examples/xachshadow.pl
examples/homepage-logo
examples/windify
examples/prep4gif
examples/ditherize
examples/view3d
examples/feedback
examples/xachlego
examples/xachshadow
examples/parasite-editor
examples/scratches.pl
examples/blowinout.pl
examples/scratches
examples/blowinout
examples/terral_text
examples/xachvision.pl
examples/xachvision
examples/gimpmagick
examples/perlcc
examples/animate_cells

21
plug-ins/perl/TODO
View File

@ -21,10 +21,15 @@ API generalization
firetext! AND _grayscale_ for map_gradient(!)
bugs
* make test should not be run without DISPLAY
* gimp_layer_set_name(4, "(null)") = gimp: fatal error: sigsegv caught
gimp (pid:27638): [E]xit, [H]alt, show [S]tack trace or [P]roceed:
this should not crash the gimp itself, but rather gimp-perl (or libc).
[KILL] * ftp://metalab.unc.edu/pub/Linux/X11/gtkbuffet/libs/gtkxmhtml/ into INSTALL
* gtview_log (perlcc & helpfenster) erste zeile anzeigen + scrollbar
[DONE] * make test should not be run without DISPLAY
* document on_xxx functions and register_callback
* fix Gimp::Feature::missing => on_query-dir!
* update logulator
[DONE] * update logulator
* on-query => remove gimp::fu parasite(?)
* bricks requires disable for pattern(?)
* better default argument-handlign via a "massage_args" callback from Gimp/UI/interact?
@ -33,20 +38,14 @@ bugs
* scroll behaviour, use clist instead of list?
* document Gimp::PDL and rect2, ...2 functions!
* Kommandozeilenmodus(!). (???)
[DONE] * KILL :auto from default(!)
* auto-flush of gdrawable when merge_shadow(?)
[KILL] * auto-flush of gdrawable when merge_shadow(?)
* gimp-piddle must be written back automatically on destroy, if changed
* gimp-tile set dirty automatically(!)
[KILL] * perl module install dependency
[KILL] * $Config{cc} might not understand Gimps CFLAGS (-mpentium).
[KILL] * wait for working gimp_file_load (or do it myself?)
* get rid of xs_exit. please please fuck me plenty.
[KILL] * get rid of xs_exit. please please fuck me plenty.
* create gimpstyle.pod
important issues
[DONE] * improve PDB explorer
[DONE] * input image arguments
* find_next_guide is a lousy interface. => just do num_guides
* constant names (RADIO) automatically into help strings!
* migrate BOOT: into INIT() (forgot why but important for B)
@ -66,11 +65,9 @@ important issues
* Gimp::ping
* allow plug-ins to register with only a drawable argument(!)
* gradient button
[KILL] * implement Perl-Server RSET and shared lock(!)
* weighted movement in drawing tools
* --function localfunc to select one of the registered scripts
* create working progress when Net and $verbose
[KILL] * Gimp::Fu::command(?)
* default parameters at end(!)
* try to deduce default parameters

3
plug-ins/perl/UI/UI.pm
View File

@ -322,6 +322,7 @@ sub GTK_CLASS_INIT {
sub GTK_OBJECT_INIT {
my (@color) = @class_def_color;
shift unless ref $_[0];
my($color_button) = @_;
$color_button->{_color} ||= [@color];
@ -411,8 +412,6 @@ sub cb_color_button {
$color_button->{_cs_window} = $cs_window;
}
1;
package Gimp::UI;
sub logo {

69
plug-ins/perl/configure vendored
View File

@ -858,7 +858,7 @@ rm -f conftest*
GIMP_LIBS=""
GIMP_CFLAGS_NOUI=""
GIMP_LIBS_NOUI=""
{ echo "configure: error: ** unable to find gimp" 1>&2; exit 1; }
echo "configure: warning: ** unable to find gimp" 1>&2
fi
@ -867,6 +867,21 @@ rm -f conftest*
rm -f conf.gimptest
gimptool_major_version=`$GIMPTOOL $gimptool_args --version | \
sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'`
gimptool_minor_version=`$GIMPTOOL $gimptool_args --version | \
sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'`
if test $gimptool_major_version -lt 2 && test $gimptool_minor_version -lt 1 ; then
echo
echo '** you are using a too old version of gimp (this includes all _stable_'
echo '** 1.0.x versions!). While this plug-in should still compile with the'
echo '** released 1.0.x versions of the gimp, many scripts will not, since they'
echo '** already use the new API.'
echo
fi
# Check whether --with-glib-prefix or --without-glib-prefix was given.
if test "${with_glib_prefix+set}" = set; then
withval="$with_glib_prefix"
@ -920,7 +935,7 @@ fi
# Extract the first word of "glib-config", so it can be a program name with args.
set dummy glib-config; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:924: checking for $ac_word" >&5
echo "configure:939: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_path_GLIB_CONFIG'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -955,7 +970,7 @@ fi
min_glib_version=1.2.0
echo $ac_n "checking for GLIB - version >= $min_glib_version""... $ac_c" 1>&6
echo "configure:959: checking for GLIB - version >= $min_glib_version" >&5
echo "configure:974: checking for GLIB - version >= $min_glib_version" >&5
no_glib=""
if test "$GLIB_CONFIG" = "no" ; then
no_glib=yes
@ -978,7 +993,7 @@ echo "configure:959: checking for GLIB - version >= $min_glib_version" >&5
echo $ac_n "cross compiling; assumed OK... $ac_c"
else
cat > conftest.$ac_ext <<EOF
#line 982 "configure"
#line 997 "configure"
#include "confdefs.h"
#include <glib.h>
@ -1054,7 +1069,7 @@ main ()
}
EOF
if { (eval echo configure:1058: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
if { (eval echo configure:1073: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@ -1088,7 +1103,7 @@ fi
CFLAGS="$CFLAGS $GLIB_CFLAGS"
LIBS="$LIBS $GLIB_LIBS"
cat > conftest.$ac_ext <<EOF
#line 1092 "configure"
#line 1107 "configure"
#include "confdefs.h"
#include <glib.h>
@ -1098,7 +1113,7 @@ int main() {
return ((glib_major_version) || (glib_minor_version) || (glib_micro_version));
; return 0; }
EOF
if { (eval echo configure:1102: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:1117: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
echo "*** The test program compiled, but did not run. This usually means"
echo "*** that the run-time linker is not finding GLIB or finding the wrong"
@ -1140,7 +1155,7 @@ rm -f conftest*
ac_gimp_save_CPPFLAGS="$CPPFLAGS"
CPPFLAGS="$CPPFLAGS $GIMP_CFLAGS"
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
echo "configure:1144: checking how to run the C preprocessor" >&5
echo "configure:1159: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@ -1155,13 +1170,13 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
#line 1159 "configure"
#line 1174 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1165: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:1180: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@ -1172,13 +1187,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
#line 1176 "configure"
#line 1191 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1182: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:1197: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@ -1189,13 +1204,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
#line 1193 "configure"
#line 1208 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1199: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:1214: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@ -1220,7 +1235,7 @@ fi
echo "$ac_t""$CPP" 1>&6
cat > conftest.$ac_ext <<EOF
#line 1224 "configure"
#line 1239 "configure"
#include "confdefs.h"
#include <libgimp/gimp.h>
EOF
@ -1238,17 +1253,17 @@ for ac_hdr in libgimp/gimpmodule.h libintl.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
echo "configure:1242: checking for $ac_hdr" >&5
echo "configure:1257: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1247 "configure"
#line 1262 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1252: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:1267: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@ -1280,17 +1295,17 @@ for ac_hdr in unistd.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
echo "configure:1284: checking for $ac_hdr" >&5
echo "configure:1299: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1289 "configure"
#line 1304 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1294: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:1309: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@ -1322,12 +1337,12 @@ CONFIG_H="config.h"
for ac_func in vsnprintf
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1326: checking for $ac_func" >&5
echo "configure:1341: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1331 "configure"
#line 1346 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@ -1350,7 +1365,7 @@ $ac_func();
; return 0; }
EOF
if { (eval echo configure:1354: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:1369: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@ -1406,12 +1421,12 @@ fi
for ac_func in _exit
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1410: checking for $ac_func" >&5
echo "configure:1425: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1415 "configure"
#line 1430 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@ -1434,7 +1449,7 @@ $ac_func();
; return 0; }
EOF
if { (eval echo configure:1438: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:1453: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else

17
plug-ins/perl/configure.in
View File

@ -30,11 +30,26 @@ AC_ARG_WITH(libs, [ --with-libs=DIR Additionally search for librarie
AC_PATH_PROGS(GIMP,gimp)
AM_PATH_GIMP(1.0.4,, AC_MSG_ERROR(
AM_PATH_GIMP(1.0.4,, AC_MSG_WARN(
** unable to find gimp, make sure it's in your path (version 1.0.4+ required!)
** You can get the gimp from ftp://ftp.gimp.org/pub/gimp.
))
gimptool_major_version=`$GIMPTOOL $gimptool_args --version | \
sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
gimptool_minor_version=`$GIMPTOOL $gimptool_args --version | \
sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
if test $gimptool_major_version -lt 2 && test $gimptool_minor_version -lt 1 ; then
echo
echo '** you are using a too old version of gimp (this includes all _stable_'
echo '** 1.0.x versions!). While this plug-in should still compile with the'
echo '** released 1.0.x versions of the gimp, many scripts will not, since they'
echo '** already use the new API.'
echo
fi
AM_PATH_GLIB(1.2.0,, AC_MSG_ERROR(
** unable to find glib, make sure it's in your path (version 1.2.0+ required!)
** You can get glib from ftp://ftp.gtk.org/pub/glib.

113
plug-ins/perl/examples/alpha2color Executable file
View File

@ -0,0 +1,113 @@
#!/usr/bin/perl
use Gimp qw( :auto N_ );
use Gimp::Fu;
# alpha2color.pl
# by Seth Burgess <sjburges@gimp.org>
# Version 0.02
# Oct 16th, 1998
#
# This script simply changes the current alpha channel to a given color
# instead. I'm writing it primarily for use with the displace plugin,
# but I imagine it'll have other uses.
# TODO: Selection is currently ignored. It'd be better if it remembered
# what the previous selection was.
# Gimp::set_trace(TRACE_ALL);
# Revision History
# v0.02 - fixed up @color (should be $color) and undef; (should be return();)
sub save_layers_state ($) {
$img = shift;
my @layers = $img->get_layers;
$i = 0;
foreach $lay (@layers) {
if ($lay->get_visible){
$arr[$i] = 1;
}
else {
$arr[$i] = 0;
}
$i++;
}
return @arr;
}
sub restore_layers_state($@) {
$img = shift;
@arr = @_;
my @layers = $img->get_layers;
$i = 0;
foreach $lay (@layers) {
$lay->set_visible($arr[$i]);
$i++;
}
}
sub alpha2col {
my ($img, $drawable, $color) = @_;
my $oldcolor = gimp_palette_get_background();
my @layers = gimp_image_get_layers($img);
# if there's not enough layers, abort.
if ($#layers < 0) {
gimp_message("You need at least 1 layer to perform alpha2color!");
print "Only ", scalar(@layers), " layers found!(", $layers[0],")\n";
return 0;
}
# Hide the bottom layer, so it doesn't get into the merge visible later.
@layer_visibilities = save_layers_state ($img);
# foreach $visible (@layer_visibilities) {
# print $visible, "\n";
# }
$target_layer = gimp_image_get_active_layer($img);
@offsets=$target_layer->offsets;
# print $target_layer, "\n";
foreach $eachlay (@layers) {
$eachlay->set_visible(0);
}
$target_layer->set_visible(1);
gimp_palette_set_background($color);
$newlay = $target_layer->copy(1);
$img->add_layer($newlay, 0);
$newlay->set_offsets(@offsets);
$target_layer->set_active_layer;
$img->selection_all;
$target_layer->edit_fill;
$img->selection_none;
$foreground = gimp_image_merge_visible_layers($img,0);
restore_layers_state($img, @layer_visibilities);
gimp_palette_set_background($oldcolor);
gimp_displays_flush();
return();
}
register
"plug_in_alpha2color",
"Alpha 2 Color",
"Change the current alpha to a selected color.",
"Seth Burgess",
"Seth Burgess<sjburges\@gimp.org>",
"2-15-98",
N_"<Image>/Image/Alpha/Alpha2Color...",
"RGBA",
[
[PF_COLOR, "color", "Color for current alpha", [127,127,127]]
],
\&alpha2col;
exit main;

109
plug-ins/perl/examples/blowinout Executable file
View File

@ -0,0 +1,109 @@
#!/usr/bin/perl
# Blow In/Out
# John Pitney
use Gimp 1.06;
use Gimp::Fu;
# print "hello there\n";
# Gimp::set_trace(TRACE_CALL);
sub blowinout {
my ($img, $drawable, $angle, $nsteps, $distance, $inmode, $arithmode) = @_;
# bail out if $drawable isn't a layer
# print "Starting\n";
if( gimp_selection_is_empty($img) == 0) { return };
# if ($nsteps == 0) return;
eval { $img->undo_push_group_start };
# save the background color for later restoration
my $oldbg = gimp_palette_get_background();
#get the drawable dimensions
my $xsize = gimp_drawable_width($drawable);
my $ysize = gimp_drawable_height($drawable);
# Set background color to 128, for clearing dm
gimp_palette_set_background([128,128,128]);
# Create a grayscale workspace image for displacement map
my $dm = gimp_image_new($xsize, $ysize, 1);
eval { $dm->undo_push_group_start };
# It needs to have 2 layers
my $dmlayer = gimp_layer_new($dm, $xsize, $ysize, GRAY_IMAGE, "newlayer",
100, NORMAL_MODE);
gimp_image_add_layer($dm, $dmlayer, 0);
# Create the layers, one-by-one
my $i = 1;
my $xdist = ($arithmode) ?
$i * $distance / $nsteps * -cos($angle * 3.14159 / 180) :
$distance ** ($i/$nsteps) * -cos($angle * 3.14159 / 180);
my $ydist = ($arithmode) ?
$i * $distance / $nsteps * sin($angle * 3.14159 / 180) :
$distance ** ($i/$nsteps) * sin($angle * 3.14159 / 180);
gimp_edit_clear($dmlayer);
plug_in_noisify(1, $dm, $dmlayer, 0, 255, 255, 255, 0);
gimp_levels($dmlayer, 0, 0, 255, 1.0, 128, 255);
$drawable = gimp_layer_copy($drawable, 0);
gimp_image_add_layer($img, $drawable, -1);
plug_in_displace(1, $img, $drawable, $xdist, $ydist, 1, 1, $dmlayer,
$dmlayer, 1);
if ( $inmode == 1 )
{
gimp_image_lower_layer($img, $drawable);
};
for ( $i = 2; $i <= $nsteps; $i++ ) {
$xdist = ($arithmode) ?
$i * $distance / $nsteps * -cos($angle * 3.14159 / 180) :
$distance ** ($i/$nsteps) * -cos($angle * 3.14159 / 180);
$ydist = ($arithmode) ?
$i * $distance / $nsteps * sin($angle * 3.14159 / 180) :
$distance ** ($i/$nsteps) * sin($angle * 3.14159 / 180);
gimp_edit_clear($dmlayer);
plug_in_noisify(1, $dm, $dmlayer, 0, 255, 255, 255, 0);
gimp_levels($dmlayer, 0, 0, 255, 1.0, 128, 255);
$drawable = gimp_layer_copy($drawable, 0);
gimp_image_add_layer($img, $drawable, -1);
plug_in_displace(1, $img, $drawable, $xdist, $ydist, 1, 1, $dmlayer,
$dmlayer, 1);
if ( $inmode == 1 )
{
gimp_image_lower_layer($img, $drawable);
};
}
eval { $dm->undo_push_group_end };
# gimp_image_remove_layer($dm, $dmlayer);
# gimp_image_delete ($dm);
gimp_palette_set_background($oldbg);
eval { $img->undo_push_group_end };
# gimp_displays_flush(); unneccessary (and dangerous ;)
(); # I like smileys ;)
}
register
"blowinout",
"Blow selected layer inout",
"Generates an animation thats blows the selected layer in or out",
"John Pitney",
"John Pitney <pitney\@uiuc.edu>",
"1999-03-15",
N_"<Image>/Filters/Distorts/BlowInOut",
"*",
[
[PF_INT32, "angle", "Wind Angle, 0 is left", 120],
[PF_INT32, "steps", "Number of Steps/Layers", 5],
[PF_VALUE, "distance", "How far to blow",30],
# What I really need here are radio buttons! Maybe they even exist...
# You wanted them...
[PF_RADIO, "direction", "Blow direction", 0, [In => 1, Out => 0]],
[PF_RADIO, "series", "Kind of series", 1, [Arithmetic => 1, Geometric => 0]]
],
[],
\&blowinout;
exit main;

89
plug-ins/perl/examples/border Executable file
View File

@ -0,0 +1,89 @@
#!/usr/bin/perl
#BEGIN {$^W=1};
use Gimp::Feature qw(pdl);
use Gimp;
use Gimp::Fu;
use PDL::LiteF;
# Gimp::set_trace(TRACE_ALL);
register "border_average",
"calculates the average border colour",
"calulcates the average border colour",
"Marc Lehmann",
"Marc Lehmann",
"0.2.2",
N_"<Image>/Filters/Misc/Border Average",
"RGB",
[
[PF_INT32, "thickness", "Border size to take in count", 10],
[PF_INT32, "bucket_exponent", "Bits for bucket size (default=4: 16 Levels)", 4],
],
[
[PF_COLOUR, "border_colour", "Average Border Colour"],
],
sub { # es folgt das eigentliche Skript...
my($image,$drawable,$thickness,$exponent)=@_;
($empty,@bounds)=$drawable->mask_bounds();
return () if $empty;
my $rexpo = 8-$exponent;
my $bucket_num = 1<<$exponent;
# ideally, we'd use a three-dimensional array, but index3 isn't
# implemented yet, so we do it flat (Still its nicer than C).
my $cube = zeroes long,$bucket_num**3;
my $width = $drawable->width;
my $height = $drawable->height;
$thickness=$width if $thickness>$width;
$thickness=$height if $thickness>$height;
local *add_new_colour = sub($) {
# linearize and quantize pixels (same as original, slightly wrong)
my $pixels = $_[0] >> $rexpo;
# intead of something like
# $cube->index3d($pixels)++;
# we have to first flatten the rgb triples into indexes and use index instead
my $flatten = long([$bucket_num**2,$bucket_num**1,$bucket_num**0]);
my $subcube = $cube->index(inner($pixels,$flatten)->clump(2));
$subcube++;
};
Gimp->progress_init("Border Average", 0);
add_new_colour ($drawable->pixel_rgn ($bounds[0] ,$bounds[1] , $thickness,$height, 0, 0)
->get_rect(0,0, $thickness,$height));
add_new_colour ($drawable->pixel_rgn ($bounds[2]-$thickness,$bounds[1] , $thickness,$height, 0, 0)
->get_rect(0,0, $thickness,$height));
add_new_colour ($drawable->pixel_rgn ($bounds[0] ,$bounds[1] , $width ,$thickness, 0, 0)
->get_rect(0,0, $width, $thickness));
add_new_colour ($drawable->pixel_rgn ($bounds[0] ,$bounds[3]-$thickness, $width ,$thickness, 0, 0)
->get_rect(0,0, $width, $thickness));
# now find the colour
my $max = $cube->maximum_ind;
my $b = $max % $bucket_num << $rexpo;
my $g = ($max >>= $exponent) % $bucket_num << $rexpo;
my $r = ($max >>= $exponent) % $bucket_num << $rexpo;
if ($Gimp::Fu::run_mode != RUN_NONINTERACTIVE)
{
my $layer = new Layer ($image, width $image, height $image, RGB_IMAGE, "bordercolour", 100, NORMAL_MODE);
add_layer $image $layer,0;
Palette->set_background([$r,$g,$b]);
$layer->edit_fill;
Gimp->message("Added layer with border colour ($r,$g,$b) on top");
}
[$r,$g,$b];
};
exit main;

77
plug-ins/perl/examples/ditherize Executable file
View File

@ -0,0 +1,77 @@
#!/usr/bin/perl
use strict 'subs';
use Gimp;
use Gimp::Fu;
#
# this is quite convoluted, but I found no other way to do this than:
#
# create a new image & one layer
# copy & paste the layer
# ditherize new image
# copy & paste back
#
#Gimp::set_trace(TRACE_ALL);
my %imagetype2layertype = (
RGB, RGB_IMAGE,
GRAY, GRAY_IMAGE,
INDEXED, INDEXED_IMAGE,
);
register "plug_in_ditherize",
"dithers current selection",
"This script takes the current selection and dithers it just like convert to indexed",
"Marc Lehmann",
"Marc Lehmann",
"1.2",
N_"<Image>/Filters/Noise/Ditherize",
"RGB*, GRAY*",
[
[PF_RADIO, "dither_type", "The dither type (see gimp_convert_indexed)", 1,
[none => 0, fs => 1, "fs/low-bleed" => 2, ordered => 3]],
[PF_SLIDER, "colours", "The number of colours to dither to", 10, [0, 256, 1, 1]],
],
sub {
my($image,$drawable,$dither,$colours)=@_;
Gimp::set_trace(-1);
$drawable->is_layer or die "this plug-in only works for layers";
$image->undo_push_group_start;
# make sure something is selected
$drawable->mask_bounds or $image->selection_all;
my ($x1,$y1,$x2,$y2)=($drawable->mask_bounds)[1..4];
my ($w,$h)=($x2-$x1,$y2-$y1);
my $sel = $image->selection_save;
$image->rect_select($x1,$y1,$w,$h,REPLACE,0,0);
$drawable->edit_copy;
$sel->selection_load;
$sel->remove_channel;
my $copy = new Image($w, $h, $image->base_type);
$copy->undo_disable;
my $draw = new Layer($copy, $w, $h,
$imagetype2layertype{$image->base_type},
"temporary layer", 100, NORMAL_MODE);
$copy->add_layer ($draw, 1);
$draw->edit_paste(0)->anchor;
$copy->convert_indexed ($dither, MAKE_PALETTE, $colours, 1, 1, "");
$draw->edit_copy;
$drawable->edit_paste(1)->anchor;
$copy->delete;
$image->undo_push_group_end;
();
};
exit main;

70
plug-ins/perl/examples/example-fu Executable file
View File

@ -0,0 +1,70 @@
#!/usr/bin/perl
use Gimp;
use Gimp::Fu;
register "gimp_fu_example_script", # fill in a function name
"A non-working example of Gimp::Fu usage", # and a short description,
"Just a starting point to derive new ". # a (possibly multiline) help text
"scripts. Always remember to put a long".
"help message here!",
"Marc Lehmann <pcg\@goof.com>", # don't forget your name (author)
"(c) 1998, 1999 Marc Lehmann", # and your copyright!
"19990316", # the date this script was written
N_"<Toolbox>/Xtns/Gimp::Fu Example", # the menu path
"RGB*, GRAYA", # image types to accept (RGB, RGAB amnd GRAYA)
[
# argument type, switch name , a short description , default value, extra arguments
[PF_SLIDER , "width" , "The image width" , 360, [300, 500]],
[PF_SPINNER , "height" , "The image height" , 100, [100, 200]],
[PF_STRING , "text" , "The Message" , "example text"],
[PF_INT , "bordersize" , "The bordersize" , 10],
[PF_FLOAT , "borderwidth" , "The borderwidth" , 1/5],
[PF_FONT , "font" , "The Font Family" ],
[PF_COLOUR , "text_colour" , "The (foreground) text colour", [10,10,10]],
[PF_COLOUR , "bg_colour" , "The background colour" , "#ff8000"],
[PF_TOGGLE , "ignore_cols" , "Ignore colours" , 0],
[PF_IMAGE , "extra_image" , "An additonal picture to ignore"],
[PF_DRAWABLE , "extra_draw" , "Somehting to ignroe as well" ],
[PF_RADIO , "type" , "The effect type" , 0, [small => 0, large => 1]],
[PF_BRUSH , "a_brush" , "An unused brush" ],
[PF_PATTERN , "a_pattern" , "An unused pattern" ],
[PF_GRADIENT , "a_gradients" , "An unused gradients" ],
],
sub {
# now do sth. useful with the garbage we got ;)
my($width,$height,$text,$font,$fg,$bg,$ignore,$brush,$pattern,$gradient)=@_;
# set tracing
Gimp::set_trace(TRACE_ALL);
my $img=new Image($width,$height,RGB);
# put an undo group around any modifications, so that
# they can be undone in one step. The eval shields against
# gimp-1.0, which does not have this function.
eval { $img->undo_push_group_start };
my $l=new Layer($img,$width,$height,RGB,"Background",100,NORMAL_MODE);
$l->add_layer(0);
# now a few syntax examples
Palette->set_foreground($fg) unless $ignore;
Palette->set_background($bg) unless $ignore;
fill $l BG_IMAGE_FILL;
$text_layer=$img->text_fontname(-1,10,10,$text,5,1,xlfd_size($font),$font);
gimp_palette_set_foreground("green");
# close the undo push group
eval { $img->undo_push_group_end };
$img; # return the image, or an empty list, i.e. ()
};
exit main;

32
plug-ins/perl/examples/example-net Executable file
View File

@ -0,0 +1,32 @@
#!/usr/bin/perl
# example for the gimp-perl-server (also called Net-Server)
use Gimp;
Gimp::on_lib {
print STDERR "$0: this script is not intended to be run from within the gimp!\n";
};
Gimp::on_net {
# simple benchmark ;)
$img=new Gimp::Image(600,300,RGB);
# the is the same as $img = new Image(600,300,RGB)
$bg=$img->layer_new(30,20,RGB_IMAGE,"Background",100,NORMAL_MODE);
$bg->add_layer(1);
new Gimp::Display($img);
for $i (0..255) {
Palette->set_background([$i,255-$i,$i]);
$bg->edit_fill;
Display->displays_flush ();
}
# Gimp::Net::server_quit; # kill the gimp-perl-server-extension (ugly name)
};
exit main;

37
plug-ins/perl/examples/example-oo Normal file
View File

@ -0,0 +1,37 @@
#!/usr/bin/perl
# this extension shows some oo-like calls
# it's really easy
use Gimp;
# the extension that's called.
sub plug_in_example_oo {
my $img=new Image(300,200,RGB);
my $bg=new Layer($img,300,200,RGB_IMAGE,"Background",100,NORMAL_MODE);
Palette->set_background([200,200,100]);
$bg->fill(BG_IMAGE_FILL);
# Palette->set_background([200,100,200]);
# gimp_drawable_fill ($bg,BG_IMAGE_FILL);
$img->add_layer($bg,1);
new Display($img);
}
Gimp::on_run {
plug_in_example_oo;
};
Gimp::on_query {
gimp_install_procedure("plug_in_example_oo", "a test plug-in in perl",
"try it out", "Marc Lehmann", "Marc Lehmann", "1998-04-27",
N_"<Toolbox>/Xtns/Perl Example Plug-in", "*", PROC_EXTENSION,
[[PARAM_INT32, "run_mode", "Interactive, [non-interactive]"]], []);
};
exit main;

41
plug-ins/perl/examples/feedback Executable file
View File

@ -0,0 +1,41 @@
#!/usr/bin/perl
# 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;
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 <sjburges\@gimp.org>",
"2-15-99",
N_"<Image>/Filters/Noise/Feedback",
"RGB, GRAY",
[
[PF_SLIDER, "offset", "the amount the frames will offset", 3, [0, 255, 1]],
[PF_SLIDER, "repeat", "the number of times to repeat the illusion", 3, [0, 100, 1]],
],
sub {
my($img,$drawable,$offset,$repeat)=@_;
eval { $img->undo_push_group_start };
for (; $repeat>0; $repeat--) {
$drawable = $img->flatten;
$copylayer = $drawable->copy(1);
$img->add_layer($copylayer,0);
$copylayer->scale($img->width - $offset, $img->height - $offset, 0);
}
$img->flatten;
eval { $img->undo_push_group_end };
return();
};
exit main;

151
plug-ins/perl/examples/homepage-logo Normal file
View File

@ -0,0 +1,151 @@
#!/usr/bin/perl
# THIS IS OUTDATED AND WILL NOT RUN WITH CURRENT GIMP VERSIONS!
# this test-plugin will create a simple button, and does automatically
# save it as an indexed gif in /tmp/x.gif
# it works as plug-in as well as standalone!
# this script is old (its the first script ever written for gimp-perl)
# and I had no time to fix it yet.
use Gimp;
$blend1 = [0, 150, 255];
$blend2 = [0, 255, 208];
$black = "#000000";
$font = "Engraver";
# enable example mode... if disabled, it will write out some logos, and not
# wont' display anything.
$example = 1;
# set trace level to watch functions as they are executed
Gimp::set_trace(TRACE_NAME) if $example;
sub set_fg ($) { gimp_palette_set_foreground ($_[0]) };
sub set_bg ($) { gimp_palette_set_background ($_[0]) };
sub get_fg ($) { gimp_palette_get_foreground () };
sub get_bg ($) { gimp_palette_get_background () };
# shorthand function for drawing text
sub text($$$$$) {
my($img,$text,$border,$font,$size)=@_;
my $layer=gimp_text($img,-1,0,0,$text,$border,1,$size,PIXELS,"*",$font,"*","*","*","*");
if (wantarray()) {
($layer,gimp_text_get_extents($text,$size,PIXELS,"*",$font,"*","*","*","*"));
} else {
$layer;
}
}
# convert image to indexed
# and automatically save it as interlaced gif.
sub index_and_save($$) {
my($img,$path)=@_;
gimp_image_flatten($img);
gimp_convert_indexed_palette($img,1,0,32,"");
file_gif_save(RUN_NONINTERACTIVE,$img,-1,$path,$path,1,0,0,0) unless $example;
}
sub write_logo {
my($string,$active,$w,$h,$uc)=@_;
# create a new image
my $img=gimp_image_new($w,$h,RGB);
# and a layer for it
my $bg=gimp_layer_new($img,$w,$h,RGB_IMAGE,"Background",100,NORMAL_MODE);
gimp_image_add_layer($img,$bg,1);
set_fg($blend1);
set_bg($blend2);
# blend the background
gimp_blend($bg,FG_BG_HSV,NORMAL_MODE,LINEAR,100,0,
REPEAT_NONE,0,0,0,
0,0,$w*0.9,$h);
gimp_rect_select ($img,$w*0.92,0,$w,$h,REPLACE, 0, 0);
gimp_blend($bg,FG_BG_HSV,NORMAL_MODE,LINEAR,100,0,
REPEAT_NONE,0,0,0,
$w,0,$w*0.92,0);
gimp_selection_all($img);
set_fg($black);
my ($text,$tw,$th,$ta,$td) = text ($img, $string, 1, $font, $active ? $h*0.7 : $h*0.5);
gimp_layer_translate ($text,($w-$tw)/2,($h-$th+$td)/2);
my ($shadow) = gimp_layer_copy ($text, 0);
plug_in_gauss_rle ($text, 1, 1, 1) unless $active;
gimp_image_add_layer ($img,$shadow,1);
gimp_shear ($shadow,1,ORIENTATION_HORIZONTAL,-$th);
gimp_layer_scale ($shadow, $tw, $th*0.3, 1);
gimp_layer_translate ($shadow, $th*0.1, $th*0.3);
plug_in_gauss_rle ($shadow, 1, 1, 1);
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;
# add an under construction sign
if ($uc) {
set_fg($active ? "#a00000" : "#000000");
my ($uc,$tw,$th,$ta,$td) = text ($img, "u/c", 1, $font, $h*0.4);
gimp_rotate ($uc,1,0.2);
gimp_layer_translate ($uc,$w*0.84,($h-$th+$td)/2);
}
index_and_save ($img, "/root/www/src/marc/images/${string}_".($active ? "on" : "off").".gif");
gimp_display_new ($img) if $example;
gimp_image_delete($img) unless $example;
}
# the extension that's called.
sub extension_homepage_logo {
# if in example mode just draw one example logo.
if($example) {
push(@logos,[ "-Projects", 0, 480, 60 ]);
# push(@logos,[ "-Projects", 1, 480, 60 ]);
} else {
for $active (0, 1) {
for $string (qw(Projects -Background -Main)) {
push(@logos,[$string,$active,240,30]);
}
}
for $active (0, 1) {
for $string (qw(PGCC Judge -FreeISDN -Gimp -Destripe -Links -EGCS)) {
push(@logos,[$string,$active,240,20]);
}
}
}
gimp_progress_init ("rendering buttons...");
$numlogos = $#logos+1;
while($#logos>=0) {
gimp_progress_update (1-($#logos+1)/$numlogos);
my($string,$active,$w,$h)=@{pop(@logos)};
$uc=$string=~s/^-//;
write_logo($string,$active,$w,$h,$uc);
}
}
sub query {
gimp_install_procedure("extension_homepage_logo", "a test extension in perl",
"try it out", "Marc Lehmann", "Marc Lehmann", "1997-02-06",
N_"<Toolbox>/Xtns/Homepage-Logo", "*", PROC_EXTENSION,
[[PARAM_INT32, "run_mode", "Interactive, [non-interactive]"]], []);
}
sub net {
extension_homepage_logo;
}
exit main;

545
plug-ins/perl/examples/logulator
View File

File diff suppressed because it is too large Load Diff

2
plug-ins/perl/examples/perlcc
View File

@ -78,7 +78,7 @@ sub gtkview_log {
$w->vbox->add($b);
$b->realize; # for gtk-1.0
$b->insert($font,$b->style->fg(-normal),undef,$log);
$b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*($lines+1));
$b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*($lines+2));
$b = new Gtk::Button "OK";
$b->can_default(1);

109
plug-ins/perl/examples/prep4gif Executable file
View File

@ -0,0 +1,109 @@
#!/usr/bin/perl
use Gimp qw(:auto N_ __);
use Gimp::Fu;
# This script requires a Gimp version >= 0.96 (I haven't checked - ymmv)
# small changes by Marc Lehmann <pcg@goof.com>
# prep4gif.pl
# by Seth Burgess <sjburges@gimp.org>
# June 29, 1998
#
# This perl plug-in prepares a multilayer RGB image for use as a
# transparent gif. To use this prpoerly, you want to have something
# close to the intended background as the bottom layer. If convert
# to indexed is not selected, the bottom two options are unused.
#
# TODO: Write a nicer GUI than Gimp::Fu provides (learn some gtk)
# Anything else that seems useful
# Gimp::set_trace(TRACE_ALL);
sub prep {
my ($img, $drawable, $threshold, $growth, $index, $dither, $colors) = @_;
# Duplicate this image, and work on the duplicate for the rest of the
# procedure.
my $out = gimp_channel_ops_duplicate($img);
# @layers is the ordered list, from top to bottom, of all layers in the
# duplicated image. To find length of the list, use $#layers
my @layers = gimp_image_get_layers($out);
# if there's not enough layers, abort.
if ($#layers <= 0) {
gimp_message(__"You need at least 2 layers to perform prep4gif");
return;
}
# Show the image early - this makes debugging a breeze
my $newdisplay = gimp_display_new($out);
# Hide the bottom layer, so it doesn't get into the merge visible later.
my $bottomlayer = $layers[$#layers];
gimp_layer_set_visible($bottomlayer, 0);
gimp_layer_add_alpha($bottomlayer);
# NOTE TO PERL NEWBIES - 'my' variables should be declared in their outermost
# scope - if defined inside the if statement, will disappear to program.
my $foreground;
if ($#layers > 1) {
$foreground = gimp_image_merge_visible_layers($out, 0);
}
else {
$foreground = $layers[0];
};
my $layer_mask = gimp_layer_create_mask($foreground,2);
gimp_image_add_layer_mask ($out, $foreground, $layer_mask);
gimp_threshold($layer_mask,$threshold,255);
# Transfer layer mask to selection, and grow the selection
gimp_selection_layer_alpha($foreground);
gimp_selection_grow($out,$growth);
# Apply this selection to the background
gimp_layer_set_visible($bottomlayer, 1);
gimp_image_set_active_layer($out, $bottomlayer);
gimp_selection_invert($out);
gimp_edit_cut($bottomlayer);
# Clean up after yourself
gimp_image_remove_layer_mask($out, $foreground, 1);
my $outlayer = gimp_image_merge_visible_layers($out,0);
# Convert to indexed
if ($index) {
gimp_convert_indexed($out,1, MAKE_PALETTE, $colors, $dither, 1, "");
}
# Show all the changes.
gimp_displays_flush();
();
}
register
"prep4gif",
"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 <sjburges\@gimp.org>",
"2-15-98",
N_"<Image>/Filters/Web/Prepare for GIF...",
"RGB*",
[
[PF_INT32, "lower_threshold", "Lower Alpha Threshold", 64],
[PF_INT32, "growth", "How Much growth for safety ",1],
[PF_TOGGLE, "convert_to_indexed", "Convert Image to indexed", 0],
[PF_TOGGLE, "dither", "Floyd-Steinberg Dithering?", 1],
[PF_INT32, "colors", "Colors to quantize to", "255"],
],
\&prep;
exit main;

59
plug-ins/perl/examples/scratches Executable file
View File

@ -0,0 +1,59 @@
#!/usr/bin/perl
use Gimp;
use Gimp::Fu;
use Gimp::Util;
sub new_scratchlayer {
my($image,$length,$gamma,$angle)=@_;
my $type=$image->layertype(0);
my($layer)=$image->layer_new ($image->width, $image->height, $image->layertype(0),
"displace layer ($angle)", 100, NORMAL_MODE);
$layer->add_layer(-1);
$layer->fill (WHITE_IMAGE_FILL);
$layer->noisify (0, 1, 1, 1, 0);
$layer->mblur (0, $length, $angle);
#$layer->levels (VALUE_LUT, 120, 255, $gamma, 0, 255);
$layer->levels (VALUE_LUT, 120, 255, 0.3, 0, 255);
$layer;
}
register "scratches",
"Create a scratch effect",
"Add scratches to an existing image. Works best on a metallic-like background.",
"Marc Lehmann",
"Marc Lehmann <pcg\@goof.com>",
"19990223",
N_"<Image>/Filters/Distorts/Scratches",
"*",
[
[PF_SLIDER , "angle_x" , "The horizontal angle" , 30, [ 0, 360]],
[PF_SLIDER , "angle_y" , "The vertical angle" , 70, [ 0, 360]],
[PF_SLIDER , "gamma" , "Scratch map gamma" , 0.3, [0.1, 10, 0.05]],
[PF_SPINNER , "smoothness" , "The scratch smoothness" , 15, [ 0, 400]],
[PF_SPINNER , "length" , "The scratch length" , 10, [ 0, 400]],
#[PF_BOOL, , "bump_map" , "Use bump map instead of displace", 0],
],
[],
['gimp-1.1'],
sub {
my($image,$drawable,$anglex,$angley,$gamma,$length,$width)=@_;
$image->undo_push_group_start;
my $layer1 = new_scratchlayer ($image, $length, $gamma, $anglex);
my $layer2 = new_scratchlayer ($image, $length, $gamma, $angley);
$drawable->displace ($width, $width, 1, 1, $layer1, $layer2, WRAP);
$layer1->remove_layer;
$layer2->remove_layer;
$image->undo_push_group_end;
$image;
};
exit main;

37
plug-ins/perl/examples/view3d Executable file
View File

@ -0,0 +1,37 @@
#!/usr/bin/perl
use Gimp::Feature qw(pdl);
use PDL;
BEGIN { eval "use PDL::Graphics::TriD"; $@ and Gimp::Feature::missing('PDL TriD (OpenGL) support') }
use Gimp;
use Gimp::Fu;
register
'view3d',
'View grayscale drawable in 3D',
'This script uses PDL::Graphics:TriD to view a grayscale drawable in 3D. You can choose a Cartesian (default) or Polar projection, toggle the drawing of lines, and toggle normal smoothing.',
'Tom Rathborne', 'GPLv2', '1999-03-11',
N_"<Image>/View/3D Surface",
'RGB*,GRAY*', [
[ PF_BOOL, 'polar', 'Radial view', 0],
[ PF_BOOL, 'lines', 'Draw grid lines', 0],
[ PF_BOOL, 'smooth', 'Smooth surface normals', 1]
], [],
sub {
my ($img, $dwb, $polar, $lines, $smooth) = @_;
my $w = $dwb->width;
my $h = $dwb->height;
my $regn = $dwb->pixel_rgn (0, 0, $w, $h, 0, 0);
my $surf = $regn->get_rect (0, 0, $w, $h);
$surf=$surf->slice("(0)");
imag3d [ $polar ? 'POLAR2D' : 'SURF2D', $surf ],
{ 'Lines' => $lines, 'Smooth' => $smooth };
();
};
exit main;

47
plug-ins/perl/examples/webify Executable file
View File

@ -0,0 +1,47 @@
#!/usr/bin/perl
use Gimp;
use Gimp::Fu;
#Gimp::set_trace(TRACE_ALL);
register "webify",
"Make an image suitable for the web",
"This plug-in converts the image to indexed, with some extra options",
"Marc Lehmann",
"Marc Lehmann",
"1.0",
N_"<Image>/Filters/Web/Webify",
"RGB*, GRAY*",
[
[PF_BOOL, "new", "create a new image?", 1],
[PF_BOOL, "transparent", "make transparent?", 1],
[PF_COLOUR, "bg_color", "the background colour to use for transparency", "white"],
[PF_SLIDER, "threshold", "the threshold to use for background detection", 3, [0, 255, 1]],
[PF_INT32, "colors", "how many colours to use (0 = don't convert to indexed)", 32],
[PF_BOOL, "autocrop", "autocrop at end?", 1],
],
sub {
my($img,$drawable,$new,$alpha,$bg,$thresh,$colours,$autocrop)=@_;
$img = $img->channel_ops_duplicate if $new;
eval { $img->undo_push_group_start };
$drawable = $img->flatten;
if ($alpha) {
$drawable->add_alpha;
$drawable->by_color_select($bg,$thresh,REPLACE,1,0,0,0);
$drawable->edit_cut if $img->selection_bounds;
}
Plugin->autocrop($drawable) if $autocrop;
$img->convert_indexed (2, 0, $colours, 0, 0, '') if $colours;
eval { $img->undo_push_group_end };
$new ? ($img->clean_all, $img) : ();
};
exit main;

65
plug-ins/perl/examples/windify Executable file
View File

@ -0,0 +1,65 @@
#!/usr/bin/perl
# 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);
sub windify {
my ($img, $drawable, $angle, $density, $distance, $wrap) = @_;
my $oldbg = gimp_palette_get_background();
my $xsize = gimp_drawable_width($drawable);
my $ysize = gimp_drawable_height($drawable);
my $out = gimp_image_new($xsize,$ysize,0);
gimp_palette_set_background([128,128,128]);
my $windlayer = gimp_layer_new($out,$xsize,$ysize,RGB_IMAGE,"Windlayer",100,NORMAL_MODE);
gimp_drawable_fill($windlayer, 0);
gimp_image_add_layer($out,$windlayer,0);
my $windlayercopy = gimp_layer_copy($windlayer, 1);
gimp_image_add_layer($out,$windlayercopy,0);
plug_in_noisify(1,$out,$windlayercopy,0,$density/255,
$density/255,
$density/255,1);
plug_in_mblur(1,$out,$windlayercopy,0,15,$angle);
gimp_layer_set_mode($windlayercopy, 10); # Lighten Only
gimp_image_merge_visible_layers($out,0);
# many thanks to Dov for this suggestion as a workaround to the
# gimp_image_merge_visible_layers bug
my $newlay = gimp_image_get_active_layer ($out);
plug_in_displace(1,$img,$drawable,-$distance*cos($angle*180/3.14159),
$distance*sin($angle*180/3.14159),
1,1, $newlay,$newlay, $wrap);
gimp_image_remove_layer($out,$newlay);
gimp_image_delete ($out);
gimp_palette_set_background($oldbg);
gimp_displays_flush();
undef;
}
register
"windify",
"Add wind to an image",
"Blow your image all over :)",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1998-09-14",
N_"<Image>/Filters/Distorts/Windify",
"*",
[
[PF_INT32, "angle", "Wind Angle, 0 is left", 120],
[PF_INT32, "density", "How Much Is Blown",80],
[PF_VALUE, "distance", "How Far Its Blown",30],
[PF_TOGGLE, "smear", "Smear on Edges (or Wrap)",0]
],
\&windify;
exit main;

119
plug-ins/perl/examples/xachlego Executable file
View File

@ -0,0 +1,119 @@
#!/usr/bin/perl
# This is (hopefully) a demonstration of how pathetically easy it is to script
# a neato effect you've come up with. This lil' effect was created by xach,
# and translated by sjburges (me). You can consider it released under the GPL
# or Artistic liscence, whichever makes you happier.
#
# <Xach> sjburges: 1. pixelize the photo 2. in a new white layer, render a grid
# at the same resolution as the pixelize, then blur it. threshold the
# grid until you get a roundish blob in the center of each square (you
# may need to repeat a few times).
# <Xach> sjburges: meanwhile, back at the pixelized image, bumpmap it with
# itself and a depth of about 5. do this twice. then bumpmap it with
# the round blobby layer.
# <Xach> then create a new, clean grid, and bumpmap the pixelized layer with it
#
# (To get a decent blobby grid)
# <Xach> <Xach> render a grid at 10x10, gaussian blur at 7, then set levels to
# 196 1.00 234
# Revision - 1.1: added a gimp_displays_flush() for 1.0.x users
# stopped deleting the layers after removal - it was
# causing bad things to happen with refcounts. I hope
# gimp is cleaning up this memory on its own...
# 1.2: Fixed buggy selection handling - oops ;)
# 1.3: Added undo capability by Marc Lehman <pcg@goof.com>
# 1.4: Marc Lehman <pcg@goof.com>, changed function name
# 1.5: Seth Burgess <sjburges@gimp.org> added my email, put it
# in a directory more suitable than the lame "Misc"
# Here's the boring start of every script...
use Gimp qw(:auto __ N_);
use Gimp::Fu;
register "xach_blocks",
"Xach's Blocks o' Fun",
"Turn your picture into something that resembles a certain trademarked
building block creation",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"2-15-98",
N_"<Image>/Filters/Map/Xach Blocks...",
"*",
[
[PF_SLIDER, "block_size", "The size of the blocks", 10, [0, 255, 1]],
[PF_SLIDER, "knob_factor", "The size of your knob", 40, [0, 100, 5]],
],
sub {
my($img,$drawable,$blocksize, $knobfactor)=@_;
$selection_flag = 0;
eval { $img->undo_push_group_start };
if (!$drawable->has_alpha) {
$drawable->add_alpha;
};
if ($img->selection_is_empty) {
$img->selection_all;
$selection_flag = 1;
}
$oldbackground = gimp_palette_get_background();
# Now the fun begins :)
$selection = $img->selection_save;
#1. Pixelize the photo
$drawable->plug_in_pixelize($blocksize);
# 2. in a new white layer, render a grid
# at the same resolution as the pixelize, then blur it.
$gridlayer = $img->layer_new($img->width, $img->height, RGBA_IMAGE, "Grid 1", 100, 0);
$img->add_layer($gridlayer,0);
$img->selection_all;
gimp_edit_clear($gridlayer);
gimp_palette_set_background([255,255,255]);
gimp_edit_fill($gridlayer);
$gridlayer->plug_in_grid(1, $blocksize, 0, [0,0,0], 255, 1, $blocksize, 0, [0,0,0], 255, 0, 0, 0, [0,0,0], 0);
$gridlayer->plug_in_gauss_iir(0.7*$blocksize, 1, 1);
# threshold the
# grid until you get a roundish blob in the center of each square (you
# may need to repeat a few times).
$gridlayer->levels(0, 196, 234, $knobfactor/100.0 , 0, 255);
# <Xach> sjburges: meanwhile, back at the pixelized image, bumpmap it with
# itself and a depth of about 5. do this twice.
gimp_selection_load($selection);
$drawable->plug_in_bump_map($drawable, 135, 45, 5, 0, 0, 0, 0, 1, 0, 0);
$drawable->plug_in_bump_map($drawable, 135, 45, 5, 0, 0, 0, 0, 1, 0, 0);
$drawable->plug_in_bump_map($gridlayer, 135, 45, 5, 0, 0, 0, 0, 1, 0, 0);
# <Xach> then create a new, clean grid, and bumpmap the pixelized layer with it
$img->selection_all;
$cleangrid = $img->layer_new($img->width, $img->height,
RGBA_IMAGE, "Grid 2", 100, 0);
$img->add_layer($cleangrid,0);
gimp_edit_fill($cleangrid);
$cleangrid->plug_in_grid(1, $blocksize, 0, [0,0,0], 255, 1, $blocksize, 0, [0,0,0], 255, 0, 0, 0, [0,0,0], 0);
gimp_selection_load($selection);
$drawable->plug_in_bump_map($cleangrid, 135, 45, 3, 0, 0, 0, 0, 1, 0, 0);
$img->selection_all;
# Clean up stuff
$img->remove_layer($cleangrid);
# $cleangrid->delete; # Deleting these layers after removal seems to cause
# strange problems (I think gimp handles this
# automatically now)
$img->remove_layer($gridlayer);
# $gridlayer->delete;
gimp_selection_load($selection);
gimp_palette_set_background($oldbackground);
if ($selection_flag ==1) {
$img->selection_none;
}
eval { $img->undo_push_group_end };
return ();
};
exit main;

87
plug-ins/perl/examples/xachshadow Executable file
View File

@ -0,0 +1,87 @@
#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if 0; # not running under some shell
# by Seth Burgess <sjburges@gimp.org>
#[Xach] start off with an image, then pixelize it
#[Xach] then add alpha->add layer mask [20:21]
#[Xach] render a checkerboard into the layer mask
#[Xach] duplicate the image. fill the original with black, then blur the layer
# mask (i used 30% of pixelize size) and offset it by some value (i
# chose 20% of the pixelize size)
#[Xach] duplicate the duplicate, remove the layer mask, move it below everything
#[Xach] then add a new white layer on top, set the mode to multiply, and render
# a grid into it at pixelize size
#[Xach] that's a bit roundabout, but it's also in the xcf
#
# Because the way xach does it is a bit ackward, I'm switching it around a bit
# and working from the bottom up..
# Revision 1.1: Marc Lehman <pcg@goof.com> added undo capability
# Revision 1.2: Marc Lehman <pcg@goof.com>, changed function name
# Revision 1.3: Seth Burgess <sjburges@gimp.org>, changed location and
# added my email address
#
# Here's the boring start of every script...
use Gimp qw(:auto __ N_);
use Gimp::Fu;
register "xach_shadows",
"Xach's Shadows o' Fun",
"Screen of 50% of your drawing into a dropshadowed layer.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"2-15-98",
N_"<Image>/Filters/Map/Xach Shadows...",
"RGB*, GRAY*",
[
[PF_SLIDER, "block_size", "The size of the blocks...", 10, [0, 255, 1]],
],
sub {
my($img,$drawable,$blocksize) =@_;
eval { $img->undo_push_group_start };
# $selection_flag = 0;
if (!$drawable->has_alpha) {
$drawable->add_alpha;
};
# This only can be applied to an entire image right now..
# $selection = $img->selection_save;
$img->selection_all;
$oldbackground = gimp_palette_get_background();
# Now the fun begins :)
$drawable->plug_in_pixelize($blocksize);
$shadowlayer = $drawable->layer_copy(0);
$img->add_layer($shadowlayer,0);
$checkmask = $shadowlayer->create_mask(WHITE_MASK);
$img->add_layer_mask($shadowlayer, $checkmask);
plug_in_checkerboard ($img, $checkmask, 0, $blocksize);
$frontlayer = $shadowlayer->layer_copy(0);
$img->add_layer($frontlayer,0);
gimp_palette_set_background([0,0,0]);
$shadowlayer->fill(BG_IMAGE_FILL);
$checkmask->plug_in_gauss_iir(0.3*$blocksize, 1, 1);
gimp_channel_ops_offset ($checkmask, 1, 0, 0.2*$blocksize, 0.2*$blocksize);
$gridlayer = $img->layer_new($img->width, $img->height, RGBA_IMAGE, "Grid 1", 100, 0);
$img->add_layer($gridlayer,0);
$img->selection_all;
gimp_edit_clear($gridlayer);
gimp_palette_set_background([255,255,255]);
gimp_edit_fill($gridlayer);
$gridlayer->plug_in_grid((1, $blocksize, 0, [0,0,0], 255) x 3);
gimp_layer_set_mode($gridlayer, 3);
# Clean up stuff
gimp_palette_set_background($oldbackground);
eval { $img->undo_push_group_end };
gimp_displays_flush();
return();
};
exit main;

54
plug-ins/perl/examples/xachvision Executable file
View File

@ -0,0 +1,54 @@
#!/usr/bin/perl
# Once again, an effect of Xach's
# Created by Seth Burgess <sjburges@gimp.org>
use Gimp qw(:auto __ N_);
use Gimp::Fu;
register "xachvision",
"Xach Survielence Camera/XachVision",
"This makes an interlaced-looking machine vision type thing.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-02-28",
N_"<Image>/Filters/Noise/Xach Vision...",
"RGB*, GRAY*",
[
[PF_COLOR, "color", "What Color to see the world in", [0, 255, 0]],
[PF_SLIDER, "added_noise", "How much noise to add", 25, [0,255,5]]
],
sub {
my($img,$drawable,$color,$amt) =@_;
eval { $img->undo_push_group_start };
$oldbackground = gimp_palette_get_background();
$midlayer = $drawable->gimp_layer_copy(1);
$img->add_layer($midlayer, 0);
$toplayer = $drawable->gimp_layer_copy(0);
$img->add_layer($toplayer, 0);
gimp_palette_set_background($color);
$toplayer->edit_fill();
$toplayer->set_mode(COLOR_MODE);
gimp_palette_set_background([0,0,0]);
$drawable->edit_fill();
$amt = $amt/255;
$midlayer->plug_in_noisify(1,$amt, $amt, $amt, $amt);
$midmask = $midlayer->create_mask(0);
$img->add_layer_mask($midlayer, $midmask);
$midmask->plug_in_grid($img->height * 3, 3, 0, 0);
$midmask->plug_in_gauss_iir(1.01, 1, 1);
gimp_palette_set_background($oldbackground);
eval { $img->undo_push_group_end };
gimp_displays_flush();
return();
};
exit main;

1704
plug-ins/perl/po/it.po
View File

File diff suppressed because it is too large Load Diff

6
plug-ins/perl/scm2perl
View File

@ -98,10 +98,8 @@ $parser = new Parse::RecDescent <<'EOA';
RGB RGB_IMAGE
RGBA RGBA_IMAGE
ADD SELECTION_ADD
SUB SELECTION_SUB
REPLACE SELECTION_REPLACE
LINEAR LINEAR_INTERPOLATION
NORMAL NORMAL_MODE
ADDITION ADDITION_MODE