OXYGENHUB
◆ main openmsx / share / scripts / _save_msx_screen.tcl
7.4 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
set_help_text save_msx_screen \
2 
{Lookup the screen mode and save the current screen to a MSX compatible binary
3 
file. This file can for example be loaded in MSX-BASIC using the BLOAD command.
4
5 
This script was originally developed by NYYRIKKI, see also this forum thread:
6 
http://www.msx.org/forum/msx-talk/general-discussion/taking-sc5-snapshot-games
7 
}
8
9 
proc save_msx_screen {basename} {
10 
	# Gives an error in case of an invalid screen mode.
11 
	set mode_num [get_screen_mode_number]
12
13 
	# Read VDP registers (only once)
14 
	foreach n {2 3 4 5 6 9 10 11 23} {
15 
		set R$n [vdpreg $n]
16 
	}
17
18 
	set name_base        [expr {($R2      ) * 0x400}]
19 
	set name_base_80     [expr {($R2 & 252) * 0x400}]
20 
	set name_base_bitmap [expr {($R2 &  96) * 0x400}]
21 
	set color_base       [expr {($R3      ) * 0x40 + $R10 * 0x4000}]
22 
	set color_base_2     [expr {($R3 & 128) * 0x40 + $R10 * 0x4000}]
23 
	set pattern_base     [expr {($R4      ) * 0x800}]
24 
	set pattern_base_2   [expr {($R4 &  60) * 0x800}]
25 
	set spr_att_base     [expr {($R5      ) * 0x80 + $R11 * 0x8000}]
26 
	set spr_att_base_2   [expr {($R5 & 252) * 0x80 + $R11 * 0x8000 - 0x200}]
27 
	set spr_pat_base     [expr {($R6      ) * 0x800}]
28 
	set interlace        [expr {(($R9 & 12) == 12) && ($R2 & (($mode_num < 7) ? 16 : 32))}]
29
30 
	set sections [list]
31 
	set sections2 [list]
32 
	switch [get_screen_mode] {
33 
	"TEXT40" {
34 
		lappend sections "VRAM" $name_base 0x400                    ;# BG Map
35 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
36 
		lappend sections "VRAM" [expr {$name_base + 0x420}] 0x3E0   ;# Fill (BG Map)
37 
		lappend sections "VRAM" $pattern_base 0x800                 ;# BG Tiles
38 
	}
39 
	"TEXT80" {
40 
		lappend sections "VRAM" $name_base_80 0x800                 ;# BG Map
41 
		lappend sections "VRAM" $color_base 0x700                   ;# Blink
42 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
43 
		lappend sections "VRAM" [expr {$name_base_80 + 0xF20}] 0xE0 ;# Fill (BG Map)
44 
		lappend sections "VRAM" $pattern_base 0x800                 ;# BG Tiles
45 
	}
46 
	"1" {
47 
		lappend sections "VRAM" $pattern_base 0x1800                ;# BG Tiles
48 
		lappend sections "VRAM" $name_base 0x300                    ;# BG Map
49 
		lappend sections "VRAM" $spr_att_base 0x500                 ;# OBJ Attributes
50 
		lappend sections "VRAM" $color_base 0x20                    ;# BG Colors
51 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
52 
		lappend sections "VRAM" [expr {$color_base + 0x40}] 0x17C0  ;# Fill (BG Colors)
53 
		lappend sections "VRAM" $spr_pat_base 0x800                 ;# OBJ Tiles
54 
	}
55 
	"2" {
56 
		lappend sections "VRAM" $pattern_base_2 0x1800              ;# BG Tiles
57 
		lappend sections "VRAM" $name_base 0x300                    ;# BG Map
58 
		lappend sections "VRAM" $spr_att_base 0x80                  ;# OBJ Attributes
59 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
60 
		lappend sections "VRAM" [expr {$spr_att_base + 0xA0}] 0x460 ;# Fill (OBJ Attributes)
61 
		lappend sections "VRAM" $color_base_2 0x1800                ;# BG Colors
62 
		lappend sections "VRAM" $spr_pat_base 0x800                 ;# OBJ Tiles
63 
	}
64 
	"3" {
65 
		lappend sections "VRAM" $pattern_base 0x800                 ;# BG Tiles
66 
		lappend sections "VRAM" $name_base 0x1300                   ;# BG Map
67 
		lappend sections "VRAM" $spr_att_base 0x520                 ;# OBJ Attributes
68 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
69 
		lappend sections "VRAM" [expr {$spr_att_base + 0x540}] 0x17C0 ;# Fill (OBJ Attributes)
70 
		lappend sections "VRAM" $spr_pat_base 0x800                 ;# OBJ Tiles
71 
	}
72 
	"4" {
73 
		lappend sections "VRAM" $pattern_base_2 0x1800              ;# BG Tiles
74 
		lappend sections "VRAM" $name_base 0x380                    ;# BG Map
75 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
76 
		lappend sections "VRAM" [expr {$name_base + 0x3A0}] 0x60    ;# Fill (BG Map)
77 
		lappend sections "VRAM" $spr_att_base_2 0x400               ;# OBJ Attributes
78 
		lappend sections "VRAM" $color_base_2 0x1800                ;# BG Colors
79 
		lappend sections "VRAM" $spr_pat_base 0x800                 ;# OBJ Tiles
80 
	}
81 
	"5" - "6" {
82 
		set lines1 [expr {$R23 > 24 ? 256 - $R23 : 232}]            ;# Store 232 lines, even
83 
		set lines2 [expr {232 - $lines1}]                           ;# though only 212 are visible
84 
		set base2 [expr {$name_base_bitmap ^ (0x8000 * $interlace)}]
85 
		set base1 [expr {$base2 + $R23 * 128}]
86 
		lappend sections "VRAM" $base1 [expr {$lines1 * 128}]       ;# Bitmap (part 1)
87 
		lappend sections "VRAM" $base2 [expr {$lines2 * 128}]       ;# Bitmap (part 2)
88 
		lappend sections "VRAM" $spr_att_base_2 0x280               ;# Sprite colors + attributes
89 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
90 
		lappend sections "VRAM" [expr {$name_base_bitmap ^ (0x8000 * $interlace) + 0x76A0}] 0x160 ;# Fill (Bitmap)
91 
		lappend sections "VRAM" $spr_pat_base 0x800                 ;# Sprite character patterns
92 
		if {$interlace} {
93 
			lappend sections2 "VRAM" [expr {$base1 ^ 0x8000}] [expr {$lines1 * 128}]   ;# Bitmap (part 1)
94 
			lappend sections2 "VRAM" [expr {$base2 ^ 0x8000}] [expr {$lines2 * 128}]   ;# Bitmap (part 2)
95 
			lappend sections2 "VRAM" [expr {$spr_att_base_2 ^ 0x8000}] 0x280           ;# Sprite colors + attributes
96 
			lappend sections2 "VDP palette" 0 0x20                                     ;# Palette
97 
			lappend sections2 "VRAM" [expr {$name_base_bitmap + 0x76A0}] 0x160         ;# Fill (Bitmap)
98 
			lappend sections2 "VRAM" [expr {$spr_pat_base ^ 0x8000}] 0x800             ;# Sprite character patterns
99 
		}
100 
	}
101 
	"7" - "8" - "11" - "12" {
102 
		set lines1 [expr {$R23 > 16 ? 256 - $R23 : 240}]            ;# Store 240 lines, even
103 
		set lines2 [expr {240 - $lines1}]                           ;# though only 212 are visible
104 
		set base2 [expr {($name_base_bitmap * 2) & 0x10000 - (0x10000 * $interlace)}]
105 
		set base1 [expr {$base2 + $R23 * 256}]
106 
		lappend sections "VRAM" $base1 [expr {$lines1 * 256}]       ;# Bitmap (part 1)
107 
		lappend sections "VRAM" $base2 [expr {$lines2 * 256}]       ;# Bitmap (part 2)
108 
		lappend sections "VRAM" $spr_pat_base 0x800                 ;# Sprite character patterns
109 
		lappend sections "VRAM" $spr_att_base_2 0x280               ;# Sprite colors + attributes
110 
		lappend sections "VDP palette" 0 0x20                       ;# Palette
111 
		if {$interlace} {
112 
			lappend sections2 "VRAM" [expr {$base1 ^ 0x10000}] [expr {$lines1 * 256}]  ;# Bitmap (part 1)
113 
			lappend sections2 "VRAM" [expr {$base2 ^ 0x10000}] [expr {$lines2 * 256}]  ;# Bitmap (part 2)
114 
			lappend sections2 "VRAM" [expr {$spr_pat_base ^ 0x10000}] 0x800            ;# Sprite character patterns
115 
			lappend sections2 "VRAM" [expr {$spr_att_base_2 ^ 0x10000}] 0x280          ;# Sprite colors + attributes
116 
			lappend sections2 "VDP palette" 0 0x20                                     ;# Palette
117 
		}
118 
	}}
119
120 
	set directory [file normalize $::env(OPENMSX_USER_DATA)/../screenshots]
121
122 
	set result ""
123 
	foreach {ext sec} [list ".SC" $sections ".S1" $sections2] {
124 
		if {[llength $sec] == 0} break
125
126 
		# Open file with correct extension
127 
		set fname [file join $directory [format "%s%s%X" $basename $ext $mode_num]]
128 
		set out [open $fname w]
129 
		fconfigure $out -translation binary
130
131 
		# write header
132 
		set end_addr -1
133 
		foreach {type addr size} $sec {
134 
			incr end_addr $size
135 
		}
136 
		set header [list 0xFE 0 0 [expr {$end_addr & 255}] [expr {$end_addr / 256}] 0 0]
137 
		puts -nonewline $out [binary format c* $header]
138
139 
		# write data sections
140 
		foreach {type addr size} $sec {
141 
			puts -nonewline $out [debug read_block $type $addr $size]
142 
		}
143 
		close $out
144
145 
		append result "Screen written to $fname\n"
146 
	}
147 
	return $result
148 
}