Updated 2013-09-03 21:59:03 by RLE

Overview edit

SS Apr62004: Gimp Client is a pure Tcl package that allows one to use Tcl to script Gimp without the use of some kind of special plugin, but just over TCP/IP. It uses the Script-Fu Server of Gimp, and translates Tcl calls to equivalent Scheme code on-the-fly (no static bindings between procedures). Using this stuff, Tcl can fully access the PDB capabilities of Gimp, even on remote hosts. The API is exactly the Scheme's one translated to Tcl, with the only difference that while Scheme's return values to PDB calls are always lists, in the case of a single return value the Tcl version of functions will just return the value instead of a one-element list (avoid a lot of useles lindex calls).

Tcp/Ip edit

This stuff can work with remote hosts, that is, it's possible to control a remote Gimp using TCP/IP. This can be very useful in the case of a print-service.

Usage edit

Run the Gimp 2.0 program (should work with 1.2 also, but the Script-Fu Server of 1.x versions appears to be less stable... try it if you want), Execute the 'Script-Fu Server' From the Xtns menu. Run the Gimp Client code. There is a very short example script that is executed for default.

Debuging is enabled in the code. This shows the actual scheme code that is sent to the server.

License edit

This program is free software, under the terms of the GPL License. The program is Copyright(C) 2004 Salvatore Sanfilippo.

