ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/cebix/Frodo4/TkGui.tcl
Revision: 1.1
Committed: 2003-07-01T15:46:46Z (20 years, 10 months ago) by cebix
Content type: application/x-tcl
Branch: MAIN
Log Message:
imported files

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