'''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

----
[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.
----
[stevel] works nicely on MacOSX using The Gimp 2.0 - well done!