many small improvements in toxy, plustot added

svn path=/trunk/externals/miXed/; revision=1321

7 files changed, 280 insertions, 118 deletions

diff --git a/test/toxy/button-test.pd b/test/toxy/button-test.pd
index 1fff19f..b37978b 100644
--- a/test/toxy/button-test.pd
+++ b/test/toxy/button-test.pd
@@ -14,12 +14,14 @@ red -command .<.>;
 #X msg 56 101 -bg gray -text "";
 #X msg 250 74 query tk_chooseColor;
 #X obj 250 101 tot .;
-#X msg 166 187 -command .<:t1 bang.>;
+#X msg 166 186 -command .<:t1 bang.>;
 #X msg 68 186 -width \$1;
 #X floatatom 68 162 5 0 0 0 - - -;
 #X msg 62 132 set -activebackground \$1;
 #X msg 90 213 -command .(set c [tk_chooseColor] .: eval .<| set "-bg"
 $c "-text" $c.>.);
+#X obj 294 268 loadbang;
+#X msg 294 295 ini .- config -textvariable "";
 #X connect 0 0 3 0;
 #X connect 1 0 0 0;
 #X connect 2 0 0 0;
@@ -35,3 +37,5 @@ $c "-text" $c.>.);
 #X connect 14 0 13 0;
 #X connect 15 0 0 0;
 #X connect 16 0 0 0;
+#X connect 17 0 18 0;
+#X connect 18 0 0 0;
diff --git a/test/toxy/default.wid b/test/toxy/default.wid
index abe9a5a..f3f549f 100644
--- a/test/toxy/default.wid
+++ b/test/toxy/default.wid
@@ -1,54 +1,152 @@
-# first the setup stuff (is this the right place for it?)
+# LATER transfer the `standard' toxy setup definitions into a tcl package
+# LATER think about using a slave interpreter, and a toxy-specific connection
 
 # LATER ask for adding something of the sort to pd.tk:
 bind Canvas <1> {+focus %W}
 
