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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
# Tcl/Tk Drum GUI for the Synthesis Toolkit (STK)
# Set initial control values
set press 127
# Turn down the reverb
puts "ControlChange 0.0 1 44.0 0.0"
# Configure main window
wm title . "STK Drum Controller"
wm iconname . "drum"
. config -bg black
# Configure slider
scale .bPressure -from 0 -to 128 -length 100 \
-command {changePress } -variable press\
-orient horizontal -label "Velocity" \
-tickinterval 64 -showvalue true -bg grey66
pack .bPressure -pady 5 -padx 5
# Configure buttons
frame .buttons -bg black
frame .buttons.left -bg black
frame .buttons.right -bg black
button .buttons.left.bass -text Bass -bg grey66 \
-command { playDrum 36 } -width 7
button .buttons.left.snare -text Snare -bg grey66 \
-command { playDrum 38 } -width 7
button .buttons.left.tomlo -text LoTom -bg grey66 \
-command { playDrum 41 } -width 7
button .buttons.left.tommid -text MidTom -bg grey66 \
-command { playDrum 45 } -width 7
button .buttons.left.tomhi -text HiTom -bg grey66 \
-command { playDrum 50 } -width 7
button .buttons.left.homer -text Homer -bg grey66 \
-command { playDrum 90 } -width 7
button .buttons.right.hat -text Hat -bg grey66 \
-command { playDrum 42 } -width 7
button .buttons.right.ride -text Ride -bg grey66 \
-command { playDrum 46 } -width 7
button .buttons.right.crash -text Crash -bg grey66 \
-command { playDrum 49 } -width 7
button .buttons.right.cowbel -text CowBel -bg grey66 \
-command { playDrum 56 } -width 7
button .buttons.right.tamb -text Tamb -bg grey66 \
-command { playDrum 54 } -width 7
button .buttons.right.homer -text Homer -bg grey66 \
-command { playDrum 90 } -width 7
pack .buttons.left.bass -pady 5
pack .buttons.left.snare -pady 5
pack .buttons.left.tomlo -pady 5
pack .buttons.left.tommid -pady 5
pack .buttons.left.tomhi -pady 5
pack .buttons.left.homer -pady 5
pack .buttons.right.hat -pady 5
pack .buttons.right.ride -pady 5
pack .buttons.right.crash -pady 5
pack .buttons.right.cowbel -pady 5
pack .buttons.right.tamb -pady 5
pack .buttons.right.homer -pady 5
pack .buttons.left -side left -pady 5 -padx 5
pack .buttons.right -side right -pady 5 -padx 5
pack .buttons -pady 5 -padx 5
# Configure exit button
button .exit -text "Exit Program" -bg grey66 -command myExit
pack .exit -side bottom -pady 20
# Bind an X windows "close" event with the Exit routine
bind . <Destroy> +myExit
proc myExit {} {
puts [format "ExitProgram"]
flush stdout
close stdout
exit
}
proc playDrum {value} {
global press
puts [format "NoteOn 0.0 1 %i %f" $value $press]
flush stdout
}
proc changePress {value} {
global press
set press $value
}
bind . <Configure> { center_the_toplevel %W }
proc center_the_toplevel { w } {
# Callback on the <Configure> event for a toplevel
# that should be centered on the screen
# Make sure that we aren't configuring a child window
if { [string equal $w [winfo toplevel $w]] } {
# Calculate the desired geometry
set width [winfo reqwidth $w]
set height [winfo reqheight $w]
set x [expr { ( [winfo vrootwidth $w] - $width ) / 2 }]
set y [expr { ( [winfo vrootheight $w] - $height ) / 2 }]
#set y 0
# Hand the geometry off to the window manager
wm geometry $w ${width}x${height}+${x}+${y}
# Unbind <Configure> so that this procedure is
# not called again when the window manager finishes
# centering the window. Also, revert geometry management
# to internal default for subsequent size changes.
bind $w <Configure> {}
wm geometry $w ""
}
return
}
|
