SS 2004-04-06: 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).
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.
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.
Debugging is enabled in the code. This shows the actual Scheme code that is sent to the server.
This program is free software, under the terms of the GPL License. The program is Copyright(C) 2004 Salvatore Sanfilippo.
# 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 closeTV: 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 separate 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.
2004-05-08: 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 immediately 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 whether I can automatically generate BWise blocks for image processing operations, which I think could be very interesting.
2005-03-30: 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 2009-04-01: 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?
JEL 2009-04-07: 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.