frodo-wii/Src/Frodo_GUI.tcl

#!/usr/bin/wish

# Frodo Tk GUI by Lutz Vieweg <lkv@mania.robin.de>
# requires Tk >= 4.1
#
# Frodo (C) 1994-1997,2002-2005 Christian Bauer
#
# 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-1307  USA

#package require Tk 4.1

set prefname "$env(HOME)/.frodorc"

proc defaults {} {
	global pref
	set pref(NormalCycles) "63"
	set pref(BadLineCycles) "23"
	set pref(CIACycles) "63"
	set pref(FloppyCycles) "64"
	set pref(SkipFrames) "4"
	set pref(DriveType8) "DIR"
	set pref(DrivePath8) "./64prgs"
	set pref(DriveType9) "D64"
	set pref(DrivePath9) "./disk1.d64"
	set pref(DriveType10) "DIR"
	set pref(DrivePath10) ""
	set pref(DriveType11) "DIR"
	set pref(DrivePath11) ""
	set pref(SIDType) "NONE"
	set pref(SpritesOn) "TRUE"
	set pref(SpriteCollisions) "TRUE"
	set pref(Joystick1On) "FALSE"
	set pref(Joystick2On) "TRUE"
	set pref(JoystickSwap) "FALSE"
	set pref(LimitSpeed) "FALSE"
	set pref(FastReset) "FALSE"
	set pref(CIAIRQHack) "FALSE"
	set pref(MapSlash) "TRUE"
	set pref(Emul1541Proc) "FALSE"
	set pref(ShowOptions) "FALSE"
	set pref(SIDFilters) "TRUE"
}

proc s2bool { s } {
	if {$s == "TRUE"} {return 1}
	return 0
}

defaults

if {![catch { set in [open $prefname] }]} {
	while {![eof $in]} {
		set line [gets $in]
		if [regexp {^([^ ]*)[ ]*=[ ]*([^ ]*)$} $line range name val] {
			switch -exact $name {
				"NormalCycles" {
					set pref(NormalCycles) $val
				}
				"BadLineCycles" {
					set pref(BadLineCycles) $val
				}
				"CIACycles" {
					set pref(CIACycles) $val
				}
				"FloppyCycles" {
					set pref(FloppyCycles) $val
				}
				"SkipFrames" {
					set pref(SkipFrames) $val
				}  
				"DriveType8" {
					set pref(DriveType8) $val
				}
				"DrivePath8" {
					set pref(DrivePath8) $val
				}
				"DriveType9" {
					set pref(DriveType9) $val
				}  
				"DrivePath9" {
					set pref(DrivePath9) $val
				}
				"DriveType10" {
					set pref(DriveType10) $val
				} 
				"DrivePath10" {
					set pref(DrivePath10) $val
				}
				"DriveType11" {
					set pref(DriveType11) $val
				} 
				"DrivePath11" {
					set pref(DrivePath11) $val
				}
				"SIDType" {
					set pref(SIDType) $val
				}
				"SpritesOn" {
					set pref(SpritesOn) [s2bool $val]
				}
				"SpriteCollisions" {
					set pref(SpriteCollisions) [s2bool $val]
				}
				"Joystick1On" {
					set pref(Joystick1On) [s2bool $val]
				}
				"Joystick2On" {
					set pref(Joystick2On) [s2bool $val]
				}
				"JoystickSwap" {
					set pref(JoystickSwap) [s2bool $val]
				}
				"LimitSpeed" {
					set pref(LimitSpeed) [s2bool $val]
				}
				"FastReset" {
					set pref(FastReset) [s2bool $val]
				}
				"CIAIRQHack" {
					set pref(CIAIRQHack) [s2bool $val]
				}
				"MapSlash" {
					set pref(MapSlash) [s2bool $val]
				}
				"Emul1541Proc" {
					set pref(Emul1541Proc) [s2bool $val]
				}
				"ShowOptions" {
					set pref(ShowOptions) [s2bool $val]
				}
				"SIDFilters" {
					set pref(SIDFilters) [s2bool $val]
				}
			}
		}	
	}
}

