1#!/usr/local/bin/wish8.6
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
8set prefname "$env(HOME)/.frodorc"
9
10proc 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
40proc s2bool { s } {
41	if {$s == "TRUE"} {return 1}
42	return 0
43}
44
45defaults
46
47if {![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
135proc bool2s { b } {
136	if {$b} { return "TRUE" }
137	return "FALSE"
138}
139
140proc 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
180proc Quit {} {
181	puts -nonewline "q"
182	flush stdout
183	exit 0
184}
185
186# =============================================================
187
188frame .cmds
189pack .cmds -expand false -fill both
190
191button .cmds.quit -text "Quit" -command "Quit"
192pack .cmds.quit -side left -expand true -fill both
193
194button .cmds.reset -text "Reset" -command {puts -nonewline "r" ; flush stdout}
195pack .cmds.reset -side left -expand true -fill both
196
197# =============================================================
198
199proc Change { {dummy1 ""} {dummy2 ""}} {
200	WritePrefs
201}
202
203#====================== begin of fs-box ========================
204
205proc 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
213proc 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
397proc 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
507proc 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
539proc 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
600proc 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
635set num(1) "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
636set num(2) "abcdefghijklmnopqrstuvwxyza"
637set num(3) "12345678901"
638
639proc 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
660frame .drives -borderwidth 0
661pack .drives -side top -expand false -fill x
662
663label .drives.l -text "Disk Drive Controls" -height 2
664pack .drives.l -side top -expand true -fill both
665
666checkbutton .drives.ef -text "Emulate 1541 CPU (Drive 8 only)" -variable pref(Emul1541Proc) -command "Change" -bg "dark grey" -anchor w
667pack .drives.ef -side top -expand true -fill both
668
669frame .drives.d8 -borderwidth 0
670pack .drives.d8 -side top -expand true -fill x
671
672label .drives.d8.l -text "8" -width 2
673pack .drives.d8.l -side left -expand false
674radiobutton .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    }
679pack .drives.d8.d64 -side left -expand false -fill y
680
681radiobutton .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    }
686pack .drives.d8.dir -side left -expand false
687
688radiobutton .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    }
693pack .drives.d8.t64 -side left -expand false
694
695entry .drives.d8.name -textvar pref(DrivePath8)
696bind .drives.d8.name <Return> "Change"
697bind .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}
701pack .drives.d8.name -side left -expand true -fill x
702
703button .drives.d8.n -text "N" -command { set pref(DrivePath8) [NDname $pref(DrivePath8)]; Change }
704pack .drives.d8.n -side left -expand false
705
706frame .drives.d9
707pack .drives.d9 -side top -expand true -fill x
708
709label .drives.d9.l -text "9" -width 2
710pack .drives.d9.l -side left -expand false
711radiobutton .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    }
716pack .drives.d9.d64 -side left -expand false
717
718radiobutton .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    }
723pack .drives.d9.dir -side left -expand false
724
725radiobutton .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    }
730pack .drives.d9.t64 -side left -expand false
731
732entry .drives.d9.name -textvar pref(DrivePath9)
733bind .drives.d9.name <Return> "Change"
734bind .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}
738pack .drives.d9.name -side left -expand true -fill x
739
740button .drives.d9.n -text "N" -command { set pref(DrivePath9) [NDname $pref(DrivePath9)]; Change }
741pack .drives.d9.n -side left -expand false
742
743
744frame .drives.d10
745pack .drives.d10 -side top -expand true -fill x
746
747label .drives.d10.l -text "10" -width 2
748pack .drives.d10.l -side left -expand false
749radiobutton .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    }
754pack .drives.d10.d64 -side left -expand false
755
756radiobutton .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    }
761pack .drives.d10.dir -side left -expand false
762
763radiobutton .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    }
768pack .drives.d10.t64 -side left -expand false
769
770entry .drives.d10.name -textvar pref(DrivePath10)
771bind .drives.d10.name <Return> "Change"
772bind .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}
776pack .drives.d10.name -side left -expand true -fill x
777
778button .drives.d10.n -text "N" -command { set pref(DrivePath10) [NDname $pref(DrivePath10)]; Change }
779pack .drives.d10.n -side left -expand false
780
781
782frame .drives.d11
783pack .drives.d11 -side top -expand true -fill x
784
785label .drives.d11.l -text "11" -width 2
786pack .drives.d11.l -side left -expand false
787radiobutton .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    }
792pack .drives.d11.d64 -side left -expand false
793
794radiobutton .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    }
799pack .drives.d11.dir -side left -expand false
800
801radiobutton .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    }
806pack .drives.d11.t64 -side left -expand false
807
808entry .drives.d11.name -textvar pref(DrivePath11)
809bind .drives.d11.name <Return> "Change"
810bind .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}
814pack .drives.d11.name -side left -expand true -fill x
815
816button .drives.d11.n -text "N" -command { set pref(DrivePath11) [NDname $pref(DrivePath11)]; Change }
817pack .drives.d11.n -side left -expand false
818
819
820# =============================================================
821
822global show_options_string
823
824checkbutton .more_options -borderwidth 3 -relief raised -textvariable show_options_string -variable pref(ShowOptions) -command "Change"
825pack .more_options -side top -expand false -fill x
826
827frame .nums -borderwidth 3 -relief raised
828
829scale .nums.nc -from 1 -to 200 -orient horizontal -variable pref(NormalCycles) \
830               -label "Normal Cycles"
831pack .nums.nc -side top -expand false -fill x
832
833scale .nums.bc -from 1 -to 200 -orient horizontal -variable pref(BadLineCycles) \
834               -label "Bad Line Cycles"
835pack .nums.bc -side top -expand false -fill x
836
837scale .nums.cc -from 1 -to 200 -orient horizontal -variable pref(CIACycles) \
838               -label "CIA Cycles"
839pack .nums.cc -side top -expand false -fill x
840
841scale .nums.fc -from 1 -to 200 -orient horizontal -variable pref(FloppyCycles) \
842               -label "Floppy Cycles"
843pack .nums.fc -side top -expand false -fill x
844
845scale .nums.sf -from 1 -to 10 -orient horizontal -variable pref(SkipFrames) \
846               -label "Skip Frames"
847pack .nums.sf -side top -expand false -fill x
848
849# =============================================================
850
851frame .bools1 -borderwidth 3 -relief raised
852
853frame .bools1.sprites
854pack .bools1.sprites -side left -expand true -fill both
855
856checkbutton .bools1.sprites.o -text "Sprites" -variable pref(SpritesOn) -command "Change"
857pack .bools1.sprites.o -anchor nw -expand false -fill y
858
859checkbutton .bools1.sprites.c -text "Sprite Collisions" \
860            -variable pref(SpriteCollisions) -command "Change"
861pack .bools1.sprites.c -anchor nw -expand false -fill y
862
863
864frame .bools1.joy
865pack .bools1.joy -side left -expand true -fill both
866
867checkbutton .bools1.joy.j1 -text "Joy 1" -variable pref(Joystick1On) -command "Change"
868pack .bools1.joy.j1 -anchor nw -expand false -fill y
869
870checkbutton .bools1.joy.j2 -text "Joy 2" -variable pref(Joystick2On) -command "Change"
871pack .bools1.joy.j2 -anchor nw -expand false -fill y
872
873checkbutton .bools1.joy.swap -text "Swap 1<->2" -variable pref(JoystickSwap) -command "Change"
874pack .bools1.joy.swap -anchor nw -expand false -fill y
875
876
877frame .bools2 -borderwidth 3 -relief raised
878
879frame .bools2.m1
880pack .bools2.m1 -side left -expand true -fill both
881
882checkbutton .bools2.m1.ls -text "Limit Speed" -variable pref(LimitSpeed) -command "Change"
883pack .bools2.m1.ls -anchor nw -expand false -fill y
884
885checkbutton .bools2.m1.fr -text "Fast Reset" -variable pref(FastReset) -command "Change"
886pack .bools2.m1.fr -anchor nw -expand false -fill y
887
888
889frame .bools2.m2
890pack .bools2.m2 -side left -expand true -fill both
891
892checkbutton .bools2.m2.ch -text "CIA IRQ Hack" -variable pref(CIAIRQHack) -command "Change"
893pack .bools2.m2.ch -anchor nw -expand false -fill y
894
895checkbutton .bools2.m2.ms -text "Map '/'" -variable pref(MapSlash) -command "Change"
896pack .bools2.m2.ms -anchor nw -expand false -fill y
897
898
899frame .bools4 -relief raised -borderwidth 3
900
901frame .bools4.st
902pack .bools4.st -side left -expand true -fill both
903
904label .bools4.st.l -text "SID Emulation"
905pack .bools4.st.l -anchor nw
906radiobutton .bools4.st.none -text "None" -variable pref(SIDType) -value "NONE" \
907            -command {Change}
908pack .bools4.st.none -anchor nw
909
910radiobutton .bools4.st.digi -text "Digital" -variable pref(SIDType) -value "DIGITAL" \
911            -command {Change}
912pack .bools4.st.digi -anchor nw
913
914frame .bools4.sf
915pack .bools4.sf -side left -expand true -fill both
916
917checkbutton .bools4.sf.sf -text "SID Filters" -variable pref(SIDFilters) -command "Change"
918pack .bools4.sf.sf -side top -expand false -fill y
919
920
921# =============================================================
922
923frame .pcmd
924pack .pcmd -side top -expand false -fill both
925
926button .pcmd.apply -text "Apply" -command "Change"
927pack .pcmd.apply -side left -expand true -fill both
928
929button .pcmd.default -text "Defaults" -command "defaults ; Change"
930pack .pcmd.default -side left -expand false -fill both
931
932# =============================================================
933
934set ledcolors(0) "#d9d9d9"
935set ledcolors(1) "red"
936set ledcolors(2) "brown"
937
938proc 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
966proc 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
986proc 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
1001fileevent stdin readable { ListenToFrodo }
1002
1003# =============================================================
1004
1005wm title . "Frodo Preferences Menu"
1006
1007# set trace and trigger it now
1008trace variable pref(Emul1541Proc) w set_Emul1541Proc
1009set pref(Emul1541Proc) $pref(Emul1541Proc)
1010
1011# set trace and trigger it now
1012trace variable pref(ShowOptions) w set_ShowOptions
1013set pref(ShowOptions) $pref(ShowOptions)
1014
1015tkwait window .
1016
1017
1018
1019