-proc ::toxy::itemleave {path target varname} {
-    if {[catch {$path get} ::toxy::itemvalue] == 0} {
-	set $varname $::toxy::itemvalue
-# LATER try sending only if changed
-	pd $target.rp _value $::toxy::itemvalue \;
-    }
+# In order to keep the state after our canvas has been destroyed
+# (i.e. our subpatch closed) -- use 'store' and 'restore' handlers,
+# if defined, otherwise try setting -variable and -textvariable traces.
+
+proc ::toxy::itemdotrace {target varname ndxname op} {
+    if {[catch {set v [set $varname]}] == 0} {
+	if {$v != [set $varname.last]} {
+# FIXME activate this on demand (for explicit traces)
+#	    pd $target.rp _value $v \;
+	    set $varname.last $v
+	}
+    } else { puts stderr [concat failed ::toxy::itemdotrace] }
 }
 
-proc ::toxy::itemvis {tkclass path target name varname cvpath px py} {
-    set ::toxy::itemfailure [catch {$tkclass $path} ::toxy::itemerrmess]
-    if {$::toxy::itemfailure} {
-	pd $target.rp _failure $::toxy::itemerrmess \;
-    } else {
+proc ::toxy::itembindtrace {varname mastername ndxname op} {
+    set $varname [set $mastername]
+}
 
-	if {[info exists ::toxy::itemoptions]} {
-	    catch {eval $path config $::toxy::itemoptions}
-	    unset ::toxy::itemoptions
+proc ::toxy::itemsettrace {op path target varname} {
+    if {[catch {$path cget $op} res] == 0} {
+	if {$res == ""} {
+	    if {[catch {$path config $op $varname} err]} {
+		error $err
+	    }
+	} else {
+	    trace add variable $res write "::toxy::itembindtrace $varname"
 	}
+	if {![info exists $varname.last]} { set $varname.last "" }
+	trace add variable $varname write "::toxy::itemdotrace $target"
+	return
+    } else { return 0 }
+}
 
-	$cvpath create window $px $py \
-	    -anchor nw -window $path -tags [concat toxy$name $target]
+# LATER revisit -- seems clumsy and fragile
+proc ::toxy::itemremovetrace {op path varname} {
+    if {[catch {$path cget $op} res] == 0} {
+	if {$res == $varname} {
+	    if {[catch {$path config $op ""} err]} {
+		error $err
+	    }
+	} elseif {$res != ""} {
+	    catch { trace remove variable \
+		$res write "::toxy::itembindtrace $varname" }
+	}
+    }
+}
 
-	if {[info exists ::toxy::masterinits]} {
-	    catch {eval $::toxy::masterinits}
-	    unset ::toxy::masterinits
+proc ::toxy::itemdestroy {path varname} {
+    ::toxy::itemremovetrace -variable $path $varname.var
+    ::toxy::itemremovetrace -textvariable $path $varname.txt
+    unset -nocomplain $varname.last $varname.var $varname.txt $varname
+    catch {destroy $path}
+}
+
+proc ::toxy::itemgetconfig {path target} {
+    pd $target.rp _config $target.rp [$path cget -bg] \
+	[winfo reqwidth $path] [winfo reqheight $path] \
+	[catch {$path config -state normal}]\;
+}
+
+proc ::toxy::itemvisconfig {path target name varname cvpath px py} {
+    if {[info exists ::toxy::itemoptions]} {
+	catch {eval $path config $::toxy::itemoptions}
+	unset ::toxy::itemoptions
+    }
+
+    $cvpath create window $px $py \
+	-anchor nw -window $path -tags [concat toxy$name $target]
+
+# FIXME
+    if {[info exists ::toxy::storethispath]} {
+# FIXME explicit traces
+	set needtraces 0
+    } else {
+	set needtraces 1
+    }
+
+    if {$needtraces != 0} {
+	if {[catch {::toxy::itemsettrace -variable \
+		$path $target $varname.var} res1]} {
+	    error $res1
 	}
-	if {[info exists ::toxy::typeinits]} {
-	    catch {eval $::toxy::typeinits}
-	    unset ::toxy::typeinits
+	if {[catch {::toxy::itemsettrace -textvariable \
+		$path $target $varname.txt} res2]} {
+	    error $res2
 	}
-	if {[info exists ::toxy::iteminits]} {
-	    catch {eval $::toxy::iteminits}
-	    unset ::toxy::iteminits
+#	puts stderr [concat traces: ($res1) ($res2)]
+	if {$res1 == 0 && $res2 == 0} {
+#	    puts stderr [concat toxy warning: $path untraceable]
 	}
+    }
 
-	pd $target.rp _config $target.rp [$path cget -bg] \
-	    [winfo reqwidth $path] [winfo reqheight $path] \
-	    [catch {$path config -state normal}]\;
+    if {[info exists ::toxy::masterinits]} {
+	catch {eval $::toxy::masterinits}
+	unset ::toxy::masterinits
+    }
+    if {[info exists ::toxy::typeinits]} {
+	catch {eval $::toxy::typeinits}
+	unset ::toxy::typeinits
+    }
+    if {[info exists ::toxy::iteminits]} {
+	catch {eval $::toxy::iteminits}
+	unset ::toxy::iteminits
+    }
 
-# LATER think where to plug this in
-	bind $path <Leave> [concat ::toxy::itemleave $path $target $varname]
-	if {[info exists $varname]} {
-	    catch {eval $path set $$varname}
-	    unset $varname
-	}
+    ::toxy::itemgetconfig $path $target
+
+    return
+}
+
+proc ::toxy::itemvis {tkclass path target name varname cvpath px py} {
+    if {[winfo exists $path]} {
+#	puts [concat $path exists]
+	set ::toxy::itemfailure 0
+    } else {
+	set ::toxy::itemfailure [catch {$tkclass $path} ::toxy::itemerrmess]
+    }
+    if {$::toxy::itemfailure == 0} {
+	set ::toxy::itemfailure [catch {::toxy::itemvisconfig \
+	    $path $target $name $varname $cvpath $px $py} \
+	    ::toxy::itemerrmess]
     }
+    if {$::toxy::itemfailure} {
+	if {[winfo exists $path]} {destroy $path}
+	pd $target.rp _failure $::toxy::itemerrmess \;
+    }
+}
+
+proc ::toxy::itemclick {target cvpath x y b f} {
+    pd $target.rp _click \
+	[$cvpath canvasx [expr $x - [winfo rootx $cvpath]]] \
+	[$cvpath canvasy [expr $y - [winfo rooty $cvpath]]] $b $f\;
+}
+
+# FIXME
+proc ::toxy::scalecommand {target sel v} {
+    pd [concat $target $sel $v \;]
+}
+
+proc ::toxy::popupcommand {path target remote i text} {
+    set [$path cget -textvariable] $text
+    pd [concat $target _cb $i \;]
+    pd [concat $remote $i \;]
 }
 
 proc ::toxy::popup {path target remote entries args} {
@@ -56,86 +154,51 @@ proc ::toxy::popup {path target remote entries args} {
     set i 1
     foreach e $entries {
 	$path.pop add command -label [lindex $e 0] \
-	    -command [concat ::toxy::callback $target \
-		-text [lindex $e [expr {[llength $e] > 1}]] \; \
-		::toxy::callback $remote $i]
+	    -command [concat ::toxy::popupcommand $path $target $remote $i \
+		[lindex $e [expr {[llength $e] > 1}]]]
 	incr i
     }
 }
 
-proc ::toxy::kb {path target remote noctaves size} {
-    set lft [expr {round(5 * $size)}]
-    set top [expr {5 * $size}]
-    set bot [expr {100 * $size}]
-    set dx [expr {round(17 * $size)}]
-    set wid [expr {$dx - $size * .5}]
-    set blbot [expr {$bot * .65}]
-
-    $path config -height [expr {$bot + $top}] \
-	-width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}]
-
-    for {set octave 0} {$octave <= $noctaves} {incr octave} {
-	set prevkey 0
-	foreach key {0 2 4 5 7 9 11} {
-	    set ndx [expr $octave * 12 + $key]
-	    set id [$path create rect $lft $top \
-		[expr {$lft + $wid}] $bot -fill white -tags $path.$ndx]
-	    $path bind $id <1> [concat ::toxy::kbset \
-		$path $target $remote $ndx]
-	    if {$key - $prevkey > 1} {
-		incr ndx -1
-		set x [expr {$lft - $wid * .22}]
-		set id [$path create rect $x $top [expr {$x + $wid * .44}] \
-		    $blbot -fill black -tags $path.$ndx]
-		$path bind $id <1> [concat ::toxy::kbset \
-		    $path $target $remote $ndx]
-	    }
-	    set prevkey $key
-	    incr lft $dx
-	    if {$octave == $noctaves && $key == 0} break
-	}
-    }
-    set ::toxy::kbval($target) 0
-    set ::toxy::kbcol($target) white
-    $path itemconfig $path.0 -fill grey
-}
-
-proc ::toxy::kbout {path target remote} {
-    ::toxy::callback $target _cb $::toxy::kbval($target)
-    if {$remote != "."} {::toxy::callback $remote $::toxy::kbval($target)}
-}
-
-proc ::toxy::kbset {path target remote value} {
-    $path itemconfig $path.$::toxy::kbval($target) \
-	-fill $::toxy::kbcol($target)
-    set ::toxy::kbval($target) $value
-    set ::toxy::kbcol($target) [lindex [$path itemconfig $path.$value -fill] 4]
-    $path itemconfig $path.$value -fill grey
-    ::toxy::kbout $path $target $remote
-}
-
 # the default initializer
 #> default
 
+# empirically, binding event coords as %X - [winfo rootx .^.c] works better,
+# than %x + [winfo x %W], or %x + t->te_xpix, LATER investigate
+
 # pdtk_canvas_mouseup is a hack, which we must call anyway
 bind .- <ButtonRelease> {
- eval .<|_inout 1.>
- pdtk_canvas_mouseup .^.c [expr %x + [winfo x %W]] [expr %y + [winfo y %W]] %b
+    eval .<|_inout 3.>
+    pdtk_canvas_mouseup .^.c \
+	[expr %X - [winfo rootx .^.c]] [expr %Y - [winfo rooty .^.c]] %b
 }
 
-bind .- <1> .<|_click %x %y %b 0.>
-bind .- <3> .<|_click %x %y %b 8.>
-bind .- <Motion> .<|_motion %x %y.>
+bind .- <1> {::toxy::itemclick .| .^.c %X %Y %b 0}
+bind .- <Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 1}
+bind .- <Control-1> {::toxy::itemclick .| .^.c %X %Y %b 2}
+bind .- <Control-Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 3}
+bind .- <Alt-1> {::toxy::itemclick .| .^.c %X %Y %b 4}
+bind .- <Alt-Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 5}
+bind .- <Alt-Control-1> {::toxy::itemclick .| .^.c %X %Y %b 6}
+bind .- <Alt-Control-Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 7}
+bind .- <3> {::toxy::itemclick .| .^.c %X %Y %b 8}
+
+bind .- <Motion> .<|_motion \
+    [.^.c canvasx [expr %X - [winfo rootx .^.c]]] \
+    [.^.c canvasy [expr %Y - [winfo rooty .^.c]]] 0.>
 bind .- <Enter> .<|_inout 1.>
 bind .- <Leave> .<|_inout 0.>
 
+# standard widget types
+
 #> bang button
 #. -image ::toxy::img::empty -command .<.>
 #. -bg pink -activebackground red -width 50 -height 50
 #. @bang .- flash .: .- invoke
 
 #> float scale
-#. -command .<.> -bg pink -activebackground red -length 200
+#. -command [concat ::toxy::scalecommand .| _cb]
+#. -bg pink -activebackground red -length 200
 #. @float .- set .#1
 
 #> symbol entry
@@ -143,14 +206,3 @@ bind .- <Leave> .<|_inout 0.>
 #. @symbol .- delete 0 end .: .- insert 0 .#1
 
 bind .- <Return> {eval .<[.- get].>; focus .^.c}
-
-#> kb canvas
-#. -bg yellow -cursor hand1
-#. #oct 4 #size .75
-#. @bang ::toxy::kbout .- .| .
-#. @float ::toxy::kbset .- .| . .#1
-
-::toxy::kb .- .| . .#oct .#size
-
-# undo the "bind Canvas <1> {+focus %W}" in the setup part above
-bind .- <FocusIn> {focus .^.c}
diff --git a/test/toxy/kb.wid b/test/toxy/kb.wid
new file mode 100644
index 0000000..e447697
--- /dev/null
+++ b/test/toxy/kb.wid
@@ -0,0 +1,63 @@
+proc ::toxy::kb {path target remote noctaves size} {
+    set lft [expr {round(5 * $size)}]
+    set top [expr {5 * $size}]
+    set bot [expr {100 * $size}]
+    set dx [expr {round(17 * $size)}]
+    set wid [expr {$dx - $size * .5}]
+    set blbot [expr {$bot * .65}]
+
+    $path config -height [expr {$bot + $top}] \
+	-width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}]
+
+    for {set octave 0} {$octave <= $noctaves} {incr octave} {
+	set prevkey 0
+	foreach key {0 2 4 5 7 9 11} {
+	    set ndx [expr $octave * 12 + $key]
+	    set id [$path create rect $lft $top \
+		[expr {$lft + $wid}] $bot -fill white -tags $path.$ndx]
+	    $path bind $id <1> [concat ::toxy::kbset \
+		$path $target $remote $ndx]
+	    if {$key - $prevkey > 1} {
+		incr ndx -1
+		set x [expr {$lft - $wid * .22}]
+		set id [$path create rect $x $top [expr {$x + $wid * .44}] \
+		    $blbot -fill black -tags $path.$ndx]
+		$path bind $id <1> [concat ::toxy::kbset \
+		    $path $target $remote $ndx]
+	    }
+	    set prevkey $key
+	    incr lft $dx
+	    if {$octave == $noctaves && $key == 0} break
+	}
+    }
+    set ::toxy::kbval($target) 0
+    set ::toxy::kbcol($target) white
+    $path itemconfig $path.0 -fill grey
+}
+
+proc ::toxy::kbout {path target remote} {
+    pd [concat $target _cb $::toxy::kbval($target) \;]
+    if {$remote != "."} {
+	pd [concat $remote $::toxy::kbval($target) \;]
+    }
+}
+
+proc ::toxy::kbset {path target remote value} {
+    $path itemconfig $path.$::toxy::kbval($target) \
+	-fill $::toxy::kbcol($target)
+    set ::toxy::kbval($target) $value
+    set ::toxy::kbcol($target) [lindex [$path itemconfig $path.$value -fill] 4]
+    $path itemconfig $path.$value -fill grey
+    ::toxy::kbout $path $target $remote
+}
+
+#> kb canvas
+#. -bg yellow -cursor hand1
+#. #oct 4 #size .75
+#. @bang ::toxy::kbout .- .| .
+#. @float ::toxy::kbset .- .| . .#1
+
+::toxy::kb .- .| . .#oct .#size
+
+# undo the "bind Canvas <1> {+focus %W}" in the setup part above
+bind .- <FocusIn> {focus .^.c}
diff --git a/test/toxy/scale-test.pd b/test/toxy/scale-test.pd
index e35a4a2..c13d3b3 100644
--- a/test/toxy/scale-test.pd
+++ b/test/toxy/scale-test.pd
@@ -1,7 +1,8 @@
 #N canvas 79 51 599 397 12;
