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-2004 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 . |