diff options
Diffstat (limited to 'test/toxy/setup.wid')
| -rw-r--r-- | test/toxy/setup.wid | 272 |
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 |