1032 lines
28 KiB
Tcl
Executable File
1032 lines
28 KiB
Tcl
Executable File
#!/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 .
|