proc bool2s { b } {
	if {$b} { return "TRUE" }
	return "FALSE" 
}

proc WritePrefs { } {
	global pref prefname
	
	if [catch { set out [open "$prefname" "w"] }] {
		puts stderr "unable to write preferences file '$prefname'"
	} else {
		puts $out "NormalCycles = $pref(NormalCycles)"
		puts $out "BadLineCycles = $pref(BadLineCycles)"
		puts $out "CIACycles = $pref(CIACycles)"
		puts $out "FloppyCycles = $pref(FloppyCycles)"
		puts $out "SkipFrames = $pref(SkipFrames)"
		puts $out "DriveType8 = $pref(DriveType8)"
		puts $out "DrivePath8 = $pref(DrivePath8)"
		puts $out "DriveType9 = $pref(DriveType9)"
		puts $out "DrivePath9 = $pref(DrivePath9)"
		puts $out "DriveType10 = $pref(DriveType10)"
		puts $out "DrivePath10 = $pref(DrivePath10)"
		puts $out "DriveType11 = $pref(DriveType11)"
		puts $out "DrivePath11 = $pref(DrivePath11)"
		puts $out "SIDType = $pref(SIDType)"
		puts $out "SpritesOn = [bool2s $pref(SpritesOn)]"
		puts $out "SpriteCollisions = [bool2s $pref(SpriteCollisions)]"
		puts $out "Joystick1On = [bool2s $pref(Joystick1On)]"
		puts $out "Joystick2On = [bool2s $pref(Joystick2On)]"
		puts $out "JoystickSwap = [bool2s $pref(JoystickSwap)]"
		puts $out "LimitSpeed = [bool2s $pref(LimitSpeed)]"
		puts $out "FastReset = [bool2s $pref(FastReset)]"
		puts $out "CIAIRQHack = [bool2s $pref(CIAIRQHack)]"
		puts $out "MapSlash = [bool2s $pref(MapSlash)]"
		puts $out "Emul1541Proc = [bool2s $pref(Emul1541Proc)]"
		puts $out "ShowOptions = [bool2s $pref(ShowOptions)]"
		puts $out "SIDFilters = [bool2s $pref(SIDFilters)]"
		
		close $out
		
		puts -nonewline "p"
		flush stdout
	}	
}

proc Quit {} {
	puts -nonewline "q"
	flush stdout
	exit 0
}

# =============================================================

frame .cmds
pack .cmds -expand false -fill both

button .cmds.quit -text "Quit" -command "Quit"
pack .cmds.quit -side left -expand true -fill both

button .cmds.reset -text "Reset" -command {puts -nonewline "r" ; flush stdout}
pack .cmds.reset -side left -expand true -fill both

# =============================================================

proc Change { {dummy1 ""} {dummy2 ""}} {
	WritePrefs
}

#====================== begin of fs-box ========================

proc check_file_type {filename var} {
  global pref
  switch [file extension $filename] {
     .d64 - .x64 { set $var D64; Change }
     .lnx - .t64 { set $var T64; Change }
  }
}

