ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/cebix/Frodo4/TkGui.tcl
Revision: 1.3
Committed: 2003-07-01T19:14:08Z (20 years, 9 months ago) by cebix
Content type: application/x-tcl
Branch: MAIN
CVS Tags: VERSION_4_2, HEAD
Changes since 1.2: +0 -0 lines
State: FILE REMOVED
Log Message:
TkGui.tcl renamed to Frodo_GUI.tcl, which is now expected and installed in
/usr/bin

File Contents

# Content
1 #!/usr/bin/wish
2
3 # Frodo Tk GUI by Lutz Vieweg <lkv@mania.robin.de>
4 # requires Tk >= 4.1
5 #
6 # Frodo (C) 1994-1997,2002-2003 Christian Bauer
7 #
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 .