-#X obj 22 197 widget scale s -command .<.> -variable ::toxy::simplescale
--label "Simple Scale" -orient h -length 300 -width 50 -font "Helvetica
-12" -from -16 -to 16 -showvalue 0 @float .- set .#1;
+#X obj 22 197 widget scale s -command [concat ::toxy::scalecommand
+.| _cb] -variable ::toxy::simplescale -label "Simple Scale" -orient
+h -length 300 -width 50 -font "Helvetica 12" -from -16 -to 16 -showvalue
+0 @float .- set .#1;
 #X floatatom 22 336 5 0 0 0 - - -;
 #X floatatom 191 128 5 0 0 0 - - -;
 #X msg 191 159 -from \$1;
@@ -11,19 +12,21 @@
 #X obj 44 133 tgl 15 0 empty empty empty 0 -6 0 8 -262144 -1 -1 0 1
 ;
 #X floatatom 214 336 5 0 0 0 - - -;
-#X msg 36 102 -command .<.>;
+#X msg 33 103 -command [concat ::toxy::scalecommand .| _cb];
 #X obj 214 306 r \$0-scale;
-#X msg 22 70 -command .<: \$1-scale .>;
+#X msg 22 70 -command [concat ::toxy::scalecommand \$1-scale float]
+;
 #X obj 22 10 loadbang;
 #X obj 22 40 int \$0;
 #X msg 113 10 bang;
