widget: redefine, version control, better kb

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

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