diff options
Diffstat (limited to 'test/toxy')
| -rw-r--r-- | test/toxy/kb-test.pd | 48 | ||||
| -rw-r--r-- | test/toxy/kb.wid | 199 | ||||
| -rw-r--r-- | test/toxy/multiscale.wid | 3 | ||||
| -rw-r--r-- | test/toxy/setup.wid | 31 |
4 files changed, 237 insertions, 44 deletions
diff --git a/test/toxy/kb-test.pd b/test/toxy/kb-test.pd index 22df275..df6fdef 100644 --- a/test/toxy/kb-test.pd +++ b/test/toxy/kb-test.pd @@ -1,8 +1,8 @@ -#N canvas 354 116 645 486 12; +#N canvas 238 92 749 477 12; #X obj 37 59 widget kb k1; #X floatatom 37 160 5 0 0 0 - - -; -#X obj 37 310 widget kb k2 #oct 10 #size 0.35 -bg red; -#X floatatom 37 369 5 0 0 0 - - -; +#X obj 37 310 widget kb k2 #oct 10 #size 0.5 -bg red; +#X floatatom 37 402 5 0 0 0 - - -; #X floatatom 120 237 5 0 0 0 - - -; #X floatatom 37 24 5 0 0 0 - - -; #X msg 114 24 bang; @@ -10,8 +10,39 @@ #X floatatom 205 237 5 0 0 0 - - -; #X msg 205 271 #size \$1; #X msg 120 271 #oct \$1; +#X msg 180 24 redefine; +#X msg 374 196 redefine; +#X obj 111 160 unpack; +#X floatatom 154 196 5 0 0 0 - - -; +#X obj 108 402 unpack; +#X floatatom 151 437 5 0 0 0 - - -; +#X obj 214 160 print; +#X obj 309 271 print; +#X msg 284 24 clear; +#X obj 309 233 tow . kb k2; +#X msg 309 196 bang; +#N canvas 126 77 407 234 out 0; +#X obj 119 28 inlet; +#X obj 119 65 unpack; +#X obj 119 185 s sf2in; +#X obj 119 145 pack; +#X obj 217 28 inlet; +#X obj 119 103 + 24; #X connect 0 0 1 0; +#X connect 1 0 5 0; +#X connect 1 1 3 1; +#X connect 3 0 2 0; +#X connect 4 0 5 1; +#X connect 5 0 3 0; +#X restore 382 271 pd out; +#X floatatom 425 233 5 0 0 0 - - -; +#X msg 474 196 clear; +#X obj 483 233 tow . kb k1; +#X connect 0 0 1 0; +#X connect 0 0 13 0; +#X connect 0 0 17 0; #X connect 2 0 3 0; +#X connect 2 0 15 0; #X connect 4 0 10 0; #X connect 5 0 0 0; #X connect 6 0 0 0; @@ -19,3 +50,14 @@ #X connect 8 0 9 0; #X connect 9 0 2 0; #X connect 10 0 2 0; +#X connect 11 0 0 0; +#X connect 12 0 20 0; +#X connect 13 1 14 0; +#X connect 15 1 16 0; +#X connect 19 0 0 0; +#X connect 20 0 18 0; +#X connect 20 0 22 0; +#X connect 21 0 20 0; +#X connect 23 0 22 1; +#X connect 24 0 20 0; +#X connect 25 0 22 0; diff --git a/test/toxy/kb.wid b/test/toxy/kb.wid index 8a081d7..901db15 100644 --- a/test/toxy/kb.wid +++ b/test/toxy/kb.wid @@ -1,3 +1,68 @@ +proc ::toxy::kbout {path target remote oldchord newchord} { + foreach key $oldchord { + pd [concat $target _cb [lindex $key 0] 0 \;] + if {$remote != "."} { + pd [concat $remote [lindex $key 0] 0 \;] + } + } + foreach key $newchord { + pd [concat $target _cb [lindex $key 0] [lindex $key 1] \;] + if {$remote != "."} { + pd [concat $remote [lindex $key 0] [lindex $key 1] \;] + } + } +} + +proc ::toxy::kbput {path target remote keys appendmode doout} { + set oldchord {} + set newchord {} + if {$appendmode} { + foreach key $keys { + set ndx [lindex $key 0] +# FIXME upper limit + if {$ndx >= 0} { + if {$appendmode == 1} { + set found \ + [lsearch $::toxy::kbchord($target) [concat $ndx *]] + } else { set found -1 } + if {$found < 0} { + $path itemconfig $path.$ndx -fill grey + lappend newchord $key + lappend ::toxy::kbchord($target) $key + } else { + $path itemconfig $path.$ndx \ + -fill [lindex [$path gettags $path.$ndx] 2] + lappend oldchord $key + set ::toxy::kbchord($target) \ + [lreplace $::toxy::kbchord($target) $found $found] + } + } + } +# FIXME oldchord + set ::toxy::kbchord($target) \ + [lsort -unique -integer -index 0 $::toxy::kbchord($target)] + } else { + set oldchord $::toxy::kbchord($target) + foreach key $::toxy::kbchord($target) { + set ndx [lindex $key 0] + $path itemconfig $path.$ndx \ + -fill [lindex [$path gettags $path.$ndx] 2] + } + foreach key $keys { + set ndx [lindex $key 0] +# FIXME upper limit + if {$ndx >= 0} { + $path itemconfig $path.$ndx -fill grey + lappend newchord $key + } + } + set ::toxy::kbchord($target) [lsort -unique -integer -index 0 $newchord] + } + if {$doout} { + ::toxy::kbout $path $target $remote $oldchord $newchord + } +} + proc ::toxy::kb {path target remote noctaves size} { # guard against BadAlloc crashes if {$size > 10} {set size 10} @@ -11,55 +76,143 @@ proc ::toxy::kb {path target remote noctaves size} { $path config -height [expr {$bot + $top}] \ -width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}] + bind $path <Enter> +[concat ::toxy::kbenter $path $target] + bind $path <Leave> +[concat ::toxy::kbleave $path $target] + bind $path <B1-Motion> \ + +[concat ::toxy::kbdrag $path $target $remote %X %Y 0] + bind $path <B1-Shift-Motion> \ + +[concat ::toxy::kbdrag $path $target $remote %X %Y 1] + bind $path <B1-Control-Motion> \ + +[concat ::toxy::kbdrag $path $target $remote %X %Y 2] + 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] + set id [$path create rect $lft $top [expr {$lft + $wid}] $bot \ + -fill white -tags "$ndx $path.$ndx white"] + $path bind $id <1> \ + [concat ::toxy::kbpress $path $target $remote $ndx %y 0] + $path bind $id <Shift-1> \ + [concat ::toxy::kbpress $path $target $remote $ndx %y 1] + $path bind $id <Control-1> \ + [concat ::toxy::kbcontrolon $path $target $remote $ndx %y] + $path bind $id <Control-ButtonRelease> \ + [concat ::toxy::kbcontroloff $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] + $blbot -fill black -tags "$ndx $path.$ndx black"] + $path bind $id <1> \ + [concat ::toxy::kbpress $path $target $remote $ndx %y 0] + $path bind $id <Shift-1> \ + [concat ::toxy::kbpress $path $target $remote $ndx %y 1] + $path bind $id <Control-1> \ + [concat ::toxy::kbcontrolon $path $target $remote $ndx %y] + $path bind $id <Control-ButtonRelease> \ + [concat ::toxy::kbcontroloff $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 + set ::toxy::kbisinside($target) 0 + set chord $::toxy::kbchord($target) + set ::toxy::kbchord($target) {} + ::toxy::kbput $path $target $remote $chord 0 0 } -proc ::toxy::kbout {path target remote} { - pd [concat $target _cb $::toxy::kbval($target) \;] - if {$remote != "."} { - pd [concat $remote $::toxy::kbval($target) \;] +proc ::toxy::kbgetvel {path ndx y} { + set g [$path coords $path.$ndx] + set top [lindex $g 1] + set bot [lindex $g 3] + set vel [expr 100.0 - 99.0 * ($top - $y) / ($top - $bot)] + if {$vel < 1.0} {set vel 1.0} elseif {$vel > 100.0} {set vel 100.0} + return $vel +} + +proc ::toxy::kbcontrolon {path target remote ndx y} { + if {[$path cget -state] == "normal"} { + $path itemconfig $path.$ndx -fill red + ::toxy::kbout $path $target $remote {} \ + [list [concat $ndx [::toxy::kbgetvel $path $ndx $y]]] } } -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 +proc ::toxy::kbcontroloff {path target remote ndx} { + if {[$path cget -state] == "normal"} { + if {[lsearch $::toxy::kbchord($target) [concat $ndx *]] < 0} { + $path itemconfig $path.$ndx \ + -fill [lindex [$path gettags $path.$ndx] 2] + } else { + $path itemconfig $path.$ndx -fill grey + } + ::toxy::kbout $path $target $remote [list [concat $ndx 0]] {} + } +} + +proc ::toxy::kbpress {path target remote ndx y shift} { + if {[$path cget -state] == "normal"} { + ::toxy::kbput $path $target $remote \ + [list [concat $ndx [::toxy::kbgetvel $path $ndx $y]]] $shift 1 + } +} + +proc ::toxy::kbdrag {path target remote rx ry shift} { + if {$shift <= 1 && $::toxy::kbisinside($target) && \ + [$path cget -state] == "normal"} { + set x [expr $rx - [winfo rootx $path]] + set y [expr $ry - [winfo rooty $path]] + set ndx [lindex [$path gettags [$path find closest $x $y]] 0] + if {[lsearch $::toxy::kbchord($target) [concat $ndx *]] < 0} { + ::toxy::kbput $path $target $remote \ + [list [concat $ndx [::toxy::kbgetvel $path $ndx $y]]] $shift 1 + } + } +} + +proc ::toxy::kbenter {path target} { + set ::toxy::kbisinside($target) 1 +} + +proc ::toxy::kbleave {path target} { + set ::toxy::kbisinside($target) 0 +} + +proc ::toxy::kbbang {path target remote} { + ::toxy::kbout $path $target $remote {} $::toxy::kbchord($target) +} + +proc ::toxy::kbfloat {path target remote ndx} { + ::toxy::kbput $path $target $remote [list [concat $ndx 50.0]] 0 1 +} + +proc ::toxy::kblist {path target remote args} { +# LATER (::toxy::kbput ... 1) +} + +proc ::toxy::kbset {path target remote args} { +# LATER (::toxy::kbput ... 0) } #> kb canvas #. -bg yellow -cursor hand1 #. #oct 4 #size .75 -#. @bang ::toxy::kbout .- .| . -#. @float ::toxy::kbset .- .| . .#1 +#. @bang ::toxy::kbbang .- .| . +#. @float ::toxy::kbfloat .- .| . .#1 +#. @list ::toxy::kblist .- .| . .#args +#. @set ::toxy::kbset .- .| . .#args +#. @clear ::toxy::kbput .- .| . {} 0 1 ::toxy::kb .- .| . .#oct .#size # undo the "bind Canvas <1> {+focus %W}" from the setup.wid bind .- <FocusIn> {focus .^.c} + +#@ new +set ::toxy::kbchord(.|) {} + +#@ free +unset ::toxy::kbchord(.|) diff --git a/test/toxy/multiscale.wid b/test/toxy/multiscale.wid index 18f5603..bff9c4f 100644 --- a/test/toxy/multiscale.wid +++ b/test/toxy/multiscale.wid @@ -35,7 +35,8 @@ proc ::toxy::multiscale {path cvpath target remote count lo hi res dx dy bg} { } set id [$path create window $px $py -width $dx -height $dy \ -anchor nw -window $path.s$ndx -tags $path.s$ndx] - ::toxy::master $path.s$ndx $path $cvpath $target +# ::toxy::master $path.s$ndx $path $cvpath $target + ::toxy::master $path.s$ndx $cvpath $target incr px $dx } } diff --git a/test/toxy/setup.wid b/test/toxy/setup.wid index 3ae0a70..98fe7fb 100644 --- a/test/toxy/setup.wid +++ b/test/toxy/setup.wid @@ -1,4 +1,7 @@ -# LATER transfer the `standard' toxy setup definitions into a tcl package +package provide toxywidgets 0.1.0.14 + +# LATER keep standard widget setup in a .tcl file (transfered into a .wiq), and +# glue separate .wid files with standard widget definitions into another .wiq # 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, @@ -116,11 +119,9 @@ proc ::toxy::item_visconfig {path target name varname cvpath px py} { } } - if {[info exists ::toxy::masterinit]} { - set failed [catch {eval $::toxy::masterinit} res] - unset ::toxy::masterinit - if {$failed} { error [concat in ::toxy::masterinit: $res] } - } + set failed [catch {::toxy::master $path $cvpath $target} res] + if {$failed} { error [concat in ::toxy::master: $res] } + if {[info exists ::toxy::typeinit]} { set failed [catch {eval $::toxy::typeinit} res] unset ::toxy::typeinit @@ -183,7 +184,7 @@ proc ::toxy::master_motion {target cvpath x y} { [$cvpath canvasy [expr {$y - [winfo rooty $cvpath]}]] 0 \; } -proc ::toxy::master {path toppath cvpath target} { +proc ::toxy::master {path cvpath target} { # FIXME subitem handling in megawidgets bind $path <ButtonRelease> "::toxy::master_release $target $cvpath %X %Y %b" bind $path <1> "::toxy::item_click $target $cvpath %X %Y %b 0" @@ -198,10 +199,13 @@ proc ::toxy::master {path toppath cvpath target} { bind $path <3> "::toxy::item_click $target $cvpath %X %Y %b 8" bind $path <Motion> "::toxy::master_motion $target $cvpath %X %Y" + bind $path <B1-Motion> "::toxy::master_motion $target $cvpath %X %Y" bind $path <Enter> "::toxy::item_inout $target 1" bind $path <Leave> "::toxy::item_inout $target 0" } +# standard widget types, LATER move to separate .wid files + # FIXME proc ::toxy::scale_command {target sel v} { if {$::toxy::scale_isactive} { @@ -242,16 +246,6 @@ proc ::toxy::popup {path target remote entries args} { } else { error [concat in ::toxy::popup: $err] } } -# master initializer -#> master - -::toxy::master .- .- .^.c .| - -# FIXME -set ::toxy::scale_isactive 1 - -# standard widget types - #> bang button #. -image ::toxy::img::empty -command .<.> #. -bg pink -activebackground red -width 50 -height 50 @@ -263,6 +257,9 @@ set ::toxy::scale_isactive 1 #. @float .- set .#1 #. @vset ::toxy::scale_doset .- .#1 +# FIXME +set ::toxy::scale_isactive 1 + #> symbol entry #. -bg pink -font .(helvetica 24.) -width 16 #. @symbol .- delete 0 end .: .- insert 0 .#1 |