yosh/ 40775 767 770 0 6740554101 10434 5ustar gnomegnomeyosh/diffs100664 767 770 33072 6740553156 11605 0ustar gnomegnome? app/macro.h ? app/macro.c ? app/macro.scm ? app/macro_support.scm Index: configure.in =================================================================== RCS file: /cvs/gnome/gimp/configure.in,v retrieving revision 1.171 diff -u -r1.171 configure.in --- configure.in 1999/06/28 13:28:29 1.171 +++ configure.in 1999/07/07 04:27:04 @@ -331,6 +331,8 @@ AC_FUNC_ALLOCA +GUILE_FLAGS + dnl Check for sys/select.h AC_MSG_CHECKING([fd_set and sys/select]) @@ -629,6 +631,8 @@ plug-ins/megawidget/Makefile plug-ins/gpc/Makefile plug-ins/dbbrowser/Makefile +plug-ins/guile-fu/Makefile +plug-ins/guile-fu/scripts/Makefile plug-ins/script-fu/Makefile plug-ins/script-fu/scripts/Makefile plug-ins/webbrowser/Makefile Index: app/Makefile.am =================================================================== RCS file: /cvs/gnome/gimp/app/Makefile.am,v retrieving revision 1.86 diff -u -r1.86 Makefile.am --- app/Makefile.am 1999/07/03 08:31:49 1.86 +++ app/Makefile.am 1999/07/07 04:27:04 @@ -28,6 +28,8 @@ gimpsignal.h gimp_SOURCES = \ + macro.h \ + macro.c \ about_dialog.c \ about_dialog.h \ actionarea.c \ @@ -409,6 +411,7 @@ -DLIBDIR=\""$(gimpplugindir)"\" \ -DLOCALEDIR=\""$(localedir)"\" \ -DREGEX_MALLOC \ + -DMACROS \ @GIMP_THREAD_FLAGS@ \ @GIMP_MP_FLAGS@ Index: app/app_procs.c =================================================================== RCS file: /cvs/gnome/gimp/app/app_procs.c,v retrieving revision 1.88 diff -u -r1.88 app_procs.c --- app/app_procs.c 1999/06/26 03:11:25 1.88 +++ app/app_procs.c 1999/07/07 04:27:04 @@ -70,6 +70,7 @@ #include "palette.h" #include "patterns.h" #include "plug_in.h" +#include "macro.h" #include "module_db.h" #include "procedural_db.h" #include "session.h" @@ -490,6 +491,7 @@ procedural_db_init (); RESET_BAR(); internal_procs_init (); + macro_register (); RESET_BAR(); parse_buffers_init (); Index: app/appenv.h =================================================================== RCS file: /cvs/gnome/gimp/app/appenv.h,v retrieving revision 1.14 diff -u -r1.14 appenv.h --- app/appenv.h 1999/02/22 19:30:02 1.14 +++ app/appenv.h 1999/07/07 04:27:04 @@ -68,4 +68,6 @@ extern GimpSet* image_context; extern MessageHandlerType message_handler; +#include "macro.h" + #endif /* APPENV_H */ Index: app/clone.c =================================================================== RCS file: /cvs/gnome/gimp/app/clone.c,v retrieving revision 1.26 diff -u -r1.26 clone.c --- app/clone.c 1999/07/06 15:18:24 1.26 +++ app/clone.c 1999/07/07 04:27:04 @@ -312,9 +312,22 @@ if (clone_options->type == PATTERN_CLONE) if (!get_active_pattern ()) g_message (_("No patterns available for this operation.")); +#ifdef MACROS + macro_add ("(clone start %d %d %d %d %d %f %f)\n", + pdb_image_to_id (gimp_drawable_gimage (drawable)), + gimp_drawable_get_tattoo (drawable), + pdb_image_to_id (gimp_drawable_gimage (src_drawable_)), + gimp_drawable_get_tattoo (src_drawable_), + clone_options->type, + (gfloat) src_x, + (gfloat) src_y); +#endif break; case FINISH_PAINT : +#ifdef MACROS + macro_add ("(clone finish)\n"); +#endif draw_core_stop (paint_core->core, active_tool); if (clone_options->aligned == AlignNo && !first) { Index: app/ellipse_select.c =================================================================== RCS file: /cvs/gnome/gimp/app/ellipse_select.c,v retrieving revision 1.15 diff -u -r1.15 ellipse_select.c --- app/ellipse_select.c 1999/07/02 17:40:10 1.15 +++ app/ellipse_select.c 1999/07/07 04:27:04 @@ -49,6 +49,14 @@ { Channel * new_mask; +#ifdef MACROS + macro_add ("(ellipse_select %d %f %f %f %f %d %d %d %f)\n", + pdb_image_to_id (gimage), + (gfloat) x, (gfloat) y, + (gfloat) w, (gfloat) h, + op, antialias, feather, feather_radius); +#endif + /* if applicable, replace the current selection */ if (op == SELECTION_REPLACE) gimage_mask_clear (gimage); Index: app/gimpbrushlist.c =================================================================== RCS file: /cvs/gnome/gimp/app/gimpbrushlist.c,v retrieving revision 1.19 diff -u -r1.19 gimpbrushlist.c --- app/gimpbrushlist.c 1999/04/23 20:53:24 1.19 +++ app/gimpbrushlist.c 1999/07/07 04:27:04 @@ -41,6 +41,7 @@ #include "devices.h" #include "errors.h" #include "general.h" +#include "gimpcontext.h" #include "gimprc.h" #include "gimpsignal.h" #include "menus.h" @@ -412,6 +413,14 @@ gimp_brush_list_get_brush_index(brush_list, brush)); device_status_update (current_device); + +#ifdef MACROS + macro_add ("(brush select \"%s\" %f %d %d)\n", + brush->name, + gimp_context_get_opacity (gimp_context_get_current ()), + gimp_brush_get_spacing (get_active_brush ()), + gimp_context_get_paint_mode (gimp_context_get_current ())); +#endif } Index: app/paint_core.c =================================================================== RCS file: /cvs/gnome/gimp/app/paint_core.c,v retrieving revision 1.52 diff -u -r1.52 paint_core.c --- app/paint_core.c 1999/07/02 17:40:10 1.52 +++ app/paint_core.c 1999/07/07 04:27:04 @@ -46,6 +46,25 @@ #define SQR(x) ((x) * (x)) #define EPSILON 0.00001 +#include +#include + +#if 0 +#define TIMERS \ + struct timeval _x_[2]; + +#define TIMERS_START \ + gettimeofday (&_x_[0], NULL) + +#define TIMERS_STOP(n) \ + gettimeofday (&_x_[1], NULL); \ + printf ("%d - %10d\n", n, (_x_[1].tv_sec*1000000+_x_[1].tv_usec) - (_x_[0].tv_sec*1000000+_x_[0].tv_usec)); +#else +#define TIMERS +#define TIMERS_START +#define TIMERS_STOP(n) +#endif + /* global variables--for use in the various paint tools */ PaintCore non_gui_paint_core; @@ -136,6 +155,59 @@ }, }; +#ifdef MACROS +void +pc_macro (PaintCore * paint_core, + GimpDrawable *drawable, + gint how) +{ + static numstrokes = 0; + static maxstrokes = 0; + static gfloat * strokes = NULL; + + switch (how) + { + case INIT_PAINT: + numstrokes = 0; + break; + + case MOTION_PAINT: + if (numstrokes >= maxstrokes) + { + gfloat * s = g_new (gfloat, 2 * (maxstrokes + 50)); + if (strokes) + memcpy (s, strokes, 2 * sizeof(gfloat) * numstrokes); + g_free (strokes); + strokes = s; + maxstrokes += 50; + } + strokes[2*numstrokes] = paint_core->curx; + strokes[2*numstrokes+1] = paint_core->cury; + numstrokes++; + break; + + case FINISH_PAINT: + { + gint i; + + macro_add ("(strokes start %d)\n", numstrokes); + for (i=0; itime); /* Let the specific painting function initialize itself */ +#ifdef MACROS + pc_macro (paint_core, drawable, INIT_PAINT); +#endif (* paint_core->paint_func) (paint_core, drawable, INIT_PAINT); if (paint_core->pick_colors @@ -269,8 +344,13 @@ paint_core->lastytilt = paint_core->curytilt; } else - (* paint_core->paint_func) (paint_core, drawable, MOTION_PAINT); - + { +#ifdef MACROS + pc_macro (paint_core, drawable, MOTION_PAINT); +#endif + (* paint_core->paint_func) (paint_core, drawable, MOTION_PAINT); + } + gdisplay_flush_now (gdisp); } @@ -294,6 +374,9 @@ gdk_flush (); /* Let the specific painting function finish up */ +#ifdef MACROS + pc_macro (paint_core, gimage_active_drawable (gdisp->gimage), FINISH_PAINT); +#endif (* paint_core->paint_func) (paint_core, gimage_active_drawable (gdisp->gimage), FINISH_PAINT); /* Set tool state to inactive -- no longer painting */ @@ -341,6 +424,7 @@ paint_core->lastpressure = paint_core->curpressure; paint_core->lastxtilt = paint_core->curxtilt; paint_core->lastytilt = paint_core->curytilt; + } void @@ -457,7 +541,10 @@ case RESUME: break; - case HALT: + case HALT : +#ifdef MACROS + pc_macro (paint_core, drawable, FINISH_PAINT); +#endif (* paint_core->paint_func) (paint_core, drawable, FINISH_PAINT); draw_core_stop (paint_core->core, tool); paint_core_cleanup (); @@ -732,6 +819,9 @@ total = dist + paint_core->distance; initial = paint_core->distance; +#ifdef MACROS + pc_macro (paint_core, drawable, MOTION_PAINT); +#endif while (paint_core->distance < total) { n = (int) (paint_core->distance / paint_core->spacing + 1.0 + EPSILON); @@ -1241,10 +1331,13 @@ PixelRegion srcPR; TileManager *alt = NULL; int offx, offy; - + TIMERS; + if (! (gimage = drawable_gimage (drawable))) return; + TIMERS_START; + /* set undo blocks */ set_undo_tiles (drawable, canvas_buf->x, canvas_buf->y, @@ -1269,6 +1362,9 @@ else /* mode != CONSTANT */ brush_to_canvas_buf (paint_core, brush_mask, brush_opacity); + TIMERS_STOP(1); + TIMERS_START; + /* intialize canvas buf source pixel regions */ srcPR.bytes = canvas_buf->bytes; srcPR.x = 0; srcPR.y = 0; @@ -1283,6 +1379,8 @@ alt, /* specify an alternative src1 */ canvas_buf->x, canvas_buf->y); + TIMERS_STOP(2); + /* Update the undo extents */ paint_core->x1 = MINIMUM (paint_core->x1, canvas_buf->x); paint_core->y1 = MINIMUM (paint_core->y1, canvas_buf->y); Index: app/paintbrush.c =================================================================== RCS file: /cvs/gnome/gimp/app/paintbrush.c,v retrieving revision 1.32 diff -u -r1.32 paintbrush.c --- app/paintbrush.c 1999/07/06 18:13:59 1.32 +++ app/paintbrush.c 1999/07/07 04:27:04 @@ -294,6 +294,16 @@ switch (state) { case INIT_PAINT : + +#ifdef MACROS + macro_add ("(paintbrush start %d %d %f %f %d)\n", + pdb_image_to_id (gimp_drawable_gimage (drawable)), + gimp_drawable_get_tattoo (drawable), + paintbrush_options->fade_out, + paintbrush_options->gradient_length, + paintbrush_options->incremental); +#endif + #if TIMED_BRUSH timer = g_timer_new(); g_timer_start(timer); @@ -310,6 +320,10 @@ break; case FINISH_PAINT : +#ifdef MACROS + macro_add ("(paintbrush finish)\n"); +#endif + #if TIMED_BRUSH if (timer) { Index: app/palette.c =================================================================== RCS file: /cvs/gnome/gimp/app/palette.c,v retrieving revision 1.45 diff -u -r1.45 palette.c --- app/palette.c 1999/06/14 22:17:37 1.45 +++ app/palette.c 1999/07/07 04:27:05 @@ -252,6 +252,10 @@ foreground[1] = g; foreground[2] = b; +#ifdef MACROS + macro_add ("(palette foreground %d %d %d)\n", r, g, b); +#endif + palette_get_foreground (&rr, &gg, &bb); if (no_interface == FALSE) { @@ -272,6 +276,10 @@ background[0] = r; background[1] = g; background[2] = b; + +#ifdef MACROS + macro_add ("(palette background %d %d %d)\n", r, g, b); +#endif palette_get_background (&rr, &gg, &bb); if (no_interface == FALSE) Index: app/patterns.c =================================================================== RCS file: /cvs/gnome/gimp/app/patterns.c,v retrieving revision 1.16 diff -u -r1.16 patterns.c --- app/patterns.c 1999/05/05 12:31:49 1.16 +++ app/patterns.c 1999/07/07 04:27:05 @@ -304,6 +304,10 @@ pattern_select_select (pattern_select_dialog, pattern->index); device_status_update (current_device); + +#ifdef MACROS + macro_add ("(pattern select \"%s\")\n", pattern->name); +#endif } Index: app/pencil.c =================================================================== RCS file: /cvs/gnome/gimp/app/pencil.c,v retrieving revision 1.14 diff -u -r1.14 pencil.c --- app/pencil.c 1999/07/06 15:18:24 1.14 +++ app/pencil.c 1999/07/07 04:27:05 @@ -50,6 +50,11 @@ switch (state) { case INIT_PAINT : +#ifdef MACROS + macro_add ("(pencil start %d %d)\n", + pdb_image_to_id (gimp_drawable_gimage (drawable)), + gimp_drawable_get_tattoo (drawable)); +#endif break; case MOTION_PAINT : @@ -57,6 +62,9 @@ break; case FINISH_PAINT : +#ifdef MACROS + macro_add ("(pencil finish)\n"); +#endif break; default : Index: app/rect_select.c =================================================================== RCS file: /cvs/gnome/gimp/app/rect_select.c,v retrieving revision 1.42 diff -u -r1.42 rect_select.c --- app/rect_select.c 1999/07/02 17:40:10 1.42 +++ app/rect_select.c 1999/07/07 04:27:14 @@ -59,6 +59,14 @@ { Channel * new_mask; +#ifdef MACROS + macro_add ("(rect_select %d %f %f %f %f %d %d %f)\n", + pdb_image_to_id (gimage), + (gfloat) x, (gfloat) y, + (gfloat) w, (gfloat) h, + op, feather, feather_radius); +#endif + /* if applicable, replace the current selection */ if (op == SELECTION_REPLACE) gimage_mask_clear (gimage); Index: plug-ins/Makefile.am =================================================================== RCS file: /cvs/gnome/gimp/plug-ins/Makefile.am,v retrieving revision 1.54 diff -u -r1.54 Makefile.am --- plug-ins/Makefile.am 1999/07/03 08:31:50 1.54 +++ plug-ins/Makefile.am 1999/07/07 04:27:14 @@ -9,6 +9,7 @@ megawidget \ gpc \ dbbrowser \ + guile-fu \ script-fu \ $(GIMP_PERL) \ AlienMap \ yosh/plug-ins/ 40775 767 770 0 6740510126 12171 5ustar gnomegnomeyosh/plug-ins/guile-fu/ 40775 767 770 0 6740554213 13713 5ustar gnomegnomeyosh/plug-ins/guile-fu/.cvsignore100664 767 770 61 6740507660 15751 0ustar gnomegnomeMakefile.in Makefile .deps _libs .libs script-fu yosh/plug-ins/guile-fu/Makefile.am100664 767 770 1755 6740507660 16060 0ustar gnomegnome## Process this file with automake to produce Makefile.in SUBDIRS = scripts scriptdata = pluginlibdir = $(gimpplugindir)/plug-ins bin_PROGRAMS = guile-fu-driver pluginlib_PROGRAMS = guile-fu guile_fu_SOURCES = \ interp.c \ interp.h \ main.c \ server.c \ server.h guile_fu_driver_SOURCES = \ driver.c INCLUDES = \ -I$(top_srcdir) \ $(GTK_CFLAGS) \ $(GUILE_CFLAGS) \ -I$(includedir) guile_fu_LDADD = \ $(top_builddir)/libgimp/libgimpui.la \ $(top_builddir)/libgimp/libgimp.la \ $(GUILE_LDFLAGS) \ $(GTK_LIBS) guile_fu_driver_LDADD = \ -lreadline \ $(GTK_LIBS) DEPS = \ $(top_builddir)/libgimp/libgimpui.la \ $(top_builddir)/libgimp/libgimp.la guile_fu_DEPENDENCIES = $(DEPS) .PHONY: files files: @files=`ls $(DISTFILES) 2> /dev/null`; for p in $$files; do \ echo $$p; \ done @for subdir in $(SUBDIRS); do \ files=`cd $$subdir; $(MAKE) files | grep -v "make\[[1-9]\]"`; \ for file in $$files; do \ echo $$subdir/$$file; \ done; \ done yosh/plug-ins/guile-fu/main.c100664 767 770 4216 6740507660 15107 0ustar gnomegnome/* The GIMP -- an image manipulation program * Copyright (C) 1999 Ray Lehtiniemi * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include "libgimp/gimp.h" #include "server.h" #include "interp.h" static void quit (void) { } static void query (void) { static GParamDef server_args[] = { { PARAM_INT32, "run_mode", "[Interactive], non-interactive" }, { PARAM_INT32, "port", "The port on which to listen for requests" }, { PARAM_STRING, "logfile", "The file to log server activity to" } }; static gint nserver_args = sizeof (server_args) / sizeof (server_args[0]); gimp_install_procedure ("extension_guile_fu", "Provides a server for remote guile operation", "Provides a server for remote guile operation", "Ray Lehtiniemi", "Ray Lehtiniemi", "1999", "/Xtns/Guile-Fu", "", PROC_EXTENSION, nserver_args, 0, server_args, NULL); } static void run (gchar *name, gint nparams, GParam *param, gint *nreturn_vals, GParam **return_vals) { run_the_server (name, nparams, param, nreturn_vals, return_vals); } GPlugInInfo PLUG_IN_INFO = { NULL, quit, query, run, }; static int inner_main (int argc, char * argv[]) { if ((argc >= 4) && (! strcmp (argv[1], "-gimp"))) { return gimp_main (argc, argv); } else { interp_init (); interp_main (); return 0; } } int main (int argc, char * argv[]) { gh_enter (argc, argv, inner_main); return 0; } yosh/plug-ins/guile-fu/scripts/ 40775 767 770 0 6740553222 15401 5ustar gnomegnomeyosh/plug-ins/guile-fu/scripts/chalice.scm100664 767 770 24130 6740507660 17617 0ustar gnomegnome;; -*- scheme -*- ;;===================================================================== ;; ;; Chalice-Gimp Protocol ;; ;; A set of routines that create and interact with a session object ;; ;;===================================================================== ;; Create/edit the script in a gimp node (define chalice-start (lambda (_script _node . args) (let ((s (make-session 'interactive))) ((s 'init) _script _node) ((s 'verify)) ((s 'exec)) ((s 'show)) (add-session 'interactive s) #f))) ;; Get the latest script for the node being edited (define chalice-retrieve (lambda () (let ((s (get-session 'interactive))) ((s 'sync)) ((s 'verify)) ((s 'get-script))))) ;; Terminate an interactive editing session (define chalice-stop (lambda () (let ((s (get-session 'interactive))) ((s 'kill)) #f))) ;; Make sure the node is in a valid state (define chalice-verify (lambda (_script _node . args) (let ((s (make-session 'batch))) ((s 'init) _script _node) ((s 'verify)) ((s 'kill)) #f))) ;; Execute the node script in non-interactive id (define chalice-execute (lambda (_script _node . args) (let ((s (make-session 'batch))) ((s 'init) _script _node) ((s 'verify)) ((s 'exec)) ((s 'kill)) #f))) ;;===================================================================== ;; ;; Session List ;; ;;===================================================================== (define session-list '()) (define (get-session id) (let ((s (assq id session-list))) (or (pair? s) (throw 'session-does-not-exist id)) (cadr s))) (define (add-session id session) (set! session-list (cons (list id session) session-list))) (define (remove-session id) (set! session-list (delq (assq id session-list) session-list))) (define (session-exists? id) (assq id session-list)) ;;===================================================================== ;; ;; Session ;; ;; A mediator that creates and manages several subobjects. ;; ;; node - inputs/outputs for chalice node ;; script - the recorded macro ;; gimp - gimps internal state ;; ;;===================================================================== (define (make-session id) (if (session-exists? id) (throw 'session-already-exists id)) (let* ((gimp #f) (node #f) (script #f)) ;; given a freshly created image in gimp and a macro we've ;; received from chalice, play back the macro (define (exec) ((gimp 'exec-macro) ((script 'get))) #f) ;; ask the script object for the macro (define (get-script) ((script 'get))) ;; create our internal state from the script and node objects we ;; received from chalice (define (init _script _node) (set! gimp (make-gimp)) (set! node (make-node _node)) (set! script (make-script gimp node _script)) ((gimp 'init) node) #f) ;; shut down (define (kill) (remove-session id) ((gimp 'stop-macro)) ((gimp 'kill)) #f) ;; pop up the window and start recording (define (show) ((gimp 'show)) ((gimp 'start-macro)) #f) ;; stop recording, gather up the results, and start recording ;; again (define (sync) ((gimp 'stop-macro)) ((script 'add) ((gimp 'get-macro))) ((gimp 'start-macro)) #f) ;; make sure all the internal state looks good (define (verify) (or (and node script gimp) (throw 'bad-internal-state "run away...")) #f) ;; the session object (lambda (cmd) (cond ((eq? cmd 'exec) exec) ((eq? cmd 'get-script) get-script) ((eq? cmd 'init) init) ((eq? cmd 'kill) kill) ((eq? cmd 'show) show) ((eq? cmd 'sync) sync) ((eq? cmd 'verify) verify) (#t (oops "session")))))) ;;===================================================================== ;; ;; Gimp State ;; ;; Handle invoking script-fu operations ;; ;;===================================================================== (define (make-gimp) (let ((gimage -1) (gdisplay -1)) (define (add-layer l) (let ((layer (car (apply gimp-layer-new (cons gimage (car l)))))) (gimp-drawable-fill layer TRANS-IMAGE-FILL) (gimp-image-add-layer gimage layer 0) (if (not (null? (cdr l))) (let ((mask (car (apply gimp-layer-create-mask (cons layer (cadr l)))))) (gimp-image-add-layer-mask gimage layer mask))))) (define (init node) (set! gimage (car (apply gimp-image-new (node 'image)))) (map add-layer (node 'layers))) (define (show) (if (eqv? gimage -1) (throw 'gimp-show "No gimage")) (set! gdisplay (car (gimp-display-new gimage)))) (define (kill) (or (eqv? gdisplay -1) (begin (gimp-display-delete gdisplay) (set! gdisplay -1) (set! gimage -1))) (or (eqv? gimage -1) (begin (gimp-image-delete gimage) (set! gimage -1)))) (define (start-macro) (gimp-macro 1 "the-macro.trace")) (define (stop-macro) (gimp-macro 0 "the-macro.trace")) (define (get-macro) #f) (define (exec-macro s) #f) (lambda (cmd) (cond ((eq? cmd 'init) init) ((eq? cmd 'show) show) ((eq? cmd 'kill) kill) ((eq? cmd 'start-macro) start-macro) ((eq? cmd 'stop-macro) stop-macro) ((eq? cmd 'get-macro) get-macro) ((eq? cmd 'exec-macro) exec-macro) (#t (oops "gimp")))))) ;;===================================================================== ;; ;; Node ;; ;; An image which the macro will be played back on. ;; ;;===================================================================== (define (make-node _node) (let* ((layers ()) (image ())) ;; make sure node looks valid (define (arg-is-bad) (define (image-ok? i) #t) (define (layer-ok? l) #t) (define (mask-ok? m) #t) ;; check a single input (define (value-ok? v) (cond ((eq? (car v) 'image) (image-ok? (cdr v))) ((eq? (car v) 'layer) (layer-ok? (cdr v))) ((eq? (car v) 'mask) (mask-ok? (cdr v))) (#t #f))) ;; make sure the list of inputs looks kosher (define (values-ok? v) (or (null? v) (and (value-ok? (car v)) (values-ok? (cdr v))))) ;; check the order of the various inputs using a small state machine (define (ordering-ok? tags state) (if (null? tags) (> state 1) (let ((x (list (car tags) state))) (cond ((equal? x '(image 0)) (ordering-ok? (cdr tags) 1)) ((equal? x '(layer 1)) (ordering-ok? (cdr tags) 2)) ((equal? x '(layer 2)) (ordering-ok? (cdr tags) 2)) ((equal? x '(mask 2)) (ordering-ok? (cdr tags) 3)) ((equal? x '(layer 3)) (ordering-ok? (cdr tags) 2)) (#t #f))))) (not (and (pair? _node) (eq? (car _node) 'node) (ordering-ok? (map car (cdr _node)) 0) (values-ok? (cdr _node))))) ;; parse the _node argument and save the results so we can make a ;; layer stack out of them later (define (parse-node) (let* ((i (cadr _node)) (l (cddr _node)) (width (cadr i)) (height (caddr i)) (type (cadr (cddr i)))) (define (layer l) (list width height (cond ((eq? type 'RGB) RGBA_IMAGE) ((eq? type 'GRAY) GRAYA_IMAGE)) "Foo" 100 NORMAL)) (define (mask m) (list WHITE-MASK)) (define (parse-layers l) (cond ((null? l) (throw 'parse-layers "no layers!")) ((null? (cdr l)) (list (list (layer (car l))))) ((eq? 'layer (caadr l)) (cons (list (layer (car l))) (parse-layers (cdr l)))) (#t (cons (list (layer (car l)) (mask (cadr l))) (parse-layers (cddr l)))))) (set! layers (parse-layers l)) (set! image (list width height (cond ((eq? type 'RGB) RGB) ((eq? type 'GRAY) GRAY)))))) (if (arg-is-bad) (oops "node") (begin (parse-node) (lambda (cmd) (cond ((eq? cmd 'image) image) ((eq? cmd 'layers) layers) (#t (oops "node")))))))) ;;===================================================================== ;; ;; Script ;; ;; A recorded macro. ;; ;;===================================================================== (define (make-script gimp node _script) (define (get) _script) (define (add s) (write-line "not implemented") #f) (define (arg-is-bad) #f) (if (arg-is-bad) (oops "script") (lambda (cmd) (cond ((eq? cmd 'get) get) ((eq? cmd 'add) add) (#t (oops "script")))))) ;;===================================================================== ;; ;; Misc Stuff ;; ;;===================================================================== (define (return-no . args) #f) (define (return-yes . args) #t) (define (oops class) (lambda (. args) (write-line (string-append class ": unknown command")) #f)) (define nuke (lambda () (map (lambda (i) (gimp-display-delete i)) (array->list (cadr (gimp-display-list)))) (map (lambda (i) (gimp-image-delete i)) (array->list (cadr (gimp-list-images)))))) yosh/plug-ins/guile-fu/scripts/guile-fu.scm100664 767 770 16416 6740507660 17754 0ustar gnomegnome;; -*- scheme -*- ;; this is invoked by the guile-fu extension at startup (define gf-init (lambda () (gf-init-vars) (gf-init-autoloads) (gf-load "macro.scm") (gf-load "chalice.scm") (gf-load "test.scm"))) ;; this is invoked for every line we get from the driver (define gf-eval (lambda (c) (catch #t (lambda () (eval-string c)) (lambda args (cons 'PROBLEM: args))))) (define gf-eval-2 (lambda (c) (catch #t (lambda () (let* ((res #f) (out (with-output-to-string (lambda () (set! res (eval-string c)))))) (cons out (list res)))) (lambda args (cons 'PROBLEM: args))))) ;; this is invoked in the (unimplemented) standalone mode (define gf-repl top-repl) ;; the home dir for guile-fu development (define projdir "/home/gnome/src/gimp-macro/plug-ins/guile-fu/scripts/") ;; should we reload from the development tree? (define use-latest #t) ;; load a component of guile-fu (define gf-load (lambda (f) (if use-latest (load (string-append projdir f)) (primitive-load-path f)))) ;; the various symbols to make scripts pretty (define gf-init-vars (lambda () (map (lambda (z) (module-define! (current-module) (car z) (cdr z))) '((NORMAL . 0) (DISSOLVE . 1) (BEHIND . 2) (MULTIPLY . 3) (SCREEN . 4) (OVERLAY . 5) (DIFFERENCE . 6) (ADDITION . 7) (SUBTRACT . 8) (DARKEN-ONLY . 9) (LIGHTEN-ONLY . 10) (HUE . 11) (SATURATION . 12) (COLOR . 13) (VALUE . 14) (DIVIDE . 15) (FG-BG-RGB . 0) (FG-BG-HSV . 1) (FG-TRANS . 2) (CUSTOM . 3) (LINEAR . 0) (BILINEAR . 1) (RADIAL . 2) (SQUARE . 3) (CONICAL-SYMMETRIC . 4) (CONICAL-ASYMMETRIC . 5) (SHAPEBURST-ANGULAR . 6) (SHAPEBURST-SPHERICAL . 7) (SHAPEBURST-DIMPLED . 8) (SPIRAL-CLOCKWISE . 9) (SPRIAL-ANTICLOCKWISE . 10) (REPEAT-NONE . 0) (REPEAT-SAWTOOTH . 1) (REPEAT-TRIANGULAR . 2) (FG-BUCKET-FILL . 0) (BG-BUCKET-FILL . 1) (PATTERN-BUCKET-FILL . 2) (FG-IMAGE-FILL . 0) (BG-IMAGE-FILL . 1) (WHITE-IMAGE-FILL . 2) (TRANS-IMAGE-FILL . 3) (NO-IMAGE-FILL . 4) (RGB . 0) (GRAY . 1) (INDEXED . 2) (RGB_IMAGE . 0) (RGBA_IMAGE . 1) (GRAY_IMAGE . 2) (GRAYA_IMAGE . 3) (INDEXED_IMAGE . 4) (INDEXEDA_IMAGE . 5) (RED-CHANNEL . 0) (GREEN-CHANNEL . 1) (BLUE-CHANNEL . 2) (GRAY-CHANNEL . 3) (INDEXED-CHANNEL . 4) (WHITE-MASK . 0) (BLACK-MASK . 1) (ALPHA-MASK . 2) (APPLY . 0) (DISCARD . 1) (EXPAND-AS-NECESSARY . 0) (CLIP-TO-IMAGE . 1) (CLIP-TO-BOTTOM-LAYER . 2) (ADD . 0) (SUB . 1) (REPLACE . 2) (INTERSECT . 3) (PIXELS . 0) (POINTS . 1) (IMAGE-CLONE . 0) (PATTERN-CLONE . 1) (BLUR . 0) (SHARPEN . 1) (TRUE . 1) (FALSE . 0) (SF-IMAGE . 0) (SF-DRAWABLE . 1) (SF-LAYER . 2) (SF-CHANNEL . 3) (SF-COLOR . 4) (SF-TOGGLE . 5) (SF-VALUE . 6) (SF-STRING . 7) (SF-ADJUSTMENT . 8) (SF-FONT . 9) (SF-PATTERN . 10) (SF-BRUSH . 11) (SF-GRADIENT . 12) (SF-FILENAME . 13) (SF-SLIDER . 0) (SF-SPINNER . 1))))) ;; get a list of all the exported PDB routines and bind an autoloader ;; to each one (define gf-init-autoloads (lambda () (let ((funcs (gf-run "gimp_procedural_db_query" (cons 4 "") (cons 4 "") (cons 4 "") (cons 4 "") (cons 4 "") (cons 4 "") (cons 4 "")))) (if (eq? (car funcs) 3) (map gf-make-pdb (caddr funcs)) (throw 'autoload-setup-failed))))) ;; this routine accepts a PDB name and binds an autoloader for the ;; name to the corresponding symbol. the autoloader will query gimp ;; about the proc and create the real invoker when it is first run. (define gf-make-pdb (lambda (name) (let ((func (gf-make-symbol name)) (types ()) (vals ())) ;; formats the PDB return values according to spec (define format-return-vals (lambda (values spec) (let ((v (map cons vals values))) (cond ((list? spec) (map (lambda (x) (assq-ref v x)) spec)) (spec (assq-ref v spec)) (#t values))))) ;; invoke the PDB routine on the args. if there are too many ;; args, the first is assumed to be a spec for ;; format-return-vals (define invoke-pdb (lambda args (let* ((z (> (length args) (length types))) (a (if z (cdr args) args)) (x (cons name (map cons types a))) (v (apply gf-run x))) (or (memq (car v) '(2 3)) (throw 'pdb-failure func)) (if z (format-return-vals (cdr v) (car args)) (cdr v))))) ;; the autoloader stub (define stub (lambda args (let ((nums (gf-get-nums name))) (set! types (gf-get-signature name (car nums))) (set! vals (gf-get-vals name (cadr nums))) (module-define! (current-module) func invoke-pdb) (apply invoke-pdb args)))) ;; bind the autoloader stub to the symbol (module-define! (current-module) func stub)))) ;; convert a PDB name to a scheme symbol (define gf-make-symbol (lambda (s) (set! s (string-copy s)) (while (string-index s #\_) (string-set! s (string-index s #\_) #\-)) (string->symbol s))) ;; get the number of args and return vals (define gf-get-nums (lambda (s) (let ((info (gf-run "gimp_procedural_db_proc_info" (cons 4 s)))) (if (not (eq? (car info) 3)) (throw 'proc-info-failed s)) (list (cadr (cdddr (cdddr info))) (caddr (cdddr (cdddr info))))))) ;; get the argument signature for the named PDB routine (define gf-get-signature (lambda (s n) (let ((types ())) (while (> n 0) (set! n (- n 1)) (let ((arg (gf-run "gimp_procedural_db_proc_arg" (cons 4 s) (cons 0 n)))) (if (not (eq? (car arg) 3)) (throw 'proc-arg-failed n)) (set! types (cons (cadr arg) types)))) types))) ;; get the return value names for the PDB routine (define gf-get-vals (lambda (s n) (let ((vals ())) (while (> n 0) (set! n (- n 1)) (let ((arg (gf-run "gimp_procedural_db_proc_val" (cons 4 s) (cons 0 n)))) (if (not (eq? (car arg) 3)) (throw 'proc-val-failed n)) (set! vals (cons (gf-make-symbol (caddr arg)) vals)))) vals))) yosh/plug-ins/guile-fu/scripts/Makefile.am100664 767 770 712 6740507660 17517 0ustar gnomegnome## Process this file with automake to produce Makefile.in SUBDIRS = schemedir = $(datadir)/guile/site scheme_DATA = \ guile-fu.scm \ chalice.scm \ macro.scm \ test.scm .PHONY: files files: @files=`ls $(DISTFILES) 2> /dev/null`; for p in $$files; do \ echo $$p; \ done @for subdir in $(SUBDIRS); do \ files=`cd $$subdir; $(MAKE) files | grep -v "make\[[1-9]\]"`; \ for file in $$files; do \ echo $$subdir/$$file; \ done; \ done yosh/plug-ins/guile-fu/scripts/macro.scm100664 767 770 16550 6740507660 17337 0ustar gnomegnome; -*- scheme -*- (define (trace->macro trace macro) (with-input-from-file trace read-the-trace-file) (with-output-to-file macro and-create-the-macro-file)) (define (read-the-trace-file) (make-script-from (the-optimized (input-file)))) (define (and-create-the-macro-file) (print-the-vars) (and-the-body) (and-the-registration)) (define (make-script-from file) (map (lambda (l) (parse l parsers)) (reverse file))) (define (the-optimized l) (cond ((null? l) '()) ((null? (cdr l)) l) (else (let ((first (car l)) (next (cadr l))) (if (and (eq? (car first) (car next)) (eq? (cadr first) (cadr next))) (the-optimized (cons first (cddr l))) (cons first (the-optimized (cdr l)))))))) (define (input-file) (let ((file ())) (define (parse) (let ((line (read))) (cond ((eof-object? line) file) (else (set! file (cons line file)) (parse))))) (parse))) (define (print-the-vars) (write (macro-vars 'dump)) (newline) (newline)) (define (and-the-body) (write `(define (macro-body ,@(macro-parms 'names)) ,@(apply append (macro-steps 'get)))) (newline) (newline)) (define (and-the-registration) (write `(script-fu-register "macro-body" "/Xtns/Macros/Run" "Run the macro" "Ray Lehtiniemi " "Ray Lehtiniemi" "03/27/99" "" ,@(apply append (macro-parms 'types)))) (newline) (newline)) ;;------------------------------------------------------------ (define (parse line parsers) (let ((handler (assq-ref parsers (car line)))) (if handler (apply (eval handler) (cdr line))))) (define parsers '( (brush . parse-brush) ;(clone . parse-clone) ;(paintbrush . parse-paintbrush) (palette . parse-palette) (pattern . parse-pattern) ;(strokes . parse-strokes) ;(stroke . parse-stroke) )) (define (make-pdb cmd . args) (macro-steps 'add `(,cmd ,@args))) (define (make-var type val) (macro-vars 'add type val)) (define (make-parm type name default) (macro-parms 'add `(,type ,name ',default))) ;; the guts of the parser. each routine parses a particular type of ;; line from the trace file. (define (parse-brush cmd . args) (case cmd ((select) (let ((x (make-parm 'SF-BRUSH "Brush" args))) (make-pdb `(gimp-brushes-set-brush ,(macro-parms 'name x))))) ((spacing) (let ((x (make-var 'brush-spacing (car args)))) (make-pdb `(gimp-brushes-set-spacing (macro-vars 'get ,x))))) ((opacity) (let ((x (make-parm 'SF-VALUE "opacity" (number->string (car args))))) (make-pdb `(gimp-brushes-set-opacity ,(macro-parms 'name x))))) ((paintmode) (make-pdb `(gimp-brushes-set-paint-mode ,(car args)))))) (define (parse-palette cmd . args) (case cmd ((foreground) (let ((x (make-parm 'SF-COLOR "foreground" args))) (make-pdb `(gimp-palette-set-foreground ,(macro-parms 'name x))))) ((background) (let ((x (make-parm 'SF-COLOR "background" args))) (make-pdb `(gimp-palette-set-background ,(macro-parms 'name x))))))) (define (parse-pattern cmd . args) (case cmd ((select) (let ((x (make-parm 'SF-PATTERN "pattern" (car args)))) (make-pdb `(gimp-patterns-set-pattern ,(macro-parms 'name x))))))) ;;------------------------------------------------------------ ;; the parsed steps of the trace file. generally these correspond ;; pretty closely to registered PDB functions. (define macro-steps (let ((steps ())) (define (add args) (set! steps (append! args steps))) (lambda (cmd . args) (case cmd ((add) (add args)) ((get) (reverse steps)) ((optimize) (set! steps (optimize steps))) )))) ;; the vars. these guys have to be looked up at run time since they ;; might not exist when the script is loaded. eg: ids of layers ;; created in the middle of a macro. (define macro-vars (let ((by-data ()) (by-num ()) (count 0)) (define (add args) (let ((x (assoc args by-data))) (if x (cdr x) (begin (set! count (1+ count)) (set! by-data (acons args count by-data)) (set! by-num (acons count args by-num)) count)))) (define (dump) ;; this code gets executed in script-fu, not guile, so it can't ;; use the 'case' syntax `(define (macro-vars cmd . args) (let ((vals ',by-num)) (cond ((eq? cmd 'get) (caddr (assq (car args) vals))) ((eq? cmd 'raw) vals) )))) (lambda (cmd . args) (case cmd ((add) (add args)) ((dump) (dump)) )))) ;; the parms. these guys will need to correspond to the types in ;; script-fu-enums.h (define macro-parms (let ((by-data ()) (by-num ()) (count 0)) (define (add args) (let ((x (assoc args by-data))) (if x (cdr x) (begin (set! count (1+ count)) (set! by-data (acons args count by-data)) (set! by-num (acons count args by-num)) count)))) (define (name x) (string->symbol (string-append "parm" (number->string x)))) (lambda (cmd . args) (case cmd ((add) (add args)) ((name) (name (car args))) ((names) (map name (map car (reverse by-num)))) ((types) (map cadr (reverse by-num))) )))) (define (parse-clone cmd . args) (case cmd ((start) (set! pc-args args)) ((finish) (macro-steps 'add `(let* ((drawable (car (gimp-image-get-layer-by-tattoo img ,(cadr pc-args)))) (src (car (gimp-image-get-layer-by-tattoo img ,(cadddr pc-args)))) (strokes (cons-array ,pc-count 'double))) (scale-stroke strokes 0 ',pc-strokes) (gimp-clone drawable src ,@(cddddr pc-args) ,pc-count strokes)))))) (define (parse-paintbrush cmd . args) (case cmd ((start) (set! pc-args args)) ((finish) (macro-steps 'add `(let* ((drawable (car (gimp-image-get-layer-by-tattoo img ,(cadr pc-args)))) (strokes (cons-array ,pc-count 'double))) (scale-stroke strokes 0 ',pc-strokes) (gimp-paintbrush-extended drawable ,(caddr pc-args) ,pc-count strokes ,(caddr (cddr pc-args)))))))) ;; paint core arguments (define pc-args ()) (define pc-count 0) (define pc-strokes ()) (define (parse-strokes cmd . args) (case cmd ((start) (set! pc-count (* 2 (car args))) (set! pc-strokes '())) ((finish) #f))) (define (parse-stroke cmd . args) (set! pc-strokes (append pc-strokes args))) yosh/plug-ins/guile-fu/scripts/test.scm100664 767 770 6661 6740507660 17177 0ustar gnomegnome;; -*- scheme -*- ;;===================================================================== ;; ;; Test and Debugging Stuff ;; ;;===================================================================== ;;===================================================================== ;; reload the world ;;===================================================================== (define x (lambda () (gf-load "guile-fu.scm") (gf-init))) ;;===================================================================== ;; Chalice protocol test driver ;;===================================================================== (define q (lambda (n) (chalice-start (script n) (node n) "parms"))) (define w (lambda () (chalice-retrieve))) (define e (lambda () (chalice-stop))) (define r (lambda (n) (chalice-execute (script n) (node n) "parms"))) (define t (lambda (n) (chalice-verify (script n) (node n) "parms"))) ;;===================================================================== ;; guile-fu testing ;;===================================================================== ;; guile-fu calling conventions (define a (lambda () (let ((img (file-jpeg-load 'image 0 "foo.jpg" "foo.jpg"))) (gimp-display-new 'display img)))) ;; script-fu calling conventions (define s (lambda () (let ((img (file-jpeg-load 0 "foo.jpg" "foo.jpg"))) (gimp-display-new (car img))))) ;;===================================================================== ;; Node/script factory ;;===================================================================== (define (qq n) (cadr (assq (if (< n 4) n 1) '((1 ((node (image 128 128 GRAY) (layer)) "The script for node 1")) (2 ((node (image 256 256 RGB) (layer) (mask) (layer)) "The script for node 2")) (3 ((node (image 175 300 RGB) (layer) (mask) (layer) (layer) (mask) (layer) (mask) (layer) (layer)) "The script for node 3")) )))) (define (node n) (car (qq n))) (define (script n) (cadr (qq n))) ;;===================================================================== ;; Test cases ;;===================================================================== (define (test-node-valid?) (define pass '((node (image 1 2 RGB) (layer)) (node (image 1 2 GRAY) (layer) (layer)) (node (image 1 2 RGB) (layer) (mask)) (node (image 1 2 RGB) (layer) (mask) (layer)) (node (image 1 2 RGB) (layer) (layer) (mask)))) (define fail '((nodd (image 1 2 RGB) (layer)) (node (omage 1 2 RGB) (layer)) (node (image 1 0 RGB) (layer)) (node (image 1 2 3) (layer)) (node (image 1 2 RGB)) (node (image 1 2 RGB) (mask)) (node (image 1 2 RGB) (layer) (mask) (mask)))) (define (test n) ((make-node n) 'valid?)) (print (map test pass)) (print (map test fail))) yosh/plug-ins/guile-fu/scripts/macro_support.scm100664 767 770 264 6740507645 21071 0ustar gnomegnome (define (lookup n) (cadddr (assq n macro-vars))) (define (scale-stroke a i s) (if (car s) (begin (aset a i (car s)) (scale-stroke a (+ i 1) (cdr s))))) yosh/plug-ins/guile-fu/server.h100664 767 770 2010 6740507660 15464 0ustar gnomegnome/* The GIMP -- an image manipulation program * Copyright (C) 1999 Ray Lehtiniemi * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #ifndef SERVER_H #define SERVER_H void run_the_server (gchar *name, gint nparams, GParam *param, gint *nreturn_vals, GParam **return_vals); #endif yosh/plug-ins/guile-fu/server.c100664 767 770 33135 6740507660 15513 0ustar gnomegnome/* The GIMP -- an image manipulation program * Copyright (C) 1999 Ray Lehtiniemi * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "config.h" #ifdef HAVE_SYS_SELECT_H #include #endif /* HAVE_SYS_SELECT_H */ #include "libgimp/gimp.h" #include "server.h" #include "interp.h" #ifdef NO_DIFFTIME #define difftime(a,b) (((double)(a)) - ((double)(b))) #endif #ifndef NO_FD_SET # define SELECT_MASK fd_set #else # ifndef _AIX typedef long fd_mask; # endif # if defined(_IBMR2) # define SELECT_MASK void # else # define SELECT_MASK int # endif #endif /* image information */ /* Header format for incoming commands... * bytes: 1 2 3 * MAGIC CMD_LEN_H CMD_LEN_L */ /* Header format for outgoing responses... * bytes: 1 2 3 4 * MAGIC ERROR? RSP_LEN_H RSP_LEN_L */ #define COMMAND_HEADER 3 #define RESPONSE_HEADER 4 #define MAGIC 'G' #define MAGIC_BYTE 0 #define CMD_LEN_H_BYTE 1 #define CMD_LEN_L_BYTE 2 #define ERROR 1 #define RSP_LEN_H_BYTE 2 #define RSP_LEN_L_BYTE 3 /* * Local Structures */ typedef struct { gchar *command; gint filedes; gint request_no; } SFCommand; typedef struct { GtkWidget *port_entry; GtkWidget *log_entry; gint port; gchar *logfile; gint run; } ServerInterface; /* * Local Functions */ static void server_start (gint port, gchar *logfile); static gint execute_command (SFCommand *cmd); static gint read_from_client (gint filedes); static gint make_socket (guint port); static void server_log (gchar *format, ...); static void server_quit (void); static gint server_interface (void); static void ok_callback (GtkWidget *widget, gpointer data); static void cancel_callback (GtkWidget *widget, gpointer data); /* * Local variables */ static gint server_sock; static GList *command_queue = NULL; static gint queue_length = 0; static gint request_no = 0; static FILE *server_log_file = NULL; static GHashTable *clientname_ht = NULL; static SELECT_MASK server_active, server_read; static ServerInterface sint = { NULL, /* port entry widget */ NULL, /* log entry widget */ 10008, /* default port number */ "/home/gnome/foo", /* use stdout */ FALSE /* run */ }; void run_the_server (gchar *name, gint nparams, GParam *params, gint *nreturn_vals, GParam **return_vals) { static GParam values[1]; GStatusType status = STATUS_SUCCESS; GRunModeType run_mode; run_mode = params[0].data.d_int32; switch (run_mode) { case RUN_INTERACTIVE: if (server_interface ()) server_start (sint.port, sint.logfile); break; case RUN_NONINTERACTIVE: server_start (params[1].data.d_int32, params[2].data.d_string); break; case RUN_WITH_LAST_VALS: status = STATUS_CALLING_ERROR; g_warning ("Guile-Fu server does not handle \"RUN_WITH_LAST_VALS\""); default: break; } *nreturn_vals = 1; *return_vals = values; values[0].type = PARAM_STATUS; values[0].data.d_status = status; } static void script_fu_server_listen (gint timeout) { struct sockaddr_in clientname; struct timeval tv; struct timeval *tvp; gint i; size_t size; /* Set time struct */ if (timeout) { tv.tv_sec = timeout / 1000; tv.tv_usec = timeout % 1000; tvp = &tv; } else tvp = NULL; /* Block until input arrives on one or more active sockets or timeout occurs. */ server_read = server_active; if (select (FD_SETSIZE, &server_read, NULL, NULL, tvp) < 0) { perror ("select"); return; } /* Service all the sockets with input pending. */ for (i = 0; i < FD_SETSIZE; ++i) if (FD_ISSET (i, &server_read)) { if (i == server_sock) { /* Connection request on original socket. */ gint new; size = sizeof (clientname); new = accept (server_sock, (struct sockaddr *) &clientname, &size); if (new < 0) { perror ("accept"); return; } /* Associate the client address with the socket */ g_hash_table_insert (clientname_ht, (gpointer) new, g_strdup (inet_ntoa (clientname.sin_addr))); FD_SET (new, &server_active); } else { if (read_from_client (i) < 0) { /* Disassociate the client address with the socket */ g_hash_table_remove (clientname_ht, (gpointer) i); close (i); FD_CLR (i, &server_active); } } } } static void server_start (gint port, gchar *logfile) { SFCommand *cmd; /* Set up the clientname hash table */ clientname_ht = g_hash_table_new (g_direct_hash, NULL); /* Setup up the server log file */ if (logfile) server_log_file = fopen (logfile, "a"); else server_log_file = NULL; if (server_log_file == NULL) server_log_file = stdout; /* Create the socket and set it up to accept connections. */ server_sock = make_socket (port); if (listen (server_sock, 5) < 0) { perror ("listen"); return; } /* Initialize the set of active sockets. */ FD_ZERO (&server_active); FD_SET (server_sock, &server_active); /* load up all the gimp commands */ interp_init (); /* Loop until the server is finished */ server_log ("\n(initialized)\n"); while (interp_active ()) { script_fu_server_listen (0); while (command_queue) { /* Get the current command */ cmd = (SFCommand *) command_queue->data; /* Process the command */ execute_command (cmd); /* Remove the command from the list */ command_queue = g_list_remove (command_queue, cmd); queue_length--; /* Free the request */ g_free (cmd->command); g_free (cmd); } } server_quit (); /* Close the server log file */ if (server_log_file != stdout) fclose (server_log_file); } static gint execute_command (SFCommand *cmd) { guchar buffer[RESPONSE_HEADER]; gchar *response; time_t clock1, clock2; gint response_len; gint i; /* handle the request */ time (&clock1); server_log ("\n(process %d", cmd->request_no); { char * t = ctime (&clock1); t[strlen (t) - 1] = '\0'; server_log ("\n\t\"%s\"", t); } response = interp_eval (cmd->command); response_len = strlen (response); time (&clock2); server_log ("\n\t(%d seconds elapsed))\n", (gint) difftime (clock2, clock1)); /* Write the response to the client */ buffer[MAGIC_BYTE] = MAGIC; buffer[ERROR] = 0; buffer[RSP_LEN_H_BYTE] = (guchar) (response_len >> 8); buffer[RSP_LEN_L_BYTE] = (guchar) (response_len & 0xFF); for (i = 0; i < RESPONSE_HEADER; i++) if (write (cmd->filedes, buffer + i, 1) < 0) { /* Write error */ perror ("write"); g_free (response); return 0; } for (i = 0; i < response_len; i++) if (write (cmd->filedes, response + i, 1) < 0) { /* Write error */ perror ("write"); g_free (response); return 0; } g_free (response); return 0; } static gint read_from_client (gint filedes) { SFCommand *cmd; guchar buffer[COMMAND_HEADER]; gchar *command; gchar *clientaddr; time_t clock; gint command_len; gint nbytes; gint i; for (i = 0; i < COMMAND_HEADER; i++) { if ((nbytes = read (filedes, buffer + i, 1)) < 0) { /* Read error. */ perror ("read"); return 0; } else if (nbytes == 0) /* End-of-file. */ return -1; } if (buffer[MAGIC_BYTE] != MAGIC) { server_log ("\n(Error in script-fu command transmission)\n"); return -1; } command_len = (buffer [CMD_LEN_H_BYTE] << 8) | buffer [CMD_LEN_L_BYTE]; command = g_new (gchar, command_len + 1); for (i = 0; i < command_len; i++) if (read (filedes, command + i, 1) == 0) { server_log ("\n(Error reading command. Read %d out of %d bytes)\n", i, command_len); return -1; } command[command_len] = '\0'; cmd = g_new (SFCommand, 1); cmd->filedes = filedes; cmd->command = command; cmd->request_no = request_no ++; /* Add the command to the queue */ command_queue = g_list_append (command_queue, cmd); queue_length ++; /* Get the client address from the address/socket table */ clientaddr = g_hash_table_lookup (clientname_ht, (gpointer) cmd->filedes); time (&clock); server_log ("\n(receive %d", cmd->request_no); { char * t = ctime (&clock); t[strlen (t) - 1] = '\0'; server_log ("\n\t\"%s\"", t); } server_log ("\n\t%s)\n", cmd->command); return 0; } static gint make_socket (guint port) { gint sock; struct sockaddr_in name; gint v = 1; /* Create the socket. */ sock = socket (PF_INET, SOCK_STREAM, 0); if (sock < 0) { perror ("socket"); gimp_quit (); } setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, &v, sizeof(v)); /* Give the socket a name. */ name.sin_family = AF_INET; name.sin_port = htons (port); name.sin_addr.s_addr = htonl (INADDR_ANY); if (bind (sock, (struct sockaddr *) &name, sizeof (name)) < 0) { perror ("bind"); gimp_quit (); } return sock; } static void server_log (gchar *format, ...) { va_list args; char *buf; va_start (args, format); buf = g_strdup_vprintf (format, args); va_end (args); fputs (buf, server_log_file); if (server_log_file != stdout) fflush (server_log_file); } static void server_quit (void) { int i; server_log ("\n(exit)\n"); for (i = 0; i < FD_SETSIZE; ++i) if (FD_ISSET (i, &server_active)) shutdown (i, 2); } static gint server_interface () { GtkWidget *dlg; GtkWidget *button; GtkWidget *label; GtkWidget *table; gchar **argv; gint argc; argc = 1; argv = g_new (gchar *, 1); argv[0] = g_strdup ("guile-fu"); gtk_init (&argc, &argv); gtk_rc_parse (gimp_gtkrc ()); dlg = gtk_dialog_new (); gtk_window_set_title (GTK_WINDOW (dlg), "Guile-Fu Server Options"); gtk_window_position (GTK_WINDOW (dlg), GTK_WIN_POS_MOUSE); gtk_signal_connect (GTK_OBJECT (dlg), "destroy", (GtkSignalFunc) cancel_callback, NULL); gtk_container_border_width (GTK_CONTAINER (GTK_DIALOG (dlg)->action_area), 2); /* Action area */ button = gtk_button_new_with_label ("OK"); GTK_WIDGET_SET_FLAGS (button, GTK_CAN_DEFAULT); gtk_signal_connect (GTK_OBJECT (button), "clicked", (GtkSignalFunc) ok_callback, dlg); gtk_box_pack_start (GTK_BOX (GTK_DIALOG (dlg)->action_area), button, TRUE, TRUE, 0); gtk_widget_grab_default (button); gtk_widget_show (button); button = gtk_button_new_with_label ("Cancel"); GTK_WIDGET_SET_FLAGS (button, GTK_CAN_DEFAULT); gtk_signal_connect_object (GTK_OBJECT (button), "clicked", (GtkSignalFunc) gtk_widget_destroy, GTK_OBJECT (dlg)); gtk_box_pack_start (GTK_BOX (GTK_DIALOG (dlg)->action_area), button, TRUE, TRUE, 0); gtk_widget_show (button); /* The table to hold port & logfile entries */ table = gtk_table_new (2, 2, FALSE); gtk_container_border_width (GTK_CONTAINER (table), 4); gtk_box_pack_start (GTK_BOX (GTK_DIALOG (dlg)->vbox), table, TRUE, TRUE, 0); /* The server port */ label = gtk_label_new ("Server Port: "); gtk_misc_set_alignment (GTK_MISC (label), 0.0, 0.5); gtk_table_attach (GTK_TABLE (table), label, 0, 1, 0, 1, GTK_SHRINK | GTK_FILL, GTK_SHRINK, 0, 1); gtk_widget_show (label); sint.port_entry = gtk_entry_new (); gtk_table_attach (GTK_TABLE (table), sint.port_entry, 1, 2, 0, 1, GTK_EXPAND | GTK_SHRINK | GTK_FILL, GTK_SHRINK, 1, 1); gtk_entry_set_text (GTK_ENTRY (sint.port_entry), "10008"); gtk_widget_show (sint.port_entry); /* The server logfile */ label = gtk_label_new ("Server Logfile: "); gtk_misc_set_alignment (GTK_MISC (label), 0.0, 0.5); gtk_table_attach (GTK_TABLE (table), label, 0, 1, 1, 2, GTK_SHRINK | GTK_FILL, GTK_SHRINK, 0, 1); gtk_widget_show (label); sint.log_entry = gtk_entry_new (); if (sint.logfile) gtk_entry_set_text (sint.log_entry, sint.logfile); gtk_table_attach (GTK_TABLE (table), sint.log_entry, 1, 2, 1, 2, GTK_EXPAND | GTK_SHRINK | GTK_FILL, GTK_SHRINK, 1, 1); gtk_widget_show (sint.log_entry); gtk_widget_show (table); gtk_widget_show (dlg); gtk_main (); gdk_flush (); return sint.run; } static void ok_callback (GtkWidget *widget, gpointer data) { sint.port = atoi (gtk_entry_get_text (GTK_ENTRY (sint.port_entry))); sint.logfile = g_strdup (gtk_entry_get_text (GTK_ENTRY (sint.log_entry))); sint.run = TRUE; gtk_widget_destroy (GTK_WIDGET (data)); } static void cancel_callback (GtkWidget *widget, gpointer data) { gtk_main_quit (); } yosh/plug-ins/guile-fu/interp.c100664 767 770 35750 6740507660 15513 0ustar gnomegnome/* The GIMP -- an image manipulation program * Copyright (C) 1999 Ray Lehtiniemi * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include #include #include "libgimp/gimp.h" #include "interp.h" /* turn a string into an interned symbol */ #define LOOKUP(x) SCM_CAR (scm_intern0 (x)) /* export stuff to guile */ static void register_everything (void); /* a flag for the benefit of the server main loop */ static gint active = 0; gint interp_active (void) { return active; } /* register various routines, then load the user's init files and the guile-fu server core */ void interp_init (void) { SCM tail = SCM_EOL; register_everything (); tail = scm_cons (LOOKUP ("begin"), tail); tail = scm_cons (SCM_LIST1 (LOOKUP ("load-user-init")), tail); tail = scm_cons (SCM_LIST2 (LOOKUP ("primitive-load-path"), scm_makfrom0str ("guile-fu.scm")), tail); tail = scm_cons (SCM_LIST1 (LOOKUP ("gf-init")), tail); scm_eval_x (scm_reverse_x (tail, SCM_UNDEFINED)); active = 1; } /* evaluate the cmd string and stringify the resulting expression */ gchar * interp_eval (gchar * cmd) { SCM tail = SCM_EOL; tail = scm_cons (LOOKUP ("begin"), tail); tail = scm_cons (SCM_LIST2 (LOOKUP ("gf-eval"), scm_makfrom0str (cmd)), tail); tail = scm_reverse_x (tail, SCM_UNDEFINED); tail = scm_strprint_obj (scm_eval_x (tail)); return (g_strdup (SCM_CHARS (tail))); } /* drop into the standalone main loop */ void interp_main (void) { SCM tail = SCM_EOL; tail = scm_cons (LOOKUP ("begin"), tail); tail = scm_cons (SCM_LIST1 (LOOKUP ("gf-repl")), tail); tail = scm_reverse_x (tail, SCM_UNDEFINED); exit (scm_exit_status (scm_eval_x (tail))); } /* set the continue flag to zero so the main driver knows to exit */ static SCM quit (void) { active = 0; return SCM_UNDEFINED; } /* the primary PDB marshaller. this function accepts a string with the name of the PDB procedure to invoke and a list of cons cells with the arguments. the car of each cell is the type of arg expected and the cdr is the arg itself. if the args look good, we invoke the routine and send back the results */ static SCM run_proc (SCM name, SCM params) { GParam *args = NULL; GParam *vals = NULL; gint nargs = 0; gint nvals = 0; SCM retval = SCM_EOL; gint i; SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name), name, SCM_ARG1, "run_proc"); nargs = scm_ilength (params); SCM_ASSERT (nargs >= 0, params, SCM_ARG2, "run_proc"); if (nargs != 0) { args = (GParam *) g_new (GParam, nargs); for (i = 0; i < nargs; i++) { SCM param, type, val; param = SCM_CAR (params); params = SCM_CDR (params); if (SCM_NCONSP (param)) goto die_args; type = SCM_CAR (param); val = SCM_CDR (param); if (SCM_NINUMP (type)) goto die_args; args[i].type = scm_num2long (type, SCM_ARGn, "run_proc"); switch (args[i].type) { case PARAM_INT32: case PARAM_DISPLAY: case PARAM_IMAGE: case PARAM_LAYER: case PARAM_CHANNEL: case PARAM_DRAWABLE: case PARAM_SELECTION: { if (SCM_NINUMP (val)) goto die_args; args[i].data.d_int32 = (gint32) scm_num2long (val, SCM_ARGn, "run_proc"); } break; case PARAM_INT16: { if (SCM_NINUMP (val)) goto die_args; args[i].data.d_int16 = (gint16) scm_num2long (val, SCM_ARGn, "run_proc"); } break; case PARAM_INT8: { if (SCM_NINUMP (val)) goto die_args; args[i].data.d_int8 = (gint8) scm_num2long (val, SCM_ARGn, "run_proc"); } break; case PARAM_FLOAT: { if (SCM_NINUMP (val)) goto die_args; args[i].data.d_float = (gfloat) scm_num2dbl (val, "run_proc"); } break; case PARAM_STRING: { if (SCM_IMP (val) || SCM_NSTRINGP (val)) goto die_args; args[i].data.d_string = g_strdup (SCM_CHARS (val)); } break; case PARAM_INT32ARRAY: { if (0) /* FIXME */ goto die_args; args[i].data.d_int32array = (gint32*) SCM_CHARS (val); } break; case PARAM_INT16ARRAY: { if (0) /* FIXME */ goto die_args; args[i].data.d_int16array = (gint16*) SCM_CHARS (val); } break; case PARAM_INT8ARRAY: { if (0) /* FIXME */ goto die_args; args[i].data.d_int8array = (gint8*) SCM_CHARS (val); } break; case PARAM_FLOATARRAY: { if (0) /* FIXME */ goto die_args; args[i].data.d_floatarray = (gdouble*) SCM_CHARS (val); } break; case PARAM_STRINGARRAY: { gchar **array; gint n, j; if ((i < 1) || args[i-1].type != PARAM_INT32) goto die_args; n = args[i-1].data.d_int32; if (scm_ilength (val) != n) goto die_args; array = args[i].data.d_stringarray = g_new (char *, n); for (j=0; j void interp_init (void); gchar * interp_eval (gchar *); void interp_main (void); gint interp_active (void); #endif yosh/plug-ins/guile-fu/driver.c100664 767 770 5026 6740507660 15456 0ustar gnomegnome/* a tcp client that attaches to the gimpserver */ #include #include #include #include #include #include #include #include #include #include static char *line_read = (char *)NULL; static char *gimp_read = (char *)NULL; static int fd = -1; static char * get_input (void) { if (line_read) { free (line_read); line_read = (char *)NULL; } line_read = readline ("> "); if (line_read && *line_read) { add_history (line_read); } return line_read; } static int disconnect_from_gimp (void) { close (fd); fd = -1; return 1; } static int connect_to_gimp (void) { struct sockaddr_in sock; if (fd != -1) disconnect_from_gimp (); fd = socket (AF_INET, SOCK_STREAM, 0); if (fd == -1) return -1; memset (&sock, 0, sizeof (sock)); sock.sin_family = AF_INET; sock.sin_addr.s_addr = inet_addr ("127.0.0.1"); sock.sin_port = htons (10008); if (connect (fd, &sock, sizeof (sock)) != 0) return -1; return 0; } static int send_to_gimp (void) { unsigned char n; g_return_val_if_fail (connect_to_gimp () == 0, -1); g_return_val_if_fail (write (fd, "G", 1) == 1, -1); n = (strlen (line_read) >> 8) & 0xff; g_return_val_if_fail (write (fd, &n, 1) == 1, -1); n = strlen (line_read) & 0xff; g_return_val_if_fail (write (fd, &n, 1) == 1, -1); n = strlen (line_read); g_return_val_if_fail (write (fd, line_read, n) == n, -1); return 0; } static int read_from_gimp (void) { unsigned char head[4]; int size; int done; size = 4; done = 0; while (done < size) { int nread = read (fd, &head[done], size-done); g_return_val_if_fail (nread > 0, -1); done += nread; } g_return_val_if_fail (head[0] == 'G', -1); if (head[1] != 0) { g_warning ("Oops"); } size = (head[2] << 8) + head[3]; if (gimp_read) { free (gimp_read); gimp_read = (char *)NULL; } gimp_read = malloc (size+1); done = 0; while (done < size) { int nread = read (fd, gimp_read+done, size-done); g_return_val_if_fail (nread > 0, -1); done += nread; } gimp_read[size] = '\0'; printf ("received: %s\n", gimp_read); fflush (stdout); return 0; } int main (int argc, char **argv) { while (get_input ()) { if (send_to_gimp () == 0) { sleep (1); read_from_gimp (); } } return 0; } yosh/yosh.txt100664 767 770 4315 6740554100 12256 0ustar gnomegnome hi yosh this is the start of the macro recording stuff i was working on. i haven't done anything since late march. i did get it at least compiling against the latest changes to CVS gimp. the cowmgr stuff hasn;t changed since the last version on ftp.gimp.org. i started merging it, but didn;t get too far. if there's anything usable, i'll tar that up and send it along in a bit. to build this: get glib, gtk, gimp, and guile-core from the guile cvs server apply diffs to gimp add new files and dirs to gimp build and install everything the basic idea is to record actions into a trace file then munge the trace file into a script-fu script which can then be run as a macro. i originally tried to use script-fu, but SIOD is just too broken so i hacked up a guile version of script-fu. the guile version of script-fu can use the standard script-fu return value convention, or else you can pass an output format description as the first argument. this is either a symbol or list of symbols which are the names of the output args you want. this allows you to do: (set! the-image (file-jpeg-load 'image 0 "foo.jpg" "foo.jpg")) instead of (set! the-image (car (file-jpeg-load 0 "foo.jpg" "foo.jpg"))) anyway, to create a trace file: - start gimp - start Xtns->Guile-Fu - start guile-fu-driver - enter (+ 1 2) to test you should get 3 back, so the driver contacted the guile-fu server and things are running nicely. from this driver, you can access the macro stuff as well as the chalice.scm remote control stuff i did earlier. see test.scm for some shortcuts. next, type into the driver: - (gimp-macro 1 "take1.trc") ... start drawing, etc in gimp ... - (gimp-macro 0 "take1.trc") now there should be a file called take1.trc with all the stuff you've done. the next step is to process this into a script-fu macro. this is done manually for now, but should be easy to do from (gimp-macro 0 "take1.trc"): - start guile - load macro.scm - (trace->macro "take1.trc" "take1.scm") - move take1.scm into users script dir - Xtns->Script-Fu->Refresh - Xtns->Macros->Run the converted script does not yet work, but the script-fu should pop up and ask you for parameters to use when running the macro. yosh/app/ 40775 767 770 0 6740510115 11211 5ustar gnomegnomeyosh/app/macro.c100664 767 770 4050 6740507635 12567 0ustar gnomegnome #include "macro.h" static FILE * macro_file = NULL; static Argument * macro_invoker (Argument *args); void macro_add (gchar * fmt, ...) { va_list ap; if (macro_file) { va_start (ap, fmt); vfprintf (macro_file, fmt, ap); va_end (ap); } } ProcArg macro_args[] = { { PDB_INT32, "action", "what to do: { MACRO-STOP (0), MACRO-START (1), MACRO-FLUSH (2)}" }, { PDB_STRING, "filename", "the file to record to" } }; ProcRecord macro_proc = { "gimp_macro", "macro facility", "records macros", "Ray Lehtiniemi", "Ray Lehtiniemi", "1999", PDB_INTERNAL, /* Input arguments */ 2, macro_args, /* Output arguments */ 0, NULL, /* Exec method */ { { macro_invoker } }, }; static Argument * macro_invoker (Argument *args) { int success = TRUE; gint action = 0; gchar * name = NULL; /* action */ if (success) { action = args[0].value.pdb_int; switch (action) { case 0: case 1: case 2: break; default: success = FALSE; } } /* filename */ if (success) { name = (gchar*) args[1].value.pdb_pointer; if (name == NULL) { success = FALSE; } } if (success) { switch (action) { case 0: if (macro_file) { fclose (macro_file); macro_file = NULL; } break; case 1: if (macro_file) { success = FALSE; } else { macro_file = fopen (name, "w"); if (macro_file == NULL) { success = FALSE; } } break; case 2: if (macro_file) { fflush (macro_file); } else { success = FALSE; } break; } } return procedural_db_return_args (¯o_proc, success); } yosh/app/macro.h100664 767 770 251 6740507633 12551 0ustar gnomegnome#ifndef MACRO_H #define MACRO_H #include #include #include "procedural_db.h" void macro_add (gchar *, ...); extern ProcRecord macro_proc; #endif