proc fs_FileSelect {w {title {FileSelector}} {filter {*}} {name {}} typevar} {
	global fs_priv

	if {[info commands tk_getOpenFile] != ""} {
	   switch $filter {
	      "*.{t64,lnx}" {
	         set types {
		    {{t64/lnx archive files} {.t64 .lnx}}
		    {{disk files} {.d64 .x64}}
		    {{all files} *}
		 }
	      }
	      "*.{d64,x64}" {
	         set types {
		    {{disk files} {.d64 .x64}}
		    {{t64/lnx archive files} {.t64 .lnx}}
		    {{all files} *}
		 }
	      }
	      default {
	         set types {
		    {{all files} *}
		    {{disk files} {.d64 .x64}}
		    {{t64/lnx archive files} {.t64 .lnx}}
		 }
	      }
	   }
	   if {[file isdir $name]} {
		set name $name
	   } else {
		set name "[file dirname $name]"
	   }
	   set fs_priv(result) [tk_getOpenFile -filetypes $types -initialdir  $name]
	   check_file_type $fs_priv(result) $typevar
	   return $fs_priv(result)
	}

	# remainder of the code is for pre-tk8.0

	if {$name != ""} {
		if {[file isdir $name]} {
			set filter "$name/$filter"
		} else {
			set filter "[file dirname $name]/$filter"
		}
	}

	set fs_priv(window) $w
	set fs_priv(filter) $filter
	set fs_priv(name) ""
	set fs_priv(result) ""
	 
	# if this window already exists, destroy it
	catch {destroy $w}

	# create new toplevel
	toplevel $w
	wm title $w $title

	# create frames	

	# create filter-entry
	frame $w.filter
	pack $w.filter -side top -fill x
	label $w.filter.lbl -text "Filter"
	pack $w.filter.lbl -side top -anchor w
	entry $w.filter.et -textvar fs_priv(filter)
	pack $w.filter.et -side top -fill x -expand true
	bind $w.filter.et <Return> { fs_newpath }
	button $w.filter.up -text "Up" -command {
	        set f [file dirname $fs_priv(filter)]
	        set t [file tail $fs_priv(filter)]
		if {$f == "."} {set f [pwd]}
		set f [file dirname $f]
		if {$f == "/"} {set f ""}
		set fs_priv(filter) "$f/$t"
		fs_newpath
	}
	pack $w.filter.up -side top -anchor w
	
	#create list-frames
	frame $w.l
	pack $w.l -side top -fill both -expand true
	frame $w.l.d
	pack $w.l.d -side left -fill both -expand true
	frame $w.l.f
	pack $w.l.f -side left -fill both -expand true
	
	fs_slist $w.l.d Directories single

	fs_slist $w.l.f Files single
	bind $w.l.f.top.lst <ButtonRelease-1> {
		focus %W
		global fs_priv
		set sel [%W curselection]
		if {$sel != ""} {
			set fs_priv(name) [%W get [%W curselection]]
		}
	}

	bind $w.l.f.top.lst <Double-Button-1> "$w.bts.ok flash; $w.bts.ok invoke"
	bind $w.l.d.top.lst <Double-Button-1> {
		global fs_priv
	        set f [file dirname $fs_priv(filter)]
	        set t [file tail $fs_priv(filter)]
		set d [%W get active]
		switch $d {
		   "." { }
		   ".." {
		      if {$f == "."} {set f [pwd]}
		      set fs_priv(filter) "[file dirname $f]/$t"
		   }
		   default { 
		      if {$f == "/"} {set f ""}
		      set fs_priv(filter) "$f/$d/$t"
		   }
		}
		fs_newpath
	}
	
	#create name-entry

	frame $w.name
	pack $w.name -side top -fill x
	label $w.name.lbl -text "Filename"
	pack $w.name.lbl -side top -anchor w
	entry $w.name.et -textvar fs_priv(name)
	pack $w.name.et -side top -fill x
	bind $w.name.et <FocusOut> {
		global fs_priv
		set fs_priv(filter) \
		    "[file dirname $fs_priv(name)]/*[file extension $fs_priv(filter)]"
		fs_newpath
	}
	bind $w.name.et <Return> {
		global fs_priv
		set n $fs_priv(name)
		
		if {[string index $n 0] != "/" && [string index $n 0] != "~"} {
			set n "[file dirname $fs_priv(filter)]/$n"
		}

		set n "[file dirname $n]/[file tail $n]"
		
		set fs_priv(result) $n
	}
	
	# create buttons
	frame $w.bts
	pack $w.bts -side top -fill x
	button $w.bts.ok -text "OK" -command {
		global fs_priv
	        set w $fs_priv(window)
		set sel [$w.l.f.top.lst curselection]
		if {$sel != ""} {
		   set val [$w.l.f.top.lst get $sel]
		   set fs_priv(result) "[file dirname $fs_priv(filter)]/$val"
		}
	}
	pack $w.bts.ok -side left -expand true
		
	button $w.bts.cancel -text "Cancel" -command {
		global fs_priv
		set fs_priv(result) ""
	}
	pack $w.bts.cancel -side left -expand true
	
	fs_newpath

	set oldfocus [focus]
	grab $w
	focus $w
	
	tkwait variable fs_priv(result)

	if { "$oldfocus" != "" } { focus $oldfocus }

	destroy $w

	check_file_type $fs_priv(result) $typevar

	return $fs_priv(result)	
}

