#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

#   Alana - A Turing Machine Simulator
#   Copyright (C) 2003 Markus Triska
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
#
#   You can contact me via triska@gmx.at


if {[info tclversion] < 8.3} {
	puts "This program requires Tcl >= 8.3. You have: [info tclversion]"
	exit
}

set version "1.0"
set windowtitle "Alana $version"
array set delta {}
array set final_states {}
# note that these special states use characters that are normally not usable
set undefined "<Undefined>"
set done "Done!"
set filename ""
set lastsaved "\n"
set current_state $undefined
# display 15 cells
set cell_min -7
set cell_max  7
set speed 3
set wantscancel 0
set running 0
set tapehead 0
set edit_cell 0
set blank "_"
set tape_content {}
set parsing_error 0
set gui 1
set undolist {}
set maxundo 64

# The tape is saved internally as a single list that extends only to the right.
# Logically, the tape can be accessed using indices  (-infinity ... +infinity).
# real_index must be used for conversion. In the internal list, numbered from
# [0 ... +infinity), odd-numbered indices are used for the left extent of the
# tape, even-numbered indices for the right extent.
# This has 2 advantages:
#   *) lappend can always be used, no need for more expensive (really?) linsert
#   *) indices remain constant, simplifying undo operations
# On the other hand, space may be wasted on TMs that only move to the right,
# and computing real_index wastes time. Then again, if efficiency was at
# premium, you would have to use a different language anyway.


proc real_index {pos} {
	set realpos [expr abs($pos) << 1]
	if {$pos < 0} {
		incr realpos -1
	}

	global tape_content blank
	# grow list on demand (quite a bit more than necessary at this time)
	if {$realpos >= [llength $tape_content]} {
		for {set i 0} {$i <= 20} {incr i} {
			lappend tape_content $blank $blank $blank $blank
		}
	}
	return $realpos
}

proc set_tape {pos char} {
	global tape_content
	set i [real_index $pos]
	set tape_content [lreplace $tape_content $i $i $char]
}

proc get_tape {pos} {
	global tape_content
	# don't change this to the combined form
	#    return [lindex $tape_content [real_index $pos]]
	# because the tape can be modified in [real_index]
	set i [real_index $pos]
	return [lindex $tape_content $i]
}


proc next_delta {} {
	global current_state delta tapehead
	set symbol [get_tape $tapehead]
	set index "$current_state-$symbol"
	if {[info exists delta($index)]} {
		return [split $delta($index)]
	} else {
		return -1
	}
}

proc next_state {{invoked "nokeyboard"}} {
	global tapehead current_state displaystate final_states done
	global undefined gui
	if {$current_state == $undefined} {
		# When invoked via Ctrl + e, we would risk some Tcl/Tk error
		# (because further Ctlr + e presses might be scheduled and will
		# interfere if we display the message box).
		if {$gui && $invoked == "nokeyboard"} {
			tk_messageBox -icon info -message "Current state: undefined.\nSelect a state and try again."
		} elseif {!$gui} {
			puts {State undefined. Define the starting state via [<state>]}
		}
		return 0
	} elseif {$current_state == $done} {
		# same as above
		if {$invoked == "nokeyboard"} {
			tk_messageBox -icon info -message "Computation finished.\nSelect a state to start again."
		}
		return 0
	}

	set next [next_delta]
	if {$next != -1} {
		if {$gui} {
			global undolist maxundo
			set char [get_tape $tapehead]
			lappend undolist [list $tapehead $current_state $char]
			if {[llength $undolist] > $maxundo} {
				set undolist [lreplace $undolist 0 0]
			}
		}
		set newstate [lindex $next 0]
		set_state $newstate
		set_tape $tapehead [lindex $next 1]
		shift_head [lindex $next 2]
	} else {
		if {[info exists final_states($current_state)]} {
			set_state $done
			return 0
		}

		set_state $undefined
		return 0
	}
	return 1
}

proc display_next_state {} {
	global displaynext undefined final_states current_state done
	if {$current_state == $done} {
		$displaynext configure -text $done
		return
	}

	set next [next_delta]
	if {$next == -1} {
		if {[info exists final_states($current_state)]} {
			$displaynext configure -text $done
		} else {
			$displaynext configure -text $undefined
		}
	} else {
		$displaynext configure -text "[lindex $next 0]  [lindex $next 1]  [lindex $next 2]"
	}
}

