OXYGENHUB
◆ main openmsx / share / scripts / _vdp.tcl
5.3 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
namespace eval vdp {
2
3 
set_help_text getcolor \
4 
{Returns the current V99x8 palette settings for the given color index (0-15).
5 
The result is format as RGB, with each component in the range 0-7.
6 
}
7 
proc getcolor {index} {
8 
	set rb [debug read "VDP palette" [expr {2 * $index}]]
9 
	set g  [debug read "VDP palette" [expr {2 * $index + 1}]]
10 
	format "%03x" [expr {(($rb * 16) & 0x700) + (($g * 16) & 0x070) + ($rb & 0x007)}]
11 
}
12
13 
set_help_text setcolor \
14 
{Changes the V99x8 palette settings. See also getcolor.
15
16 
usage:
17 
  setcolor <index> <r><g><b>
18 
   <index>   0-15
19 
   <r><g><b> 0-7
20 
}
21 
proc setcolor {index rgb} {
22 
	if {[catch {
23 
		if {[string length $rgb] != 3} error
24 
		set r [string index $rgb 0]
25 
		set g [string index $rgb 1]
26 
		set b [string index $rgb 2]
27 
		if {($index < 0) || ($index > 15)} error
28 
		if {($r > 7) || ($g > 7) || ($b > 7)} error
29 
		debug write "VDP palette" [expr {$index * 2}] [expr {$r * 16 + $b}]
30 
		debug write "VDP palette" [expr {$index * 2 + 1}] $g
31 
	}]} {
32 
		error "Usage: setcolor <index> <rgb>\n index 0..15\n r,g,b 0..7"
33 
	}
34 
}
35
36 
proc format_table {entries columns frmt sep func} {
37 
	set result ""
38 
	set rows [expr {($entries + $columns - 1) / $columns}]
39 
	for {set row 0} {$row < $rows} {incr row} {
40 
		set line ""
41 
		for {set col 0} {$col < $columns} {incr col} {
42 
			set index [expr {$row + ($col * $rows)}]
43 
			if {$index < $entries} {
44 
				append line [format $frmt $index [$func $index]] $sep
45 
			}
46 
		}
47 
		append result "${line}\n"
48 
	}
49 
	return $result
50 
}
51
52 
set_help_text vdpreg "Reads or writes a V99x8 register."
53 
proc vdpreg {reg {value ""}} {
54 
	if {$value eq ""} {
55 
		debug read "VDP regs" $reg
56 
	} else {
57 
		debug write "VDP regs" $reg $value
58 
	}
59 
}
60
61 
set_help_text vdpregs "Gives an overview of the V99x8 registers."
62 
proc vdpregs {} {
63 
	format_table 32 4 "%2d : 0x%02x" "   " vdpreg
64 
}
65
66 
set_help_text v9990reg "Reads or writes a V9990 register."
67 
proc v9990reg {reg {value ""}} {
68 
	if {$value eq ""} {
69 
		debug read "Sunrise GFX9000 regs" $reg
70 
	} else {
71 
		debug write "Sunrise GFX9000 regs" $reg $value
72 
	}
73 
}
74
75 
set_help_text v9990regs "Gives an overview of the V9990 registers."
76 
proc v9990regs {} {
77 
	format_table 55 5 "%2d : 0x%02x" "   " v9990reg
78 
}
79
80 
set_help_text palette "Gives an overview of the V99x8 palette registers."
81 
proc palette {} {
82 
	format_table 16 4 "%x:%s" "  " getcolor
83 
}
84
85 
set_help_text vdpvramaddress "Gives the current VDP VRAM pointer"
86 
proc vdpvramaddress {} {
87 
    return [expr ([expr ([debug read "VDP regs" 14] << 14)] | [expr (([debug read "VRAM pointer" 1] & 63) << 8)] | [debug read "VRAM pointer" 0])]
88 
}
89
90 
set_help_text vdpstatus "Shortcut for reading the VDP status registers"
91 
proc vdpstatus {reg} {
92 
    debug read "VDP status regs" $reg
93 
}
94
95 
proc val2bin val {
96 
	set binRep [binary format c $val]
97 
	binary scan $binRep B* binStr
98 
	return $binStr
99 
}
100
101 
variable mode_lookup
102
103 
set mode_lookup(00000000) 1;# Screen 1
104 
set mode_lookup(00000001) "TEXT40";# Screen 0 (WIDTH 40)
105 
set mode_lookup(00000010) 3;# Screen 3
106 
set mode_lookup(00000100) 2;# Screen 2
107 
set mode_lookup(00001000) 4;# Screen 4
108 
set mode_lookup(00001001) "TEXT80";# Screen 0 (WIDTH 80)
109 
set mode_lookup(00001100) 5;# Screen 5
110 
set mode_lookup(00010000) 6;# Screen 6
111 
set mode_lookup(00010100) 7;# Screen 7
112 
set mode_lookup(00011100) 8;# Screen 8
113
114 
set_help_text get_screen_mode_number "Decodes the current screen mode from the VDP registers (as would be used in the BASIC SCREEN command)"
115 
proc get_screen_mode_number {} {
116 
	set mode [get_screen_mode]
117 
	if {[string range $mode 0 3] eq "TEXT"} {
118 
		return 0
119 
	} elseif {$mode eq "invalid"} {
120 
		return -1
121 
	}
122 
	return $mode
123 
}
124
125 
set_help_text get_screen_mode "Decodes the current screen mode from the VDP registers (and returns it as a string)."
126 
proc get_screen_mode {} {
127 
	variable mode_lookup
128 
	set val [expr {(([vdpreg 0] & 14) << 1) | (([vdpreg 1] & 8) >> 2) | (([vdpreg 1] & 16) >> 4)}]
129 
	if {[catch {set mode $mode_lookup([val2bin $val])}]} {
130 
		return "invalid"
131 
	}
132 
	if {(($mode == 8) || ($mode == 7)) && ([vdpreg 25] & 8)} {
133 
		set mode [expr {([vdpreg 25] & 16) ? 11 : 12}]
134 
	}
135 
	return $mode
136 
}
137
138 
set_help_text vpeek \
139 
{Similar to the BASIC vpeek command, reads a byte from the video RAM.
140 
This command has the same view on the VRAM as the programmer sees (as opposed
141 
to the physical VRAM content):
142 
 - The whole 128kB address space is visible, if the machine has less VRAM
143 
   then some parts will either be mirrored or unmapped.
144 
 - Depending on the current screen mode, the VRAM addressing is interleaved
145 
   or not. This command follows that addressing scheme (IOW, normally you
146 
   don't have to care).
147 
See also the 'vpoke' command.
148 
}
149 
proc vpeek {addr} {
150 
	debug read VRAM $addr
151 
}
152
153 
set_help_text vpoke \
154 
{Similar to the BASIC vpoke command, writes a byte to the video RAM.
155 
See the 'vpeek' command for more info about the VRAM address space.
156 
}
157 
proc vpoke {addr val} {
158 
	debug write VRAM $addr $val
159 
}
160
161 
proc get_frame_duration {} {
162 
	expr {(1368.0 * (([vdpreg 9] & 2) ? 313 : 262)) / (6 * 3579545)}
163 
}
164
165 
namespace export getcolor
166 
namespace export setcolor
167 
namespace export get_screen_mode
168 
namespace export get_screen_mode_number
169 
namespace export vdpreg
170 
namespace export vdpregs
171 
namespace export v9990regs
172 
namespace export vpeek
173 
namespace export vpoke
174 
namespace export palette
175 
namespace export vdpvramaddress
176 
namespace export vdpstatus
177 
namespace export get_frame_duration
178
179 
} ;# namespace vdp
180
181 
namespace import vdp::*
182 
namespace forget vdp::get_frame_duration;# keep this out of the global namespace