1 files changed, 272 insertions, 0 deletions
diff --git a/test/toxy/setup.wid b/test/toxy/setup.wid
new file mode 100644
index 0000000..9f66b61
--- /dev/null
+++ b/test/toxy/setup.wid
@@ -0,0 +1,272 @@
+# LATER transfer the `standard' toxy setup definitions into a tcl package
+# LATER think about using a slave interpreter, and a toxy-specific connection
+# LATER gather aqua incompatibilities, and decide, if there is no other
+# way than branching (different meaning of -bg, -borderwidth trouble,
+# right click, etc.)
+
+# LATER ask for adding something of the sort to pd.tk:
+bind Canvas <1> {+focus %W}
+
+# 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]} res] == 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: $res] }
+}
+
+proc ::toxy::itembindtrace {varname mastername ndxname op} {
+    set $varname [set $mastername]
+}
+
+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 {
+	    if {[info tclversion] < 8.4} {
+		trace variable $res w "::toxy::itembindtrace $varname"
+	    } else {
+		trace add variable $res write "::toxy::itembindtrace $varname"
+	    }
+	}
+	if {![info exists $varname.last]} { set $varname.last "" }
+	if {[info tclversion] < 8.4} {
+	    trace variable $varname w "::toxy::itemdotrace $target"
+	} else {
+	    trace add variable $varname write "::toxy::itemdotrace $target"
+	}
+	return
+    } else { return 0 }
+}
+
+# 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 != ""} {
+	    if {[info tclversion] < 8.4} {
+		catch { trace vdelete $res w "::toxy::itembindtrace $varname" }
+	    } else {
+		catch { trace remove variable \
+		    $res write "::toxy::itembindtrace $varname" }
+	    }
+	}
+    }
+}
+
+proc ::toxy::itemdestroy {path varname} {
+    ::toxy::itemremovetrace -variable $path $varname.var
+    ::toxy::itemremovetrace -textvariable $path $varname.txt
+    if {[info tclversion] < 8.4} {
+	catch { unset $varname.last $varname.var $varname.txt $varname }
+    } else {
+	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]} {
+	set failed [catch {eval $path config $::toxy::itemoptions} res]
+	unset ::toxy::itemoptions
+	if {$failed} { error [concat in $path config: $res] }
+    }
+
+    $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 [concat in ::toxy::itemsettrace: $res1]
+	}
+	if {[catch {::toxy::itemsettrace -textvariable \
+		$path $target $varname.txt} res2]} {
+	    error [concat in ::toxy::itemsettrace: $res2]
+	}
+#	puts stderr [concat traces: ($res1) ($res2)]
+	if {$res1 == 0 && $res2 == 0} {
+#	    puts stderr [concat toxy warning: $path untraceable]
+	}
+    }
+
+    if {[info exists ::toxy::masterinits]} {
+	set failed [catch {eval $::toxy::masterinits} res]
+	unset ::toxy::masterinits
+	if {$failed} { error [concat in ::toxy::masterinits: $res] }
+    }
+    if {[info exists ::toxy::typeinits]} {
+	set failed [catch {eval $::toxy::typeinits} res]
+	unset ::toxy::typeinits
+	if {$failed} { error [concat in ::toxy::typeinits: $res] }
+    }
+    if {[info exists ::toxy::iteminits]} {
+	set failed [catch {eval $::toxy::iteminits} res]
+	unset ::toxy::iteminits
+	if {$failed} { error [concat in ::toxy::iteminits: $res] }
+    }
+
+    ::toxy::itemgetconfig $path $target
+
+    return
+}
+
+proc ::toxy::itemvis {tkclass path target name varname cvpath px py} {
+    if {[winfo exists $path]} {
+#	puts stderr [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}
+	puts stderr [concat tcl error: $::toxy::itemerrmess]
+	pd $target.rp _failure \;
+    }
+}
+
+# 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 \;]
+    if {$remote != "."} {
+	pd [concat $remote $i \;]
+    }
+}
+
+proc ::toxy::popup {path target remote entries args} {
+    if {[winfo exists $path.pop]} {
+#	puts stderr [concat $path.pop exists]
+    } elseif {[catch {eval {menu $path.pop} $args} err] == 0} {
+	set i 0
+	foreach e $entries {
+	    if {$e == "."} {
+		$path.pop add separator
+	    } else {
+		incr i
+		$path.pop add command -label [lindex $e 0] \
+		    -command [concat ::toxy::popupcommand \
+			$path $target $remote $i \
+			    [lindex $e [expr {[llength $e] > 1}]]]
+	    }
+	}
+    } else { error [concat in ::toxy::popup: $err] }
+}
+
+# empirically, binding event coords as %X - [winfo rootx $cvpath] works
+# better, than %x + [winfo x %W], or %x + t->te_xpix, LATER investigate
+
+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\;
+}
+
+proc ::toxy::iteminout {target v} {
+    pd [concat $target.rp _inout $v \;]
+}
+
+proc ::toxy::masterrelease {target cvpath x y b} {
+    ::toxy::iteminout $target 3
+# pdtk_canvas_mouseup is a hack, which we must call anyway
+    pdtk_canvas_mouseup $cvpath \
+	[expr {$x - [winfo rootx $cvpath]}] \
+	[expr {$y - [winfo rooty $cvpath]}] $b
+}
+
+proc ::toxy::mastermotion {target cvpath x y} {
+    pd $target.rp _motion \
+	[$cvpath canvasx [expr {$x - [winfo rootx $cvpath]}]] \
+	[$cvpath canvasy [expr {$y - [winfo rooty $cvpath]}]] 0 \;
+}
+
+proc ::toxy::masterinit {path target cvpath} {
+    set topitem [expr {[string index $cvpath end-1] == "."}]
+# FIXME subitem handling
+    if {$topitem} {
+	bind $path <ButtonRelease> \
+	    "::toxy::masterrelease $target $cvpath %X %Y %b"
+    }
+    bind $path <1> "::toxy::itemclick $target $cvpath %X %Y %b 0"
+    bind $path <Shift-1> "::toxy::itemclick $target $cvpath %X %Y %b 1"
+    bind $path <Control-1> "::toxy::itemclick $target $cvpath %X %Y %b 2"
+    bind $path <Control-Shift-1> "::toxy::itemclick $target $cvpath %X %Y %b 3"
+    bind $path <Alt-1> "::toxy::itemclick $target $cvpath %X %Y %b 4"
+    bind $path <Alt-Shift-1> "::toxy::itemclick $target $cvpath %X %Y %b 5"
+    bind $path <Alt-Control-1> "::toxy::itemclick $target $cvpath %X %Y %b 6"
+    bind $path <Alt-Control-Shift-1> \
+	"::toxy::itemclick $target $cvpath %X %Y %b 7"
+    bind $path <3> "::toxy::itemclick $target $cvpath %X %Y %b 8"
+
+    bind $path <Motion> "::toxy::mastermotion $target $cvpath %X %Y"
+    bind $path <Enter> "::toxy::iteminout $target 1"
+    bind $path <Leave> "::toxy::iteminout $target 0"
+}
+
+# master initializer
+#> master
+
+::toxy::masterinit .- .| .^.c
+
+# standard widget types
+
+#> bang button
+#. -image ::toxy::img::empty -command .<.>
+#. -bg pink -activebackground red -width 50 -height 50
+#. @bang .- flash .: .- invoke
+
+#> float scale
+#. -command [concat ::toxy::scalecommand .| _cb]
+#. -bg pink -activebackground red -length 200
+#. @float .- set .#1
+
+#> symbol entry
+#. -bg pink -font .(helvetica 24.) -width 16
+#. @symbol .- delete 0 end .: .- insert 0 .#1
+
+bind .- <Return> {eval .<[.- get].>; focus .^.c}
+
+#> popup menubutton
+#. -menu .-.pop
+#. -bg purple -fg white -activebackground magenta -text popup
+#. -width 8 -relief raised -borderwidth 3
+#. @float if .(.#1 >= 1.) .(.-.pop invoke .#1.)
+#. #items test
+#. #iprops "-bg" purple "-fg" white "-activebackground" magenta "-borderwidth" 3
+
+::toxy::popup .- .| . [concat .#items] .#iprops