proc fs_DirSelect {w {title {FileSelector}} {filter {*}} {name {}} } {
	global fs_priv

	if {$name != ""} {
		if {[file isdir $name]} {
			set filter $name
		} else {
			set filter [file dirname $name]
		}
	}

	if {[info commands tk_chooseDirectory] != ""} {
	   return [tk_chooseDirectory -initialdir $filter]
	}

	# remainder of the code is for pre-tk8.3

	set fs_priv(window) $w
	set fs_priv(filter) $filter
	set fs_priv(name) $name
	set fs_priv(result) ""
	 
	# if this window already exists, destroy it
	catch {destroy $w}

	# create new toplevel
	toplevel $w
	wm title $w $title

	# create frames	

	# create filter-entry
	frame $w.filter
	pack $w.filter -side top -fill x
	label $w.filter.lbl -text "Directory"
	pack $w.filter.lbl -side top -anchor w
	entry $w.filter.et -textvar fs_priv(filter)
	pack $w.filter.et -side top -fill x -expand true
	bind $w.filter.et <Return> { fs_dir_newpath }
	button $w.filter.up -text "Up" -command {
	        set f $fs_priv(filter)
		if {$f == "."} {set f [pwd]}
		set fs_priv(filter) [file dirname $f]
		fs_dir_newpath
	}
	pack $w.filter.up -side top -anchor w
	
	#create list-frames
	frame $w.l
	pack $w.l -side top -fill both -expand true
	frame $w.l.d
	pack $w.l.d -side left -fill both -expand true
	
	fs_slist $w.l.d "Sub Directories" single

	bind $w.l.d.top.lst <Double-Button-1> {
		global fs_priv
	        set f [string trimright $fs_priv(filter) /]
		set d [%W get active]
		switch $d {
		   "." { }
		   ".." {
		      if {$f == "."} {set f [pwd]}
		      set fs_priv(filter) [file dirname $f]
		   }
		   default {
		      if {$f == "/"} {set f ""}
		      set fs_priv(filter) "$f/$d"
		   }
		}
		fs_dir_newpath
	}
	
	# create buttons
	frame $w.bts
	pack $w.bts -side top -fill x
	button $w.bts.ok -text "OK" -command {
		global fs_priv
	        set w $fs_priv(window)
		set sel [$w.l.d.top.lst curselection]
		if {$sel != ""} {
		   set val [$w.l.d.top.lst get $sel]
		   set fs_priv(result) "$fs_priv(filter)/$val"
		} else {
		   set fs_priv(result) $fs_priv(filter)
		}
	}
	pack $w.bts.ok -side left -expand true
		
	button $w.bts.cancel -text "Cancel" -command {
		global fs_priv
		set fs_priv(result) ""
	}
	pack $w.bts.cancel -side left -expand true
	
	fs_dir_newpath

	set oldfocus [focus]
	grab $w
	focus $w
	
	tkwait variable fs_priv(result)

	if { "$oldfocus" != "" } { focus $oldfocus }

	destroy $w

	return $fs_priv(result)	
}

proc fs_slist {w title mode} {

	if {$title != ""} {
		label $w.lbl -text $title
		pack $w.lbl -side top -anchor w
	}

	frame $w.top
	pack $w.top -side top -fill both -expand true
	frame $w.bot
	pack $w.bot -side top -fill x
	
	listbox $w.top.lst -relief sunken -bd 2 -yscrollcommand "$w.top.vs set" \
	        -xscrollcommand "$w.bot.hs set" -selectmode $mode \
	        -font -*-courier-medium-r-normal--14-*-*-*-*-*-*
	pack $w.top.lst -side left -fill both -expand true

	scrollbar $w.top.vs -relief sunken -bd 2 -command "$w.top.lst yview" \
	          -orient vertical
	pack $w.top.vs -side left -fill y
	
	scrollbar $w.bot.hs -relief sunken -bd 2 -command "$w.top.lst xview" \
	          -orient horizontal
	pack $w.bot.hs -side left -fill x -expand true
	
	frame $w.bot.pad -width [expr [lindex [$w.top.vs config -width] 4] + \
	                        [lindex [$w.top.vs config -bd] 4] *2]

	pack $w.bot.pad -side left
		
}

