char tcl_procs[] = "\
#\n\
#    This file is part of tk707.\n\
#\n\
#    Copyright (C) 2000, 2001, 2002, 2003, 2004 Chris Willing and Pierre Saramito \n\
#\n\
#    tk707 is free software; you can redistribute it and/or modify\n\
#    it under the terms of the GNU General Public License as published by\n\
#    the Free Software Foundation; either version 2 of the License, or\n\
#    (at your option) any later version.\n\
#\n\
#    Foobar is distributed in the hope that it will be useful,\n\
#    but WITHOUT ANY WARRANTY; without even the implied warranty of\n\
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n\
#    GNU General Public License for more details.\n\
#\n\
#    You should have received a copy of the GNU General Public License\n\
#    along with Foobar; if not, write to the Free Software\n\
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA\n\
#\n\
#=====================================================\n\
#	File procs.tcl\n\
#	Procedures for the tcl side of the program\n\
#=====================================================\n\
\n\
proc play_pattern {grp pat} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 pattern_list pl\n\
\n\
	if {$mo(PATTERN_REPEAT)} {\n\
\n\
		#puts \"TIMER = [tk7_timer_status]\"\n\
		set steps [tk7_get_last_step $grp $pat]\n\
		set dur [tk7_pattern_play $grp $pat]\n\
\n\
		cycle_notes 1 [expr 55 * 120 / $mo(tempo)] 0 0 $steps\n\
\n\
		# Fudge factor (extra time to change track display) in track play mode\n\
		if {$mo(rdrw) == $xox(READ) || $mo(patr) == $xox(TRACK)} {\n\
			incr dur -160\n\
			if {$dur < 0} {\n\
				set dur 0\n\
			}\n\
			#set mo(REPEAT_INTERVAL) [expr $dur - 160]\n\
			set mo(REPEAT_INTERVAL) $dur\n\
		} else {\n\
			set mo(REPEAT_INTERVAL) $dur\n\
		}\n\
	}\n\
}\n\
proc stop_pattern {} {\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
\n\
#puts \"do stop_pattern\"\n\
	tk7_pattern_stop\n\
	set mo(REPEAT_INTERVAL) 10\n\
}\n\
\n\
proc ac_clear {tp} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
	upvar #0 pattern_list pl\n\