Source code edit

 # Tcl client for Gimp's Script-Fu Server.
 # Copyright(C) 2004 Salvatore Sanfilippo
 #
 # This is free software, under the terms of the GPL license version 2.
 # You can get a copy of the license from http://www.gnu.org/copyleft/gpl.html
 #
 # TODO:
 #
 # - Define more constants
 # - Write some decent example
 # - Add some higher level subcommand with sane defaults
 #   and options to specify more details, in the Tcl way.
 
 namespace eval gimp {}
 namespace eval gimp::method {}
 
 set gimp::debug 1
 
 ################################################################################
 # GIMP constants
 ################################################################################
 
 # Image type
 set gimp::RGB 0
 set gimp::GRAY 1
 set gimp::INDEXED 2
 
 # Layer type
 set gimp::RGB_IMAGE 0
 set gimp::RGBA_IMAGE 1
 set gimp::GRAY_IMAGE 2
 set gimp::GRAYA_IMAGE 3
 set gimp::INDEXED_IMAGE 4
 set gimp::INDEXEDA_IMAGE 5
 
 # Layer mode
 set gimp::NORMAL_MODE 0
 set gimp::DISSOLVE_MODE 1
 set gimp::BEHIND_MODE 2
 set gimp::MULTIPLY_MODE 3
 set gimp::SCREEN_MODE 4
 set gimp::OVERLAY_MODE 5
 set gimp::DIFFERENCE_MODE 6
 set gimp::ADDITION_MODE 7
 set gimp::SUBTRACT_MODE 8
 set gimp::SUBTRACT_MODE 8
 set gimp::DARKEN_ONLY_MODE 9
 set gimp::HUE_MODE 11
 set gimp::SATURATION_MODE 12
 set gimp::COLOR_MODE 13
 set gimp::VALUE_MODE 14
 set gimp::DIVIDE_MODE 15
 set gimp::DODGE_MODE 16
 set gimp::BURN_MODE 17
 set gimp::HARDLIGHT_MODE 18
 set gimp::SOFTLIGHT_MODE 19
 set gimp::GRAIN_EXTRACT_MODE 20
 set gimp::GRAIN_MERGE_MODE 21
 set gimp::COLOR_ERASE_MODE 22
 
 # Fill type
 set gimp::FOREGROUND_FILL 0
 set gimp::BACKGROUND_FILL 1
 set gimp::WHITE_FILL 2
 set gimp::TRANSPARENT_FILL 3
 set gimp::PATTERN_FILL 3
 
 # Units
 set gimp::PIXELS 0
 set gimp::POINTS 1
 
 # Connect to a running GIMP (with Script-Fu Server enabled)
 proc gimp::connect {{host 127.0.0.1} {port 10008}} {
     set fd [socket $host $port]
     fconfigure $fd -encoding binary -translation binary
     set handle "gimp-$fd"
     interp alias {} $handle {} gimp::request $fd
     set script {
 (begin
     (define (scheme-list->tcl l)
       (let ((len (length l)) (i 0) (res ""))
         (while (< i len)
           (set! res (string-append res " {" (scheme->tcl (nth i l)) "}"))
           (set! i (+ i 1)))
         res))
 
     (define (scheme->tcl o)
       (cond
         ((pair? o) (scheme-list->tcl o))
         ((number? o) (number->string o))
         ((null? o) "{}")
         ((string? o) o)))
 
     (define (tclinterface-get-procedure-info procname)
         (let ((x (gimp-procedural-db-proc-info procname)))
             (begin
                 (set! numargs (nth 6 x))
                 (set! numvals (nth 7 x))
                 (set! tclargs "")
                 (set! tclvals "")
                 (set! i 0)
                 (while (< i numargs)
                     (let ((procinfo (gimp-procedural-db-proc-arg procname i)))
                         (set! tclargs (string-append tclargs
                             "{" (number->string (nth 0 procinfo)) " "
                                 "{" (nth 1 procinfo) "}} ")))
                     (set! i (+ i 1)))
                 (set! i 0)
                 (while (< i numvals)
                     (let ((procinfo (gimp-procedural-db-proc-val procname i)))
                         (set! tclvals (string-append tclvals
                             "{" (number->string (nth 0 procinfo)) " "
                                 "{" (nth 1 procinfo) "}} ")))
                     (set! i (+ i 1)))
                 (string-append "{" tclargs "} {" tclvals "}")))))
 
     }
     ::gimp::evalscheme $fd $script
     return $handle
 }
 
 # Use the Script-Fu Server binary protocol to evaluate a Scheme s-expression.
 proc gimp::evalscheme {fd script} {
     # Send the query...
     set script [string trim $script]
     if {$::gimp::debug} {puts "Script: $script"}
     set query "G[binary format S [string length $script]]$script"
     puts -nonewline $fd $query
     flush $fd
     # Get the reply...
     set hdr [read $fd 4]
     binary scan [string index $hdr 1] c errorcode
     binary scan [string range $hdr 2 3] S replylen
     if {$::gimp::debug} {
         puts "Reply error code: $errorcode len: $replylen"
     }
     set reply [read $fd $replylen]
     if {$::gimp::debug} {
         puts "Reply: $reply"
     }
     if {$errorcode} {
         error "Script-Fu error '[string trim $reply]' executing '$script'"
     }
     return $reply
 }
 
 # Handle requests to Gimp handlers. Actually it's a dispatcher
 # that calls the on-the-fly binding code if needed.
 proc gimp::request {fd request args} {
     if {[catch {info args ::gimp::method::$request}]} {
         ::gimp::trytobind $fd $request
     }
     eval ::gimp::method::$request $fd $args
 }
 
 # Try to create bindings on-the-fly for the called Scheme function.
 proc gimp::trytobind {fd funcname} {
     set pdbname [string map [list - _] $funcname]
     set scheme "(tclinterface-get-procedure-info \"$pdbname\")"
     if {[catch {::gimp::evalscheme $fd $scheme} result]} {
         # No PDB function with this name
         return
     } else {
         foreach {args vals} $result break
         set arglist fd
         set scheme "(scheme->tcl ($funcname "
         foreach a $args {
             foreach {type name} $a break
             append scheme "\[tcl->scheme $type \$$name\] "
             lappend arglist $name
         }
         append scheme "))"
         puts $scheme
         if {[llength $vals] > 1} {
             proc ::gimp::method::$funcname $arglist [format {
                 ::gimp::evalscheme $fd %s
             } "\"$scheme\""]
         } else {
             proc ::gimp::method::$funcname $arglist [format {
                 lindex [::gimp::evalscheme $fd %s] 0
             } "\"$scheme\""]
         }
     }
 }
 
 # Convert Tcl PDB arguments to Scheme's equivalent
 proc tcl->scheme {type val} {
     switch -- $type {
         0 - 1 - 2 - 3 {
             # Number and IDs
             return $val
         }
         5 - 6 - 7 - 8 - 9 - 10 {
             # Array of different types
             set res "'("
             foreach e $val {
                 append res [switch -- $type {
                     5 - 6 - 7 - 8 - 10 {tcl->scheme 0 $e}
                     9 {tcl->scheme 4 $e}
                 }] " "
             }
             append res ")"
         }
         4 {
             # String
             set q [list $val]
             if {[string length $q] != [string length $val]} {
                 return "\"[string range $q 1 end-1]\""
             } else {
                 return "\"$val\""
             }
         }
         default {
             # Id of images, layers, and so on.
             return $val
         }
     }
 }
 
 ################################################################################
 # Methods that does not have a counter-part in the Scheme environment
 ################################################################################
 
 # Eval a scheme script
 proc gimp::method::remote-eval {fd script} {
     ::gimp::evalscheme $fd $script
 } 
 
 # Close the link with Gimp and remove the alias
 proc gimp::method::close fd {
     ::close $fd
     set handle "gimp-$fd"
     interp alias {} $handle {}
 }
 
 ################################################################################
 # Testing
 ################################################################################
 set gimp [gimp::connect]
 
 proc example gimp {
     set width 300
     set height 150
     set bgcolor [list 63 113 187]
     set textcolor [list 255 255 0]
     set img [$gimp gimp-image-new $width $height $gimp::RGB]
     set drawable [$gimp gimp-layer-new $img $width $height $gimp::RGB_IMAGE "FooLayer" 100 $gimp::NORMAL_MODE]
     $gimp gimp-image-undo-disable $img
     $gimp gimp-image-add-layer $img $drawable 0
     $gimp gimp-palette-set-foreground $textcolor
     $gimp gimp-palette-set-background $bgcolor
     $gimp gimp-edit-fill $drawable $gimp::BACKGROUND_FILL
     $gimp gimp-drawable-update $drawable 0 0 $width $height
     $gimp gimp-text-fontname $img $drawable 10 10 "Tcl+Gimp=Fun" 0 1 30 $gimp::PIXELS "Verdana"
     $gimp gimp-display-new $img
     $gimp gimp-image-undo-enable $img
 }
 
 example $gimp
 $gimp close

