# Simple piano
# MIDI GM1 standard instrument groups (zero-based)
array set inst_groups {
0 Piano
8 Percussion
16 Organ
24 Guitar
32 Bass
40 Strings
48 Ensemble
56 Brass
64 Reed
72 Pipe
80 {Synth Lead}
88 {Synth Pad}
96 {Synth Effects}
104 Ethnic
112 Percussive
120 {Sound Effects}
}
# MIDI GM1 standard instrument numbers (zero-based) to names
array set inst_names {
0 {Acoustic Grand}
1 {Bright Acoustic}
2 {Electric Grand}
3 {Honky Tonk}
4 {Electric Piano 1}
5 {Electric Piano 2}
6 Harpsichord
7 Clavinet
8 Celesta
9 Glockenspiel
10 {Music Box}
11 Vibraphone
12 Marimba
13 Xylophone
14 {Tubular Bells}
15 {Dulcimer Organ}
16 {Drawbar Organ}
17 {Percussive Organ}
18 {Rock Organ}
19 {Church Organ}
20 {Reed Organ}
21 Accordian
22 Harmonica
23 {Tango Accordian}
24 {Nylon String}
25 {Steel String}
26 {Jazz Electric}
27 {Clean Electric}
28 {Muted Electric}
29 {Overdrive Guitar}
30 {Distortion Guitar}
31 {Harmonics Guitar}
32 {Acoustic Bass}
33 {Fingered Bass}
34 {Picked Bass}
35 {Fretless Bass}
36 {Slap Bass 1}
37 {Slap Bass 2}
38 {Synth Bass 1}
39 {Synth Bass 2}
40 Violin
41 Viola
42 Cello
43 Contrabass
44 Tremolo
45 Pizzicato
46 {Orchestral Harp}
47 {Timpani Ensemble}
48 Strings
49 {Slow Strings}
50 {Syn Strings 1}
51 {Syn Strings 2}
52 {Choir Aahs}
53 {Choir Oohs}
54 {Synth Voice}
55 {Orchestra Hit Brass}
56 Trumpet
57 Trombone
58 Tuba
59 {Muted Trumpet}
60 {French Horn}
61 {Brass Section}
62 {SynthBrass 1}
63 {SynthBrass 2}
64 {Soprano Sax}
65 {Alto Sax}
66 {Tenor Sax}
67 {Baritone Sax}
68 Oboe
69 {English Horn}
70 Bassoon
71 Clarinet
72 Piccolo
73 Flute
74 Recorder
75 {Pan Flute}
76 Bottle
77 Shakuhchi
78 Whistle
79 Ocorina
80 Square
81 Sawtooth
82 Calliope
83 Chiff
84 Charang
85 Voice
86 Fifths
87 {Bass/Lead Synth}
88 {New Age Synth}
89 {Warm Synth}
90 Polysynth
91 {Choir Synth}
92 {Bowed Synth}
93 {Metallic Synth}
94 {Halo Synth}
95 {Sweep Synth}
96 {Ice Rain FX}
97 {Sound Track FX}
98 {Crystal FX}
99 {Atmosphere FX}
100 {Brightness FX}
101 {Goblins FX}
102 {Echos FX}
103 Sci-Fi
104 Sitar
105 Banjo
106 Shamisen
107 Koto
108 Kalimba
109 Bagpipe
110 Fiddle
111 Shanai
112 {Tinkle Bell}
113 Agogo
114 {Steel Drums}
115 Woodblock
116 {Taiko Drum}
117 {Melodic Tom}
118 {Synth Drum}
119 {Rev Cymbal}
120 {Fret Noise}
121 {Breath Noise}
122 Seashore
123 {Bird Tweet}
124 Telephone
125 Helicopter
126 Applause
127 Gunshot
}
proc drawKeyboard {c x0 y0 dx dy nkeys} {
set y1 [expr {$y0+$dy}]
set y05 [expr $y1*.67] ;# length of black keys
set dx2 [expr {$dx/2}] ;# offset of black keys
set nkey 0
for {set note 48} {$nkey < $nkeys} {incr note ; incr nkey} {
set key [expr {($note - 36) % 12}]
if {$key==1 || $key==3 || $key==6 || $key==8 || $key==10} {
# black key
set x [expr {$x0 - $dx*.35}]
set id [$c create rect $x $y0 [expr {$x+$dx*0.6}] $y05 \
-fill black -tags [list note $note black]]
} else {
# white key
set id [$c create rect $x0 $y0 [expr $x0+$dx] $y1 \
-fill white -tags [list note $note white]]
incr x0 $dx
incr x0 1
}
}
$c raise black
set maxx [lindex [$c bbox all] 2]
if {[$c cget -width]<$maxx} {$c config -width [expr {$maxx}]}
set maxy [lindex [$c bbox all] 3]
if {[$c cget -height]<$maxy} {$c config -height [expr {$maxy}]}
for {set but 10} {$but < 20} {incr but} {
bind $c <ButtonPress-$but> [list noteOnOff %W 60 %b %x %y]
# need all binding since buttons 10..19 are not implicitely grabbed
bind all <ButtonRelease-$but> [list noteOnOff .c 0 %b 0 0]
}
}
proc noteOnOff {c volume button x y} {
set duration [expr {$volume ? -1 : 0}]
if {$duration} {
# note on
set x [$c canvasx $x]
set y [$c canvasy $y]
set id [$c find closest $x $y]
if {$id ne ""} {
set note [lindex [$c gettags $id] 1]
if {$note ne ""} {
muzic::playnote 0 $note $volume $duration
$c move $id -1 -4
$c addtag b$button withtag $id
}
}
} else {
# note off
foreach id [$c find withtag b$button] {
set note [lindex [$c gettags $id] 1]
if {$note ne ""} {
muzic::playnote 0 $note $volume $duration
}
}
$c move b$button 1 4
$c dtag b$button
}
}
proc setChannel {val} {
muzic::channel 0 $val
set ::inst(name) $::inst_names($val)
set ::inst(channel) $val
}
proc selectGroup {grp row col} {
set ::inst(grp) $grp
for {set i 0} {$i < 8} {incr i} {
set ii [expr {$grp + $i}]
.j.i$i configure -text $::inst_names($ii)
}
foreach w [winfo child .i] {
$w configure -background #339933 -foreground #000000
}
.i.l${row}${col} configure -background #55BB55 -foreground #FFFFFF
if {![info exists ::inst(grp_$grp)]} {
set ::inst(grp_$grp) 0
}
selectInstrument $::inst(grp_$grp)
}
proc selectInstrument {inst} {
set ii [expr {$::inst(grp) + $inst}]
foreach w [winfo child .j] {
$w configure -background #4444AA -foreground #000000
}
.j.i${inst} configure -background #6666CC -foreground #CCCCCC
setChannel $ii
set ::inst(grp_$::inst(grp)) $inst
}
proc makeGUI {} {
bind . <Key-Break> exit
bind . <Configure> {}
set mmwidth [winfo screenmmwidth .]
if {$mmwidth < 100} {
font configure TkDefaultFont -size 5 -weight bold
} elseif {$mmwidth < 140} {
font configure TkDefaultFont -size 6 -weight bold
} else {
font configure TkDefaultFont -size 8
}
set width [winfo screenwidth .]
set height [winfo screenheight .]
incr width -60
set kwidth [expr round($width / 29.0)]
set kheight [expr round($kwidth * 6.25)]
set bheight [expr {$height - $kheight}]
set pady [expr round($bheight * 0.5 * 0.03)]
frame .i -width $width -height [expr round($bheight * 0.5)]
foreach i [lsort -integer [array names ::inst_groups]] {
set ii [expr {$i / 8}]
set col [expr {$ii % 4}]
set row [expr {$ii / 4}]
label .i.l${row}${col} -text $::inst_groups($i) -pady $pady \
-background #44AA44 -foreground #000000
grid .i.l${row}${col} -row $row -column $col -sticky nswe \
-padx 5 -pady 5
bind .i.l${row}${col} <ButtonPress> [list selectGroup $i $row $col]
}
frame .j -width $width -height [expr round($bheight * 0.3)]
foreach i {0 1 2 3 4 5 6 7} {
set col [expr {$i % 4}]
set row [expr {$i / 4}]
label .j.i$i -background #4444AA -foreground #000000 -pady $pady
grid .j.i$i -row $row -column $col -sticky nswe -padx 5 -pady 5
bind .j.i$i <ButtonPress> [list selectInstrument $i]
}
foreach i {0 1 2 3} {
grid columnconfigure .i $i -uniform 1 -weight 1
grid columnconfigure .j $i -uniform 1 -weight 1
}
grid propagate .i 0
grid propagate .j 0
selectGroup 0 0 0
selectInstrument 0
canvas .c -height 250 -borderwidth 0 -highlightthickness 0
drawKeyboard .c 10 5 $kwidth $kheight 49
pack .i .j -side top -pady 10
pack .c -fill x -side top -pady 10 -padx 5 -expand 1
}
muzic::init
wm attributes . -fullscreen 1
borg screenorientation landscape
# safe power when in background
bind . <<DidEnterBackground>> {muzic::close}
bind . <<DidEnterForeground>> {
muzic::init
catch {setChannel $inst(channel)}
}
sdltk screensaver 0
# translation of finger up/down to buttons 10..19
# but no other translations
sdltk touchtranslate 16
. configure -bg #282828
option add *background #282828
# gross hack for potential orientation change
# otherwise screen width/height can be wrong
# for geometry computation
bind . <Configure> {
bind . <Configure> {}
after 500 makeGUI
}