7 |
use File::Slurp; |
use File::Slurp; |
8 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
9 |
use Z80; # import |
use Z80; # import |
10 |
|
use Screen qw/$white $black/; |
11 |
|
|
12 |
use base qw(Class::Accessor VRac Z80 Screen Prefs Session); |
use base qw(Class::Accessor VRac Z80 Screen Prefs Session); |
13 |
__PACKAGE__->mk_accessors(qw(booted)); |
__PACKAGE__->mk_accessors(qw(booted)); |
58 |
$self->open_screen; |
$self->open_screen; |
59 |
$self->load_rom({ |
$self->load_rom({ |
60 |
0x0000, 'rom/Galaksija/ROM1.BIN', |
0x0000, 'rom/Galaksija/ROM1.BIN', |
61 |
0x2000, 'rom/Galaksija/ROM2.BIN', |
0x1000, 'rom/Galaksija/ROM2.BIN', |
62 |
# 0xE000, 'rom/Galaksija/GAL_PLUS.BIN', |
# 0xE000, 'rom/Galaksija/GAL_PLUS.BIN', |
63 |
}); |
}); |
64 |
|
|
190 |
|
|
191 |
=head2 render_vram |
=head2 render_vram |
192 |
|
|
193 |
|
Render characters as graphic |
194 |
|
|
195 |
|
=cut |
196 |
|
|
197 |
|
my $char_rom = 'rom/Galaksija/CHRGEN.BIN'; |
198 |
|
|
199 |
|
my @chars = map { ord($_) } split(//, read_file( $char_rom )); |
200 |
|
warn "loaded ", $#chars, " characters\n"; |
201 |
|
|
202 |
|
my @char2pos; |
203 |
|
|
204 |
|
# maken from mess/video/galaxy.c |
205 |
|
foreach my $char ( 0 .. 255 ) { |
206 |
|
my $c = $char; |
207 |
|
if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) { |
208 |
|
$c -= 64; |
209 |
|
} elsif ( $c > 191 ) { |
210 |
|
$c -= 128; |
211 |
|
} |
212 |
|
$char2pos[ $char ] = ( $c & 0x7f ); |
213 |
|
} |
214 |
|
|
215 |
|
warn dump( @char2pos ); |
216 |
|
|
217 |
|
sub render_vram { |
218 |
|
my $self = shift; |
219 |
|
|
220 |
|
my $addr = 0x2800; |
221 |
|
|
222 |
|
my @pixels = ("\x00") x ( 32 * 16 * 13 ); |
223 |
|
my $a = 0; |
224 |
|
|
225 |
|
for my $y ( 0 .. 15 ) { |
226 |
|
for my $x ( 0 .. 31 ) { |
227 |
|
my $c = $mem[ $addr++ ]; |
228 |
|
$c = $char2pos[ $c ]; |
229 |
|
for my $l ( 0 .. 12 ) { |
230 |
|
my $o = $l << 5; # *32 |
231 |
|
my $co = ( $l << 7 ) | $c; |
232 |
|
$pixels[ $a + $x + $o ] = $chars[ $co ]; |
233 |
|
} |
234 |
|
} |
235 |
|
$a += ( 32 * 13 ); # next line |
236 |
|
} |
237 |
|
|
238 |
|
my $vram = SDL::Surface->new( |
239 |
|
-width => 256, |
240 |
|
-height => 256, |
241 |
|
-depth => 1, # 1 bit per pixel |
242 |
|
-pitch => 32, # bytes per line |
243 |
|
-from => pack("C*", @pixels), |
244 |
|
); |
245 |
|
$vram->set_colors( 0, $black, $white ); |
246 |
|
|
247 |
|
$self->render_frame( $vram ); |
248 |
|
|
249 |
|
# $self->render_vram_text; |
250 |
|
} |
251 |
|
|
252 |
|
|
253 |
|
=head2 render_vram_text |
254 |
|
|
255 |
Simple hex dumper of text buffer |
Simple hex dumper of text buffer |
256 |
|
|
257 |
=cut |
=cut |
258 |
|
|
259 |
my $last_dump = ''; |
my $last_dump = ''; |
260 |
|
|
261 |
sub render_vram { |
sub render_vram_text { |
262 |
my $self = shift; |
my $self = shift; |
263 |
|
|
264 |
my $addr = 0x2800; |
my $addr = 0x2800; |