TV Voluntered 'testing' the gimp link via script-fu and tcl script, unfortunately I on windows XP (SP 1) cannot get it to connect, even though script-fu seems to start up as seperate process, and the sources (I used precompiled bins though) indicate the port number as indeed 10008. There's no server port getting occupied after startup. On to linux and maybe some digging / cygwin compilation.

(May 8 2004) I 'finally' got gimp 2.0 running on RH9, which is cool, though I'm not sure which of my compiled or prefab libs it is all using, and even though the theming engine cannot be found...

So I immedetely tried out the script and indeed it works well! Now I'm off to at some point get into the script, get into the fu interface to see if I can make the menu's (which I know) easily into a tcl command, and wether I can automatically generate BWise blocks for image processing operations, which I think could be very interesting.

(mar 30 '05) Meanwhile I made Gimp driving with BWise which I should think about updating with the 'save' (I made a jpg version work) blocks, and also on-canvas image display of results (I've done that but it's not on the page yet).

stevel works nicely on MacOSX using The Gimp 2.0 - well done!

thgr (Apr 1 2009) tried this beauty in gimp 2.4.6 on windows and found that with a little modification in gimp::connect it is working:
 proc gimp::connect {{host 127.0.0.1} {port 10008}} {
     set fd [socket $host $port]
     fconfigure $fd -encoding binary -translation binary
     set handle "gimp-$fd"
     interp alias {} $handle {} gimp::request $fd
     set script {
 (begin
     (define (scheme-list->tcl l)
       (let ((len (length l)) (i 0) (res ""))
         (while (< i len)
           (set! res (string-append res " {" (scheme->tcl (nth i l)) "}"))
           (set! i (+ i 1)))
         res))
 
     (define (scheme->tcl o)
       (cond
         ((pair? o) (scheme-list->tcl o))
         ((number? o) (number->string o))
         ((null? o) "{}")
         ((string? o) o)))
 
     (define (tclinterface-get-procedure-info procname)
         (let ((x (gimp-procedural-db-proc-info procname)) 
               (numargs 0) (numvals 0) (tclargs "") (tclvals "") (i 0))
             (begin
                 (set! numargs (nth 6 x))
                 (set! numvals (nth 7 x))
                 (while (< i numargs)
                     (let ((procinfo (gimp-procedural-db-proc-arg procname i)))
                         (set! tclargs (string-append tclargs
                             "{" (number->string (nth 0 procinfo)) " "
                                 "{" (nth 1 procinfo) "}} ")))
                     (set! i (+ i 1)))
                 (set! i 0)
                 (while (< i numvals)
                     (let ((procinfo (gimp-procedural-db-proc-val procname i)))
                         (set! tclvals (string-append tclvals
                             "{" (number->string (nth 0 procinfo)) " "
                                 "{" (nth 1 procinfo) "}} ")))
                     (set! i (+ i 1)))
                 (string-append "{" tclargs "} {" tclvals "}")))))
 
     }
     ::gimp::evalscheme $fd $script
     return $handle
 }

But I still get errors for parameters with hyphens in it (e.g. fill-type). If I modify the tcl->scheme calls to ${fill-type} in trytobind gimp raises an error otherwise I get the 'can't read "fill": no such variable' error in tcl ... Maybe someone can fix this?

(Apr 7, 2009) Looks like both TCL and Gimp may have changed since this script was written. Even with your changes, scheme is giving me string-append errors before hitting the hyphenated variable issue you are seeing. This running the example code on Linux (F8) with Gimp 2.4.7. Too bad, I've used Gimp Client in the past and it was very useful. -JEL