# 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 ################################################################################ # The args are: host port # defaults: localhost 10008 set gimp [gimp::connect] ### the Bwise part, by TV # fill in the place where your bwise script is here: source bwise343start_redhat.tcl #see above #source gimpinit.tcl # the blocks: newproc {} init in {width height bgcolor textcolor } newproc {set gimp-image-new.img [$gimp gimp-image-new ${gimp-image-new.width} ${gimp-image-new.height} $gimp::RGB]} gimp-image-new {width height} {img} 40 {} {} 27 103 newproc {set gimp-layer-new.drawable [$gimp gimp-layer-new ${gimp-layer-new.img} ${gimp-layer-new.width} ${gimp-layer-new.height} $gimp::RGB_IMAGE "FooLayer" 100 $gimp::NORMAL_MODE]} gimp-layer-new {img width height} {drawable} 40 {} {} 137 7 newproc {set gimp-image-undo-disable.imgcopy [$gimp gimp-image-undo-disable ${gimp-image-undo-disable.img}]} gimp-image-undo-disable img imgcopy 40 {} {} 256 133 newproc {set gimp-image-add-layer.out [$gimp gimp-image-add-layer ${gimp-image-add-layer.img} ${gimp-image-add-layer.drawable} 0]} gimp-image-add-layer {drawable img} {out} 40 {} {} 383 105 newproc {set gimp-palette-set-foreground.out [$gimp gimp-palette-set-foreground ${gimp-palette-set-foreground.textcolor}]} gimp-palette-set-foreground textcolor out 40 {} {} 145 219 newproc {set gimp-palette-set-background.out [$gimp gimp-palette-set-background ${gimp-palette-set-background.bgcolor}]} gimp-palette-set-background bgcolor out 40 {} {} 145 174 newproc {set gimp-edit-fill.out [$gimp gimp-edit-fill ${gimp-edit-fill.drawable} $gimp::BACKGROUND_FILL]} gimp-edit-fill {drawable do} out 40 {} {} 470 90 newproc {set gimp-drawable-update.out [$gimp gimp-drawable-update ${gimp-drawable-update.drawable} 0 0 ${gimp-drawable-update.width} ${gimp-drawable-update.height}]} gimp-drawable-update {drawable width height do} out 40 {} {} 561 164 newproc {set gimp-text-fontname.out [$gimp gimp-text-fontname ${gimp-text-fontname.img} ${gimp-text-fontname.drawable} ${gimp-text-fontname.x} ${gimp-text-fontname.y} ${gimp-text-fontname.text} 0 1 ${gimp-text-fontname.size} $gimp::PIXELS ${gimp-text-fontname.font} ]} gimp-text-fontname {img drawable x y text size font do} out 40 {} {} 649 59 newproc {set gimp-display-new.out [$gimp gimp-display-new ${gimp-display-new.img}]} gimp-display-new {img do} out 40 {} {} 735 44 newproc {set gimp-image-undo-enable.out [$gimp gimp-image-undo-enable ${gimp-image-undo-enable.img}] } gimp-image-undo-enable {img do} out 40 {} {} 735 100 connect wire0 init width gimp-image-new width connect wire1 init height gimp-image-new height connect wire2 gimp-image-new img gimp-layer-new img connect wire3 init width gimp-layer-new width connect wire4 init height gimp-layer-new height connect wire7 gimp-image-new img gimp-image-undo-disable img connect wire10 gimp-layer-new drawable gimp-image-add-layer drawable connect wire11 gimp-image-new img gimp-image-add-layer img connect wire13 init textcolor gimp-palette-set-foreground textcolor connect wire15 init bgcolor gimp-palette-set-background bgcolor connect wire21 gimp-layer-new drawable gimp-edit-fill drawable connect wire22 gimp-edit-fill out gimp-drawable-update do connect wire23 init height gimp-drawable-update height connect wire24 init width gimp-drawable-update width connect wire25 gimp-layer-new drawable gimp-drawable-update drawable connect wire27 gimp-image-new img gimp-text-fontname img connect wire28 gimp-layer-new drawable gimp-text-fontname drawable connect wire29 gimp-drawable-update out gimp-text-fontname do connect wire30 gimp-image-add-layer out gimp-edit-fill do connect wire31 gimp-text-fontname out gimp-display-new do connect wire32 gimp-image-new img gimp-display-new img connect wire33 gimp-image-new img gimp-image-undo-enable img connect wire34 gimp-display-new out gimp-image-undo-enable do # now the block related variables\n set init.bfunc {} set init.bfunc_init {} set init.bgcolor { 63 113 187} set init.height {150} set init.in {} set init.textcolor { 255 255 0} set init.width {300} set gimp-image-new.bfunc {set gimp-image-new.img [$gimp gimp-image-new ${gimp-image-new.width} ${gimp-image-new.height} $gimp::RGB]} set gimp-image-new.bfunc_init {} set gimp-image-new.height {150} set gimp-image-new.img {10} set gimp-image-new.width {300} set gimp-layer-new.bfunc {set gimp-layer-new.drawable [$gimp gimp-layer-new ${gimp-layer-new.img} ${gimp-layer-new.width} ${gimp-layer-new.height} $gimp::RGB_IMAGE "FooLayer" 100 $gimp::NORMAL_MODE]} set gimp-layer-new.bfunc_init {} set gimp-layer-new.drawable {27} set gimp-layer-new.height {150} set gimp-layer-new.img {10} set gimp-layer-new.width {300} set gimp-image-undo-disable.bfunc {set gimp-image-undo-disable.imgcopy [$gimp gimp-image-undo-disable ${gimp-image-undo-disable.img}]} set gimp-image-undo-disable.bfunc_init {} set gimp-image-undo-disable.img {10} set gimp-image-undo-disable.imgcopy {1} set gimp-image-add-layer.bfunc {set gimp-image-add-layer.out [$gimp gimp-image-add-layer ${gimp-image-add-layer.img} ${gimp-image-add-layer.drawable} 0]} set gimp-image-add-layer.bfunc_init {} set gimp-image-add-layer.drawable {27} set gimp-image-add-layer.img {10} set gimp-image-add-layer.out {} set gimp-palette-set-foreground.bfunc {set gimp-palette-set-foreground.out [$gimp gimp-palette-set-foreground ${gimp-palette-set-foreground.textcolor}]} set gimp-palette-set-foreground.bfunc_init {} set gimp-palette-set-foreground.out {} set gimp-palette-set-foreground.textcolor { 255 255 0} set gimp-palette-set-foreground.textcolour { 255 255 0} set gimp-palette-set-background.bfunc {set gimp-palette-set-background.out [$gimp gimp-palette-set-background ${gimp-palette-set-background.bgcolor}]} set gimp-palette-set-background.bfunc_init {} set gimp-palette-set-background.bgcolor { 63 113 187} set gimp-palette-set-background.bgcolour { 63 113 187} set gimp-palette-set-background.out {} set gimp-edit-fill.bfunc {set gimp-edit-fill.out [$gimp gimp-edit-fill ${gimp-edit-fill.drawable} $gimp::BACKGROUND_FILL]} set gimp-edit-fill.bfunc_init {} set gimp-edit-fill.do {} set gimp-edit-fill.drawable {27} set gimp-edit-fill.out {} set gimp-drawable-update.bfunc {set gimp-drawable-update.out [$gimp gimp-drawable-update ${gimp-drawable-update.drawable} 0 0 ${gimp-drawable-update.width} ${gimp-drawable-update.height}]} set gimp-drawable-update.bfunc_init {} set gimp-drawable-update.do {} set gimp-drawable-update.drawable {27} set gimp-drawable-update.height {150} set gimp-drawable-update.out {} set gimp-drawable-update.width {300} set gimp-text-fontname.bfunc {set gimp-text-fontname.out [$gimp gimp-text-fontname ${gimp-text-fontname.img} ${gimp-text-fontname.drawable} ${gimp-text-fontname.x} ${gimp-text-fontname.y} ${gimp-text-fontname.text} 0 1 ${gimp-text-fontname.size} $gimp::PIXELS ${gimp-text-fontname.font} ]} set gimp-text-fontname.bfunc_init {} set gimp-text-fontname.do {} set gimp-text-fontname.drawable {27} set gimp-text-fontname.font {helvetica} set gimp-text-fontname.img {10} set gimp-text-fontname.out {28} set gimp-text-fontname.size {40} set gimp-text-fontname.text {tcl Gimp testing} set gimp-text-fontname.x {10} set gimp-text-fontname.y {10} set gimp-display-new.bfunc {set gimp-display-new.out [$gimp gimp-display-new ${gimp-display-new.img}]} set gimp-display-new.bfunc_init {} set gimp-display-new.do {28} set gimp-display-new.img {10} set gimp-display-new.out {10} set gimp-image-undo-enable.bfunc {set gimp-image-undo-enable.out [$gimp gimp-image-undo-enable ${gimp-image-undo-enable.img}] } set gimp-image-undo-enable.bfunc_init {} set gimp-image-undo-enable.do {10} set gimp-image-undo-enable.img {10} set gimp-image-undo-enable.out {1}
(I've just added coordinates to the block create functions, so they appear in place, and also the block variable initial settings, needed for the init and text block to fill in parameter values before the first 'run'. I just used the values from some canvas-'state', many are not sensible or needed, and will simply be overwritten by the correct data during the first 'fun_prop' )A day later I've figured out GIMP can in practice also be told to save files, and to close its window when it is done (though I have the impression I did have a memory leak of a part of a MB per cycle), and I've made BWise blocks for that, too.Further, it is possible to make a web application of this by running tclhttpd together with bwise, and give it the appropriate DirectUrl proc, which is fun. I'll write/list when I have time, and maybe I'll think about a usable web setup.TV ''(apr 4 ' 05) Here are the bwise canvas file and a small change in the proc 'transfer' to introduce a small delay in the progress of the network to give the gimp communication time to catch up, and an image file from the below canvas which should allow you to run also a jpg-save operation automatically from the bwise graph talking to gimp-2 , where you can call the data window up on the 'save' block to change the filename pin and control the quality parameter:
[http://82.171.148.176/Wiki/cangimp6.tcl]
[http://www.theover.org/Wiki/gimpinit_noechoprint.tcl] [http://www.theover.org/Wiki/transfer_slow.tcl]