diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/toxy/button-test.pd | 6 | ||||
| -rw-r--r-- | test/toxy/default.wid | 264 | ||||
| -rw-r--r-- | test/toxy/kb.wid | 63 | ||||
| -rw-r--r-- | test/toxy/scale-test.pd | 25 | ||||
| -rw-r--r-- | test/toxy/test.wid | 6 | ||||
| -rw-r--r-- | test/toxy/txt-test.pd | 25 | ||||
| -rw-r--r-- | test/toxy/txt.wid | 9 |
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 |