proc set_state {state} {
	global current_state displaystate gui
	set current_state $state
	if {$gui} {
		$displaystate configure -text $state
		display_next_state
	}
}

proc set_tape_content {newtapecontent} {
	global tape_content
	set tape_content {}
	set pos 0
	foreach char $newtapecontent {
		set_tape $pos $char
		incr pos
	}
}

set last_parsed ""
proc parse_instructions {instructions {initial_load 0}} {
	global delta parsing_error final_states statemenu tapehead
	global undefined current_state statuslabel tape_content gui
	global last_parsed
	regsub -all {#.*?\n} $instructions "" instructions
	regsub -all {[\r\t\n]} $instructions " " instructions
	# add space around parentheses, brackets and curly braces to get them
	# treated as separate tokens by [split]
	regsub -all {\(} $instructions { ( } instructions
	regsub -all {\)} $instructions { ) } instructions
	regsub -all {\[} $instructions { [ } instructions
	regsub -all {\]} $instructions { ] } instructions
	regsub -all {\{} $instructions " { " instructions
	regsub -all {\}} $instructions " } " instructions

	regsub -all {\s+} $instructions " " instructions
	set instructions [string trim $instructions]
	# puts "new: $instructions"
	if {!$initial_load && [string equal $instructions $last_parsed]} {
		return
	}
	set last_parsed $instructions

	set instlist [split $instructions]
	# parsing loop - extract delta instructions etc.

	array unset delta
	array unset final_states
	set start_state -1
	set allstates {}
	set newtapecontent {}

	set err_nobrac 1
	set err_wrongdelta 2
	set err_wrongchar 3

	if {$gui} {
		$statemenu delete 0 end
	}

	set parsing_error 0
	set toknumber 0
	set token ""
	while { [llength $instlist] > 0 } {
		# puts "Parsing: $instructions"
		set token [lindex $instlist 0]
		set instlist [lreplace $instlist 0 0]
		if {$token == ""} { continue }
		incr toknumber
		# puts "Parsing $token"

		if {$token == "("} {
			# begin of delta - could be of the form
			# (1 x 2 y R), (1 x 2 R) or (1 x R)
			# assume (1 x 2 r)
			set state [lindex $instlist 0]
			set char [lindex $instlist 1]
			set replacechar $char
			set newstate [lindex $instlist 2]
			set leftright [lindex $instlist 3]
			if {[lindex $instlist 5] == ")"} {
				set replacechar [lindex $instlist 3]
				set leftright [lindex $instlist 4]
				set instlist [lreplace $instlist 0 5]
			} elseif {[lindex $instlist 4] == ")"} {
				set instlist [lreplace $instlist 0 4]
			} elseif {[lindex $instlist 3] == ")"} {
				set newstate $state
				set leftright [lindex $instlist 2]
				set instlist [lreplace $instlist 0 3]
			} else {
				set parsing_error $err_wrongdelta
				break
			}
			set leftright [string toupper $leftright]
			if { $leftright != "R" && $leftright != "L" } {
				set parsing_error $err_wrongdelta
				break
			}

			lappend allstates $state
			lappend allstates $newstate

			set delta($state-$char) "$newstate $replacechar $leftright"
			# puts "$state $char $newstate $replacechar $leftright"
		} elseif {$token == "\["} {
			if {[lindex $instlist 0] == "\]"} {
				set instlist [lreplace $instlist 0 0]
				continue
			}
			if {[lindex $instlist 1] != "\]"} {
				set parsing_error $err_nobrac
				break
			}
			set start_state [lindex $instlist 0]
			lappend allstates $start_state
			set instlist [lreplace $instlist 0 1]
		} elseif {$token == "\{"} {
			array unset final_states
			while {[lindex $instlist 0] != "\}"} {
				if {[llength $instlist] == 0} {
					set parsing_error $err_nobrac
					break
				}

				set newfinal [lindex $instlist 0]
				set final_states($newfinal) 1
				lappend allstates $newfinal

				set instlist [lreplace $instlist 0 0]
			}
			set instlist [lreplace $instlist 0 0]
		} else {
			global blank
			if {$token != $blank} {
				lappend newtapecontent $token
			}
		}
	}

	set sortopt "-integer"
	set wrongchar ""
	foreach state $allstates {
		if {[regexp {^[0-9]+$} $state] == 0} {
			set sortopt "-ascii"
		}
		if {[regexp {^[0-9a-zA-Z_-]+$} $state] == 0} {
			regexp {[^0-9a-zA-Z]+$} $state wrongchar
			set parsing_error $err_wrongchar
			break
		}
	}

	set allstates [lsort $sortopt -unique $allstates]

	if {$parsing_error != 0} {
		set errmessage ""
		if {$parsing_error == $err_nobrac} {
			set whatmissing "parenthesis"
			if {$token == "\["} {
				set whatmissing "bracket"
			} elseif {$token == "\{"} {
				set whatmissing "curly brace"
			}
			set errmessage "Missing closing $whatmissing at entity $toknumber"
		} elseif {$parsing_error == $err_wrongdelta} {
			set errmessage "Invalid delta instruction at entity $toknumber"
		} elseif {$parsing_error == $err_wrongchar} {
			set errmessage "Invalid symbol in state identifier: $wrongchar"
		}
		array unset delta
		array unset final_states

		if {$gui} {
			$statuslabel configure -text $errmessage
			display_next_state
		} else {
			puts $errmessage
		}
		return
	} else {
		if {$gui} {
			$statuslabel configure -text "Valid"
			foreach state $allstates {
				$statemenu add command -label $state -command "set_state $state"
			}
		}
	}

	if {$initial_load} {
		set tapehead 0
		global undolist
		set undolist {}
		set_tape_content $newtapecontent
		if {$gui} {
			update_cells
		}
		if {$start_state != -1} {
			set_state $start_state
		}
	}

	if {$gui} {
		display_next_state
	}
}

proc select_cell {cellnum} {
	global edit_cell
	set edit_cell $cellnum
	focus .wait_for_content
}

proc change_cell_content {cell content} {
	if {[regexp {[\t\n\r]} $content] != 0} { return }
	if {$content == " " || $content == ""} { set content "_" }

	global tapehead gui
	set_tape [expr $tapehead + $cell] $content

	if {$gui} {
		.tape.cell$cell configure -text $content
		display_next_state
	}
}

proc update_cells {} {
	global cell_min cell_max tapehead
	for {set i $cell_min} {$i <= $cell_max } {incr i} {
		.tape.cell$i configure -text [get_tape [expr $tapehead + $i]]
	}
}

proc shift_head {param} {
	global gui tapehead
	if { $param == "L" } {
		incr tapehead -1
	} else {
		incr tapehead
	}
	if {$gui} {
		global edit_cell
		set edit_cell 0
		update_cells
		display_next_state
	}
}

proc set_window_title {} {
	global gui windowtitle filename
	if {$gui} {
		if {$filename == ""} {
			wm title . $windowtitle
		} else {
			wm title . "$windowtitle - $filename"
		}
	}
}

proc save_file {{choose 0}} {
	global filename lastsaved deltaentry
	if {$filename == "" || $choose} {
		set filename [tk_getSaveFile]
		if {$filename == ""} { return -1 }
		set_window_title
	}
	set cmd {
		set fid [open $filename w]
		set content [$deltaentry get 1.0 end]
		puts -nonewline $fid $content
		close $fid
		set lastsaved $content
	}

	if {[catch $cmd err] != 0} {
		tk_messageBox -icon error -message "Could not write to $filename."
		return -1
	}
	return 0
}

proc needs_save {} {
	global lastsaved deltaentry
	set content [$deltaentry get 1.0 end]
	if {[string equal $content $lastsaved]} {
		return 0
	}
	return 1
}

proc ask_save {title} {
	set response [tk_messageBox -icon question -type yesnocancel -title $title -message "File modified. Do you want to save your changes?"]
	return $response
}

proc new_file {} {
	global filename lastsaved deltaentry
	if {[needs_save]} {
		set response [ask_save "New"]
		if {$response == "yes"} {
			save_file
		} elseif {$response == "cancel"} {
			return
		}
	}
	set filename ""
	set_window_title
	set lastsaved "\n"
	$deltaentry delete 1.0 end
	parse_instructions "" 1
}

proc do_load {file} {
	global gui filename lastsaved deltaentry

	set cmd {
		set fid [open $file r]
		set content [read -nonewline $fid]
		close $fid
	}

	if {![file exists $file] || ![file readable $file]} {
		set msg "The file $file is not readable or does not exist."
		if {$gui} {
			tk_messageBox -icon error -message $msg
		} else {
			puts $msg
		}
		return 0
	}

	if {[catch $cmd err] != 0} {
		set msg "Could not read from $file."
		if {$gui} {
			tk_messageBox -icon error -message $msg
		} else {
			puts $msg
		}
		return 0
	} else {
		set filename $file
		set_window_title
		if {$gui} {
			$deltaentry delete 1.0 end
			$deltaentry insert 1.0 $content
		}
		set lastsaved "$content\n"
		parse_instructions $lastsaved 1
	}
	return 1
}

proc open_file {} {
	if {[needs_save]} {
		set response [ask_save "Open"]
		if {$response == "cancel"} {
			return
		} elseif {$response == "yes"} {
			save_file
		}
	}
	set file [tk_getOpenFile]
	if {$file == ""} { return }
	do_load $file
}

proc center_window {win} {
	set x [expr {[winfo rootx .] + [winfo reqwidth .]/2 \
		- [winfo reqwidth $win]/2}]
	set y [expr {[winfo rooty .] + [winfo reqheight .]/2 \
		- [winfo reqheight $win]/2}]
	wm geometry $win "+$x+$y"
}


proc set_geometry {win} {
	wm withdraw $win
	update idletasks
	center_window $win
	wm deiconify $win
	wm minsize $win [winfo reqwidth $win] [winfo reqheight $win]
}

proc transient_window {win title} {
	if {[winfo exists $win]} {
		center_window $win
		return ""
	}
	toplevel $win
	wm title $win $title
	wm transient $win .
	return $win
}

proc aboutscreen {} {
	set aboutwin [transient_window .aboutwin "About Alana"]
	if {$aboutwin == ""} { return }
	label $aboutwin.copyright -text \
		"Alana - A Turing Machine Simulator\n\
		http://triskam.virtualave.net/alana/alana.html\n\n\
		Alana comes with ABSOLUTELY NO WARRANTY. This is\n\
		free software, and you are welcome to distribute\n\
		it under certain conditions. Read the file COPYING\n\
		for more information.\n\n\
		Copyright (C) 2003 Markus Triska triska@gmx.at"
	button $aboutwin.ok -text "OK" -command { destroy .aboutwin }
	pack $aboutwin.copyright -pady 10 -padx 20
	pack $aboutwin.ok -pady 4
	set_geometry $aboutwin
	focus $aboutwin.ok
}

proc helpscreen {} {
	set helpwin [transient_window .helpwin "Help for Alana"]
	if {$helpwin == ""} { return }
	label $helpwin.copyright -text \
		"Syntax (informally): \n\n\
		(1 x 2 y R)\n If you are in state 1 and you see\n\
			an 'x', switch to state 2, write an 'y'\n\
			and shift the tape head to the\n\
			right. Specify (1 x 2 y L) to shift the\n\
			tape head to the left.\n\n\
		(4 7 3 R)\n If you are in state 4 and you see\n\
			a '7', switch to state 3 and shift the\n\
			tape head to the right.\n\n\
		(50 m L)\n If you are in state 50 and you see\n\
			an 'm', shift the tape head to the\n\
			left.\n\n\n\
		{42 3 20}\n States 42, 3 and 20 are final states.\n\n"
	button $helpwin.ok -text "OK" -command { destroy .helpwin }
	pack $helpwin.copyright -pady 10 -padx 20
	pack $helpwin.ok -pady 4
	set_geometry $helpwin
	focus .helpwin.ok
}

proc elaborate_cell_edit { cell } {
	global celleditbutton blank
	set t [transient_window .celledit "Edit cell"]
	if {$t == ""} { return }

	wm protocol $t WM_DELETE_WINDOW { }

	set f1 [frame $t.f1]
	label $f1.lab -text "Cell content: "
	pack $f1.lab -side left -padx 5 -pady 5
	entry $f1.ent
	set content [.tape.cell$cell cget -text]
	if {$content == $blank} {
		set content ""
	}
	$f1.ent insert 0 $content
	pack $f1.ent -side left -padx 5 -pady 5
	pack $f1 -padx 5 -pady 5

	set celleditbutton ""
	set f2 [frame $t.f2]
	button $f2.ok -text "  OK  " -command { set celleditbutton 1 }
	pack $f2.ok -side left -padx 5 -pady 5
	button $f2.cancel -text " Cancel " -command { set celleditbutton 0 }
	pack $f2.cancel -side left -padx 5 -pady 5
	pack $f2 -padx 5 -pady 5

	bind $f1.ent <KeyPress-space> { break }
	bind $f1.ent <KeyPress-Return> "$f2.ok invoke"

	set_geometry $t
	focus $f1.ent
	tkwait variable celleditbutton
	if { $celleditbutton == 1 } {
		change_cell_content $cell [$f1.ent get]
	}
	destroy $t
}

proc rightmost_nonblank_index {} {
	global tape_content blank
	set rightmost [expr ([llength $tape_content]/2) + 1]
	set min [expr -([llength $tape_content]/2) - 1]
	while {$rightmost >= $min && [get_tape $rightmost] == $blank} {
		incr rightmost -1
	}
	return $rightmost
}

proc leftmost_nonblank_index {} {
	global tape_content blank
	set leftmost [expr -([llength $tape_content] / 2) - 1]
	set max [expr ([llength $tape_content] / 2) + 1]
	while {$leftmost <= $max && [get_tape $leftmost] == $blank} {
		incr leftmost
	}
	return $leftmost
}

proc show_tape_content {} {
	set t [transient_window .tapecontent "Tape content"]
	if {$t == ""} { return }
	wm protocol $t WM_DELETE_WINDOW { }

	set f1 [frame $t.f1]
	label $f1.lab -text "Tape content: "
	pack $f1.lab -side left -padx 5 -pady 5
	entry $f1.ent -width 50
	set start [leftmost_nonblank_index]
	set end [rightmost_nonblank_index]
	for {set i $start} {$i <= $end} {incr i} {
		$f1.ent insert end [get_tape $i]
		if {$i < $end} { $f1.ent insert end " " }
	}
	pack $f1.ent -side left -padx 5 -pady 5
	pack $f1 -padx 5 -pady 5

	global showtapebutton
	set showtapebutton ""
	set f2 [frame $t.f2]
	button $f2.ok -text "  OK  " -command { set showtapebutton 1 }
	pack $f2.ok -side left -padx 5 -pady 5
	button $f2.cancel -text " Cancel " -command { set showtapebutton 0 }
	pack $f2.cancel -side left -padx 5 -pady 5
	pack $f2 -padx 5 -pady 5

	bind $f1.ent <KeyPress-Return> "$f2.ok invoke"
	bind $f1.ent <KeyPress-Escape> "$f2.cancel invoke"

	set_geometry $t
	focus $f1.ent
	tkwait variable showtapebutton
	if { $showtapebutton == 1 } {
		set new_content [$f1.ent get]
		regsub -all {\s+} $new_content " " new_content
		set new_content [string trim $new_content]
		set i $start
		global tapehead
		if {$start > $end} { set i $tapehead }
		foreach char [split $new_content] {
			set_tape $i $char
			incr i
		}
		global blank
		while {$i <= $end} {
			set_tape $i $blank
			incr i
		}
		update_cells
	}
	destroy $t
}

proc reparse {} {
	global deltaentry
	parse_instructions [$deltaentry get 1.0 end] 1
}

proc exit_yesno {} {
	if {[needs_save]} {
		set response [ask_save "Exit"]
		if {$response == "cancel"} {
			return
		} elseif {$response == "yes"} {
			if {[save_file] == -1} {
				return
			}
		}
		exit
	} else {
		set response [tk_messageBox -icon question -type yesno -title "Exit" -message "Really exit Alana?"]
		if {$response} { exit }
	}
}

proc stop {} {
	global wantscancel runbutton running deltaentry
	$runbutton configure -text "  Run  "
	set wantscancel 0
	set running 0
}

proc run {} {
	global wantscancel runbutton running speed deltaentry
	if {!$running} { break }
	if {$wantscancel} {
		stop
	} else {
		if {[next_state]} {
			set time [expr 2000 / ($speed * $speed)]
			after $time run
		} else {
			stop
		}
		update idletasks
	}
}

proc runstop {} {
	global runbutton running wantscancel deltaentry
	if {$running} {
		set wantscancel 1
	} else {
		$runbutton configure -text "  Stop  "
		set running 1
		run
	}
}

proc undo_last {{invoked "nokeyboard"}} {
	global undolist
	if {[llength $undolist] == 0} {
		# displaying a message box when invoked via shortcut would
		# risk a Tcl/Tk error when multiple key presses are scheduled
		if {$invoked == "nokeyboard"} {
			tk_messageBox -icon info -message "Nothing left to undo."
		}
		return
	}
	set undotrans [lindex $undolist end]
	set undolist [lreplace $undolist end end]

	# move tape head to position of most recent change
	global tapehead
	set dir "L"
	set pos [lindex $undotrans 0]
	if {$pos > $tapehead} {
		set dir "R"
	}
	while {$pos != $tapehead} {
		shift_head $dir
	}

	set_tape $tapehead [lindex $undotrans 2]
	update_cells
	set_state [lindex $undotrans 1]
}


# execution entry point

if {$argc > 0 && [lsearch $argv "-nogui"] != -1} {
	if {$argc == 1} {
		puts "Console mode specified, but no file given. Use\nalana <file> -nogui"
		exit
	}

	set gui 0
	set file [lindex $argv 0]
	if {![do_load $file]} {
		exit
	}
	if {$parsing_error != 0} {
		exit
	}

	set tapeindex [lsearch $argv "-tape"]
	if {$tapeindex != -1} {
		incr tapeindex
		if {$tapeindex >= $argc} {
			puts "Error: -tape specified, but no tape content given."
			exit
		}

		set newtapecontent [lindex $argv $tapeindex]
		regsub -all {\s+} $newtapecontent " " newtapecontent
		set_tape_content [split [string trim $newtapecontent]]
	}


	set everynsteps 5000
	set verbose 0
	set verboseindex [lsearch $argv "-verbose"]
	if {$verboseindex != -1} {
		set verbose 1
		set stepsindex [expr $verboseindex + 1]
		if {$stepsindex < $argc} {
			set trysteps [lindex $argv $stepsindex]
			if {[regexp {^[0-9]+$} $trysteps] == 0} {
				# could be another option
				if {[regexp {^-[a-zA-Z]*$} $trysteps] == 0} {
					puts "Illegal number: $trysteps. Using default ($everynsteps)."
				}
			} else {
				set everynsteps $trysteps
			}
		}
	}

	set numsteps 0
	while {[next_state]} {
		incr numsteps
		if {$verbose && fmod($numsteps,$everynsteps) == 0} {
			puts "Steps: $numsteps"
		}
	}

	if {$current_state == $undefined} {
		puts "State: $undefined. Machine halted."
	} elseif {$current_state == $done} {
		puts "State: Done! Input accepted."
	}

	puts "Transitions: $numsteps"
	set start [leftmost_nonblank_index]
	set end   [rightmost_nonblank_index]
	if {$start <= $end} {
		puts "Tape content:"
		for {set i $start} {$i <= $end} {incr i} {
			puts -nonewline "[get_tape $i] "
		}
		puts ""
		set thi [expr $tapehead - $start]
		puts "Tape head at index: $thi (starting at 0)"
	} else {
		puts "Tape: all blank."
	}
	exit
}

frame .wait_for_content
place .wait_for_content -x -2 -y -2
bind .wait_for_content <KeyPress> { change_cell_content $edit_cell %A }
bind .wait_for_content <KeyPress-Delete> { change_cell_content $edit_cell ""}
bind .wait_for_content <KeyPress-BackSpace> { change_cell_content $edit_cell ""}
bind .wait_for_content <KeyPress-Right> { shift_head R }
bind .wait_for_content <KeyPress-Left>  { shift_head L }
bind .wait_for_content <KeyPress-Control_L> { break }
bind .wait_for_content <KeyPress-Control_R> { break }

frame .themenu
menubutton .themenu.file -text "File" -menu .themenu.file.m
set m [menu .themenu.file.m]
$m add command -label "New" -command new_file
$m add command -label "Open..." -command open_file
$m add command -label "Save" -command save_file
$m add command -label "Save as..." -command "save_file 1"
$m add command -label "Tape content..." -command show_tape_content
$m add command -label "Reparse" -command reparse
$m add command -label "Undo" -command undo_last
$m add separator
$m add command -label Exit -command exit_yesno

menubutton .themenu.help -text "Help" -menu .themenu.help.m
set m [menu .themenu.help.m]
$m add command -label "Help..." -command helpscreen
$m add separator
$m add command -label "About..." -command aboutscreen
pack .themenu.file -side left -padx 5 -pady 5
pack .themenu.help -side right -padx 5 -pady 5
pack .themenu -fill x

frame .tape

for {set i $cell_min} {$i <= $cell_max} {incr i} {
	button .tape.cell$i -text $blank -command "select_cell $i" -relief raised
	bind .tape.cell$i <Control-Button-1> "elaborate_cell_edit $i; break"
	bind .tape.cell$i <Double-Button-1> "elaborate_cell_edit $i; break"
	pack .tape.cell$i -side left
}

.tape.cell$tapehead configure -relief groove

frame .headcontrol
button .headcontrol.headleft -text "  <<  " -command "shift_head L"
pack .headcontrol.headleft -side left
button .headcontrol.headright  -text "  >>  " -command "shift_head R"
pack .headcontrol.headright -side right

pack .headcontrol
pack .tape


set f [frame .delta]
set deltaentry [text $f.deltaentry -height 10 -width 79 -yscrollcommand "$f.ysbar set"]
bind $deltaentry <KeyPress> { if {$running} { break } }
bind $deltaentry <KeyRelease> {
	if {$running} { break }
	parse_instructions [$deltaentry get 1.0 end]
}
bind $deltaentry <Control-c> { tk_textCopy $deltaentry; break }
bind $deltaentry <Control-e> { next_state keyboard; break }
bind $deltaentry <Control-n> { new_file; break }
bind $deltaentry <Control-r> { reparse; break }
bind $deltaentry <Control-s> { save_file; break }
bind $deltaentry <Control-t> { show_tape_content; break }
bind $deltaentry <Control-u> { undo_last keyboard; break }
bind $deltaentry <Control-v> { tk_textPaste $deltaentry; break }
bind $deltaentry <Control-x> { tk_textCut $deltaentry; break }
bind $deltaentry <Alt-x>     { exit_yesno; break }
scrollbar $f.ysbar -orient vertical -command {$deltaentry yview}
grid $deltaentry $f.ysbar -sticky nsew
grid columnconfigure $f 0 -weight 1
grid rowconfigure    $f 0 -weight 1
pack $f -fill both -expand yes -padx 10 -pady 5

set f [frame .status]
pack [label $f.statuslabel -text "Input: "] -side left
set statuslabel [label $f.status -text "Valid"]
pack $statuslabel -side left
pack $f -padx 5 -pady 5

set f [frame .stateinfo]
set f1 [frame $f.left]
pack [label $f1.currentstatel -text "Current state: "] -side left
set displaystate [menubutton $f1.currentstate -menu $f1.currentstate.menu -width 25 -text "$undefined" -relief raised]
set statemenu [menu $f1.currentstate.menu]
pack $f1.currentstate -side left -padx 5 -pady 5
bind $f1.currentstate <Button-1> {
	if {$parsing_error != 0} {
		tk_messageBox -icon error -message "There is a syntax error in your instructions. Please correct it first."
		break
	}
	if {[.stateinfo.left.currentstate.menu index last] == 0} {
		tk_messageBox -icon info -message "No state is currently defined via a delta instruction.\nPlease enter your instructions first and then choose a state\nfrom this list."
		break
	}
}
pack $f1 -side left -padx 5 -pady 5 -expand yes -fill both

set f2 [frame $f.right]
set displaynext [label $f2.next -text $undefined -width 25]
pack $displaynext -side right -padx 5 -pady 5
pack [label $f2.nextlabel -text "Next: "] -side right -padx 5 -pady 5
pack $f2 -side right -padx 5 -pady 5 -expand yes -fill both
pack $f -fill both

set f [frame .steprun]
set stepbutton [button $f.step -text "Step" -command next_state]
pack $stepbutton -side left -padx 5 -pady 5 -expand yes
set runbutton [button $f.run -text " Run " -command "runstop"]
pack $runbutton -side left -padx 5 -pady 5 -expand yes
pack [label $f.speedl -text "Speed: "] -side left -padx 5 -pady 5
scale $f.speed -from 1 -to 10 -orient horizontal -variable speed -showvalue 0
pack $f.speed -side left -padx 5 -pady 5
pack $f

wm title . $windowtitle
wm protocol . WM_DELETE_WINDOW { exit_yesno }

set win .
wm withdraw $win
update idletasks
set x [expr {[winfo screenwidth $win]/2 - [winfo reqwidth $win]/2}]
set y [expr {[winfo screenheight $win]/2 - [winfo reqheight $win]/2}]
wm geometry $win "+$x+$y"
wm deiconify $win
wm minsize $win [winfo reqwidth $win] [winfo reqheight $win]


if {$argc > 0} {
	do_load [lindex $argv 0]
}
focus $deltaentry