OXYGENHUB
◆ main openmsx / share / scripts / _guess_title.tcl
5.8 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 1 
namespace eval guess_title {
2
3 
set_help_text guess_title \
4 
{Guess the title of the currently running software. Remember... it's only a guess! It will be wrong some times. (But it will be right in many cases.)
5 
}
6
7 
# Here are some cases worth to consider and test.
8
9 
# * FM-PAC as extension and a ROM game slot 2. You don't want to get the FM-PAC
10 
#   returned when it's used as FM module, but you do when you did _FMPAC and use
11 
#   the internal software of it.
12 
# * Rollerball runs in page 2 (when using the proper ROM type)
13 
# * Philips Music Module, start up with ESC. You don't want to return the ROM
14 
#   as 'running software', but when you did not press ESC, you do.
15 
# * Koei games like Teitoku no Ketsudan. In combination with an FM-PAC in slot
16 
#   1. This games seems to run from RAM mostly.
17 
# * Tape converted to cart. Runs in RAM.
18 
# * SCC extension in combination with a disk game/demo. Runs with an empty ROM
19 
#   which you don't want to return as title.
20 
# * Sony HB-75P with internal software (Personal Data Bank). Runs in page 2.
21 
# * MSX-DOS
22 
# * MSX-DOS 2 (all pages are RAM)
23
24 
# this one checks on the checkpage for external or internal software
25 
proc guess_rom_device_z80space {internal checkpage} {
26 
	lassign [get_selected_slot $checkpage] ps ss
27 
	if {$ss eq "X"} {set ss 0}
28 
	set incorrectslottype [machine_info isexternalslot $ps $ss]
29 
	if {$internal} {
30 
		set incorrectslottype [expr {!$incorrectslottype}]
31 
	}
32 
	if {$incorrectslottype} {
33 
		foreach device [machine_info slot $ps $ss $checkpage] {
34 
			set type [dict get [machine_info device $device] "type"]
35 
			# try to ignore RAM devices
36 
			if {$type ne "RAM" && $type ne "MemoryMapper" && $type ne "PanasonicRAM"} {
37 
				return $device
38 
			}
39 
		}
40 
	}
41 
	return ""
42 
}
43
44 
proc guess_rom_device_nonextension {} {
45 
	set system_rom_paths [filepool::get_paths_for_type system_rom]
46 
	# Loop over all external slots which contain a ROM, return the first
47 
	# which is not located in one of the systemrom filepools.
48 
	for {set ps 0} {$ps < 4} {incr ps} {
49 
		for {set ss 0} {$ss < 4} {incr ss} {
50 
			if {![machine_info isexternalslot $ps $ss]} continue
51 
			foreach device [machine_info slot $ps $ss 1] {
52 
				set path ""
53 
				catch {set path [dict get [machine_info device $device] "filename"]}
54 
				if {$path eq ""} continue
55 
				set ok 1
56 
				foreach syspath $system_rom_paths {
57 
					if {[string first $syspath $path] == 0} {
58 
						set ok 0; break
59 
					}
60 
				}
61 
				if {$ok} {return $device}
62 
			}
63 
		}
64 
	}
65 
	return ""
66 
}
67
68 
proc guess_rom_device_naive {} {
69 
	for {set ps 0} {$ps < 4} {incr ps} {
70 
		for {set ss 0} {$ss < 4} {incr ss} {
71 
			if {[machine_info isexternalslot $ps $ss]} {
72 
				set device_list [list]
73 
				foreach device [machine_info slot $ps $ss 1] {
74 
					# try to ignore RAM devices
75 
					set type [dict get [machine_info device $device] "type"]
76 
					if {$type ne "RAM" && $type ne "MemoryMapper" && $type ne "PanasonicRAM"} {
77 
						lappend device_list $device
78 
					}
79 
				}
80 
				if {[llength $device_list] != 0} {
81 
					return $device_list
82 
				}
83 
			}
84 
		}
85 
	}
86 
	return ""
87 
}
88
89 
proc format_title_from_path {path} {
90 
	return [string totitle [file rootname [file tail $path]]]
91 
}
92
93 
proc guess_disk_title {drive_name} {
94 
	# check name of the diskimage (remove directory part and extension)
95 
	set disk ""
96 
	catch {set disk [lindex [$drive_name] 1]}
97 
	return [format_title_from_path $disk]
98 
}
99
100 
proc guess_cassette_title {} {
101 
	# check name of the cassette image (remove directory part and extension)
102 
	set cassette ""
103 
	catch {set cassette [lindex [cassetteplayer] 1]}
104 
	return [format_title_from_path $cassette]
105 
}
106
107 
proc guess_title {{fallback ""}} {
108 
	# first try to see what is actually mapped in Z80 space
109 
	# that is often correct, if it gives a result...
110 
	# but it doesn't give a result for ROMs that copy themselves to RAM
111 
	# (e.g. Koei games, tape games converted to ROM, etc.).
112 
	set result [guess_rom_device_z80space false 1]
113 
	if {$result ne ""} {return [rom_device_to_title $result]}
114
115 
	# then try disks
116 
	# games typically run from drive A, almost never from another drive
117 
	set title [guess_disk_title "diska"]
118 
	if {$title ne ""} {return $title}
119
120 
	# then try cassette
121 
	set title [guess_cassette_title]
122 
	if {$title ne ""} {return $title}
123
124 
	# if that doesn't give a result, try non extension devices
125 
	set result [guess_rom_device_nonextension]
126 
	if {$result ne ""} {return [rom_device_to_title $result]}
127
128 
	# if that doesn't give a result, just return the first thing we find in
129 
	# an external slot
130 
	# ... this doesn't add much to the nonextension version
131 
#	set result [guess_rom_device_naive]
132
133 
	# perhaps we should simply return internal software if nothing found yet
134 
	# Do page 1 last, because BASIC is in there
135 
	set result [guess_rom_device_z80space true 3]
136 
	if {$result ne ""} {return [rom_device_to_title $result]}
137 
	set result [guess_rom_device_z80space true 2]
138 
	if {$result ne ""} {return [rom_device_to_title $result]}
139 
	set result [guess_rom_device_z80space true 1]
140 
	if {$result ne ""} {return [rom_device_to_title $result]}
141
142 
	# guess failed, return fallback
143 
	return $fallback
144 
}
145
146 
proc rom_device_to_title {device} {
147 
	set result $device
148 
	if {[openmsx_info file_type_category $device] eq "rom"} {
149 
		# it has an extension for a ROM type, so it's a path
150 
		set result [format_title_from_path $device]
151 
	}
152 
	return $result
153 
}
154
155 
# use this proc if you only want to guess ROM titles
156 
proc guess_rom_title {} {
157 
	return [rom_device_to_title [guess_rom_device]]
158 
}
159
160 
proc guess_rom_device {} {
161 
	set result [guess_rom_device_z80space false 1]
162 
	if {$result ne ""} {return $result}
163
164 
	# if that doesn't give a result, try non extension devices
165 
	set result [guess_rom_device_nonextension]
166 
	if {$result ne ""} {return $result}
167
168 
	# if that doesn't give a result, just return the first thing we find in
169 
	# an external slot (but not RAM)
170 
	set result [guess_rom_device_naive]
171 
	return $result
172 
}
173
174 
namespace export guess_title
175 
namespace export guess_rom_title
176 
namespace export guess_rom_device
177
178 
} ;# namespace guess_title
179
180 
namespace import guess_title::*