4 |
use strict; |
use strict; |
5 |
|
|
6 |
use Carp qw/confess/; |
use Carp qw/confess/; |
|
use lib './lib'; |
|
|
#use Time::HiRes qw(time); |
|
7 |
use File::Slurp; |
use File::Slurp; |
8 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
9 |
use M6502; |
use M6502; |
10 |
|
use Screen qw/$white $black/; |
11 |
|
|
12 |
use base qw(Class::Accessor VRac M6502 Screen Prefs Tape); |
use base qw(Class::Accessor VRac M6502 Screen Prefs Tape); |
13 |
#__PACKAGE__->mk_accessors(qw()); |
#__PACKAGE__->mk_accessors(qw()); |
18 |
|
|
19 |
=head1 VERSION |
=head1 VERSION |
20 |
|
|
21 |
Version 0.04 |
Version 0.05 |
22 |
|
|
23 |
=cut |
=cut |
24 |
|
|
25 |
our $VERSION = '0.04'; |
our $VERSION = '0.05'; |
26 |
|
|
27 |
=head1 SUMMARY |
=head1 SUMMARY |
28 |
|
|
57 |
|
|
58 |
warn "emulating ", $#mem, " bytes of memory\n"; |
warn "emulating ", $#mem, " bytes of memory\n"; |
59 |
|
|
60 |
|
# $self->scale( 2 ); |
61 |
|
|
62 |
$self->open_screen; |
$self->open_screen; |
63 |
$self->load_rom({ |
$self->load_rom({ |
64 |
# 0x1000 => 'dump/SCRINV.BIN', |
# 0x1000 => 'dump/SCRINV.BIN', |
65 |
# should be 0x6000, but oraoemu has 2 byte prefix |
# should be 0x6000, but oraoemu has 2 byte prefix |
66 |
# 0x5FFE => 'dump/screen.dmp', |
# 0x5FFE => '/home/dpavlin/orao/dump/screen.dmp', |
67 |
# 0xC000 => 'rom/Orao/BAS12.ROM', |
# 0xC000 => 'rom/Orao/BAS12.ROM', |
68 |
# 0xE000 => 'rom/Orao/CRT12.ROM', |
# 0xE000 => 'rom/Orao/CRT12.ROM', |
69 |
0xC000 => 'rom/Orao/BAS13.ROM', |
0xC000 => 'rom/Orao/BAS13.ROM', |
425 |
return; |
return; |
426 |
} |
} |
427 |
|
|
428 |
|
=head2 render_vram |
429 |
|
|
430 |
|
Render one frame of video ram |
431 |
|
|
432 |
|
$self->render_vram( @video_memory ); |
433 |
|
|
434 |
|
=cut |
435 |
|
|
436 |
|
my @flip; |
437 |
|
|
438 |
|
foreach my $i ( 0 .. 255 ) { |
439 |
|
my $t = 0; |
440 |
|
$i & 0b00000001 and $t = $t | 0b10000000; |
441 |
|
$i & 0b00000010 and $t = $t | 0b01000000; |
442 |
|
$i & 0b00000100 and $t = $t | 0b00100000; |
443 |
|
$i & 0b00001000 and $t = $t | 0b00010000; |
444 |
|
$i & 0b00010000 and $t = $t | 0b00001000; |
445 |
|
$i & 0b00100000 and $t = $t | 0b00000100; |
446 |
|
$i & 0b01000000 and $t = $t | 0b00000010; |
447 |
|
$i & 0b10000000 and $t = $t | 0b00000001; |
448 |
|
#warn "$i = $t\n"; |
449 |
|
$flip[$i] = $t; |
450 |
|
} |
451 |
|
|
452 |
|
|
453 |
|
sub render_vram { |
454 |
|
my $self = shift; |
455 |
|
|
456 |
|
confess "no data?" unless (@_); |
457 |
|
confess "screen size not 256*256/8 but ",($#_+1) unless (($#_+1) == (256*256/8)); |
458 |
|
|
459 |
|
return unless $self->booted; |
460 |
|
|
461 |
|
my $pixels = pack("C*", map { $flip[$_] } @_); |
462 |
|
|
463 |
|
my $vram = SDL::Surface->new( |
464 |
|
-width => 256, |
465 |
|
-height => 256, |
466 |
|
-depth => 1, # 1 bit per pixel |
467 |
|
-pitch => 32, # bytes per line |
468 |
|
-from => $pixels, |
469 |
|
); |
470 |
|
$vram->set_colors( 0, $black, $white ); |
471 |
|
|
472 |
|
$self->render_frame( $vram ); |
473 |
|
} |
474 |
|
|
475 |
=head1 AUTHOR |
=head1 AUTHOR |
476 |
|
|
477 |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |