Overview
SS Apr62004: Gimp Client is a pure Tcl package that makes Tcl able to script Gimp without to use 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
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
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
This program is free software, under the terms of the GPL License. The program is Copyright(C) 2004 Salvatore Sanfilippo.
Source code
# 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