From 5c492bdec6cd9302f0d92868ccfea8eadbd25896 Mon Sep 17 00:00:00 2001
From: carmen rocco <ix9@users.sourceforge.net>
Date: Tue, 5 Apr 2005 13:32:38 +0000
Subject: ix::gui 2005:04

svn path=/trunk/; revision=2680
---
 extensions/gui/ix/kbd.wid | 95 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)
 create mode 100755 extensions/gui/ix/kbd.wid

(limited to 'extensions/gui/ix/kbd.wid')

diff --git a/extensions/gui/ix/kbd.wid b/extensions/gui/ix/kbd.wid
new file mode 100755
index 00000000..2131562f
--- /dev/null
+++ b/extensions/gui/ix/kbd.wid
@@ -0,0 +1,95 @@
+namespace eval ::ix {
+variable kbd_lastplayed
+
+proc kbd_click {target w h} {
+    set height [winfo height $w]
+    set vel [expr $h.0 / $height.0]
+    variable kbd_lastplayed
+    set kbd_lastplayed $w
+    kbd_down $target $w $vel
+}
+proc kbd_down {target w vel} {
+    pd "$target.rp _cb [winfo name $w] $vel;"
+    $w conf -relief sunken
+}
+proc kbd_up {target w} {
+    pd "$target.rp _cb [winfo name $w] 0;"
+    $w conf -relief raised
+}
+proc kbd_release {target} {
+    variable kbd_lastplayed
+    if {$kbd_lastplayed != {}} {kbd_up $target $kbd_lastplayed}
+}
+proc kbd_key {path target count vel key} {
+    set w $path.f[expr $key / 12].$key
+    if {$vel > 0} {kbd_down $target $w $vel}
+    if {$vel == 0} {kbd_up $target $w}
+}
+proc kbd_fkey {path target count key} {
+    set w $path.f[expr $key / 12].$key
+    kbd_down $target $w 1
+    kbd_up $target $w
+}
+
+proc kbd_drag {target x y} {
+    variable kbd_lastplayed
+    set w [winfo containing $x $y]
+    if { $w == "" } { kbd_release $target; set kbd_lastplayed {}; return }
+    if { $w == $kbd_lastplayed } return
+    if {[lsearch -exact [bindtags $w] key ] == -1 } {
+	kbd_release $target
+	set kbd_lastplayed {}; return
+    } 
+    kbd_release $target
+    set h [expr $y - [winfo rooty $w]]
+    kbd_click $target $w $h
+}
+proc kbd_white {w t p} { set t {}
+    label $w -text $t -background white -foreground black \
+				     -borderwidth 1 -relief raised 
+    place $w -relx $p -y 0 -relwidth 0.142857 -relheight 1
+    bindtags $w {key}
+    lower $w
+}
+proc kbd_black {w t p} { set t {}
+    label $w -text $t -background black -foreground white \
+			     -borderwidth 1 -relief raised 
+    place $w -relx $p -y 0 -relwidth 0.1 -relheight 0.6 -anchor n
+    bindtags $w {key}
+}
+proc kbd {path target octaves} {
+    if {[winfo exists $path.f0] != 1} {
+#    foreach oct [winfo children $path] {destroy $oct}
+	$path config -width [expr $octaves * 66]
+	for {set o 0} {$o < $octaves} {incr o} {
+	    set w $path.f$o
+	    frame $w -bd 0 -height 66 -width 66
+	    kbd_white $w.[expr $o * 12]  C  0.0
+	    kbd_black $w.[expr $o * 12 + 1]  C# 0.142857
+	    kbd_white $w.[expr $o * 12 + 2]  D  0.142857
+	    kbd_black $w.[expr $o * 12 + 3]  D# 0.285714
+	    kbd_white $w.[expr $o * 12 + 4]  E  0.285714
+	    kbd_white $w.[expr $o * 12 + 5]  F  0.428571
+	    kbd_black $w.[expr $o * 12 + 6]  F# 0.571428
+	    kbd_white $w.[expr $o * 12 + 7]  G  0.571428
+	    kbd_black $w.[expr $o * 12 + 8]  G# 0.714285
+	    kbd_white $w.[expr $o * 12 + 9]  A  0.714285
+	    kbd_black $w.[expr $o * 12 + 10] A# 0.857142
+	    kbd_white $w.[expr $o * 12 + 11] H  0.857142
+	    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
+#. @list ::ix::kbd_key .- .| .#n .#2 .#1
+#. @float ::ix::kbd_fkey .- .| .#n .#1
+puts "kbd .- .|"
+::ix::kbd .- .| .#octaves
+
+bind key <1> {::ix::kbd_click .| %W %y}
+bind key <B1-Motion> {::ix::kbd_drag .| %X %Y}
+bind key <ButtonRelease-1> {::ix::kbd_release .|}
-- 
cgit v1.2.1