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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
namespace eval vdp {
set_help_text getcolor \
{Return the current V99x8 palette settings for the given color index (0-15).
The result is format as RGB, with each component in the range 0-7.
}
proc getcolor {index} {
set rb [debug read "VDP palette" [expr {2 * $index}]]
set g [debug read "VDP palette" [expr {2 * $index + 1}]]
format "%03x" [expr {(($rb * 16) & 0x700) + (($g * 16) & 0x070) + ($rb & 0x007)}]
}
set_help_text setcolor \
{Change the V99x8 palette settings. See also getcolor.
usage:
setcolor <index> <r><g><b>
<index> 0-15
<r><g><b> 0-7
}
proc setcolor {index rgb} {
if {[catch {
if {[string length $rgb] != 3} error
set r [string index $rgb 0]
set g [string index $rgb 1]
set b [string index $rgb 2]
if {($index < 0) || ($index > 15)} error
if {($r > 7) || ($g > 7) || ($b > 7)} error
debug write "VDP palette" [expr {$index * 2}] [expr {$r * 16 + $b}]
debug write "VDP palette" [expr {$index * 2 + 1}] $g
}]} {
error "Usage: setcolor <index> <rgb>\n index 0..15\n r,g,b 0..7"
}
}
proc format_table {entries columns frmt sep func} {
set result ""
set rows [expr {($entries + $columns - 1) / $columns}]
for {set row 0} {$row < $rows} {incr row} {
set line ""
for {set col 0} {$col < $columns} {incr col} {
set index [expr {$row + ($col * $rows)}]
if {$index < $entries} {
append line [format $frmt $index [$func $index]] $sep
}
}
append result "${line}\n"
}
return $result
}
set_help_text vdpreg "Read or write a V99x8 register."
proc vdpreg {reg {value ""}} {
if {$value eq ""} {
debug read "VDP regs" $reg
} else {
debug write "VDP regs" $reg $value
}
}
set_help_text vdpregs "Gives an overview of the V99x8 registers."
proc vdpregs {} {
format_table 32 4 "%2d : 0x%02x" " " vdpreg
}
set_help_text v9990reg "Read or write a V9990 register."
proc v9990reg {reg {value ""}} {
if {$value eq ""} {
debug read "Sunrise GFX9000 regs" $reg
} else {
debug write "Sunrise GFX9000 regs" $reg $value
}
}
set_help_text v9990regs "Gives an overview of the V9990 registers."
proc v9990regs {} {
format_table 55 5 "%2d : 0x%02x" " " v9990reg
}
set_help_text palette "Gives an overview of the V99x8 palette registers."
proc palette {} {
format_table 16 4 "%x:%s" " " getcolor
}
set_help_text vdpvramaddress "Gives the current VDP VRAM pointer"
proc vdpvramaddress {} {
return [expr ([expr ([debug read "VDP regs" 14] << 14)] | [expr (([debug read "VRAM pointer" 1] & 63) << 8)] | [debug read "VRAM pointer" 0])]
}
set_help_text vdpstatus "Shortcut for reading the VDP status registers"
proc vdpstatus {reg} {
debug read "VDP status regs" $reg
}
proc val2bin val {
set binRep [binary format c $val]
binary scan $binRep B* binStr
return $binStr
}
variable mode_lookup
set mode_lookup(00000000) 1;# Screen 1
set mode_lookup(00000001) "TEXT40";# Screen 0 (WIDTH 40)
set mode_lookup(00000010) 3;# Screen 3
set mode_lookup(00000100) 2;# Screen 2
set mode_lookup(00001000) 4;# Screen 4
set mode_lookup(00001001) "TEXT80";# Screen 0 (WIDTH 80)
set mode_lookup(00001100) 5;# Screen 5
set mode_lookup(00010000) 6;# Screen 6
set mode_lookup(00010100) 7;# Screen 7
set mode_lookup(00011100) 8;# Screen 8
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)"
proc get_screen_mode_number {} {
set mode [get_screen_mode]
if {[string range $mode 0 3] eq "TEXT"} {
return 0
} elseif {$mode eq "invalid"} {
return -1
}
return $mode
}
set_help_text get_screen_mode "Decodes the current screen mode from the VDP registers (and returns it as a string)."
proc get_screen_mode {} {
variable mode_lookup
set val [expr {(([vdpreg 0] & 14) << 1) | (([vdpreg 1] & 8) >> 2) | (([vdpreg 1] & 16) >> 4)}]
if {[catch {set mode $mode_lookup([val2bin $val])}]} {
return "invalid"
}
if {(($mode == 8) || ($mode == 7)) && ([vdpreg 25] & 8)} {
set mode [expr {([vdpreg 25] & 16) ? 11 : 12}]
}
return $mode
}
set_help_text vpeek \
{Similar to the BASIC vpeek command, read a byte from the video RAM.
This command has the same view on the VRAM as the programmer sees (as opposed
to the physical VRAM content):
- The whole 128kB address space is visible, if the machine has less VRAM
then some parts will either be mirrored or unmapped.
- Depending on the current screen mode, the VRAM addressing is interleaved
or not. This command follows that addressing scheme (IOW, normally you
don't have to care).
See also the 'vpoke' command.
}
proc vpeek {addr} {
debug read VRAM $addr
}
set_help_text vpoke \
{Similar to the BASIC vpoke command, write a byte to the video RAM.
See the 'vpeek' command for more info about the VRAM address space.
}
proc vpoke {addr val} {
debug write VRAM $addr $val
}
proc get_frame_duration {} {
expr {(1368.0 * (([vdpreg 9] & 2) ? 313 : 262)) / (6 * 3579545)}
}
namespace export getcolor
namespace export setcolor
namespace export get_screen_mode
namespace export get_screen_mode_number
namespace export vdpreg
namespace export vdpregs
namespace export v9990regs
namespace export vpeek
namespace export vpoke
namespace export palette
namespace export vdpvramaddress
namespace export vdpstatus
namespace export get_frame_duration
} ;# namespace vdp
namespace import vdp::*
namespace forget vdp::get_frame_duration;# keep this out of the global namespace
|
