ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/cebix/Frodo4/Src/Frodo_GUI.tcl
Revision: 1.3
Committed: 2005-06-27T19:55:48Z (18 years, 11 months ago) by cebix
Content type: application/x-tcl
Branch: MAIN
CVS Tags: VERSION_4_2
Changes since 1.2: +1 -1 lines
Log Message:
updated copyright dates

File Contents

# User Rev Content
1 cebix 1.1 #!/usr/bin/wish
2    
3     # Frodo Tk GUI by Lutz Vieweg <lkv@mania.robin.de>
4     # requires Tk >= 4.1
5     #
6 cebix 1.3 # Frodo (C) 1994-1997,2002-2005 Christian Bauer
7 cebix 1.1 #
8     # This program is free software; you can redistribute it and/or modify
9     # it under the terms of the GNU General Public License as published by
10     # the Free Software Foundation; either version 2 of the License, or
11     # (at your option) any later version.
12     #
13     # This program is distributed in the hope that it will be useful,
14     # but WITHOUT ANY WARRANTY; without even the implied warranty of
15     # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16     # GNU General Public License for more details.
17     #
18     # You should have received a copy of the GNU General Public License
19     # along with this program; if not, write to the Free Software
20     # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21    
22     #package require Tk 4.1
23    
24     set prefname "$env(HOME)/.frodorc"
25    
26     proc defaults {} {
27     global pref
28     set pref(NormalCycles) "63"
29     set pref(BadLineCycles) "23"
30     set pref(CIACycles) "63"
31     set pref(FloppyCycles) "64"
32     set pref(SkipFrames) "4"
33     set pref(DriveType8) "DIR"
34     set pref(DrivePath8) "./64prgs"
35     set pref(DriveType9) "D64"
36     set pref(DrivePath9) "./disk1.d64"
37     set pref(DriveType10) "DIR"
38     set pref(DrivePath10) ""
39     set pref(DriveType11) "DIR"
40     set pref(DrivePath11) ""
41     set pref(SIDType) "NONE"
42     set pref(SpritesOn) "TRUE"
43     set pref(SpriteCollisions) "TRUE"
44     set pref(Joystick1On) "FALSE"
45     set pref(Joystick2On) "TRUE"
46     set pref(JoystickSwap) "FALSE"
47     set pref(LimitSpeed) "FALSE"
48     set pref(FastReset) "FALSE"
49     set pref(CIAIRQHack) "FALSE"
50     set pref(MapSlash) "TRUE"
51     set pref(Emul1541Proc) "FALSE"
52     set pref(ShowOptions) "FALSE"
53     set pref(SIDFilters) "TRUE"
54     }
55    
56     proc s2bool { s } {
57     if {$s == "TRUE"} {return 1}
58     return 0
59     }
60    
61     defaults
62    
63     if {![catch { set in [open $prefname] }]} {
64     while {![eof $in]} {
65     set line [gets $in]
66     if [regexp {^([^ ]*)[ ]*=[ ]*([^ ]*)$} $line range name val] {
67     switch -exact $name {
68     "NormalCycles" {
69     set pref(NormalCycles) $val
70     }
71     "BadLineCycles" {
72     set pref(BadLineCycles) $val
73     }
74     "CIACycles" {
75     set pref(CIACycles) $val
76     }
77     "FloppyCycles" {
78     set pref(FloppyCycles) $val
79     }
80     "SkipFrames" {
81     set pref(SkipFrames) $val
82     }
83     "DriveType8" {
84     set pref(DriveType8) $val
85     }
86     "DrivePath8" {
87     set pref(DrivePath8) $val
88     }
89     "DriveType9" {
90     set pref(DriveType9) $val
91     }
92     "DrivePath9" {
93     set pref(DrivePath9) $val
94     }
95     "DriveType10" {
96     set pref(DriveType10) $val
97     }
98     "DrivePath10" {
99     set pref(DrivePath10) $val
100     }
101     "DriveType11" {
102     set pref(DriveType11) $val
103     }
104     "DrivePath11" {
105     set pref(DrivePath11) $val
106     }
107     "SIDType" {
108     set pref(SIDType) $val
109     }
110     "SpritesOn" {
111     set pref(SpritesOn) [s2bool $val]
112     }
113     "SpriteCollisions" {
114     set pref(SpriteCollisions) [s2bool $val]
115     }
116     "Joystick1On" {
117     set pref(Joystick1On) [s2bool $val]
118     }
119     "Joystick2On" {
120     set pref(Joystick2On) [s2bool $val]
121     }
122     "JoystickSwap" {
123     set pref(JoystickSwap) [s2bool $val]
124     }
125     "LimitSpeed" {
126     set pref(LimitSpeed) [s2bool $val]
127     }
128     "FastReset" {
129     set pref(FastReset) [s2bool $val]
130     }
131     "CIAIRQHack" {
132     set pref(CIAIRQHack) [s2bool $val]
133     }
134     "MapSlash" {
135     set pref(MapSlash) [s2bool $val]
136     }
137     "Emul1541Proc" {
138     set pref(Emul1541Proc) [s2bool $val]
139     }
140     "ShowOptions" {
141     set pref(ShowOptions) [s2bool $val]
142     }
143     "SIDFilters" {
144     set pref(SIDFilters) [s2bool $val]
145     }
146     }
147     }
148     }
149     }
150    
151     proc bool2s { b } {
152     if {$b} { return "TRUE" }
153     return "FALSE"
154     }
155    
156     proc WritePrefs { } {
157     global pref prefname
158    
159     if [catch { set out [open "$prefname" "w"] }] {
160     puts stderr "unable to write preferences file '$prefname'"
161     } else {
162     puts $out "NormalCycles = $pref(NormalCycles)"
163     puts $out "BadLineCycles = $pref(BadLineCycles)"
164     puts $out "CIACycles = $pref(CIACycles)"
165     puts $out "FloppyCycles = $pref(FloppyCycles)"
166     puts $out "SkipFrames = $pref(SkipFrames)"
167     puts $out "DriveType8 = $pref(DriveType8)"
168     puts $out "DrivePath8 = $pref(DrivePath8)"
169     puts $out "DriveType9 = $pref(DriveType9)"
170     puts $out "DrivePath9 = $pref(DrivePath9)"
171     puts $out "DriveType10 = $pref(DriveType10)"
172     puts $out "DrivePath10 = $pref(DrivePath10)"
173     puts $out "DriveType11 = $pref(DriveType11)"
174     puts $out "DrivePath11 = $pref(DrivePath11)"
175     puts $out "SIDType = $pref(SIDType)"
176     puts $out "SpritesOn = [bool2s $pref(SpritesOn)]"
177     puts $out "SpriteCollisions = [bool2s $pref(SpriteCollisions)]"
178     puts $out "Joystick1On = [bool2s $pref(Joystick1On)]"
179     puts $out "Joystick2On = [bool2s $pref(Joystick2On)]"
180     puts $out "JoystickSwap = [bool2s $pref(JoystickSwap)]"
181     puts $out "LimitSpeed = [bool2s $pref(LimitSpeed)]"
182     puts $out "FastReset = [bool2s $pref(FastReset)]"
183     puts $out "CIAIRQHack = [bool2s $pref(CIAIRQHack)]"
184     puts $out "MapSlash = [bool2s $pref(MapSlash)]"
185     puts $out "Emul1541Proc = [bool2s $pref(Emul1541Proc)]"
186     puts $out "ShowOptions = [bool2s $pref(ShowOptions)]"
187     puts $out "SIDFilters = [bool2s $pref(SIDFilters)]"
188    
189     close $out
190    
191     puts -nonewline "p"
192     flush stdout
193     }
194     }
195    
196     proc Quit {} {
197     puts -nonewline "q"
198     flush stdout
199     exit 0
200     }
201    
202     # =============================================================
203    
204     frame .cmds
205     pack .cmds -expand false -fill both
206    
207     button .cmds.quit -text "Quit" -command "Quit"
208     pack .cmds.quit -side left -expand true -fill both
209    
210     button .cmds.reset -text "Reset" -command {puts -nonewline "r" ; flush stdout}
211     pack .cmds.reset -side left -expand true -fill both
212    
213     # =============================================================
214    
215     proc Change { {dummy1 ""} {dummy2 ""}} {
216     WritePrefs
217     }
218    
219     #====================== begin of fs-box ========================
220    
221     proc check_file_type {filename var} {
222     global pref
223     switch [file extension $filename] {
224     .d64 - .x64 { set $var D64; Change }
225     .lnx - .t64 { set $var T64; Change }
226     }
227     }
228    
229     proc fs_FileSelect {w {title {FileSelector}} {filter {*}} {name {}} typevar} {
230     global fs_priv
231    
232     if {[info commands tk_getOpenFile] != ""} {
233     switch $filter {
234     "*.{t64,lnx}" {
235     set types {
236     {{t64/lnx archive files} {.t64 .lnx}}
237     {{disk files} {.d64 .x64}}
238     {{all files} *}
239     }
240     }
241     "*.{d64,x64}" {
242     set types {
243     {{disk files} {.d64 .x64}}
244     {{t64/lnx archive files} {.t64 .lnx}}
245     {{all files} *}
246     }
247     }
248     default {
249     set types {
250     {{all files} *}
251     {{disk files} {.d64 .x64}}
252     {{t64/lnx archive files} {.t64 .lnx}}
253     }
254     }
255     }
256     if {[file isdir $name]} {
257     set name $name
258     } else {
259     set name "[file dirname $name]"
260     }
261     set fs_priv(result) [tk_getOpenFile -filetypes $types -initialdir $name]
262     check_file_type $fs_priv(result) $typevar
263     return $fs_priv(result)
264     }
265    
266     # remainder of the code is for pre-tk8.0
267    
268     if {$name != ""} {
269     if {[file isdir $name]} {
270     set filter "$name/$filter"
271     } else {
272     set filter "[file dirname $name]/$filter"
273     }
274     }
275    
276     set fs_priv(window) $w
277     set fs_priv(filter) $filter
278     set fs_priv(name) ""
279     set fs_priv(result) ""
280    
281     # if this window already exists, destroy it
282     catch {destroy $w}
283    
284     # create new toplevel
285     toplevel $w
286     wm title $w $title
287    
288     # create frames
289    
290     # create filter-entry
291     frame $w.filter
292     pack $w.filter -side top -fill x
293     label $w.filter.lbl -text "Filter"
294     pack $w.filter.lbl -side top -anchor w
295     entry $w.filter.et -textvar fs_priv(filter)
296     pack $w.filter.et -side top -fill x -expand true
297     bind $w.filter.et <Return> { fs_newpath }
298     button $w.filter.up -text "Up" -command {
299     set f [file dirname $fs_priv(filter)]
300     set t [file tail $fs_priv(filter)]
301     if {$f == "."} {set f [pwd]}
302     set f [file dirname $f]
303     if {$f == "/"} {set f ""}
304     set fs_priv(filter) "$f/$t"
305     fs_newpath
306     }
307     pack $w.filter.up -side top -anchor w
308    
309     #create list-frames
310     frame $w.l
311     pack $w.l -side top -fill both -expand true
312     frame $w.l.d
313     pack $w.l.d -side left -fill both -expand true
314     frame $w.l.f
315     pack $w.l.f -side left -fill both -expand true
316    
317     fs_slist $w.l.d Directories single
318    
319     fs_slist $w.l.f Files single
320     bind $w.l.f.top.lst <ButtonRelease-1> {
321     focus %W
322     global fs_priv
323     set sel [%W curselection]
324     if {$sel != ""} {
325     set fs_priv(name) [%W get [%W curselection]]
326     }
327     }
328    
329     bind $w.l.f.top.lst <Double-Button-1> "$w.bts.ok flash; $w.bts.ok invoke"
330     bind $w.l.d.top.lst <Double-Button-1> {
331     global fs_priv
332     set f [file dirname $fs_priv(filter)]
333     set t [file tail $fs_priv(filter)]
334     set d [%W get active]
335     switch $d {
336     "." { }
337     ".." {
338     if {$f == "."} {set f [pwd]}
339     set fs_priv(filter) "[file dirname $f]/$t"
340     }
341     default {
342     if {$f == "/"} {set f ""}
343     set fs_priv(filter) "$f/$d/$t"
344     }
345     }
346     fs_newpath
347     }
348    
349     #create name-entry
350    
351     frame $w.name
352     pack $w.name -side top -fill x
353     label $w.name.lbl -text "Filename"
354     pack $w.name.lbl -side top -anchor w
355     entry $w.name.et -textvar fs_priv(name)
356     pack $w.name.et -side top -fill x
357     bind $w.name.et <FocusOut> {
358     global fs_priv
359     set fs_priv(filter) \
360     "[file dirname $fs_priv(name)]/*[file extension $fs_priv(filter)]"
361     fs_newpath
362     }
363     bind $w.name.et <Return> {
364     global fs_priv
365     set n $fs_priv(name)
366    
367     if {[string index $n 0] != "/" && [string index $n 0] != "~"} {
368     set n "[file dirname $fs_priv(filter)]/$n"
369     }
370    
371     set n "[file dirname $n]/[file tail $n]"
372    
373     set fs_priv(result) $n
374     }
375    
376     # create buttons
377     frame $w.bts
378     pack $w.bts -side top -fill x
379     button $w.bts.ok -text "OK" -command {
380     global fs_priv
381     set w $fs_priv(window)
382     set sel [$w.l.f.top.lst curselection]
383     if {$sel != ""} {
384     set val [$w.l.f.top.lst get $sel]
385     set fs_priv(result) "[file dirname $fs_priv(filter)]/$val"
386     }
387     }
388     pack $w.bts.ok -side left -expand true
389    
390     button $w.bts.cancel -text "Cancel" -command {
391     global fs_priv
392     set fs_priv(result) ""
393     }
394     pack $w.bts.cancel -side left -expand true
395    
396     fs_newpath
397    
398     set oldfocus [focus]
399     grab $w
400     focus $w
401    
402     tkwait variable fs_priv(result)
403    
404     if { "$oldfocus" != "" } { focus $oldfocus }
405    
406     destroy $w
407    
408     check_file_type $fs_priv(result) $typevar
409    
410     return $fs_priv(result)
411     }
412    
413     proc fs_DirSelect {w {title {FileSelector}} {filter {*}} {name {}} } {
414     global fs_priv
415    
416     if {$name != ""} {
417     if {[file isdir $name]} {
418     set filter $name
419     } else {
420     set filter [file dirname $name]
421     }
422     }
423    
424     if {[info commands tk_chooseDirectory] != ""} {
425     return [tk_chooseDirectory -initialdir $filter]
426     }
427    
428     # remainder of the code is for pre-tk8.3
429    
430     set fs_priv(window) $w
431     set fs_priv(filter) $filter
432     set fs_priv(name) $name
433     set fs_priv(result) ""
434    
435     # if this window already exists, destroy it
436     catch {destroy $w}
437    
438     # create new toplevel
439     toplevel $w
440     wm title $w $title
441    
442     # create frames
443    
444     # create filter-entry
445     frame $w.filter
446     pack $w.filter -side top -fill x
447     label $w.filter.lbl -text "Directory"
448     pack $w.filter.lbl -side top -anchor w
449     entry $w.filter.et -textvar fs_priv(filter)
450     pack $w.filter.et -side top -fill x -expand true
451     bind $w.filter.et <Return> { fs_dir_newpath }
452     button $w.filter.up -text "Up" -command {
453     set f $fs_priv(filter)
454     if {$f == "."} {set f [pwd]}
455     set fs_priv(filter) [file dirname $f]
456     fs_dir_newpath
457     }
458     pack $w.filter.up -side top -anchor w
459    
460     #create list-frames
461     frame $w.l
462     pack $w.l -side top -fill both -expand true
463     frame $w.l.d
464     pack $w.l.d -side left -fill both -expand true
465    
466     fs_slist $w.l.d "Sub Directories" single
467    
468     bind $w.l.d.top.lst <Double-Button-1> {
469     global fs_priv
470     set f [string trimright $fs_priv(filter) /]
471     set d [%W get active]
472     switch $d {
473     "." { }
474     ".." {
475     if {$f == "."} {set f [pwd]}
476     set fs_priv(filter) [file dirname $f]
477     }
478     default {
479     if {$f == "/"} {set f ""}
480     set fs_priv(filter) "$f/$d"
481     }
482     }
483     fs_dir_newpath
484     }
485    
486     # create buttons
487     frame $w.bts
488     pack $w.bts -side top -fill x
489     button $w.bts.ok -text "OK" -command {
490     global fs_priv
491     set w $fs_priv(window)
492     set sel [$w.l.d.top.lst curselection]
493     if {$sel != ""} {
494     set val [$w.l.d.top.lst get $sel]
495     set fs_priv(result) "$fs_priv(filter)/$val"
496     } else {
497     set fs_priv(result) $fs_priv(filter)
498     }
499     }
500     pack $w.bts.ok -side left -expand true
501    
502     button $w.bts.cancel -text "Cancel" -command {
503     global fs_priv
504     set fs_priv(result) ""
505     }
506     pack $w.bts.cancel -side left -expand true
507    
508     fs_dir_newpath
509    
510     set oldfocus [focus]
511     grab $w
512     focus $w
513    
514     tkwait variable fs_priv(result)
515    
516     if { "$oldfocus" != "" } { focus $oldfocus }
517    
518     destroy $w
519    
520     return $fs_priv(result)
521     }
522    
523     proc fs_slist {w title mode} {
524    
525     if {$title != ""} {
526     label $w.lbl -text $title
527     pack $w.lbl -side top -anchor w
528     }
529    
530     frame $w.top
531     pack $w.top -side top -fill both -expand true
532     frame $w.bot
533     pack $w.bot -side top -fill x
534    
535     listbox $w.top.lst -relief sunken -bd 2 -yscrollcommand "$w.top.vs set" \
536     -xscrollcommand "$w.bot.hs set" -selectmode $mode \
537     -font -*-courier-medium-r-normal--14-*-*-*-*-*-*
538     pack $w.top.lst -side left -fill both -expand true
539    
540     scrollbar $w.top.vs -relief sunken -bd 2 -command "$w.top.lst yview" \
541     -orient vertical
542     pack $w.top.vs -side left -fill y
543    
544     scrollbar $w.bot.hs -relief sunken -bd 2 -command "$w.top.lst xview" \
545     -orient horizontal
546     pack $w.bot.hs -side left -fill x -expand true
547    
548     frame $w.bot.pad -width [expr [lindex [$w.top.vs config -width] 4] + \
549     [lindex [$w.top.vs config -bd] 4] *2]
550    
551     pack $w.bot.pad -side left
552    
553     }
554    
555     proc fs_newpath {} {
556    
557     global fs_priv
558    
559     if {$fs_priv(filter) == ""} {
560     set fs_priv(filter) "./*"
561     }
562    
563     if {[file isdir $fs_priv(filter)]} {
564     set fs_priv(filter) "$fs_priv(filter)/*"
565     }
566    
567     set w $fs_priv(window)
568     set filter $fs_priv(filter)
569    
570     $w.l.d.top.lst delete 0 end
571    
572     $w.l.f.top.lst delete 0 end
573    
574     # update dirs
575     set dwidth 5
576     set files [lsort "[glob -nocomplain "[file dirname $filter]/*" ] \
577     [glob -nocomplain "[file dirname $filter]/.*"]" ]
578     foreach j $files {
579     if [file isdir $j] {
580     set name [file tail $j]
581     $w.l.d.top.lst insert end $name
582     if {[string length $name] > $dwidth} { set dwidth [string length $name] }
583     }
584     }
585    
586     #update files
587     set pos 0
588     set fwidth 5
589     set files [lsort [glob -nocomplain "$filter"]]
590     foreach j $files {
591     if [file isfile $j] {
592     set name [file tail $j]
593     $w.l.f.top.lst insert end $name
594     if {[string length $name] > $fwidth} {
595     set pos [string length [file dirname $j]]
596     set fwidth [string length $name]
597     }
598     }
599     }
600    
601     if {$fwidth < 20} { set fwidth 20 }
602     $w.l.f.top.lst configure -width [expr $fwidth+1]
603    
604     if {$dwidth < 20} { set dwidth 20 }
605     $w.l.d.top.lst configure -width [expr $dwidth+1]
606    
607    
608     if {$pos == 1} { set pos 0 }
609    
610     update idletasks
611    
612     $w.l.f.top.lst xview $pos
613    
614     }
615    
616     proc fs_dir_newpath {} {
617    
618     global fs_priv
619    
620     if {$fs_priv(filter) == ""} {
621     set fs_priv(filter) "."
622     }
623    
624     set w $fs_priv(window)
625     set filter $fs_priv(filter)
626    
627     $w.l.d.top.lst delete 0 end
628    
629     # update dirs
630     set dwidth 5
631     set files [lsort "[glob -nocomplain "$filter/*" ] \
632     [glob -nocomplain "$filter/.*"]" ]
633     foreach j $files {
634     if [file isdir $j] {
635     set name [file tail $j]
636     $w.l.d.top.lst insert end $name
637     if {[string length $name] > $dwidth} { set dwidth [string length $name] }
638     }
639     }
640    
641    
642     if {$dwidth < 20} { set dwidth 20 }
643     $w.l.d.top.lst configure -width [expr $dwidth+1]
644    
645     update idletasks
646    
647     }
648    
649     #====================== end of fs-box ========================
650    
651     set num(1) "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
652     set num(2) "abcdefghijklmnopqrstuvwxyza"
653     set num(3) "12345678901"
654    
655     proc NDname { name } {
656     global num
657     if [string match *.?64 $name] {
658     set len [string length $name]
659     set z [string index $name [expr $len-5]]
660    
661     foreach i "1 2 3" {
662     set c [string first $z $num($i)]
663     if {$c >= 0} { break }
664     }
665     incr c
666     set nname "[string range $name 0 [expr $len-6]][string index $num($i) $c][string range $name [expr $len-4] end]"
667     if [file exists $nname] { return $nname }
668     set nname "[string range $name 0 [expr $len-6]][string index $num($i) 0][string range $name [expr $len-4] end]"
669     if [file exists $nname] { return $nname }
670     }
671     return $name
672     }
673    
674     # ===========================================================
675    
676     frame .drives -borderwidth 0
677     pack .drives -side top -expand false -fill x
678    
679     label .drives.l -text "Disk Drive Controls" -height 2
680     pack .drives.l -side top -expand true -fill both
681    
682     checkbutton .drives.ef -text "Emulate 1541 CPU (Drive 8 only)" -variable pref(Emul1541Proc) -command "Change" -bg "dark grey" -anchor w
683     pack .drives.ef -side top -expand true -fill both
684    
685     frame .drives.d8 -borderwidth 0
686     pack .drives.d8 -side top -expand true -fill x
687    
688     label .drives.d8.l -text "8" -width 2
689     pack .drives.d8.l -side left -expand false
690     radiobutton .drives.d8.d64 -text "D64" -variable pref(DriveType8) -value "D64" \
691     -bg "dark grey" -command {
692     set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath8) pref(DriveType8)]
693     if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
694     }
695     pack .drives.d8.d64 -side left -expand false -fill y
696    
697     radiobutton .drives.d8.dir -text "DIR" -variable pref(DriveType8) -value "DIR" \
698     -command {
699     set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath8)]
700     if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
701     }
702     pack .drives.d8.dir -side left -expand false
703    
704     radiobutton .drives.d8.t64 -text "T64" -variable pref(DriveType8) -value "T64" \
705     -command {
706     set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath8) pref(DriveType8)]
707     if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
708     }
709     pack .drives.d8.t64 -side left -expand false
710    
711     entry .drives.d8.name -textvar pref(DrivePath8)
712     bind .drives.d8.name <Return> "Change"
713     bind .drives.d8.name <Double-1> {
714     set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath8) pref(DriveType8)]
715     if {$erg != ""} { set pref(DrivePath8) $erg ; Change }
716     }
717     pack .drives.d8.name -side left -expand true -fill x
718    
719     button .drives.d8.n -text "N" -command { set pref(DrivePath8) [NDname $pref(DrivePath8)]; Change }
720     pack .drives.d8.n -side left -expand false
721    
722     frame .drives.d9
723     pack .drives.d9 -side top -expand true -fill x
724    
725     label .drives.d9.l -text "9" -width 2
726     pack .drives.d9.l -side left -expand false
727     radiobutton .drives.d9.d64 -text "D64" -variable pref(DriveType9) -value "D64" \
728     -command {
729     set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath9) pref(DriveType9)]
730     if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
731     }
732     pack .drives.d9.d64 -side left -expand false
733    
734     radiobutton .drives.d9.dir -text "DIR" -variable pref(DriveType9) -value "DIR" \
735     -command {
736     set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath9)]
737     if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
738     }
739     pack .drives.d9.dir -side left -expand false
740    
741     radiobutton .drives.d9.t64 -text "T64" -variable pref(DriveType9) -value "T64" \
742     -command {
743     set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath9) pref(DriveType9)]
744     if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
745     }
746     pack .drives.d9.t64 -side left -expand false
747    
748     entry .drives.d9.name -textvar pref(DrivePath9)
749     bind .drives.d9.name <Return> "Change"
750     bind .drives.d9.name <Double-1> {
751     set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath9) pref(DriveType9)]
752     if {$erg != ""} { set pref(DrivePath9) $erg ; Change }
753     }
754     pack .drives.d9.name -side left -expand true -fill x
755    
756     button .drives.d9.n -text "N" -command { set pref(DrivePath9) [NDname $pref(DrivePath9)]; Change }
757     pack .drives.d9.n -side left -expand false
758    
759    
760     frame .drives.d10
761     pack .drives.d10 -side top -expand true -fill x
762    
763     label .drives.d10.l -text "10" -width 2
764     pack .drives.d10.l -side left -expand false
765     radiobutton .drives.d10.d64 -text "D64" -variable pref(DriveType10) -value "D64" \
766     -command {
767     set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath10) pref(DriveType10)]
768     if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
769     }
770     pack .drives.d10.d64 -side left -expand false
771    
772     radiobutton .drives.d10.dir -text "DIR" -variable pref(DriveType10) -value "DIR" \
773     -command {
774     set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath10)]
775     if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
776     }
777     pack .drives.d10.dir -side left -expand false
778    
779     radiobutton .drives.d10.t64 -text "T64" -variable pref(DriveType10) -value "T64" \
780     -command {
781     set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath10) pref(DriveType10)]
782     if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
783     }
784     pack .drives.d10.t64 -side left -expand false
785    
786     entry .drives.d10.name -textvar pref(DrivePath10)
787     bind .drives.d10.name <Return> "Change"
788     bind .drives.d10.name <Double-1> {
789     set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath10) pref(DriveType10)]
790     if {$erg != ""} { set pref(DrivePath10) $erg ; Change }
791     }
792     pack .drives.d10.name -side left -expand true -fill x
793    
794     button .drives.d10.n -text "N" -command { set pref(DrivePath10) [NDname $pref(DrivePath10)]; Change }
795     pack .drives.d10.n -side left -expand false
796    
797    
798     frame .drives.d11
799     pack .drives.d11 -side top -expand true -fill x
800    
801     label .drives.d11.l -text "11" -width 2
802     pack .drives.d11.l -side left -expand false
803     radiobutton .drives.d11.d64 -text "D64" -variable pref(DriveType11) -value "D64" \
804     -command {
805     set erg [fs_FileSelect .fs "Choose D64 image file" "*.{d64,x64}" $pref(DrivePath11) pref(DriveType11)]
806     if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
807     }
808     pack .drives.d11.d64 -side left -expand false
809    
810     radiobutton .drives.d11.dir -text "DIR" -variable pref(DriveType11) -value "DIR" \
811     -command {
812     set erg [fs_DirSelect .fs "Choose directory" "*" $pref(DrivePath11)]
813     if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
814     }
815     pack .drives.d11.dir -side left -expand false
816    
817     radiobutton .drives.d11.t64 -text "T64" -variable pref(DriveType11) -value "T64" \
818     -command {
819     set erg [fs_FileSelect .fs "Choose T64/LYNX archive file" "*.{t64,lnx}" $pref(DrivePath11) pref(DriveType11)]
820     if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
821     }
822     pack .drives.d11.t64 -side left -expand false
823    
824     entry .drives.d11.name -textvar pref(DrivePath11)
825     bind .drives.d11.name <Return> "Change"
826     bind .drives.d11.name <Double-1> {
827     set erg [fs_FileSelect .fs "Choose A File" "*" $pref(DrivePath11) pref(DriveType11)]
828     if {$erg != ""} { set pref(DrivePath11) $erg ; Change }
829     }
830     pack .drives.d11.name -side left -expand true -fill x
831    
832     button .drives.d11.n -text "N" -command { set pref(DrivePath11) [NDname $pref(DrivePath11)]; Change }
833     pack .drives.d11.n -side left -expand false
834    
835    
836     # =============================================================
837    
838     global show_options_string
839    
840     checkbutton .more_options -borderwidth 3 -relief raised -textvariable show_options_string -variable pref(ShowOptions) -command "Change"
841     pack .more_options -side top -expand false -fill x
842    
843     frame .nums -borderwidth 3 -relief raised
844    
845     scale .nums.nc -from 1 -to 200 -orient horizontal -variable pref(NormalCycles) \
846     -label "Normal Cycles"
847     pack .nums.nc -side top -expand false -fill x
848    
849     scale .nums.bc -from 1 -to 200 -orient horizontal -variable pref(BadLineCycles) \
850     -label "Bad Line Cycles"
851     pack .nums.bc -side top -expand false -fill x
852    
853     scale .nums.cc -from 1 -to 200 -orient horizontal -variable pref(CIACycles) \
854     -label "CIA Cycles"
855     pack .nums.cc -side top -expand false -fill x
856    
857     scale .nums.fc -from 1 -to 200 -orient horizontal -variable pref(FloppyCycles) \
858     -label "Floppy Cycles"
859     pack .nums.fc -side top -expand false -fill x
860    
861     scale .nums.sf -from 1 -to 10 -orient horizontal -variable pref(SkipFrames) \
862     -label "Skip Frames"
863     pack .nums.sf -side top -expand false -fill x
864    
865     # =============================================================
866    
867     frame .bools1 -borderwidth 3 -relief raised
868    
869     frame .bools1.sprites
870     pack .bools1.sprites -side left -expand true -fill both
871    
872     checkbutton .bools1.sprites.o -text "Sprites" -variable pref(SpritesOn) -command "Change"
873     pack .bools1.sprites.o -anchor nw -expand false -fill y
874    
875     checkbutton .bools1.sprites.c -text "Sprite Collisions" \
876     -variable pref(SpriteCollisions) -command "Change"
877     pack .bools1.sprites.c -anchor nw -expand false -fill y
878    
879    
880     frame .bools1.joy
881     pack .bools1.joy -side left -expand true -fill both
882    
883     checkbutton .bools1.joy.j1 -text "Joy 1" -variable pref(Joystick1On) -command "Change"
884     pack .bools1.joy.j1 -anchor nw -expand false -fill y
885    
886     checkbutton .bools1.joy.j2 -text "Joy 2" -variable pref(Joystick2On) -command "Change"
887     pack .bools1.joy.j2 -anchor nw -expand false -fill y
888    
889     checkbutton .bools1.joy.swap -text "Swap 1<->2" -variable pref(JoystickSwap) -command "Change"
890     pack .bools1.joy.swap -anchor nw -expand false -fill y
891    
892    
893     frame .bools2 -borderwidth 3 -relief raised
894    
895     frame .bools2.m1
896     pack .bools2.m1 -side left -expand true -fill both
897    
898     checkbutton .bools2.m1.ls -text "Limit Speed" -variable pref(LimitSpeed) -command "Change"
899     pack .bools2.m1.ls -anchor nw -expand false -fill y
900    
901     checkbutton .bools2.m1.fr -text "Fast Reset" -variable pref(FastReset) -command "Change"
902     pack .bools2.m1.fr -anchor nw -expand false -fill y
903    
904    
905     frame .bools2.m2
906     pack .bools2.m2 -side left -expand true -fill both
907    
908     checkbutton .bools2.m2.ch -text "CIA IRQ Hack" -variable pref(CIAIRQHack) -command "Change"
909     pack .bools2.m2.ch -anchor nw -expand false -fill y
910    
911     checkbutton .bools2.m2.ms -text "Map '/'" -variable pref(MapSlash) -command "Change"
912     pack .bools2.m2.ms -anchor nw -expand false -fill y
913    
914    
915     frame .bools4 -relief raised -borderwidth 3
916    
917     frame .bools4.st
918     pack .bools4.st -side left -expand true -fill both
919    
920     label .bools4.st.l -text "SID Emulation"
921     pack .bools4.st.l -anchor nw
922     radiobutton .bools4.st.none -text "None" -variable pref(SIDType) -value "NONE" \
923     -command {Change}
924     pack .bools4.st.none -anchor nw
925    
926     radiobutton .bools4.st.digi -text "Digital" -variable pref(SIDType) -value "DIGITAL" \
927     -command {Change}
928     pack .bools4.st.digi -anchor nw
929    
930     frame .bools4.sf
931     pack .bools4.sf -side left -expand true -fill both
932    
933     checkbutton .bools4.sf.sf -text "SID Filters" -variable pref(SIDFilters) -command "Change"
934     pack .bools4.sf.sf -side top -expand false -fill y
935    
936    
937     # =============================================================
938    
939     frame .pcmd
940     pack .pcmd -side top -expand false -fill both
941    
942     button .pcmd.apply -text "Apply" -command "Change"
943     pack .pcmd.apply -side left -expand true -fill both
944    
945     button .pcmd.default -text "Defaults" -command "defaults ; Change"
946     pack .pcmd.default -side left -expand false -fill both
947    
948     # =============================================================
949    
950     set ledcolors(0) "#d9d9d9"
951     set ledcolors(1) "red"
952     set ledcolors(2) "brown"
953    
954     proc ListenToFrodo {} {
955     set line [gets stdin]
956     set cmd [lindex $line 0]
957     switch -exact $cmd {
958     "speed" {
959     .speed.v configure -text "[lindex $line 1]%"
960     }
961     "ping" {
962     puts -nonewline "o"
963     flush stdout
964     }
965     "quit" {
966     exit 0
967     }
968     "leds" {
969     global ledcolors
970     .drives.d8.l configure -background $ledcolors([lindex $line 1])
971     .drives.d9.l configure -background $ledcolors([lindex $line 2])
972     .drives.d10.l configure -background $ledcolors([lindex $line 3])
973     .drives.d11.l configure -background $ledcolors([lindex $line 4])
974     }
975     default {
976     puts stderr "line = $line"
977     }
978     }
979     }
980    
981    
982     proc set_Emul1541Proc args {
983     global pref
984    
985     if {$pref(Emul1541Proc)} {
986     set state disabled
987     set pref(DriveType8) "D64"
988     } else {
989     set state normal
990     }
991     .drives.d8.dir configure -state $state
992     .drives.d8.t64 configure -state $state
993     foreach i {9 10 11} {
994     .drives.d${i}.d64 configure -state $state
995     .drives.d${i}.dir configure -state $state
996     .drives.d${i}.t64 configure -state $state
997     .drives.d${i}.name configure -state $state
998     .drives.d${i}.n configure -state $state
999     }
1000     }
1001    
1002     proc set_ShowOptions args {
1003     global pref show_options_string
1004    
1005     if {$pref(ShowOptions)} {
1006     pack .nums -side top -expand false -fill x -after .more_options
1007     pack .bools1 -side top -expand true -fill both -after .nums
1008     pack .bools2 -side top -expand true -fill both -after .bools1
1009     pack .bools4 -side top -expand true -fill both -after .bools2
1010     set show_options_string "Hide Advanced Options"
1011     } else {
1012     pack forget .nums .bools1 .bools2 .bools4
1013     set show_options_string "Show Advanced Options"
1014     }
1015     }
1016    
1017     fileevent stdin readable { ListenToFrodo }
1018    
1019     # =============================================================
1020    
1021     wm title . "Frodo Preferences Menu"
1022    
1023     # set trace and trigger it now
1024     trace variable pref(Emul1541Proc) w set_Emul1541Proc
1025     set pref(Emul1541Proc) $pref(Emul1541Proc)
1026    
1027     # set trace and trigger it now
1028     trace variable pref(ShowOptions) w set_ShowOptions
1029     set pref(ShowOptions) $pref(ShowOptions)
1030    
1031     tkwait window .