proc fs_newpath {} {

	global fs_priv

	if {$fs_priv(filter) == ""} {
		set fs_priv(filter) "./*"
	}

	if {[file isdir $fs_priv(filter)]} {
		set fs_priv(filter) "$fs_priv(filter)/*"
	}

	set w $fs_priv(window)
	set filter $fs_priv(filter)
	
	$w.l.d.top.lst delete 0 end

	$w.l.f.top.lst delete 0 end

	# update dirs
	set dwidth 5
	set files [lsort "[glob -nocomplain "[file dirname $filter]/*" ]  \
	                  [glob -nocomplain "[file dirname $filter]/.*"]" ]
	foreach j $files {
		if [file isdir $j] {
			set name [file tail $j]
			$w.l.d.top.lst insert end $name
			if {[string length $name] > $dwidth} { set dwidth [string length $name] }
		}
	}

	#update files
	set pos 0
	set fwidth 5
	set files [lsort [glob -nocomplain "$filter"]]
	foreach j $files {
		if [file isfile $j] {
			set name [file tail $j]
			$w.l.f.top.lst insert end $name
			if {[string length $name] > $fwidth} {
				set pos [string length [file dirname $j]]
				set fwidth [string length $name]
			}
		}
	}
	
	if {$fwidth < 20} { set fwidth 20 }
	$w.l.f.top.lst configure -width [expr $fwidth+1]

	if {$dwidth < 20} { set dwidth 20 }
        $w.l.d.top.lst configure -width [expr $dwidth+1]


	if {$pos == 1} { set pos 0 }
	
	update idletasks
	
	$w.l.f.top.lst xview $pos
	
}

proc fs_dir_newpath {} {

	global fs_priv

	if {$fs_priv(filter) == ""} {
		set fs_priv(filter) "."
	}

	set w $fs_priv(window)
	set filter $fs_priv(filter)
	
	$w.l.d.top.lst delete 0 end

	# update dirs
	set dwidth 5
	set files [lsort "[glob -nocomplain "$filter/*" ]  \
	                  [glob -nocomplain "$filter/.*"]" ]
	foreach j $files {
		if [file isdir $j] {
			set name [file tail $j]
			$w.l.d.top.lst insert end $name
			if {[string length $name] > $dwidth} { set dwidth [string length $name] }
		}
	}

	
	if {$dwidth < 20} { set dwidth 20 }
        $w.l.d.top.lst configure -width [expr $dwidth+1]

	update idletasks
	
}

#====================== end of fs-box ========================

set num(1) "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
set num(2) "abcdefghijklmnopqrstuvwxyza"
set num(3) "12345678901"

proc NDname { name } {
	global num
	if [string match *.?64 $name] {
		set len [string length $name]
		set z [string index $name [expr $len-5]]
		
		foreach i "1 2 3" {
			set c [string first $z $num($i)]
			if {$c >= 0} { break }
		}
		incr c
		set nname "[string range $name 0 [expr $len-6]][string index $num($i) $c][string range $name [expr $len-4] end]"
		if [file exists $nname] { return $nname }
		set nname "[string range $name 0 [expr $len-6]][string index $num($i) 0][string range $name [expr $len-4] end]"
		if [file exists $nname] { return $nname }
	}
	return $name
}

# ===========================================================

frame .drives -borderwidth 0
pack .drives -side top -expand false -fill x

label .drives.l -text "Disk Drive Controls" -height 2
pack .drives.l -side top -expand true -fill both

checkbutton .drives.ef -text "Emulate 1541 CPU (Drive 8 only)" -variable pref(Emul1541Proc) -command "Change" -bg "dark grey" -anchor w
pack .drives.ef -side top -expand true -fill both

frame .drives.d8 -borderwidth 0
pack .drives.d8 -side top -expand true -fill x

label .drives.d8.l -text "8" -width 2
pack .drives.d8.l -side left -expand false 
radiobutton .drives.d8.d64 -text "D64" -variable pref(DriveType8) -value "D64" \
    -bg "dark grey" -command {
		set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath8) pref(DriveType8)]
		if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
    }
pack .drives.d8.d64 -side left -expand false -fill y

radiobutton .drives.d8.dir -text "DIR" -variable pref(DriveType8) -value "DIR" \
    -command {
		set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath8)]
		if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
    }
pack .drives.d8.dir -side left -expand false

radiobutton .drives.d8.t64 -text "T64" -variable pref(DriveType8) -value "T64" \
    -command {
		set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath8) pref(DriveType8)]
		if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
    }
pack .drives.d8.t64 -side left -expand false

entry .drives.d8.name -textvar pref(DrivePath8)
bind .drives.d8.name <Return> "Change"
bind .drives.d8.name <Double-1> {
	set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath8) pref(DriveType8)]
	if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
}
pack .drives.d8.name -side left -expand true -fill x

button .drives.d8.n -text "N" -command { set pref(DrivePath8) [NDname $pref(DrivePath8)]; Change }
pack .drives.d8.n -side left -expand false

frame .drives.d9
pack .drives.d9 -side top -expand true -fill x

label .drives.d9.l -text "9" -width 2
pack .drives.d9.l -side left -expand false 
radiobutton .drives.d9.d64 -text "D64" -variable pref(DriveType9) -value "D64" \
    -command {
		set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath9) pref(DriveType9)]
		if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
    }
pack .drives.d9.d64 -side left -expand false

radiobutton .drives.d9.dir -text "DIR" -variable pref(DriveType9) -value "DIR" \
    -command {
		set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath9)]
		if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
    }
pack .drives.d9.dir -side left -expand false

radiobutton .drives.d9.t64 -text "T64" -variable pref(DriveType9) -value "T64" \
    -command {
		set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath9) pref(DriveType9)]
		if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
    }
pack .drives.d9.t64 -side left -expand false

entry .drives.d9.name -textvar pref(DrivePath9)
bind .drives.d9.name <Return> "Change"
bind .drives.d9.name <Double-1> {
	set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath9) pref(DriveType9)]
	if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
}
pack .drives.d9.name -side left -expand true -fill x

button .drives.d9.n -text "N" -command { set pref(DrivePath9) [NDname $pref(DrivePath9)]; Change }
pack .drives.d9.n -side left -expand false


frame .drives.d10
pack .drives.d10 -side top -expand true -fill x

label .drives.d10.l -text "10" -width 2
pack .drives.d10.l -side left -expand false 
radiobutton .drives.d10.d64 -text "D64" -variable pref(DriveType10) -value "D64" \
    -command {
		set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath10) pref(DriveType10)]
		if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
    }
pack .drives.d10.d64 -side left -expand false

radiobutton .drives.d10.dir -text "DIR" -variable pref(DriveType10) -value "DIR" \
    -command {
		set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath10)]
		if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
    }
pack .drives.d10.dir -side left -expand false

radiobutton .drives.d10.t64 -text "T64" -variable pref(DriveType10) -value "T64" \
    -command {
		set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath10) pref(DriveType10)]
		if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
    }
pack .drives.d10.t64 -side left -expand false

entry .drives.d10.name -textvar pref(DrivePath10)
bind .drives.d10.name <Return> "Change"
bind .drives.d10.name <Double-1> {
	set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath10) pref(DriveType10)]
	if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
}
pack .drives.d10.name -side left -expand true -fill x

button .drives.d10.n -text "N" -command { set pref(DrivePath10) [NDname $pref(DrivePath10)]; Change }
pack .drives.d10.n -side left -expand false


frame .drives.d11
pack .drives.d11 -side top -expand true -fill x

label .drives.d11.l -text "11" -width 2
pack .drives.d11.l -side left -expand false 
radiobutton .drives.d11.d64 -text "D64" -variable pref(DriveType11) -value "D64" \
    -command {
		set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath11) pref(DriveType11)]
		if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
    }
pack .drives.d11.d64 -side left -expand false

radiobutton .drives.d11.dir -text "DIR" -variable pref(DriveType11) -value "DIR" \
    -command {
		set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath11)]
		if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
    }
pack .drives.d11.dir -side left -expand false

radiobutton .drives.d11.t64 -text "T64" -variable pref(DriveType11) -value "T64" \
    -command {
		set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath11) pref(DriveType11)]
		if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
    }
pack .drives.d11.t64 -side left -expand false

entry .drives.d11.name -textvar pref(DrivePath11)
bind .drives.d11.name <Return> "Change"
bind .drives.d11.name <Double-1> {
	set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath11) pref(DriveType11)]
	if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
}
pack .drives.d11.name -side left -expand true -fill x

button .drives.d11.n -text "N" -command { set pref(DrivePath11) [NDname $pref(DrivePath11)]; Change }
pack .drives.d11.n -side left -expand false


# =============================================================

global show_options_string

checkbutton .more_options -borderwidth 3 -relief raised -textvariable show_options_string -variable pref(ShowOptions) -command "Change"
pack .more_options -side top -expand false -fill x

frame .nums -borderwidth 3 -relief raised

scale .nums.nc -from 1 -to 200 -orient horizontal -variable pref(NormalCycles) \
               -label "Normal Cycles"
pack .nums.nc -side top -expand false -fill x

scale .nums.bc -from 1 -to 200 -orient horizontal -variable pref(BadLineCycles) \
               -label "Bad Line Cycles"
pack .nums.bc -side top -expand false -fill x

scale .nums.cc -from 1 -to 200 -orient horizontal -variable pref(CIACycles) \
               -label "CIA Cycles"
pack .nums.cc -side top -expand false -fill x

scale .nums.fc -from 1 -to 200 -orient horizontal -variable pref(FloppyCycles) \
               -label "Floppy Cycles"
pack .nums.fc -side top -expand false -fill x

scale .nums.sf -from 1 -to 10 -orient horizontal -variable pref(SkipFrames) \
               -label "Skip Frames"
pack .nums.sf -side top -expand false -fill x

# =============================================================

frame .bools1 -borderwidth 3 -relief raised

frame .bools1.sprites
pack .bools1.sprites -side left -expand true -fill both

checkbutton .bools1.sprites.o -text "Sprites" -variable pref(SpritesOn) -command "Change"
pack .bools1.sprites.o -anchor nw -expand false -fill y

checkbutton .bools1.sprites.c -text "Sprite Collisions" \
            -variable pref(SpriteCollisions) -command "Change"
pack .bools1.sprites.c -anchor nw -expand false -fill y


frame .bools1.joy
pack .bools1.joy -side left -expand true -fill both

checkbutton .bools1.joy.j1 -text "Joy 1" -variable pref(Joystick1On) -command "Change"
pack .bools1.joy.j1 -anchor nw -expand false -fill y

checkbutton .bools1.joy.j2 -text "Joy 2" -variable pref(Joystick2On) -command "Change"
pack .bools1.joy.j2 -anchor nw -expand false -fill y

checkbutton .bools1.joy.swap -text "Swap 1<->2" -variable pref(JoystickSwap) -command "Change"
pack .bools1.joy.swap -anchor nw -expand false -fill y


frame .bools2 -borderwidth 3 -relief raised

frame .bools2.m1
pack .bools2.m1 -side left -expand true -fill both

checkbutton .bools2.m1.ls -text "Limit Speed" -variable pref(LimitSpeed) -command "Change"
pack .bools2.m1.ls -anchor nw -expand false -fill y

checkbutton .bools2.m1.fr -text "Fast Reset" -variable pref(FastReset) -command "Change"
pack .bools2.m1.fr -anchor nw -expand false -fill y


frame .bools2.m2
pack .bools2.m2 -side left -expand true -fill both

checkbutton .bools2.m2.ch -text "CIA IRQ Hack" -variable pref(CIAIRQHack) -command "Change"
pack .bools2.m2.ch -anchor nw -expand false -fill y

checkbutton .bools2.m2.ms -text "Map '/'" -variable pref(MapSlash) -command "Change"
pack .bools2.m2.ms -anchor nw -expand false -fill y


frame .bools4 -relief raised -borderwidth 3

frame .bools4.st
pack .bools4.st -side left -expand true -fill both

label .bools4.st.l -text "SID Emulation"
pack .bools4.st.l -anchor nw 
radiobutton .bools4.st.none -text "None" -variable pref(SIDType) -value "NONE" \
            -command {Change}
pack .bools4.st.none -anchor nw 

radiobutton .bools4.st.digi -text "Digital" -variable pref(SIDType) -value "DIGITAL" \
            -command {Change}
pack .bools4.st.digi -anchor nw 

frame .bools4.sf
pack .bools4.sf -side left -expand true -fill both

checkbutton .bools4.sf.sf -text "SID Filters" -variable pref(SIDFilters) -command "Change"
pack .bools4.sf.sf -side top -expand false -fill y


# =============================================================

frame .pcmd
pack .pcmd -side top -expand false -fill both

button .pcmd.apply -text "Apply" -command "Change" 
pack .pcmd.apply -side left -expand true -fill both

button .pcmd.default -text "Defaults" -command "defaults ; Change" 
pack .pcmd.default -side left -expand false -fill both

# =============================================================

set ledcolors(0) "#d9d9d9"
set ledcolors(1) "red"
set ledcolors(2) "brown"

proc ListenToFrodo {} {
	set line [gets stdin]
	set cmd [lindex $line 0]
	switch -exact $cmd {
		"speed" {
			.speed.v configure -text "[lindex $line 1]%"
		}
		"ping" {
			puts -nonewline "o"
			flush stdout
		}
		"quit" {
			exit 0
		}
		"leds" {
			global ledcolors
			.drives.d8.l configure -background $ledcolors([lindex $line 1])
			.drives.d9.l configure -background $ledcolors([lindex $line 2])
			.drives.d10.l configure -background $ledcolors([lindex $line 3])
			.drives.d11.l configure -background $ledcolors([lindex $line 4])
		}
		default {
			puts stderr "line = $line"
		}
	}
}


proc set_Emul1541Proc args {
   global pref

   if {$pref(Emul1541Proc)} {
      set state disabled
      set pref(DriveType8) "D64"
   } else {
      set state normal
   }
   .drives.d8.dir configure -state $state
   .drives.d8.t64 configure -state $state
   foreach i {9 10 11} {
      .drives.d${i}.d64 configure -state $state
      .drives.d${i}.dir configure -state $state
      .drives.d${i}.t64 configure -state $state
      .drives.d${i}.name configure -state $state
      .drives.d${i}.n configure -state $state
   }
}  

proc set_ShowOptions args {
   global pref show_options_string

   if {$pref(ShowOptions)} {
      pack .nums -side top -expand false -fill x -after .more_options
      pack .bools1 -side top -expand true -fill both -after .nums
      pack .bools2 -side top -expand true -fill both -after .bools1
      pack .bools4 -side top -expand true -fill both -after .bools2
      set show_options_string "Hide Advanced Options"
   } else {
      pack forget .nums .bools1 .bools2 .bools4
      set show_options_string "Show Advanced Options"
   }
}

fileevent stdin readable { ListenToFrodo }

# =============================================================

wm title . "Frodo Preferences Menu"

# set trace and trigger it now
trace variable pref(Emul1541Proc) w set_Emul1541Proc
set pref(Emul1541Proc) $pref(Emul1541Proc)

# set trace and trigger it now
trace variable pref(ShowOptions) w set_ShowOptions
set pref(ShowOptions) $pref(ShowOptions)

tkwait window .