1 files changed, 48 insertions, 0 deletions
diff --git a/extensions/gui/ix/toxy/kbd.wid b/extensions/gui/ix/toxy/kbd.wid
new file mode 100755
index 00000000..06c1d7e7
--- /dev/null
+++ b/extensions/gui/ix/toxy/kbd.wid
@@ -0,0 +1,48 @@
+namespace eval ::ix {
+    proc kbd_list {p t args} {
+	variable _
+	set w $p.f[expr [lindex $args 0] / 12].[lindex $args 0]
+	if {[llength $args] == 1} {set v 1;if {$_($t:lp) != -1 && $_($t:lp) ne $w} {kbd_action $_($t:lp) $t 0}} {set v [lindex $args 1]}	
+	kbd_action $w $t $v
+	set _($t:lp) $w}
+
+    proc kbd_play {t m b x y} {
+	variable _
+	foreach a {{rs {0 sunken 1 raised}} {v {0 0 1 {($y - [winfo rooty $w]) / ([winfo height $w] + 0.0)}}}} {array set [lindex $a 0] [lindex $a 1]}
+	set w [winfo containing $x $y]
+	if {$m != 1 && $_($t:lp) != -1 && $_($t:lp) ne $w} {kbd_action $_($t:lp) $t 0}
+	if {[$w cget -relief] eq $rs($b)} {kbd_action $w $t  [eval expr $v($b)]}
+	set _($t:lp) $w}
+
+    proc kbd_action {w t v} {
+	if {$v == 0} {set relief raised} {set relief sunken}
+	$w config -relief $relief
+	pd [concat $t.rp _cb [winfo name $w] $v \;]}
+
+    proc kbd_off {p t octaves} {
+	for {set o 0} {$o < $octaves} {incr o} {	
+	    for {set on 0} {$on < 12} {incr on} {
+		set w $p.f$o.[expr $o * 12 + $on]
+	        if {[$w cget -relief] eq "sunken"} {kbd_action $w $t 0}}}}
+
+    proc kbd {path t octaves b f} {
+	$path config -width [expr $octaves * 66]
+	if {![winfo exists $path.f0]} {
+	    variable _
+	    set _($t:lp) -1
+	    set bw {0 1 0 1 0 0 1 0 1 0 1 0} ; set npl {0 1 1 2 2 3 4 4 5 5 6 6}
+	    foreach a {{bg "0 $b 1 $f"} {fg "1 $b 0 $f"} {an {0 ";lower $wk" 1 "-anchor n"}} {rw {0 {[expr 1 / 7.]} 1 {[expr 1 / 10.]}}} {rh {0 {[expr 1.]} 1 {[expr 6 / 10.]}}}} {array set [lindex $a 0] [lindex $a 1]}
+	    for {set o 0} {$o < $octaves} {incr o} {
+		set w $path.f$o ; frame $w -bd 0 -height 66 -width 66
+		for {set on 0} {$on < 12} {incr on} {
+		    set wk $w.[expr $o * 12 + $on] ; set n [lindex $bw $on]
+		    eval "label $wk -bg $bg($n) -fg $fg($n) -bd 1 -relief raised;place $wk -relx [expr [lindex $npl $on] / 7.] -y 0 -relwidth $rw($n) -relheight $rh($n) $an($n)"
+		    bind $wk <1> "::ix::kbd_play $t 0 1 %X %Y"; bind $wk <B1-Motion> [bind $wk <1>];bind $wk <ButtonRelease-1> "::ix::kbd_play $t 0 0 %X %Y"; bind $wk <Enter> "::ix::kbd_play $t 1 0 %X %Y"; bind $wk <3> "::ix::kbd_play $t 1 1 %X %Y"; bind $wk <B3-Motion> [bind $wk <3>]; bind $wk <2> "::ix::kbd_off $path $t $octaves"}
+		place $w -y 0 -relheight 1.0 -relx [expr $o / $octaves.0] -relwidth [expr 1 / $octaves.0]}}}}
+
+#> kbd frame
+#. -height 100 -width 60
+#. #octaves 6 #bg black #fg white
+#. @list ::ix::kbd_list .- .| .#args
+#. @float ::ix::kbd_list .- .| .#args
+::ix::kbd .- .| .#octaves .#bg .#fg