-#X msg 269 67 @float .- set .#1;
-#X msg 269 102 remove @float;
-#X floatatom 269 40 5 0 0 0 - - -;
+#X msg 188 10 @float .- set .#1;
+#X msg 188 40 remove @float;
+#X floatatom 89 45 5 0 0 0 - - -;
 #N canvas 0 0 450 420 linked 0;
-#X obj 54 49 widget scale s -command .<.> -variable ::toxy::simplescale
--orient v -length 300 -width 50 -font "Helvetica 12" -from -16 -to
-16 -showvalue 0 @float .- set .#1;
+#X obj 54 49 widget scale s -command [concat ::toxy::scalecommand .|
+_cb] -variable ::toxy::simplescale -orient v -length 300 -width 50
+-font "Helvetica 12" -from -16 -to 16 -showvalue 0 @float .- set .#1
+;
 #X coords 0 0 1 1 80 360 1;
 #X restore 472 20 pd linked;
 #X connect 0 0 1 0;
diff --git a/test/toxy/test.wid b/test/toxy/test.wid
new file mode 100644
index 0000000..3cb82f1
--- /dev/null
+++ b/test/toxy/test.wid
@@ -0,0 +1,6 @@
+puts before
+
+#> test button
+#. -bg green -text test
+
+puts after
diff --git a/test/toxy/txt-test.pd b/test/toxy/txt-test.pd
new file mode 100644
index 0000000..fe4b48a
--- /dev/null
+++ b/test/toxy/txt-test.pd
@@ -0,0 +1,25 @@
+#N canvas 0 0 487 327 12;
+#X obj 20 24 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1
+-1;
+#X floatatom 72 92 5 0 0 0 - - -;
+#X obj 95 251 print;
+#X obj 20 210 route bang;
+#N canvas 517 44 481 430 txtpanel 1;
+#X obj 64 37 widget txt t;
+#X restore 305 31 pd txtpanel;
+#X obj 20 173 tow txtpanel txt t;
+#X msg 79 126 tot pd nlines [expr [.- index end] - 1] .`.:;
+#X obj 243 173 r nlines;
+#X floatatom 243 210 5 0 0 0 - - -;
+#X msg 136 92 replace test;
+#X msg 65 59 insert trailer end;
+#X msg 60 24 insert header "0.0";
+#X connect 0 0 5 0;
+#X connect 1 0 5 0;
+#X connect 3 1 2 0;
+#X connect 5 0 3 0;
+#X connect 6 0 5 0;
+#X connect 7 0 8 0;
+#X connect 9 0 5 0;
+#X connect 10 0 5 0;
+#X connect 11 0 5 0;
diff --git a/test/toxy/txt.wid b/test/toxy/txt.wid
new file mode 100644
index 0000000..29d7a3e
--- /dev/null
+++ b/test/toxy/txt.wid
@@ -0,0 +1,9 @@
+#> txt text
+#. -bg lightgreen -foreground brown -font .(helvetica 12 bold.) -width 40 -height 16
+#. @bang pd .| _cb [string map .(" " ".`.` ".) [.- get "0.0" end]] .`.:
+#. @float pd .| _cb [string map .(" " ".`.` ".) [.- get .#1.0 .#1.end]] .`.:
+#. @insert .- insert .#2 .#1
+#. @replace .- delete "0.0" end .: .- insert "0.0" .#1
+
+#. @store set .#1 [.- get 0.0 end]
+#. @restore insert 0.0 .#1