OXYGENHUB
◆ main openmsx / share / scripts / _vdrive.tcl
3.6 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
set_help_text vdrive \
2 
{v-drive functionality of blueMSX implemented in a Tcl script for openMSX
3 
version 1.0
4
5 
What does it do:
6 
  It is a simple Tcl script that bound to a hotkey (f.i. F9+ALT) allows
7 
  users to swap disks without using the commandconsole or Catapult for
8 
  file selection. This is especially useful for games and demos that
9 
  span over multiple disks.
10
11 
Preparations:
12 
1. If you have software that spans multiple disks, you have to name them
13 
   according to the scheme: name+digit+extension for example [metal1.dsk,
14 
   metal2.dsk, metal3.dsk]
15 
   Of course they may all be compressed with gzip, so you'll end up with
16 
   [metal1.dsk.gz, metal2.dsk.gz, metal3.dsk.gz].
17 
   The script recognizes 'dsk', 'di1', 'di2', 'xsa' and 'dmk' extensions,
18 
   with an optional '.gz' or '.zip' suffix.
19
20 
2. bind the vdrive script to a hotkey, for instance type in the console:
21 
     bind ALT+F9 "vdrive diska"
22 
     bind ALT+F10 "vdrive diskb"
23 
   vdrive will default to 'diska' when no drive parameter is specified.
24 
   Note: the two bind commands above are already the default key bindings;
25 
         you only need to execute them if you want a different key binding.
26
27 
Using:
28 
  While emulating an MSX, and the sofware asks for the next disk, simply
29 
  press the hot-key. The script will select the next disk in the sequence.
30 
  If the last disk is reached, the script will select the first disk
31 
  again. So you actually are cycling through the entire disk set as shown
32 
  in the diagram below
33
34 
   _"disk1.dsk" => ALT+F9 => "disk2.dsk" => ALT+F9 => "disk3.dsk" _
35 
  |                                                                |
36 
   <= <= <= <= <= <= <= ALT+F9  <= <= <= <= <= <= <= <= <= <= <= <=
37
38
39 
credits:
40 
  original alt+f9 v-DRIVE idea by the blueMSX crew.
41 
  copyright 2005 David Heremans
42 
}
43
44 
proc vdrive {{diskdrive "diska"} {step 1}} {
45 
	# Get current disk
46 
	if {[catch {set cmd [$diskdrive]}]} {error "No such drive: $diskdrive"}
47
48 
	# Skip for empty drive or 'special' disk
49 
	set options [lindex $cmd 2]
50 
	if       {"empty" in $options} {
51 
		error "No disk in drive: $diskdrive"
52 
	} elseif {"ramdsk" in $options} {
53 
		error "Vdrive not possible on ramdsk"
54 
	} elseif {"dirasdisk" in $options} {
55 
		error "Vdrive not possible on DirAsDisk"
56 
	}
57
58 
	# Remove (dsk|di1|di2|xsa|dmk)(.gz)? extention
59 
	set base [lindex $cmd 1]
60 
	set ext ""
61 
	set tmp [file extension $base]
62 
	foreach i {".gz" ".zip"} {
63 
		if {[string equal -nocase $i $tmp]} {
64 
			set ext $tmp
65 
			set base [file rootname $base]
66 
			break
67 
		}
68 
	}
69 
	set tmp [file extension $base]
70 
	foreach i {".dsk" ".di1" ".di2" ".xsa" ".dmk"} {
71 
		if {[string equal -nocase $i $tmp]} {
72 
			set ext ${tmp}${ext}
73 
			set base [file rootname $base]
74 
			break
75 
		}
76 
	}
77
78 
	# Split on trailing digits
79 
	if {![regexp -indices {[0-9]+$} $base match]} {
80 
		error "Name doesn't end in a number"
81 
	}
82 
	set i [lindex $match 0]
83 
	set num  [string range $base $i end]
84 
	set base [string range $base 0 $i-1]
85
86 
	# Calculate range (number of digits)
87 
	# Trim leading zeros (avoid interpreting the value as octal)
88 
	set digits [string length $num]
89 
	set range [expr {int(pow(10, $digits))}]
90 
	set num [string trimleft $num 0]
91 
	set fmt "%s%0${digits}d%s"
92
93 
	# Increase (decrease) number until new file is found.
94 
	set orig $num
95 
	while 1 {
96 
		set num [expr {($num + $step) % $range}]
97 
		if {$num == $orig} {
98 
			# We're back at the original. Explicitly test for this
99 
			# because the original file might not exist anymore.
100 
			return
101 
		}
102 
		# Construct new filename (including leading zeros)
103 
		set newfile [format $fmt $base $num $ext]
104 
		if {[file exists $newfile]} {
105 
			# New file exists, insert in the disk drive
106 
			diska $newfile
107 
			return "New diskimage: $newfile"
108 
		}
109 
	}
110 
}