# Simple piano

package require Tk
package require Borg
package require Muzic

# 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
}
