File: _rom_info.tcl

package info (click to toggle)
openmsx 20.0%2Bdfsg-1.2
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 27,544 kB
  • sloc: cpp: 236,922; xml: 49,948; tcl: 15,056; python: 5,385; perl: 281; sh: 77; makefile: 53
file content (158 lines) | stat: -rw-r--r-- 3,813 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
set_help_text rom_info\
{Prints information about the given ROM device, coming from the software
database. If no argument is given, the first found (external) ROM device is
shown.}

namespace eval rom_info {

proc tab {args} {
	set result [list]

	foreach device [machine_info device] {
		if {[dict get [machine_info device $device] "type"] eq "ROM"} {
			lappend result $device
		}
	}
	return $result
}

set_tabcompletion_proc rom_info [namespace code tab]

proc getlist_rom_info {{romdevice ""}} {
	if {$romdevice eq ""} {
		set romdevice [guess_rom_device]
		if {$romdevice eq ""} {
			error "No (external) ROM device found"
		}
	}

	if {[catch {set device_info [machine_info device $romdevice]}]} {
		error "No such device: $romdevice"
	}

	set device_type [dict get $device_info "type"]
	if {$device_type ne "ROM"} {
		error [format "Device is not of type ROM, but %s" $device_type]
	}

	set filename [dict get $device_info "filename"]

	set slotname ""
	set slot ""
	foreach slotcmd [info command cart?] {
		set extname [lindex [$slotcmd] 1]
		if {$extname eq ""} continue
		set devicename [lindex [dict get [machine_info extension $extname] devices] 0]
		if {$devicename eq $romdevice} {
			set slotname [string index $slotcmd end]
			set slotinfo [machine_info external_slot slot$slotname]
			set slotname [string toupper $slotname]
			set slot [lindex $slotinfo 0]
			set subslot [lindex $slotinfo 1]
			if {$subslot ne "X"} {
				append slot "-$subslot"
			}
		}
	}

	set actualSHA1 [dict get $device_info "actualSHA1"]
	set originalSHA1 [dict get $device_info "originalSHA1"]

	set rominfo ""
	if {[catch {set rominfo [openmsx_info software $actualSHA1]}]} {
		# try original sha1 to get more info
		catch {set rominfo [openmsx_info software $originalSHA1]}
	}
	set softPatched [expr {$actualSHA1 ne $originalSHA1}]
	set mappertype [dict get $device_info "mappertype"]

	set title ""
	set company ""
	set country ""
	set year ""
	set status ""
	set remark ""

	dict with rominfo {
		if {[info exists original] && $original} {
			# this is an unmodified original dump
			set status [format "Unmodified dump (confirmed by %s)" $orig_type]
		} else {
			# not original or unknown
			set status "Unknown"
			if {[info exists orig_type]} {
				switch $orig_type {
					"broken" {
						set status "Bad dump (game is broken)"
					}
					"translated" {
						set status "Translated from original"
					}
					"working" {
						set status "Modified but confirmed working"
					}
				}
			}
		}
	}
	if {$softPatched} {
		set statusPrefix ""
		if {$status ne ""} {
			set statusPrefix " "
		}
		set status "$status${statusPrefix}(but patched by openMSX)"
	}

	return [list \
			"filename"	$filename \
			"title"		$title \
			"year"		$year \
			"company"	$company \
			"country"	$country \
			"status"	$status \
			"remark"	$remark \
			"mappertype"	$mappertype \
			"slotname"	$slotname \
			"slot"		$slot]
}

proc rom_info {{romdevice ""}} {
	set rominfo [rom_info::getlist_rom_info $romdevice]

	dict with rominfo {
		if {$slotname ne "" && $slot ne ""} {
			append result "Cart. slot: $slotname (slot $slot)\n"
		}
		if {$title ne ""} {
			append result "Title:      $title\n"
		} elseif {$filename ne ""} {
			append result "File:       $filename\n"
		}
		if {$year ne ""} {
			append result "Year:       $year\n"
		}
		if {$company ne ""} {
			append result "Company:    $company\n"
		}
		if {$country ne ""} {
			append result "Country:    $country\n"
		}
		if {$status ne ""} {
			append result "Status:     $status\n"
		}
		if {$remark ne ""} {
			append result "Remark:     $remark\n"
		}
		if {$mappertype ne ""} {
			append result "Mapper:     $mappertype\n"
		}
	}
	return $result
}

namespace export rom_info
namespace export getlist_rom_info

} ;# namespace rom_info

namespace import rom_info::*