blob: 2131562fe4c422d52b263bcb2d77deee55ffaa66 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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 .|}
|