\n\
	switch $tp {\n\
		0	{\n\
		# CLEAR the current PATTERN\n\
			if {$mo(rdrw) != $xox(WRITE) || $mo(patr) != $xox(PATTERN)} {\n\
				return\n\
			}\n\
			set result [tk_dialog .clr CONFIRM \"Clear Pattern [expr $mo(current_pattern) + 1] Group [expr $mo(patgroup) + 1]?\" \"\" 0 Cancel \"Delete Pattern\"]\n\
			if {$result == 0} {\n\
				return\n\
			}\n\
			set mo(file_status) $xox(FILE_MODIFIED)\n\
			tk7_clear_pattern $mo(patgroup) $mo(current_pattern)\n\
			pattern_setid $mo(current_pattern)\n\
			scale_lamps_update\n\
		}\n\
\n\
		1	{\n\
		# CLEAR the current TRACK\n\
			if {$mo(rdrw) != $xox(WRITE) || $mo(patr) != $xox(TRACK)} {\n\
				return\n\
			}\n\
			set result [tk_dialog .clr CONFIRM \"Clear Track [expr $mo(current_track) + 1]?\" \"\" 0 Cancel \"Delete Track\"]\n\
			if {$result == 0} {\n\
				return\n\
			}\n\
			set mo(file_status) $xox(FILE_MODIFIED)\n\
			set tl($mo(current_track)) {}\n\
			set mo(measure) -1\n\
		}\n\
		2 	{\n\
		# CLEAR current track item from current track\n\
			if {$mo(rdrw) != $xox(WRITE) || $mo(patr) != $xox(TRACK)} {\n\
				return\n\
			}\n\
			# Clearing track item has no meaning if we're already past end\n\
			set target $mo(measure)\n\
			if {[lindex $tl($mo(current_track)) $target] == \"\"} {\n\
				#puts \"Already past end\"\n\
				return\n\
			}\n\
			set result [tk_dialog .clr CONFIRM \"Clear measure [expr $target + 1] from track [expr $mo(current_track) + 1]?\" \"\" 0 Cancel \"Delete\"]\n\
			if {$result == 0} {\n\
				return\n\
			}\n\
			set mo(file_status) $xox(FILE_MODIFIED)\n\
			set tl($mo(current_track)) [lreplace $tl($mo(current_track)) $target $target]\n\
		}\n\
		3	{\n\
		# CLEAR the rest of current track including current track item\n\
			if {$mo(rdrw) != $xox(WRITE) || $mo(patr) != $xox(TRACK)} {\n\
				return\n\
			}\n\
			# Clearing rest has no meaning if we're already past end of track\n\
			set target $mo(measure)\n\
			if {[lindex $tl($mo(current_track)) $target] == \"\"} {\n\
				# puts \"Already past end\"\n\
				return\n\
			}\n\
			set result [tk_dialog .clr CONFIRM \"    Clear rest of track [expr $mo(current_track) + 1]?\\n(includes current measure)\" \"\" 0 Cancel \"Delete\"]\n\
			if {$result == 0} {\n\
				return\n\
			}\n\
			set mo(file_status) $xox(FILE_MODIFIED)\n\
			set tl($mo(current_track)) [lreplace $tl($mo(current_track)) $target end]\n\
		}\n\
	}\n\
}\n\
proc ac_scaleback {} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
	global scale_lamps\n\
\n\
	if {$mo(patr) == $xox(PATTERN)} {\n\
		set old_scale [tk7_get_scale $mo(patgroup) $mo(current_pattern)]\n\
		set new_scale [expr $old_scale + 1]\n\
		if {$new_scale == 4} {\n\
		    set new_scale 0\n\
		}\n\
		set old_button $scale_lamps.l$old_scale\n\
		set new_button $scale_lamps.l$new_scale\n\
		tk7_set_scale $mo(patgroup) $mo(current_pattern) $new_scale\n\
		$old_button configure -background $xox(lamp_off)\n\
		$new_button configure -background $xox(lamp_on)\n\
	} else {\n\
		set target [expr $mo(measure) - 1]\n\
		set mo(measure) [measure_constrain $target]\n\
		pattern_show\n\
	}\n\
	set mo(file_status) $xox(FILE_MODIFIED)\n\
}\n\
proc ac_lastfwd {} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
\n\
	if {$mo(patr) == $xox(PATTERN)} {\n\
		if {$mo(rdrw) == $xox(READ)} {\n\
			return\n\
		}\n\
		select_laststep\n\
		set mo(file_status) $xox(FILE_MODIFIED)\n\
	} else {\n\
		set target  [expr $mo(measure) + 1]\n\
		set mo(measure) [measure_constrain $target]\n\
		pattern_show\n\
	}\n\
}\n\
proc measure_constrain {m} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
\n\
	set tracklength [llength $tl($mo(current_track))]\n\
\n\
	if {$tracklength < 1} {\n\
		if {$mo(rdrw) == $xox(READ)} {\n\
			set minpos -1\n\
			set maxpos -1\n\
		} else {\n\
			set minpos 0\n\
			set maxpos 0\n\
		}\n\
	} else {\n\
		if {$mo(rdrw) == $xox(READ)} {\n\
			set maxpos [expr $tracklength - 1]\n\
		} else {\n\
			set maxpos $tracklength\n\
		}\n\
		set minpos 0\n\
	}\n\
\n\
	# Result\n\
	if {$m <= $minpos} {\n\
		return $minpos\n\
	} elseif {$m >= $maxpos} {\n\
		return $maxpos\n\
	} else {\n\
		return $m\n\
	}\n\
}\n\
# Decide which pattern from a track to display\n\
#\n\
proc pattern_show {} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
\n\
	set raw [lindex $tl($mo(current_track)) $mo(measure)]\n\
	if {$raw != \"\"} {\n\
		set group [expr $raw / 16]\n\
		set pattern [expr $raw % 16]\n\
		ac_group $group\n\
		pattern_setid $pattern\n\
	}\n\
}\n\
\n\
# For track mode, ordinary click (on LAST MEAS button) shows last measure\n\
# of current track. Releasing button returns to orginal measure.\n\
# Shift click goes to last measure and stays there.\n\
#\n\
proc ac_lastmeas {m} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
\n\
	if {$mo(patr) == $xox(PATTERN)} {\n\
	    	#puts \"Instrument Guide\"\n\
	} else {\n\
		switch $m {\n\
			0	{\n\
				#puts \"Show Last Measure\"\n\
				set mo(oldmeasure) $mo(measure)\n\
				set target [llength $tl($mo(current_track))]\n\
				set mo(measure) [measure_constrain $target]\n\
				pattern_show\n\
			}\n\
			1	{\n\
				#puts \"Restore measure $mo(oldmeasure)\"\n\
				set mo(measure) [measure_constrain $mo(oldmeasure)]\n\
				pattern_show\n\
			}\n\
			2	{\n\
				#puts \"Go to Last Measure\"\n\
				set target [llength $tl($mo(current_track))]\n\
				set mo(measure) [measure_constrain $target]\n\
				pattern_show\n\
			}\n\
			3	{\n\
				return\n\
			}\n\
		}\n\
	}\n\
\n\
}\n\
proc select_laststep {} {\n\
	upvar #0 mode mo\n\
\n\
	if {[winfo exists .ls]} {\n\
		wm deiconify .ls\n\
	} else {\n\
		toplevel .ls\n\
		wm title .ls \"Set last pattern step\"\n\
		scale .ls.s -from 1 -to 16 -command laststep_set -orient horizontal	\\\n\
			-length 5c -relief groove -borderwidth 2\n\
		button .ls.ok -text OK -font *-${font12}-* -command {wm iconify .ls} -relief groove -borderwidth 2\n\
		pack .ls.s -side top -ipady 6\n\
		pack .ls.ok -side top -expand true -fill x\n\
	}\n\
	.ls.s set [tk7_get_last_step $mo(patgroup) $mo(current_pattern)]\n\
}\n\
proc laststep_set val {\n\
	upvar #0 mode mo\n\
\n\
	if {$val < 1 || $val > 16} {\n\
		return\n\
	}\n\
	tk7_set_last_step $mo(patgroup) $mo(current_pattern) $val\n\
}\n\
proc flam_set val {\n\
	upvar #0 mode mo\n\
	if {$val < 0 || $val > 4} {\n\
		return\n\
	}\n\
	tk7_set_flam $mo(patgroup) $mo(current_pattern) $val\n\
}\n\
proc select_flam {} {\n\
	upvar #0 mode mo\n\
\n\
	set curr [tk7_get_flam $mo(patgroup) $mo(current_pattern)]\n\
\n\
	if {[winfo exists .flam]} {\n\
		wm deiconify .flam\n\
	} else {\n\
		toplevel .flam\n\
		wm title .flam \"Set pattern flam interval\"\n\
		scale .flam.s -from 0 -to 4 -command flam_set -orient horizontal	\\\n\
			-length 5c -relief groove -borderwidth 2\n\
		button .flam.ok -text OK -font *-${font12}-* -command {wm iconify .flam} -relief groove -borderwidth 2\n\
		pack .flam.s -side top -ipady 6\n\
		pack .flam.ok -side top -expand true -fill x\n\
	}\n\
	.flam.s set [tk7_get_flam $mo(patgroup) $mo(current_pattern)]\n\
	set curr [tk7_get_flam $mo(patgroup) $mo(current_pattern)]\n\
}\n\
proc ac_flam {} {\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	if {$mo(patr) != $xox(PATTERN) || $mo(rdrw) != $xox(WRITE)} {\n\
	    return\n\
	}\n\
	select_flam\n\
}\n\
proc ac_midi {} {\n\
	global font12\n\
	upvar #0 mode mo\n\
	if {[winfo exists .ms]} {\n\
		wm deiconify .ms\n\
	} else {\n\
		toplevel .ms\n\
		wm title .ms \"MIDI Channel\"\n\
		scale .ms.s -from 1 -to 16 -command midichan_set -orient horizontal	\\\n\
			-length 5c -relief groove -borderwidth 2 -font *-${font12}-*\n\
		button .ms.ok -text OK -font *-${font12}-* -command {wm iconify .ms} \\\n\
			-relief groove -borderwidth 2\n\
		pack .ms.s -side top -ipady 6\n\
		pack .ms.ok -side top -expand true -fill x\n\
		.ms.s set [expr $mo(midi_channel)  + 1]\n\
	}\n\
}\n\
proc midichan_set val {\n\
	upvar #0 mode mo\n\
	global midi_channel\n\
\n\
	if {$val < 1 || $val >16} {\n\
		return\n\
	}\n\
	set mo(midi_channel) [expr $val - 1]\n\
	# This is needed for C code to trace midi channel,\n\
	# (I don't know how to make it trace an array variable).\n\
	set midi_channel $mo(midi_channel)\n\
}\n\
proc ac_note {widget prop} {\n\
    global tapwrite\n\
    global notes\n\
    upvar #0 tkxox xox\n\
    upvar #0 mode mo\n\
\n\
    # Extract button number from widget path\n\
    # Dependent on prefix path name: $notes.note.b0, $notes.note.b1, ..\n\
    #                                      ^ +5 ^\n\
    set prefix_length [expr [string length $notes] + 5]\n\
    set b [string range [string trimright $widget .b] $prefix_length end]\n\
\n\
    if {$mo(patr) == $xox(TRACK)} {\n\
	# TRACK mode\n\
	if {$mo(rdrw) == $xox(READ)} {\n\
		tk7_start_note_play $b $prop\n\
	} else {\n\
		# Just changeing pattern numbers\n\
		pattern_setid $b\n\
	}\n\
	return\n\
    }\n\
    # PATTERN mode\n\
    if {$mo(rdrw) == $xox(READ)} {\n\
    	# PATTERN READ mode\n\
	pattern_setid $b\n\
	if {$mo(stopgo) == $xox(START)} {\n\
	    # If running, wait till current pattern finished before changeing ?\n\
	}\n\
	return\n\
    }\n\
    # PATTERN TAP or WRITE mode\n\
    if {$mo(stopgo) != $xox(START)} {\n\
	# Just changeing pattern numbers\n\
	pattern_setid $b\n\
	return\n\
    }\n\
    # PATTERN TAP or WRITE mode with START\n\
    if {![have_zero_velocity $prop]} {\n\
	switch $mo(current_accent) {\n\
	    2       {set prop [add_strong_accent    $prop] }\n\
	    1 	    {set prop [add_weak_accent      $prop] }\n\
	    default {set prop [add_default_velocity $prop] }\n\
	}\n\
    }\n\
    if {$tapwrite} {\n\
	set step [expr [tk7_get_pat_tick] % 16]\n\
	if {$step < 0} {\n\
	    set step 0\n\
	}\n\
	ac_newinstr $notes.note$b.b\n\
	step_insert $step $prop\n\
	tk7_start_note_play $b $prop\n\
    } else {\n\
	# Recording steps\n\
	step_insert $b $prop\n\
    }\n\
}\n\
proc ac_note_off {widget} {\n\
    global notes\n\
    global tapwrite\n\
    upvar #0 tkxox xox\n\
    upvar #0 mode mo\n\
\n\
    # Extract button number from widget path\n\
    # Dependent on prefix path name: $notes.note.b0, $notes.note.b1, ..\n\
    #                                      ^ +5 ^\n\
    set prefix_length [expr [string length $notes] + 5]\n\
    set b [string range [string trimright $widget .b] $prefix_length end]\n\
\n\
    if {$mo(patr) == $xox(TRACK) && $mo(rdrw) == $xox(READ)} {\n\
	tk7_stop_note_play $b\n\
	return\n\
    }\n\
    if {$mo(rdrw) == $xox(READ) || $mo(stopgo) != $xox(START)} {\n\
	return\n\
    }\n\
    if {$tapwrite} {\n\
	tk7_stop_note_play $b\n\
	return\n\
    }\n\
}\n\
#\n\
# Accept 0->15 to set new current pattern id.\n\
# Also need to light buttons lamp.\n\
#\n\
proc pattern_setid {id} {\n\
	global grid\n\
	global notes\n\
	upvar #0 pattern_list pl\n\
	upvar #0 mode mo\n\
\n\
	lamp_onoff 0 $notes.note$mo(current_pattern).l\n\
	set mo(current_pattern) $id\n\
	lamp_onoff 1 $notes.note$id.l\n\
\n\
	# Clear the grid display & redraw for new pattern\n\
	$grid delete stepnode\n\
	set pg $mo(patgroup)\n\
	set cp $mo(current_pattern)\n\
	for {set k 0} {$k < 16} {incr k} {\n\
		set instruments [tk7_pattern_items $pg $cp $k]\n\
		set properties  [tk7_get_pattern_properties $pg $cp $k]\n\
		set idx 0\n\
		foreach instr $instruments {\n\
	                set prop  [lindex $properties $idx]\n\
			step_draw [expr $k + 1] $instr $prop\n\
			set idx [expr $idx + 1]\n\
		}\n\
	}\n\
	scale_lamps_update\n\
	refresh_comment\n\
}\n\
# Turn a \"lamp\" on or off (1 or 0 for parameter onoff).\n\
# Parameter lamp is a full widget path.\n\
#\n\
proc lamp_onoff {onoff lamp} {\n\
	upvar #0 tkxox xox\n\
\n\
	switch $onoff {\n\
		0 {\n\
			$lamp configure -bg $xox(col_def_bg)\n\
		}\n\
		1 {\n\
			$lamp configure -bg $xox(col_on)\n\
		}\n\
	}\n\
}\n\
\n\
# Respond to change of Track/Pattern controls\n\
#\n\
proc ac_patternmode {rw} {\n\
	global trpa notes tempoinfo\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
\n\
	# Check if running (can't change mode)\n\
	if {$mo(stopgo) == $xox(START)} {\n\
		return\n\
	}\n\
\n\
	if {$mo(patr) != $xox(PATTERN)} {\n\
		set mo(patr) $xox(PATTERN)\n\
		$tempoinfo itemconfigure tmtitle  -text TEMPO\n\
		$tempoinfo coords tmtitle 1c 0.5c\n\
		trace vdelete mo(current_track) w trackinfo_update\n\
		trace vdelete mo(measure) w measureinfo_update\n\
		$tempoinfo itemconfigure tempo -text $mo(tempo)\n\
		trace variable mo(tempo) w tempoinfo_update\n\
	}\n\
\n\
	if {$rw == $xox(WRITE)} {\n\
		set mo(rdrw) $xox(WRITE)\n\
		$trpa.lt configure -text PLAY\n\
		$trpa.lb configure -text \"-> WRITE <-\"\n\
		modeinfo_update 3\n\
	} else {\n\
		set mo(rdrw) [expr $xox(WRITE) - 1]\n\
		$trpa.lt configure -text \"-> PLAY <-\"\n\
		$trpa.lb configure -text \"WRITE\"\n\
		modeinfo_update 2\n\
	}\n\
\n\
	# Show current instrument\n\
	ac_newinstr $notes.note[expr $mo(current_instr) - 1].b\n\
}\n\
proc ac_trackmode {rw} {\n\
	global trpa notes tempoinfo\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	upvar #0 track_list tl\n\
\n\
	# Check if running (can't change mode)\n\
	if {$mo(stopgo) == $xox(START)} {\n\
		return\n\
	}\n\
\n\
	if {$mo(patr) != $xox(TRACK)} {\n\
		set mo(patr) $xox(TRACK)\n\
		$tempoinfo itemconfigure tmtitle -text MEASURE\n\
		$tempoinfo coords tmtitle 2.7c 0.5c\n\
		# Go to 1st pattern of new track\n\
		# Trace current measure in track\n\
		trace vdelete mo(tempo) w tempoinfo_update\n\
		trace variable mo(measure) w measureinfo_update\n\
		trace variable mo(current_track) w trackinfo_update\n\
	}\n\
\n\
	if {$rw == $xox(WRITE)} {\n\
		set mo(rdrw) $xox(WRITE)\n\
		$trpa.lt configure -text PLAY\n\
		$trpa.lb configure -text \"-> WRITE <-\"\n\
		modeinfo_update 1\n\
	} else {\n\
		set mo(rdrw) $xox(READ)\n\
		$trpa.lt configure -text \"-> PLAY <-\"\n\
		$trpa.lb configure -text WRITE\n\
		modeinfo_update 0\n\
	}\n\
	set mo(measure) [measure_constrain -1]\n\
	pattern_show\n\
\n\
	# Hide current instrument\n\
	ac_newinstr $notes.note[expr $mo(current_instr) - 1].b\n\
}\n\
# Toggle display to show tempo or measure\n\
#\n\
proc ac_tempomeasure {} {\n\
	global tempoinfo\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
\n\
	if {$mo(patr) == $xox(PATTERN)} {\n\
		return\n\
	}\n\
\n\
	if {$mo(showtrack)} {\n\
		set mo(showtrack) false\n\
		$tempoinfo itemconfigure tmtitle  -text TEMPO\n\
		$tempoinfo coords tmtitle 1c 0.5c\n\
#		trace vdelete mo(measure) w trackinfo_update\n\
		trace vdelete mo(measure) w measureinfo_update\n\
		$tempoinfo itemconfigure tempo -text $mo(tempo)\n\
		trace variable mo(tempo) w tempoinfo_update\n\
set mo(tempo) $mo(tempo)\n\
	} else {\n\
		set mo(showtrack) true\n\
		$tempoinfo itemconfigure tmtitle -text MEASURE\n\
		$tempoinfo coords tmtitle 2.7c 0.5c\n\
		# Trace current measure in track\n\
		trace vdelete mo(tempo) w tempoinfo_update\n\
		trace variable mo(measure) w measureinfo_update\n\
		trace variable mo(current_track) w trackinfo_update\n\
set mo(measure) $mo(measure)\n\
set mo(current_track) $mo(current_track)\n\
	}\n\
\n\
}\n\
\n\
proc ac_stopgo {new} {\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 track_list tl\n\
\n\
	switch $new {\n\
		0 {\n\
			set mo(stopgo) $xox(STOP)\n\
			set mo(PATTERN_REPEAT) false\n\
			stop_pattern\n\
			set stepcount [tk7_get_last_step $grp $pat]\n\
			cycle_notes 1 0 0 0 $stepcount\n\
		}\n\
		1 {\n\
			if {$new == $mo(stopgo)} {\n\
				return\n\
			}\n\
			if {$mo(patr) == $xox(TRACK)} {\n\
				set mo(TRACK_START) true\n\
			}\n\
\n\
			set mo(stopgo) $xox(START)\n\
\n\
\n\
			# This starts the player!\n\
			set mo(PATTERN_REPEAT) true\n\
		}\n\
		2 {\n\
			if {$mo(patr) == $xox(PATTERN)} {\n\
				set mo(PATTERN_REPEAT) false\n\
				stop_pattern\n\
				set mo(stopgo) $xox(STOP)\n\
			} else {\n\
				if {$mo(stopgo) == $xox(CONT)} {\n\
					set mo(stopgo) $xox(START)\n\
				} else {\n\
					set mo(stopgo) $xox(CONT)\n\
					set mo(PATTERN_REPEAT) false\n\
					stop_pattern\n\
				}\n\
			}\n\
		}\n\
	}\n\
}\n\
\n\
# For patterns,\n\
# i = 0->3 Groups\n\
# j = 0->15 Patterns\n\
# k = 0->15 Step divisions, each is a list of note events\n\
#\n\
# For tracks,\n\
# i = 0->3 Tracks, each is a list patterns (16*Group + Pattern)\n\
#\n\
proc mem_init {} {\n\
	upvar #0 pattern_list pl\n\
	upvar #0 track_list tl\n\
\n\
	# Patterns\n\
#	for {set i 0} {$i <4} {incr i} {\n\
#		for {set j 0} {$j <16 } {incr j} {\n\
#			for {set k 0} {$k < 16} {incr k} {\n\
#				set pl($i,$j,$k) {}\n\
#			}\n\
#		}\n\
#	}\n\
\n\
	# Tracks\n\
	for {set i 0} {$i <4} {incr i} {\n\
		set tl($i) {}\n\
	}\n\
	\n\
}\n\
\n\
proc ac_group {b} {\n\
	global grps\n\
\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	global comment\n\
\n\
	if {$mo(rdrw) == $xox(WRITE) && $mo(stopgo) == $xox(START)} {\n\
		return\n\
	} else {\n\
		set but_old ${grps}.lt$mo(patgroup).lamp\n\
		set but_new ${grps}.lt${b}.lamp\n\
		$but_old configure -background $xox(lamp_off)\n\
		$but_new configure -background $xox(lamp_on)\n\
		set mo(patgroup) $b\n\
		if {$mo(patr) == $xox(TRACK)} {\n\
			return\n\
		}\n\
		pattern_setid $mo(current_pattern)\n\
	}\n\
}\n\
\n\
proc ac_track {b} {\n\
	global tminfo\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
\n\
	if {$mo(patr) != $xox(TRACK) || $mo(stopgo) == $xox(START)} {\n\
		return\n\
	}\n\
	set mo(current_track) $b\n\
	set mo(measure) [measure_constrain -1]\n\
	pattern_show\n\
}\n\
\n\
proc ac_newinstr {widget} {\n\
	global gridlabel\n\
	global notes\n\
	global font12\n\
	global boldfont13\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
\n\
	# Check first that we're in PATTERN:WRITE mode\n\
	if {$mo(patr) == $xox(TRACK) || $mo(rdrw) == $xox(READ)} {\n\
		set w $notes.note[expr $mo(current_instr) - 1].instr\n\
		if {[winfo exists $w]} {\n\
			lamp_onoff 0 $w\n\
		}\n\
		return\n\
	}\n\
	# Extract button number from widget path\n\
	# Dependent on prefix path name: $notes.note.b0, $notes.note.b1, ..\n\
	#                                      ^ +5 ^\n\
	set prefix_length [expr [string length $notes] + 5]\n\
	set b [string range [string trimright $widget .b] $prefix_length end]\n\
	lamp_onoff 0 $notes.note[expr $mo(current_instr) - 1].instr\n\
	set mo(current_instr) [expr $b + 1]\n\
	lamp_onoff 1 $notes.note$b.instr\n\
\n\
	$gridlabel itemconfigure selectinstr -font *-${font12}-*\n\
	$gridlabel dtag selectinstr\n\
	$gridlabel itemconfigure ilabel[expr 15 - $b] -font *-${boldfont13}-*\n\
	$gridlabel addtag selectinstr withtag ilabel[expr 15 - $b]\n\
}\n\
\n\
# Change memory cartridge being used\n\
#\n\
proc ac_cartridge {} {\n\
	global accenter\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
\n\
	if {$mo(patr) != $xox(TRACK)} {\n\
		return\n\
	}\n\
\n\
	set mo(cartridge) [tk7_cartridge_incr]\n\
	#puts \"Cartridge $mo(cartridge)\"\n\
	switch $mo(cartridge) {\n\
		2	{\n\
			$accenter.cart.lamp configure -bg #00ff00\n\
		}\n\
		1	{\n\
			$accenter.cart.lamp configure -bg $xox(lamp_on)\n\
		}\n\
		0	-\n\
		default	{\n\
			$accenter.cart.lamp configure -bg $xox(lamp_off)\n\
		}\n\
	}\n\
\n\
}\n\
\n\
# Process Enter button\n\
#\n\
proc ac_accenter {addmode} {\n\
	global accent_label\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	upvar #0 track_list tl\n\
\n\
	if {$mo(patr) == $xox(PATTERN) && $mo(rdrw) == $xox(WRITE)} {\n\
		set mo(current_accent) [expr ($mo(current_accent)+1) % 3]\n\
		switch $mo(current_accent) {\n\
		    2       {set color $xox(col_strong_accent) }\n\
		    1 	    {set color $xox(col_weak_accent) }\n\
		    default {set color $xox(col_def_bg) }\n\
		}\n\
		$accent_label configure -bg $color\n\
		return\n\
	}\n\
	if {$mo(patr) != $xox(TRACK) || $mo(rdrw) != $xox(WRITE)} {\n\
		return\n\
	}\n\
	# Track Write\n\
	switch $addmode {\n\
		0	{\n\
			# Add/replace current pattern in current track\n\
			#puts \"ADD pattern\"\n\
			set target $mo(measure)\n\
			#puts \"Target measure is $target\"\n\
			set pat [expr [expr 16 * $mo(patgroup)] + $mo(current_pattern)]\n\
			if {[lindex $tl($mo(current_track)) $target] == \"\"} {\n\
				#puts \"Adding $pat to Track $mo(current_track)\"\n\
				lappend tl($mo(current_track)) $pat\n\
			} else {\n\
				set tl($mo(current_track)) [lreplace $tl($mo(current_track)) $target $target $pat]\n\
				#puts \"Inserting $pat to Track $mo(current_track)\"\n\
			}\n\
		}\n\
		1	{\n\
			# Insert pattern before current position in track\n\
			#puts \"INSERT pattern\"\n\
			set target $mo(measure)\n\
			#puts \"Target measure is $target\"\n\
			set pat [expr [expr 16 * $mo(patgroup)] + $mo(current_pattern)]\n\
			if {[lindex $tl($mo(current_track)) $target] == \"\"} {\n\
			#puts \"Adding $pat to Track $mo(current_track)\"\n\
				lappend tl($mo(current_track)) $pat\n\
			} else {\n\
				set tl($mo(current_track)) [linsert $tl($mo(current_track)) $target $pat]\n\
				#puts \"Inserting $pat to Track $mo(current_track)\"\n\
			}\n\
		}\n\
	}\n\
	# Go to next step\n\
	ac_lastfwd\n\
}\n\
\n\
proc have_fla {prop} {\n\
    upvar #0 tkxox xox\n\
    return [expr $prop & $xox(flam)];\n\
}\n\
proc have_weak_accent {prop} {\n\
    upvar #0 tkxox xox\n\
    return [expr $prop & $xox(weak_accent)];\n\
}\n\
proc have_strong_accent {prop} {\n\
    upvar #0 tkxox xox\n\
    return [expr $prop & $xox(strong_accent)];\n\
}\n\
proc have_zero_velocity {prop} {\n\
    upvar #0 tkxox xox\n\
    return [expr $prop & $xox(zero_velocity)];\n\
}\n\
proc set_velocity_flag {prop flag} {\n\
    upvar #0 tkxox xox\n\
    return [expr $prop & (~$xox(velocity_field)) | ($flag & $xox(velocity_field))]\n\
}\n\
proc add_weak_accent {prop} {\n\
    upvar #0 tkxox xox\n\
    return [set_velocity_flag $prop $xox(weak_accent)]\n\
}\n\
proc add_strong_accent {prop} {\n\
    upvar #0 tkxox xox\n\
    return [set_velocity_flag $prop $xox(strong_accent)]\n\
}\n\
proc add_zero_velocity {prop} {\n\
    upvar #0 tkxox xox\n\
    return [set_velocity_flag $prop $xox(zero_velocity)]\n\
}\n\
proc add_default_velocity {prop} {\n\
    upvar #0 tkxox xox\n\
    return [expr $prop & (~$xox(velocity_field))]\n\
}\n\
#\n\
# Draw a step node in the grid canvas.\n\
# Parameters step & inst are expected in 1->16 format (not 0->15).\n\
#\n\
proc step_draw {step inst prop} {\n\
	global grid\n\
    	upvar #0 tkxox xox\n\
\n\
	set x [expr $step / 2.0]\n\
	set y [expr 9.0 - [expr $inst / 2.0]]\n\
	if {[have_strong_accent $prop]} {\n\
	    set color $xox(col_strong_accent)\n\
	} elseif {[have_weak_accent $prop]} {\n\
	    set color $xox(col_weak_accent)\n\
	} elseif {[have_zero_velocity $prop]} {\n\
	    set color $xox(col_zero_velocity)\n\
	} else {\n\
	    set color $xox(col_default_velocity)\n\
	}\n\
	if {[have_fla $prop]} {\n\
	  # draw a star\n\
	  set new [$grid create polygon \\\n\
		 [expr $x - (0)]c           [expr $y - (0.1875)]c \\\n\
		 [expr $x - (-0.0681818)]c  [expr $y - (0.0681818)]c \\\n\
		 [expr $x - (-0.1875)]c     [expr $y - (0.0681818)]c \\\n\
		 [expr $x - (-0.102273)]c   [expr $y - (-0.0426136)]c \\\n\
		 [expr $x - (-0.127841)]c   [expr $y - (-0.1875)]c \\\n\
		 [expr $x - (-0.00852273)]c [expr $y - (-0.127841)]c \\\n\
		 [expr $x - (0.119318)]c    [expr $y - (-0.1875)]c \\\n\
		 [expr $x - (0.102273)]c    [expr $y - (-0.0511364)]c \\\n\
		 [expr $x - (0.1875)]c      [expr $y - (0.0681818)]c \\\n\
		 [expr $x - (0.0681818)]c   [expr $y - (0.0681818)]c \\\n\
		 [expr $x - (0)]c           [expr $y - (0.1875)]c \\\n\
		-outline $color \\\n\
		-fill    $color \\\n\
		-tags stepnode]\n\
	} else {\n\
	  # draw a circle\n\
	    set new [$grid create oval \\\n\
		[expr $x - 0.1875]c [expr $y - 0.1875]c	\\\n\
		[expr $x + 0.1875]c [expr $y + 0.1875]c \\\n\
		-outline black \\\n\
		-fill    $color \\\n\
		-tags stepnode]\n\
	}\n\
	$grid addtag ${step}_instr$inst withtag $new\n\
}\n\
#\n\
# Insert given step into current pattern with specified properties\n\
#\n\
proc step_insert {step prop} {\n\
	global grid\n\
	global tapwrite\n\
\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	upvar #0 pattern_list pl\n\
\n\
	#puts \"Inserting $mo(current_instr) at step $step into bank $mo(patgroup), pattern $mo(current_pattern)\"\n\
	# First check for duplicates (=> remove)\n\
	set pg   $mo(patgroup)\n\
	set cp   $mo(current_pattern)\n\
	set note $mo(current_instr)\n\
	if {[tk7_add_note $pg $cp $step $note]} {\n\
		tk7_set_properties $pg $cp $step $note $prop\n\
		step_draw [expr $step + 1] $mo(current_instr) $prop\n\
		#puts \"added note\"\n\
	} else {\n\
		$grid delete [expr $step + 1]_instr$mo(current_instr)\n\
		#puts \"deleted note\"\n\
	}\n\
}\n\
#\n\
# ClearGrid Display Area\n\
#\n\
proc grid_clear {} {\n\
	global grid\n\
\n\
	# Vertical lines\n\
	set xcoord 0.0\n\
	for {set i 0} {$i < 16} {incr i} {\n\
		set xcoord [expr $xcoord + 0.5]\n\
		$grid create line ${xcoord}c 0.5c ${xcoord}c 9.0c -fill #aaaaaa\n\
	}\n\
	# Horizontal lines\n\
	set ycoord 0.5\n\
	for {set i 0} {$i < 16} {incr i} {\n\
		set ycoord [expr $ycoord + 0.5]\n\
		$grid create line 0.0c ${ycoord}c 8.5c ${ycoord}c -fill #aaaaaa\n\
	}\n\
}\n\
# -----------------------------------------------------------------------------\n\
# Load sound map\n\
# -----------------------------------------------------------------------------\n\
set last_map_file_name \"\";\n\
\n\
proc load_sound_map {initialdir} {\n\
\n\
	# From TK-707 version 0.6, the format of .map files is changed\n\
	#	(they now include also abbreviation information, for volume labels).\n\
	# New format is recognized by number of saved data segments (4 rather than 3).\n\
\n\
	upvar #0 sound snd\n\
	upvar #0 last_map_file_name last_map_file_name\n\
\n\
	set ftypes	{\n\
		{{TK707 Sound Map} {.map}}\n\
		{{All types} {.*}}\n\
	}\n\
	set fname [tk_getOpenFile -filetypes $ftypes -initialdir $initialdir ]\n\
\n\
	if {$fname == \"\"} {\n\
		return\n\
	}\n\
	set last_map_file_name [lindex [split $fname /] end];\n\
\n\
	set f [open $fname r]\n\
	set data \"\"\n\
	set i 1\n\
	while {[gets $f line] >= 0} {\n\
		if {[string index $line 0] == \"#\"} {\n\
			continue\n\
		}\n\
		set data [lindex $line 0]\n\
		set datasegs [llength $data]\n\
		set snd($i,name) [lindex $data 0]\n\
		set snd($i,shortname) [lindex $data 1]\n\
		if {$datasegs == 4} {\n\
		    set snd($i,abbrev) [lindex $data 2]\n\
		    set snd($i,note) [lindex $data 3]\n\
		} else {\n\
		    # we could set a better algo to abbrev\n\
		    set snd($i,abbrev) $snd($i,shortname)\n\
		    set snd($i,note) [lindex $data 2]\n\
		}\n\
		incr i\n\
	}\n\
	close $f\n\
\n\
	# Reset Name Displays\n\
	instrument_label_reset\n\
	tk7_set_sounds\n\
}\n\
# -----------------------------------------------------------------------------\n\
# Save sound map\n\
# -----------------------------------------------------------------------------\n\
proc save_sound_map {} {\n\
\n\
	upvar #0 tkxox xox\n\
	upvar #0 sound snd\n\
	upvar #0 last_map_file_name last_map_file_name\n\
\n\
	set ftypes	{\n\
		{{TK707 Sound Map} {.map}}\n\
		{{All types} {.*}}\n\
	}\n\
	#puts \"last_map_file_name before: $last_map_file_name\"\n\
	set fname [tk_getSaveFile -filetypes $ftypes -initialfile $last_map_file_name]\n\
	if {$fname == \"\"} {\n\
		return\n\
	}\n\
	set last_map_file_name [lindex [split $fname /] end];\n\
\n\
	set f [open $fname w]\n\
	puts $f \"#################  TK707 Sound Map generated by $xox(VERSION)  #################\"\n\
	puts $f \"# Format is 16 entries of { {Long name} {Short name} {Abbrev} {Midi key value} }\"\n\
	puts $f \"############################################################################\"\n\
	for {set i 1} {$i < 17} {incr i} {\n\
		puts $f \"{ {$snd($i,name)} {$snd($i,shortname)} {$snd($i,abbrev)} {$snd($i,note)} }\"\n\
	}\n\
	close $f\n\
}\n\
# -----------------------------------------------------------------------------\n\
# Load data file\n\
# -----------------------------------------------------------------------------\n\
set last_data_file_name \"\";\n\
\n\
proc load_data_file {initialdir} {\n\
\n\
	# From TK-707 version 0.7, the format of .dat files is changed\n\
	#	(they now include also note properties information).\n\
	# New format is recognized by number of saved data segments (5 rather than 2, 3 or 4).\n\
	# They are:\n\
	#	segment 0: pattern note data\n\
	#	segment 1: pattern note properties\n\
	#	segment 2: pattern {length,scale,flam,shuffle} properties\n\
	#	segment 3: track data\n\
\n\
	# From TK-707 version 0.6, the format of .dat files is changed\n\
	#	(they now include also pattern scale information).\n\
	# New format is recognized by number of saved data segments (4 rather than 2 or 3).\n\
	# They are:\n\
	#	segment 0: pattern note data\n\
	#	segment 1: pattern length data\n\
	#	segment 2: pattern scale data\n\
	#	segment 3: track data\n\
\n\
	# From TK-707 version 0.5, the format of .dat files is changed\n\
	#	(they now include pattern length information).\n\
	# New format is recognized by number of saved data segments (3 rather than 2).\n\
	# They are:\n\
	#	segment 0: pattern note data\n\
	#	segment 1: pattern length data\n\
	#	segment 2: track data\n\
\n\
	upvar #0 track_list tl\n\
	upvar #0 mode mo\n\
	upvar #0 last_data_file_name last_data_file_name\n\
\n\
	set ftypes	{\n\
		{{TK-707 Data} {.dat}}\n\
		{{All types} {.*}}\n\
	}\n\
	set fname [tk_getOpenFile -filetypes $ftypes -initialdir $initialdir]\n\
	if {$fname == \"\"} {\n\
		return\n\
	}\n\
	set last_data_file_name [lindex [split $fname /] end];\n\
	#puts \"LOAD last_data_file_name $last_data_file_name\"\n\
\n\
	set f [open $fname r]\n\
	set data \"\"\n\
	while {[gets $f line] >= 0} {\n\
		if {[string index $line 0] == \"#\"} {\n\
			continue\n\
		}\n\
		set data \"$data [string trim $line]\"\n\
	}\n\
	close $f\n\
\n\
	# ----------------------------------\n\
	# find format version from structure\n\
	# ----------------------------------\n\
	set datasegs [llength [lindex $data 0]]\n\
	set data_version \"unknown\";\n\
	if {$datasegs == 2} {\n\
	    set data_version 2;\n\
	} elseif {$datasegs == 3} {\n\
	    set data_version 5;\n\
	} elseif {$datasegs == 4} {\n\
	    set segment2 [lindex [lindex $data 0] 2]\n\
	    set n_seg2_level2 [llength [lindex [lindex $segment2 0] 0]]\n\
	    if {$n_seg2_level2 == 1} {\n\
	        set data_version 6;\n\
	    } elseif {$n_seg2_level2 >= 4} {\n\
	        set data_version 7;\n\
	    }\n\
	}\n\
	#puts \"data_version $data_version\"\n\
	if {$data_version == \"unknown\"} {\n\
	    puts \"ERROR: ${fname}: unexpected data format\";\n\
	    return;\n\
	}\n\
	# ----------------------------------\n\
	# load segments\n\
	# ----------------------------------\n\
	set loadsegment 0\n\
	tk7_clear_tree\n\
	set pdata [lindex [lindex $data 0] $loadsegment]	;	#Pattern data\n\
	set i 0\n\
	foreach bankdata $pdata {\n\
		set j 0\n\
		foreach patterndata $bankdata {\n\
			set k 0\n\
			foreach stepdata $patterndata {\n\
				if {[llength $stepdata] > 0} {\n\
					foreach n $stepdata {\n\
						tk7_add_note $i $j $k $n\n\
					}\n\
				}\n\
				incr k\n\
			}\n\
			incr j\n\
		}\n\
		incr i\n\
	}\n\
	incr loadsegment\n\
\n\
	if {$data_version >= 7} {\n\
	    # format version 0.7 includes note properties: flam, accents, etc...\n\
	    set p_prop [lindex [lindex $data 0] $loadsegment]	;	#Pattern note properties\n\
	    set p_data [lindex [lindex $data 0] 0]\n\
	    set i 0\n\
	    foreach bank_prop $p_prop {\n\
	        set bank_data [lindex $p_data $i]\n\
		set j 0\n\
		foreach pattern_prop $bank_prop {\n\
	            set pattern_data [lindex $bank_data $j]\n\
		    set k 0\n\
		    foreach step_prop $pattern_prop {\n\
	                set step_data [lindex $pattern_data $k]\n\
			if {[llength $step_prop] > 0} {\n\
			    set idx_n 0\n\
			    foreach p $step_prop {\n\
	                        set n [lindex $step_data $idx_n]\n\
			        tk7_set_properties $i $j $k $n $p\n\
		        	incr idx_n\n\
			    }\n\
			}\n\
		        incr k\n\
		    }\n\
		    incr j\n\
		}\n\
		incr i\n\
	    }\n\
	    incr loadsegment\n\
	}\n\
	pattern_setid $mo(current_pattern)\n\
\n\
	if {$data_version >= 5} {\n\
		# format version 0.5 and 0.6 includes length info.\n\
	    	# format version 0.7 includes {length,scale,flam,shuffle} infos.\n\
		set pdata [lindex [lindex $data 0] $loadsegment] ; #Step length data\n\
		set grp 0\n\
		foreach grpdata $pdata {\n\
			set pat 0\n\
			foreach pldata $grpdata {\n\
				if {$data_version >= 7} {\n\
				    # from TK-707 version 0.7: {length,scale,flam,shuffle} infos.\n\
				    tk7_set_last_step $grp $pat [lindex $pldata 0]\n\
				    tk7_set_scale     $grp $pat [lindex $pldata 1]\n\
				    tk7_set_flam      $grp $pat [lindex $pldata 2]\n\
				    tk7_set_shuffle   $grp $pat [lindex $pldata 3]\n\
				    if {[llength $pldata] >= 5} {\n\
				      tk7_set_pattern_comment  $grp $pat [lindex $pldata 4]\n\
				    }\n\
				} else {\n\
				    # TK-707 version 0.5 and 0.6: step length info.\n\
				    tk7_set_last_step $grp $pat $pldata\n\
				}\n\
				incr pat\n\
			}\n\
			incr grp\n\
		}\n\
		incr loadsegment\n\
	}\n\
	if {$data_version == 6} {\n\
		# format version 0.6 includes step scale info.\n\
		set pdata [lindex [lindex $data 0] $loadsegment] ; #Step scale data\n\
		set grp 0\n\
		foreach grpdata $pdata {\n\
			set pat 0\n\
			foreach pldata $grpdata {\n\
				set scaleresult  [tk7_set_scale $grp $pat $pldata]\n\
				incr pat\n\
			}\n\
			incr grp\n\
		}\n\
		incr loadsegment\n\
	}\n\
	set pdata [lindex [lindex $data 0] $loadsegment]	;	#Track data\n\
	set i 0\n\
	foreach trackdata $pdata {\n\
		#puts $trackdata\n\
		set tl($i) [join $trackdata]\n\
		incr i\n\
	}\n\
	ac_track 0\n\
	pattern_show\n\
}\n\
# -----------------------------------------------------------------------------\n\
# Save data file\n\
# -----------------------------------------------------------------------------\n\
proc reverse {l1} {\n\
    set n  [llength $l1]\n\
    set l2 {}\n\
    for {set i [expr $n - 1]} {$i >= 0} {set i [expr $i - 1]} {\n\
        lappend l2 [lindex $l1 $i]\n\
    }\n\
    return $l2\n\
}\n\
proc save_data_file {} {\n\
\n\
	upvar #0 pattern_list pl\n\
	upvar #0 track_list tl\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 last_data_file_name last_data_file_name\n\
\n\
	set ftypes	{\n\
		{{TK-707 Data} {.dat}}\n\
		{{All types} {.*}}\n\
	}\n\
	#puts \"PREV last_data_file_name $last_data_file_name\"\n\
	set fname [tk_getSaveFile -filetypes $ftypes -initialfile $last_data_file_name]\n\
	if {$fname == \"\"} {\n\
		return\n\
	}\n\
	set last_data_file_name [lindex [split $fname /] end];\n\
	#puts \"NEW last_data_file_name $last_data_file_name\"\n\
\n\
	set f [open $fname w]\n\
	puts $f \"####################### MACHINE GENERATED - DO NOT EDIT #######################\"\n\
	puts $f \"####   TK707 Data file generated by $xox(VERSION)\"\n\
	puts $f \"###############################################################################\"\n\
	puts $f \"{\"							;	# Begin DATA\n\
\n\
	# PATTERN NOTES. Four groups of 16 patterns each with 16 steps.\n\
	puts $f \" {\"							;	# Begin PATTERNS\n\
	for {set i 0} {$i<4} {incr i} {\n\
	    puts $f \"  {\"						;	# Begin GROUP i\n\
	    for {set j 0} {$j<16} {incr j} {\n\
		puts $f \"   {\"						;	# Begin PATTERN j\n\
		for {set k 0} {$k<16} {incr k} {\n\
		    set instruments [tk7_pattern_items $i $j $k]\n\
		    set instruments [reverse $instruments]\n\
		    puts $f \"    { $instruments }\"\n\
		}\n\
		puts $f \"   }\"						;	# End PATTERN j\n\
	    }\n\
	    puts $f \"  }\"						;	# End GROUP i\n\
	}\n\
	puts $f \" }\"							;	# End PATTERNS\n\
\n\
	# PATTERN NOTES PROPERTIES. Four groups of 16 patterns each with 16 steps.\n\
	puts $f \" {\"							;	# Begin PATTERNS\n\
	for {set i 0} {$i<4} {incr i} {\n\
	    puts $f \"  {\"						;	# Begin GROUP i\n\
	    for {set j 0} {$j<16} {incr j} {\n\
		puts $f \"   {\"						;	# Begin PATTERN j\n\
		for {set k 0} {$k<16} {incr k} {\n\
		    set properties [tk7_get_pattern_properties $i $j $k]\n\
		    set properties [reverse $properties]\n\
		    puts $f \"    { $properties }\"\n\
		}\n\
		puts $f \"   }\"						;	# End PATTERN j\n\
	    }\n\
	    puts $f \"  }\"						;	# End GROUP i\n\
	}\n\
	puts $f \" }\"							;	# End PATTERNS\n\
\n\
	# PATTERN PROPERTIES. Four lots of sixteen 4-lists. New from TK-707 version 0.7\n\
	puts $f  \" {\"							;	# Begin PATTERN PROPERTIES\n\
	for {set i 0} {$i<4} {incr i} {\n\
		set pat_props [tk7_group_pattern_properties $i]		; 	# Group step lengths \n\
		puts $f \"  { $pat_props }\"				; 	# Group step lengths \n\
	}\n\
	puts $f  \" }\"							;	# End PATTERN PROPERTIES\n\
\n\
	# TRACK DATA. Four tracks of arbitrary length.\n\
	puts $f \" {\"							;	# Begin TRACKS\n\
	for {set i 0} {$i<4} {incr i} {\n\
		puts $f \"  { $tl($i) }\"					;	# TRACK i data\n\
	}\n\
	puts $f \" }\"							;	# End TRACKS\n\
	puts $f \"}\"							;	# End DATA\n\
	close $f\n\
}\n\
# --------------------\n\
# compute the velocity\n\
# --------------------\n\
# velocity range is 0..127 as integer\n\
# volume   range is 0..1   as float\n\
proc compute_velocity {prop volume_master volume_accent volume_instr} {\n\
\n\
    if {[have_zero_velocity $prop]} {\n\
	set velocity_factor 0\n\
    } else {\n\
    	set velocity_factor 1\n\
    }\n\
    if {[have_strong_accent $prop]} {\n\
	set accent_factor 1\n\
    } elseif {[have_weak_accent $prop]} {\n\
	set accent_factor 2/3.0\n\
    } else {\n\
	set accent_factor 1/3.0\n\
    }\n\
    set volume_note [expr  $volume_master \\\n\
	     	     	  *$velocity_factor*$volume_instr \\\n\
		      	  *$accent_factor*$volume_accent]\n\
    set velocity [expr int(127 * $volume_note + 0.5)]\n\
    return $velocity\n\
}\n\
# -----------------------------------------------------------------------------\n\
# Save midi file - current track\n\
# -----------------------------------------------------------------------------\n\
\n\
set last_midi_file_name \"\";\n\
set prev_data_file_name \"\";\n\
\n\
proc put_note {f tick_shift midinote velocity} {\n\
    if {$tick_shift > 127} {\n\
        varlen_short shortres $tick_shift\n\
	puts -nonewline $f [binary format c2 [list $shortres(high) $shortres(low)]]\n\
	set size 2\n\
    } else {\n\
        puts -nonewline $f [binary format c1 $tick_shift]\n\
	set size 1\n\
    }\n\
    puts -nonewline $f [binary format c2 [list $midinote $velocity]]\n\
    return [expr $size + 2]\n\
}\n\
proc put_note_off {f tick_shift midinote} {\n\
    return [put_note $f $tick_shift $midinote 0]\n\
}\n\
proc save_midi_file {} {\n\
	global cunit\n\
	global masterv\n\
\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	upvar #0 sound snd\n\
	upvar #0 track_list tl\n\
	upvar #0 has_delay has_delay\n\
	upvar #0 last_midi_file_name last_midi_file_name\n\
	upvar #0 last_data_file_name last_data_file_name\n\
	upvar #0 prev_data_file_name prev_data_file_name\n\
	upvar #0 instrument_to_volume instrument_to_volume\n\
\n\
	if {    ($last_data_file_name != \"\")\n\
	    && (($prev_data_file_name == \"\") ||\n\
	        ($prev_data_file_name != $last_data_file_name)) } {\n\
\n\
	    # build a predefined name:\n\
	    set x [lindex [split $last_data_file_name .] 0];\n\
	    set t $mo(current_track)\n\
	    set last_midi_file_name \"${x}-track${t}.mid\"\n\
	}\n\
	set ftypes	{\n\
		{{Midi File Format} {.mid}}\n\
		{{All types} {.*}}\n\
	}\n\
	set fname [tk_getSaveFile -filetypes $ftypes -initialfile $last_midi_file_name]\n\
	if {$fname == \"\"} {\n\
	    return\n\
	}\n\
	set last_midi_file_name [lindex [split $fname /] end];\n\
	set prev_data_file_name $last_data_file_name\n\
\n\
	set thirty_second_note_on_ratio 5; 	# customize the ratio !\n\
						# ex1: ratio=3\n\
						# => 1/3 note-on\n\
						#    2/3 note-off, for a thirty-second \n\
						# ex2: ratio=16\n\
						# => 1/16 note-on, 15/16 note-off\n\
						# ex3: ratio=1\n\
						# => 100 % note-on; not for percussions...\n\
\n\
	set tick_per_note_on            3; 	# how long, in ticks, the note is on\n\
						# DO NOT change ! because we may divide \n\
						# it per 3 quarters and eigth later...\n\
\n\
	set tick_per_thirty_second      [expr  $thirty_second_note_on_ratio*$tick_per_note_on];\n\
	set tick_per_quarter            [expr  8*$tick_per_thirty_second];\n\
\n\
	# steps are in two parts:\n\
	#	a note-on part, which have a duration independant of the scale (a hit)\n\
	#	a note-off part, which depend on the scale:\n\
\n\
	# scale(0): 1 step = quarter/4\n\
        set tick_per_step_off_scale(0) [expr $tick_per_quarter/4 - $tick_per_note_on];\n\
\n\
	# scale(1): 1 step = quarter/8\n\
        set tick_per_step_off_scale(1) [expr $tick_per_quarter/8 - $tick_per_note_on];\n\
\n\
	# scale(2): 1 step = quarter/3\n\
        set tick_per_step_off_scale(2) [expr $tick_per_quarter/3 - $tick_per_note_on];\n\
\n\
	# scale(3): 1 step = quarter/6\n\
        set tick_per_step_off_scale(3) [expr $tick_per_quarter/6 - $tick_per_note_on];\n\
\n\
	# ex1: ratio=3\n\
	#     => tick_per_step_off_scale = {15   6  21   9}\n\
	# ex1: ratio=16\n\
	#     => tick_per_step_off_scale = {93   45  125   61}\n\
	#        the grid is finer and the result is better\n\
	# ex3: ratio=1\n\
	#     => tick_per_step_off_scale = {3, 0, 5, 1}, as expected.\n\
	#	 as expected, the thirty-second has no note-off part...\n\
\n\
	#\n\
	# get volumes:\n\
	#\n\
	set volume_master [expr [$masterv.sf.s get] / 100.0]\n\
	#puts \"volume_master $volume_master\"\n\
	set volume_accent [expr [$cunit.0.sf.s get] / 100.0]\n\
	#puts \"volume_accent $volume_accent\"\n\
	set volume_set {}\n\
	for {set instrument 1} {$instrument <= 16} {incr instrument} {\n\
	    set i_vol $instrument_to_volume($instrument)\n\
	    set volume($instrument) [expr [$cunit.${i_vol}.sf.s get] / 100.0]\n\
	    #puts \"volume($instrument) $volume($instrument)\"\n\
	}\n\
	for {set instrument 1} {$instrument <= 16} {incr instrument} {\n\
	    set in_note($instrument) 0;\n\
	}\n\
	set f [open $fname w]\n\
	puts -nonewline $f MThd\n\
	puts -nonewline $f [binary format I 6]\n\
	puts -nonewline $f [binary format S 0]\n\
	puts -nonewline $f [binary format S 1]\n\
	puts -nonewline $f [binary format S $tick_per_quarter]\n\
	puts -nonewline $f MTrk\n\
	set loc_tracksize 18\n\
	puts -nonewline $f [binary format I 0]	; # Dummy tracksize\n\
\n\
	# Meta Event to set track tempo\n\
	set micro_tempo [expr 60000000 / $mo(tempo)]\n\
	puts -nonewline $f [binary format c7 [list 0 255 81 3 [expr $micro_tempo >> 16] [expr $micro_tempo >> 8] $micro_tempo]]\n\
	set tracksize 7\n\
\n\
	# Establish running status with a zero volume note\n\
	puts -nonewline $f [binary format c4 [list 0 [expr 144 + $mo(midi_channel)] 17 0]]\n\
	incr tracksize 4\n\
\n\
	set track $tl($mo(current_track))\n\
	set tick_shift 0\n\
	foreach patid $track {\n\
	    set group     [expr $patid / 16]\n\
	    set pattern   [expr $patid % 16]\n\
	    set last_step [tk7_get_last_step $group $pattern]\n\
	    set scale     [tk7_get_scale $group $pattern]\n\
	    set step 0\n\
	    while {$step < $last_step} {\n\
		set instrument_set [tk7_pattern_items          $group $pattern $step]\n\
		set property_set   [tk7_get_pattern_properties $group $pattern $step]\n\
		set idx 0\n\
		foreach instrument $instrument_set {\n\
		    if {$instrument == \"\"} {\n\
			#puts \"EMPTY instrument ?? idx = $idx\"\n\
		        incr idx\n\
			continue;\n\
		    }\n\
		    # ------------\n\
		    # start a note\n\
		    # ------------\n\
		    set midinote $snd($instrument,note)\n\
    		    set prop [lindex $property_set $idx]\n\
		    set velocity [compute_velocity $prop $volume_master $volume_accent $volume($instrument)]\n\
		    incr tracksize [put_note $f $tick_shift $midinote $velocity]\n\
		    set tick_shift 0\n\
		    if {! $has_delay($instrument) && ! [have_zero_velocity $prop]} {\n\
			# start a note without delay\n\
		        set in_note($instrument) 1\n\
		    }\n\
		    incr idx\n\
		}\n\
		set flam_interval [tk7_get_flam $group $pattern]\n\
		set tick_per_flam [expr $xox(tick_flam_duration) * $flam_interval]\n\
		incr tick_shift $tick_per_flam\n\
		if {$flam_interval != 0} {\n\
		    set idx 0\n\
		    foreach instrument $instrument_set {\n\
		        if {$instrument == \"\"} {\n\
			    continue;\n\
		        }\n\
	  	        set prop [lindex $property_set $idx]\n\
		        if {! [have_fla $prop]} {\n\
			    continue;\n\
		        }\n\
		        # ----------------------\n\
		        # write a fla note\n\
		        # ----------------------\n\
		        set midinote $snd($instrument,note)\n\
    		        set prop [lindex $property_set $idx]\n\
		        set velocity [compute_velocity $prop $volume_master $volume_accent $volume($instrument)]\n\
		        incr tracksize [put_note $f $tick_shift $midinote $velocity]\n\
		        set tick_shift 0\n\
		        incr idx\n\
		    }\n\
		}\n\
		incr tick_shift [expr $tick_per_note_on - $tick_per_flam]\n\
		foreach instrument $instrument_set {\n\
		    if {$instrument == \"\"} {\n\
			continue;\n\
		    }\n\
		    if {! $has_delay($instrument)} {\n\
			continue;\n\
		    }\n\
		    # ----------------------\n\
		    # stop a note with delay\n\
		    # ----------------------\n\
		    set midinote $snd($instrument,note)\n\
		    incr tracksize [put_note_off $f $tick_shift $midinote]\n\
		    set tick_shift 0\n\
		}\n\
		incr tick_shift $tick_per_step_off_scale($scale)\n\
\n\
		incr step\n\
	    }\n\
	}\n\
	# stop current long notes on (whistle, etc...)\n\
	for {set instrument 1} {$instrument <= 16} {incr instrument} {\n\
\n\
		if {$in_note($instrument)} {\n\
\n\
		 #puts \"stop instrument $instrument\";\n\
\n\
		 set midinote $snd($instrument,note)\n\
		 incr tracksize [put_note_off $f $tick_shift $midinote]\n\
		 set tick_shift 0\n\
	    }\n\
	}\n\
	# End of track\n\
	puts -nonewline $f [binary format c 0]\n\
	puts -nonewline $f [binary format c3 {255 47 0}]\n\
	incr tracksize 4\n\
\n\
	# Go back and insert tracksize\n\
	flush $f\n\
	seek $f $loc_tracksize\n\
	puts -nonewline $f [binary format I $tracksize]\n\
	close $f\n\
}\n\
# -----------------------------------------------------------------------------\n\
# fileMidi - TEST area\n\
# -----------------------------------------------------------------------------\n\
proc fileAction {a} {\n\
	upvar #0 pattern_list pl\n\
	upvar #0 track_list tl\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
\n\
	if {$a == 99} {\n\
		set ftypes	{\n\
			{{Midi File Format} {.mid}}\n\
			{{All types} {.*}}\n\
		}\n\
		set fname [tk_getSaveFile -filetypes $ftypes]\n\
		if {$fname == \"\"} {\n\
			return\n\
		}\n\
		set f [open $fname w]\n\
\n\
		puts -nonewline $f MThd\n\
		puts -nonewline $f [binary format I 6]\n\
		puts -nonewline $f [binary format S 0]\n\
		puts -nonewline $f [binary format S 1]\n\
		puts -nonewline $f [binary format S 7]\n\
		puts -nonewline $f MTrk\n\
		set loc_tracksize 18\n\
		puts -nonewline $f [binary format I 0]	; # Dummy tracksize\n\
\n\
		puts -nonewline $f [binary format c2 [list 0 [expr 144 + $mo(midi_channel)]]]\n\
\n\
		# Once running status is established, format is\n\
		# {note onlevel pause note offlevel pause}\n\
		puts -nonewline $f [binary format c12 {35 127 0 51 127 2 35 0 0 51 0 4}]\n\
		puts -nonewline $f [binary format c6 {48 127 2 48 0 4}]\n\
		puts -nonewline $f [binary format c6 {38 127 2 38 0 4}]\n\
		puts -nonewline $f [binary format c6 {51 127 2 51 0 4}]\n\
\n\
		# End of track\n\
		puts -nonewline $f [binary format c3 {255 47 0}]\n\
\n\
		set tracksize 35\n\
		# Go back and insert tracksize\n\
		flush $f\n\
		seek $f $loc_tracksize\n\
		puts -nonewline $f [binary format I $tracksize]\n\
		close $f\n\
	} else {\n\
		puts \"INTERNAL ERROR: Unexected file action: $a\"\n\
	}\n\
}\n\
proc varlen_short {result value} {\n\
	upvar $result res\n\
\n\
	if {$value < 128} {\n\
		set res(high) 0\n\
		set res(low) $value\n\
	} else {\n\
		set res(high) [expr 128 + [expr $value / 128]]\n\
#		set res(high) [expr 65536 + [expr $value / 128]]\n\
		set res(low) [expr $value % 128]\n\
	}\n\
}\n\
\n\
#=============================================================\n\
# These procs to edit mapping of note keys to midi note values\n\
#\n\
proc map_edit {} {\n\
	global font12\n\
	global boldfont12\n\
	upvar #0 sound snd\n\
	upvar #0 soundbuf sbuf\n\
	upvar #0 tkxox xox\n\
\n\
	if {[winfo exists .edit]} {\n\
		wm deiconify .edit\n\
	} else {\n\
		toplevel .edit\n\
		wm title .edit \"Edit Sound Map\"\n\
\n\
		set m_titles .edit.t\n\
		canvas $m_titles -height 0.75c -width 13.5c -relief raised -borderwidth 2\n\
		pack $m_titles\n\
		set m_maps .edit.m\n\
		frame $m_maps\n\
		pack $m_maps\n\
		set m_opts	.edit.o\n\
		canvas $m_opts -height 1.5c -width 13.5c\n\
		pack $m_opts\n\
\n\
		label $m_titles.key    -text \"Key\"        -font *-${boldfont12}-*\n\
		label $m_titles.long   -text \"Long Name\"  -font *-${boldfont12}-*\n\
		label $m_titles.short  -text \"Short Name\" -font *-${boldfont12}-*\n\
		label $m_titles.abbrev -text \"Abbrev\"     -font *-${boldfont12}-*\n\
		label $m_titles.note   -text \"Note\"       -font *-${boldfont12}-*\n\
		label $m_titles.test   -text \"Test\"       -font *-${boldfont12}-*\n\
		$m_titles create window  0c   0.45c -window $m_titles.key    -anchor w -width 1c\n\
		$m_titles create window  1c   0.45c -window $m_titles.long   -anchor w -width 4c\n\
		$m_titles create window  5.3c 0.45c -window $m_titles.short  -anchor w -width 2c\n\
		$m_titles create window  7.5c 0.45c -window $m_titles.abbrev -anchor w -width 2c\n\
		$m_titles create window 10.0c 0.45c -window $m_titles.note   -anchor w -width 1c\n\
		$m_titles create window 11.7c 0.45c -window $m_titles.test   -anchor w -width 1c\n\
\n\
		# Name, Shortname, Midi note entries\n\
		#\n\
		for {set i 0} {$i < 16} {incr i} {\n\
			canvas $m_maps.$i -height 1c -width 13.5c\n\
			label $m_maps.$i.l -text [expr $i + 1] -font *-${font12}-*\n\
			entry $m_maps.$i.long  -font *-${font12}-*\n\
			entry $m_maps.$i.short  -font *-${font12}-*\n\
			entry $m_maps.$i.abbrev  -font *-${font12}-*\n\
			entry $m_maps.$i.note  -font *-${font12}-*\n\
			button $m_maps.$i.test \\\n\
				-bitmap nix \\\n\
				-bg $xox(but_grey) \\\n\
				-activebackground $xox(but_grey_active) \\\n\
				-width 1.0c -height 0.7c\n\
\n\
			$m_maps.$i create window 0c   0.5c -window $m_maps.$i.l 	 -anchor w -width 1c\n\
			$m_maps.$i create window 1c   0.5c -window $m_maps.$i.long -anchor w -width 4c\n\
			$m_maps.$i create window 5c   0.5c -window $m_maps.$i.short -anchor w -width 2.5c\n\
			$m_maps.$i create window 7.5c 0.5c -window $m_maps.$i.abbrev -anchor w -width 2.5c\n\
			$m_maps.$i create window 10c  0.5c -window $m_maps.$i.note -anchor w -width 1c\n\
			$m_maps.$i create window 11.2c 0.5c -window $m_maps.$i.test -anchor w -width 2.1c\n\
\n\
			set j [expr $i + 1]\n\
			$m_maps.$i.long insert 0 $snd($j,name)\n\
			set sbuf($j,name) $snd($j,name)\n\
			$m_maps.$i.short insert 0 $snd($j,shortname)\n\
			set sbuf($j,shortname) $snd($j,shortname)\n\
			$m_maps.$i.abbrev insert 0 $snd($j,abbrev)\n\
			set sbuf($j,abbrev) $snd($j,abbrev)\n\
			$m_maps.$i.note insert 0 $snd($j,note)\n\
			set sbuf($j,note) $snd($j,note)\n\
			pack $m_maps.$i\n\
\n\
			bind $m_maps.$i.test <ButtonPress-1>    {map_start_test_note %W}\n\
			bind $m_maps.$i.test <ButtonRelease-1>  {map_stop_test_note %W}\n\
\n\
			bind $m_maps.$i.note <Shift-ButtonPress-1>   {map_start_set_note %W 1}\n\
			bind $m_maps.$i.note <Shift-ButtonRelease-1> {map_stop_set_note %W}\n\
\n\
			bind $m_maps.$i.note <Control-ButtonPress-1>   {map_start_set_note %W -1}\n\
			bind $m_maps.$i.note <Control-ButtonRelease-1> {map_stop_set_note %W}\n\
\n\
			bind $m_maps.$i.note <Button-2>  {\n\
				set noteY %y\n\
			}\n\
			bind $m_maps.$i.note <B2-Motion> {\n\
				set direction [expr %y - $noteY]\n\
				if {$direction >= 0} {\n\
				    set diff 1\n\
				} else {\n\
				    set diff -1\n\
				}\n\
				map_start_set_note %W $diff\n\
				after 500;\n\
				map_stop_set_note  %W\n\
			}\n\
		}\n\
\n\
		# Cancel, Apply, OK buttons\n\
		#\n\
		button $m_opts.cancel -text Cancel -font *-${font12}-* -command {\n\
			upvar #0 soundbuf buf\n\
			for {set i 0} {$i < 16} {incr i} {\n\
				set j [expr $i + 1]\n\
				.edit.m.$i.long delete 0 100\n\
				.edit.m.$i.long insert 0 $buf($j,name)\n\
				set snd($j,name) $buf($j,name)\n\
\n\
				.edit.m.$i.short delete 0 100\n\
				.edit.m.$i.short insert 0 $buf($j,shortname)\n\
				set snd($j,shortname) $buf($j,shortname)\n\
\n\
				.edit.m.$i.abbrev delete 0 100\n\
				.edit.m.$i.abbrev insert 0 $buf($j,abbrev)\n\
				set snd($j,abbrev) $buf($j,abbrev)\n\
\n\
				.edit.m.$i.note delete 0 end\n\
				.edit.m.$i.note insert 0 $buf($j,note)\n\
				set snd($j,note) $buf($j,note)\n\
			}\n\
			instrument_label_reset\n\
			tk7_set_sounds\n\
			destroy .edit\n\
		}\n\
		button $m_opts.apply -text Apply -font *-${font12}-* -command {\n\
			map_set_new_sounds\n\
		}\n\
		button $m_opts.ok -text OK -font *-${font12}-* -command {\n\
			map_set_new_sounds\n\
			destroy .edit\n\
		}\n\
		$m_opts create window 1c 0.75c -window $m_opts.cancel -anchor w -width 2.5c\n\
		$m_opts create window 4c 0.75c -window $m_opts.apply -anchor w -width 2.5c\n\
		$m_opts create window 7c 0.75c -window $m_opts.ok -anchor w -width 2.5c\n\
	}\n\
}\n\
\n\
proc map_set_new_sounds {} {\n\
	global .edit\n\
	upvar #0 sound snd\n\
	upvar #0 soundbuf sbuf\n\
\n\
	for {set i 0} {$i < 16} {incr i} {\n\
		set j [expr $i + 1]\n\
		set snd($j,name) [.edit.m.$i.long get]\n\
		set snd($j,shortname) [.edit.m.$i.short get]\n\
		set snd($j,abbrev) [.edit.m.$i.abbrev get]\n\
		set snd($j,note) [.edit.m.$i.note get]\n\
	}\n\
	instrument_label_reset\n\
	tk7_set_sounds\n\
}\n\
\n\
proc map_start_test_note widget {\n\
	global .edit\n\
	set k [string range [string trimright $widget .test] 8 end]\n\
	set n [.edit.m.$k.note get]\n\
	tk7_start_note_test $k $n\n\
}\n\
proc map_stop_test_note widget {\n\
	global .edit\n\
	set k [string range [string trimright $widget .test] 8 end]\n\
	set n [.edit.m.$k.note get]\n\
	tk7_stop_note_test $k $n\n\
}\n\
proc map_start_set_note {widget diff} {\n\
	set newval [expr [$widget get] + $diff]\n\
	set newval [expr $newval % 128]\n\
	$widget delete 0 end\n\
	$widget insert 0 $newval\n\
	set k [string range [string trimright $widget .note] 8 end]\n\
	tk7_start_note_test $k $newval\n\
}\n\
proc map_stop_set_note {widget} {\n\
	set keynum    [string range [string trimright $widget .note] 8 end]\n\
	set midi_note [$widget get]\n\
	tk7_stop_note_test $keynum $midi_note\n\
}\n\
#=============================================================\n\
\n\
#=====================================================\n\
# These procs to edit mapping of instruments to faders\n\
#\n\
proc fader_edit {} {\n\
	if {[winfo exists .fadermap]} {\n\
		wm deiconify .fadermap\n\
	} else {\n\
		toplevel .fadermap\n\
		wm title .fadermap \"Edit Fader Map\"\n\
\n\
		text .fadermap.intro -width 64 -height 16\n\
		.fadermap.intro insert end	\\\n\
\"Editing of the Instrument to Fader map is not implemented yet.\n\
The default mapping being used is:\n\
\n\
Vol 0 (the first fader ) - unused\n\
Vol 1	- Bass drums 1 & 2\n\
Vol 2	- Snare drums 1 & 2\n\
Vol 3	- Low Tom\n\
Vol 4	- Mid Tom\n\
Vol 5	- High Tom\n\
Vol 6	- Rimshot & Cowbell\n\
Vol 7	- Handclap & Tambourine\n\
Vol 8	- Highhats (all)\n\
Vol 9	- Crash cymbal\n\
Vol 10	- Ride cymbal\n\
VOLUME	- Master volume over all instruments\n\
\"\n\
\n\
		button .fadermap.ok -text OK -command {destroy .fadermap}\n\
\n\
		pack .fadermap.intro\n\
		pack .fadermap.ok -expand true -fill x\n\
	}\n\
\n\
}\n\
#=====================================================\n\
#\n\
# Flash the lamps for each of the 16 steps in 1 pattern\n\
# (fix later for patterns with fewer steps)\n\
#\n\
#ex: cycle_notes 1 [expr 55 * 120 / $mo(tempo)] 0 0 $steps\n\
proc cycle_notes {on dur w saved steps} {\n\
	global notes\n\
	upvar #0 tkxox xox\n\
	upvar #0 mode mo\n\
	upvar #0 flash fl\n\
\n\
	if {$on == 1} {\n\
		switch $mo(stopgo) {\n\
		0	{\n\
			#puts \"stopgo = STOP\"\n\
			set fl(count) -1\n\
			}\n\
		1	{\n\
			incr fl(count)\n\
			if {$fl(count) > [expr $steps - 1]} {\n\
				set fl(count) -1\n\
				return\n\
			}\n\
			set savecolour [lindex [$notes.note$fl(count).l configure -bg] 4]\n\
			set savedwin $notes.note$fl(count).l\n\
			#puts \"cycle $fl(count) ON \"\n\
			$savedwin configure -bg $xox(col_on)\n\
			after $dur [list cycle_notes 0 $dur $savedwin $savecolour $steps]\n\
			}\n\
		2	{\n\
			#puts \"stopgo = CONT\"\n\
			}\n\
		}\n\
	} else {\n\
#		#puts \"cycle $fl(count) OFF\"\n\
		$w configure -bg $saved\n\
		if {$mo(stopgo) != $xox(START)} {\n\
			set fl(count) 15\n\
			return\n\
		}\n\
\n\
		if {$fl(count) < $steps} {\n\
			after $dur [list cycle_notes 1 $dur 0 0 $steps]\n\
		} else {\n\
			set fl(count) -1\n\
			return\n\
		}\n\
	}\n\
\n\
}\n\
proc gridlabels_reset {} {\n\
	global gridlabel\n\
	global font12\n\
	upvar #0 sound so\n\
	for {set i 0} {$i < 16} {incr i} {\n\
		$gridlabel itemconfigure ilabel$i -text $so([expr 16 - $i],name)	\\\n\
			-font *-${font12}-* -anchor e\n\
	}\n\
}\n\
proc key_labels_reset {} {\n\
	global notes\n\
	upvar #0 sound so\n\
\n\
	for {set i 0} {$i < 16} {incr i} {\n\
		$notes.note$i.instr configure -text $so([expr $i + 1],shortname)\n\
	}\n\
}\n\
proc volume_labels_reset {} {\n\
	global cunit\n\
	upvar #0 sound so\n\
	upvar #0 volume_label vo\n\
\n\
	if {$so(2,abbrev) != \"\"} {\n\
	    set vo(1)  \"$so(1,abbrev)/$so(2,abbrev)\"\n\
	} else {\n\
	    set vo(1)  \"$so(1,abbrev)\"\n\
	}\n\
	if {$so(4,abbrev) != \"\"} {\n\
	    set vo(2)  \"$so(3,abbrev)/$so(4,abbrev)\"\n\
	} else {\n\
	    set vo(2)  \"$so(3,abbrev)\"\n\
	}\n\
	set vo(3)  \"$so(5,abbrev)\"\n\
	set vo(4)  \"$so(6,abbrev)\"\n\
	set vo(5)  \"$so(7,abbrev)\"\n\
	if {$so(9,abbrev) != \"\"} {\n\
	    set vo(6)  \"$so(8,abbrev)/$so(9,abbrev)\"\n\
	} else {\n\
	    set vo(6)  \"$so(8,abbrev)\"\n\
	}\n\
	if {$so(11,abbrev) != \"\"} {\n\
	    set vo(7)  \"$so(10,abbrev)/$so(11,abbrev)\"\n\
	} else {\n\
	    set vo(7)  \"$so(10,abbrev)\"\n\
	}\n\
	if {($so(13,abbrev) != \"\") && ($so(14,abbrev) != \"\")} {\n\
	    set vo(8)  \"$so(12,abbrev)/$so(13,abbrev)/$so(14,abbrev)\"\n\
	} elseif {$so(13,abbrev) != \"\"} {\n\
	    set vo(8)  \"$so(12,abbrev)/$so(13,abbrev)\"\n\
	} elseif {$so(14,abbrev) != \"\"} {\n\
	    set vo(8)  \"$so(12,abbrev)/$so(14,abbrev)\"\n\
	} else {\n\
	    set vo(8)  \"$so(12,abbrev)\"\n\
	}\n\
	set vo(9)  \"$so(15,abbrev)\"\n\
	set vo(10) \"$so(16,abbrev)\"\n\
\n\
	for {set i 1} {$i < 11} {incr i} {\n\
		$cunit.$i.l configure -text $vo($i)\n\
	}\n\
}\n\
proc instrument_label_reset {} {\n\
	gridlabels_reset\n\
	key_labels_reset\n\
	volume_labels_reset\n\
}\n\
proc tempoinfo_update {a b c} {\n\
	global tempoinfo\n\
	upvar $a mo\n\
	$tempoinfo itemconfigure tempo -text $mo(tempo)\n\
}\n\
proc measureinfo_update {a b c} {\n\
	global tempoinfo\n\
	upvar $a mo\n\
	upvar #0 tkxox xox\n\
	upvar #0 track_list tl\n\
\n\
	if {$mo(measure) == -1} {\n\
		$tempoinfo itemconfigure tempo -text \"\"\n\
	} else {\n\
		$tempoinfo itemconfigure tempo -text [expr $mo(measure) + 1]\n\
	}\n\
}\n\
proc trackinfo_update {a b c} {\n\
	global tminfo\n\
	upvar $a mo\n\
\n\
	switch $mo(current_track) {\n\
		0	{\n\
			$tminfo.t coords trackid 3c 0.45c\n\
			$tminfo.t itemconfigure trackid -text I\n\
		}\n\
		1	{\n\
			$tminfo.t coords trackid 4c 0.45c\n\
			$tminfo.t itemconfigure trackid -text II\n\
		}\n\
		2	{\n\
			$tminfo.t coords trackid 5c 0.45c\n\
			$tminfo.t itemconfigure trackid -text III\n\
		}\n\
		3	{\n\
			$tminfo.t coords trackid 6c 0.45c\n\
			$tminfo.t itemconfigure trackid -text IV\n\
		}\n\
	}\n\
}\n\
proc modeinfo_update {m} {\n\
	global tminfo\n\
	global tapwrite\n\
	global font12\n\
\n\
	$tminfo.m delete modetext\n\
	switch $m {\n\
		0	{\n\
			set tapwrite 1\n\
			$tminfo.m create text 1.2c 0.8c -text \"TRACK PLAY\"	\\\n\
				-tags modetext -anchor w -font *-${font12}-*\n\
		}\n\
		1	{\n\
			set tapwrite 1\n\
			$tminfo.m create text 1.2c 1.1c -text \"TRACK WRITE\"	\\\n\
				-tags modetext -anchor w -font *-${font12}-*\n\
		}\n\
		2	{\n\
			set tapwrite 1\n\
			$tminfo.m create text 4.2c 0.4c -text \"PATTERN PLAY\"	\\\n\
				-tags modetext -anchor w -font *-${font12}-*\n\
		}\n\
		3	{\n\
			if {$tapwrite} {\n\
				incr tapwrite -1\n\
				$tminfo.m create text 4.2c 0.8c -text \"PATTERN WRITE\"	\\\n\
					-tags modetext -anchor w -font *-${font12}-*\n\
			} else {\n\
				incr tapwrite\n\
				$tminfo.m create text 4.2c 1.2c -text \"TAP WRITE\"	\\\n\
					-tags modetext -anchor w -font *-${font12}-*\n\
			}\n\
		}\n\
	}\n\
}\n\
proc scale_lamps_update {} {\n\
	global scale_lamps\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
\n\
	set scale [tk7_get_scale $mo(patgroup) $mo(current_pattern)]\n\
	for {set i 0} {$i < 4} {incr i} {\n\
	    set button ${scale_lamps}.l${i}\n\
	    if {$i == $scale} {\n\
		$button configure -background $xox(lamp_on)\n\
	    } else {\n\
		$button configure -background $xox(lamp_off)\n\
	    }\n\
	}\n\
}\n\
proc locate_gridpos {x y result} {\n\
	global gridXs gridYs gridSvals gridIvals\n\
	upvar $result res\n\
\n\
	#puts \"locate_gridpos $x,$y\"\n\
	set halo 7\n\
\n\
	set resX -1\n\
	foreach i $gridXs {\n\
		if {($i > [expr $x - $halo]) && ($i < [expr $x + $halo])} {\n\
			set resX $i\n\
			break\n\
		}\n\
	}\n\
	if {$resX < 0} {\n\
		return $resX\n\
	}\n\
	#puts \"resX = $resX\"\n\
\n\
	set resY -1\n\
	foreach i $gridYs {\n\
		if {($i > [expr $y - $halo]) && ($i < [expr $y + $halo])} {\n\
			set resY $i\n\
			break\n\
		}\n\
	}\n\
	if {$resY < 0} {\n\
		return $resY\n\
	}\n\
#puts \"resY = $resY\"\n\
\n\
	set res(step) $gridSvals($resX)\n\
	set res(inst) $gridIvals($resY)\n\
\n\
	return 0\n\
}\n\
\n\
proc play_loop {} {\n\
	upvar #0 mode mo\n\
	upvar #0 tkxox xox\n\
	upvar #0 track_list tl\n\
	global button_stop	;# to invoke stop button\n\
	if {$mo(stopgo) == $xox(START) && $mo(patr) == $xox(TRACK) && $mo(rdrw) == $xox(READ)} {\n\
	\n\
		# Playing a track\n\
		if {$mo(TRACK_START)} {\n\
			set xox(play_list) $tl($mo(current_track))\n\
\n\
			# Prepare to display pattern contents\n\
			set mo(measure) -1\n\
\n\
			set mo(TRACK_START) 0\n\
		}\n\
\n\
		if {[llength $xox(play_list)] > 0} {\n\
			set target  [lindex $xox(play_list) 0]\n\
			set group [expr $target / 16]\n\
			set pat [expr $target % 16]\n\
			set xox(play_list) [lreplace $xox(play_list) 0 0]\n\
\n\
			# Prepare to display pattern contents\n\
			set target  [expr $mo(measure) + 1]\n\
			set mo(measure) [measure_constrain $target]\n\
		} else {\n\
			$button_stop invoke\n\
		}\n\
\n\
		if {$mo(PATTERN_REPEAT)} {\n\
			play_pattern $group $pat\n\
		}\n\
\n\
		# Update pattern display\n\
		pattern_show\n\
\n\
	} else { # Not playing a track\n\
\n\
		if {$mo(PATTERN_REPEAT)} {\n\
			play_pattern $mo(patgroup) $mo(current_pattern)\n\
		}\n\
	}\n\
	after $mo(REPEAT_INTERVAL) play_loop\n\
}\n\
# ----------------------------------------------------------------------------\n\
# Edit Pattern Comment\n\
# ----------------------------------------------------------------------------\n\
\n\
proc get_current_pattern_name {} {\n\
    upvar #0 mode mo\n\
    switch $mo(patgroup) {\n\
	0 { set g \"A\"; }\n\
	1 { set g \"B\"; }\n\
	2 { set g \"C\"; }\n\
	3 { set g \"D\"; }\n\
    }\n\
    set name \"$g[expr $mo(current_pattern)+1]\";\n\
    return $name;\n\
}\n\
set comment .pattern_comment;\n\
\n\
proc  refresh_comment {} {\n\
    upvar #0 mode mo\n\
    global comment;\n\
    if {[winfo exists $comment]} {\n\
    	set name [get_current_pattern_name];\n\
    	wm title $comment \"$name pattern comment\"\n\
        set old_comment [$comment.string get]\n\
        $comment.string delete 0 [expr [string length $old_comment] ]\n\
        set current_comment [tk7_get_pattern_comment $mo(patgroup) $mo(current_pattern)]\n\
        $comment.string insert 0 \"$current_comment\"\n\
    }\n\
}\n\
proc edit_pattern_comment {} {\n\
    upvar #0 mode mo\n\
    upvar #0 tkxox xox\n\
    global comment\n\
\n\
    if {[winfo exists $comment]} {\n\
	wm deiconify $comment\n\
    } else {\n\
	toplevel $comment\n\
\n\
	button $comment.quit -text quit -command {wm iconify $comment}\n\
	button $comment.ok -text ok -command comment_ok\n\
	pack $comment.quit $comment.ok -side right\n\
\n\
	# label $comment.label -text Comment: -padx 0\n\
	entry $comment.string -width 20 -relief sunken\n\
	# pack $comment.label -side left\n\
	pack $comment.string -side left -fill x -expand true\n\
\n\
	bind $comment.string <Return> comment_ok\n\
	bind $comment.string <Control-c> {wm iconify $comment}\n\
	focus $comment.string \n\
    }\n\
    refresh_comment;\n\
}\n\
proc comment_ok {} {\n\
    upvar #0 mode mo;\n\
    global comment;\n\
    set stringval [$comment.string get];\n\
    set name [get_current_pattern_name];\n\
    puts \"set $name comment to \\\"$stringval\\\"\";\n\
    tk7_set_pattern_comment $mo(patgroup) $mo(current_pattern) $stringval;\n\
    # wm iconify $comment;\n\
}\n\
";