OXYGENHUB
◆ main openmsx / share / scripts / _rom_info.tcl
3.7 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
set_help_text rom_info\
2 
{Prints information about the given ROM device, coming from the software
3 
database. If no argument is given, the first found (external) ROM device is
4 
shown.}
5
6 
namespace eval rom_info {
7
8 
proc tab {args} {
9 
	set result [list]
10
11 
	foreach device [machine_info device] {
12 
		if {[dict get [machine_info device $device] "type"] eq "ROM"} {
13 
			lappend result $device
14 
		}
15 
	}
16 
	return $result
17 
}
18
19 
set_tabcompletion_proc rom_info [namespace code tab]
20
21 
proc getlist_rom_info {{romdevice ""}} {
22 
	if {$romdevice eq ""} {
23 
		set romdevice [guess_rom_device]
24 
		if {$romdevice eq ""} {
25 
			error "No (external) ROM device found"
26 
		}
27 
	}
28
29 
	if {[catch {set device_info [machine_info device $romdevice]}]} {
30 
		error "No such device: $romdevice"
31 
	}
32
33 
	set device_type [dict get $device_info "type"]
34 
	if {$device_type ne "ROM"} {
35 
		error [format "Device is not of type ROM, but %s" $device_type]
36 
	}
37
38 
	set filename [dict get $device_info "filename"]
39
40 
	set slotname ""
41 
	set slot ""
42 
	foreach slotcmd [info command cart?] {
43 
		set extname [lindex [$slotcmd] 1]
44 
		if {$extname eq ""} continue
45 
		set devicename [lindex [dict get [machine_info extension $extname] devices] 0]
46 
		if {$devicename eq $romdevice} {
47 
			set slotname [string index $slotcmd end]
48 
			set slotinfo [machine_info external_slot slot$slotname]
49 
			set slotname [string toupper $slotname]
50 
			set slot [lindex $slotinfo 0]
51 
			set subslot [lindex $slotinfo 1]
52 
			if {$subslot ne "X"} {
53 
				append slot "-$subslot"
54 
			}
55 
		}
56 
	}
57
58 
	set actualSHA1 [dict get $device_info "actualSHA1"]
59 
	set originalSHA1 [dict get $device_info "originalSHA1"]
60
61 
	set rominfo ""
62 
	if {[catch {set rominfo [openmsx_info software $actualSHA1]}]} {
63 
		# try original sha1 to get more info
64 
		catch {set rominfo [openmsx_info software $originalSHA1]}
65 
	}
66 
	set softPatched [expr {$actualSHA1 ne $originalSHA1}]
67 
	set mappertype [dict get $device_info "mappertype"]
68
69 
	set title ""
70 
	set company ""
71 
	set country ""
72 
	set year ""
73 
	set status ""
74 
	set remark ""
75
76 
	dict with rominfo {
77 
		if {[info exists original] && $original} {
78 
			# this is an unmodified original dump
79 
			set status [format "Unmodified dump (confirmed by %s)" $orig_type]
80 
		} else {
81 
			# not original or unknown
82 
			set status "Unknown"
83 
			if {[info exists orig_type]} {
84 
				switch $orig_type {
85 
					"broken" {
86 
						set status "Bad dump (game is broken)"
87 
					}
88 
					"translated" {
89 
						set status "Translated from original"
90 
					}
91 
					"working" {
92 
						set status "Modified but confirmed working"
93 
					}
94 
				}
95 
			}
96 
		}
97 
	}
98 
	if {$softPatched} {
99 
		set statusPrefix ""
100 
		if {$status ne ""} {
101 
			set statusPrefix " "
102 
		}
103 
		set status "$status${statusPrefix}(but patched by openMSX)"
104 
	}
105
106 
	return [list \
107 
			"filename"	$filename \
108 
			"title"		$title \
109 
			"year"		$year \
110 
			"company"	$company \
111 
			"country"	$country \
112 
			"status"	$status \
113 
			"remark"	$remark \
114 
			"mappertype"	$mappertype \
115 
			"slotname"	$slotname \
116 
			"slot"		$slot]
117 
}
118
119 
proc rom_info {{romdevice ""}} {
120 
	set rominfo [rom_info::getlist_rom_info $romdevice]
121
122 
	dict with rominfo {
123 
		if {$slotname ne "" && $slot ne ""} {
124 
			append result "Cart. slot: $slotname (slot $slot)\n"
125 
		}
126 
		if {$title ne ""} {
127 
			append result "Title:      $title\n"
128 
		} elseif {$filename ne ""} {
129 
			append result "File:       $filename\n"
130 
		}
131 
		if {$year ne ""} {
132 
			append result "Year:       $year\n"
133 
		}
134 
		if {$company ne ""} {
135 
			append result "Company:    $company\n"
136 
		}
137 
		if {$country ne ""} {
138 
			append result "Country:    $country\n"
139 
		}
140 
		if {$status ne ""} {
141 
			append result "Status:     $status\n"
142 
		}
143 
		if {$remark ne ""} {
144 
			append result "Remark:     $remark\n"
145 
		}
146 
		if {$mappertype ne ""} {
147 
			append result "Mapper:     $mappertype\n"
148 
		}
149 
	}
150 
	return $result
151 
}
152
153 
namespace export rom_info
154 
namespace export getlist_rom_info
155
156 
} ;# namespace rom_info
157
158 
namespace import rom_info::*