blob: e9a20a113fa8199dd3dd8bff2e77003bcc96001f (
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
96
97
98
99
100
101
102
103
104
105
106
107
108
|
# first the setup stuff (is this the right place for it?)
# LATER ask for adding something of the sort to pd.tk:
bind Canvas <1> {+focus %W}
proc ::toxy::popup {path target remote entries args} {
eval {menu $path.pop} $args
set i 1
foreach e $entries {
$path.pop add command -label [lindex $e 0] \
-command [concat ::toxy::callback $target \
-text [lindex $e [expr {[llength $e] > 1}]] \; \
::toxy::callback $remote $i]
incr i
}
}
proc ::toxy::kb {path target remote noctaves size} {
set lft [expr {round(5 * $size)}]
set top [expr {5 * $size}]
set bot [expr {100 * $size}]
set dx [expr {round(17 * $size)}]
set wid [expr {$dx - $size * .5}]
set blbot [expr {$bot * .65}]
$path config -height [expr {$bot + $top}] \
-width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}]
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]
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]
}
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
}
proc ::toxy::kbout {path target remote} {
::toxy::callback $target _cb $::toxy::kbval($target)
if {$remote != "."} {::toxy::callback $remote $::toxy::kbval($target)}
}
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
}
# the default initializer
#> default
# pdtk_canvas_mouseup is a hack, which we must call anyway
bind .- <ButtonRelease> {
eval .<|_inout 1.>
pdtk_canvas_mouseup .^.c [expr %x + [winfo x %W]] [expr %y + [winfo y %W]] %b
}
bind .- <1> .<|_click %x %y %b 0.>
bind .- <3> .<|_click %x %y %b 8.>
bind .- <Motion> .<|_motion %x %y.>
bind .- <Enter> .<|_inout 1.>
bind .- <Leave> .<|_inout 0.>
#> bang button
#. -image ::toxy::img::empty -command .<.>
#. -bg pink -activebackground red -width 50 -height 50
#. @bang .- flash .: .- invoke
#> float scale
#. -command .<.> -bg pink -activebackground red -length 200
#. @float .- set .#1
#> symbol entry
#. -bg pink -font .(helvetica 24.) -width 16
#. @symbol .- delete 0 end .: .- insert 0 .#1
bind .- <Return> {eval .<[.- get].>; focus .^.c}
#> kb canvas
#. -bg yellow -cursor hand1
#. #oct 4 #size .75
#. @bang ::toxy::kbout .- .| .
#. @float ::toxy::kbset .- .| . .#1
::toxy::kb .- .| . .#oct .#size
# undo the "bind Canvas <1> {+focus %W}" in the setup part above
bind .- <FocusIn> {focus .^.c}
|
