--- M6502/Screen.pm 2007/07/30 17:32:41 29 +++ M6502/Screen.pm 2007/07/31 21:43:57 73 @@ -9,10 +9,16 @@ use SDL::Rect; use SDL::Color; -use base qw(Class::Accessor); -__PACKAGE__->mk_accessors(qw(debug scale show_mem run_for mem_dump trace)); +use Carp qw/confess/; -=head2 init +use base qw(Class::Accessor Prefs); +__PACKAGE__->mk_accessors(qw(app)); + +=head1 NAME + +Screen - simulated 256*256 pixels monochrome screen using SDL + +=head2 open_screen Open simulated screen @@ -20,8 +26,16 @@ our $app; -sub init { +sub open_screen { my $self = shift; + + $self->prefs; + + if ( ! $self->scale ) { + $self->scale( 1 ); + warn "using default unscaled display\n"; + } + $app = SDL::App->new( -width => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ), -height => 256 * $self->scale, @@ -30,6 +44,7 @@ #$app->grab_input( 0 ); warn "# created SDL::App\n"; + $self->app( $app ); } my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff ); @@ -89,17 +104,114 @@ =cut +my $_vram_counter; + sub vram { my ( $self, $offset, $byte ) = @_; my $x = ( $offset % 32 ) << 3; my $y = $offset >> 5; my $mask = 1; + my $scale = $self->scale; printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $self->trace; foreach ( 0 .. 7 ) { - p($x + $_, $y, $byte & $mask ); + my $on = $byte & $mask; + if ( $scale == 1 ) { + $app->pixel( $x + $_, $y, $on ? $white : $black ); + } else { + $self->p($x + $_, $y, $on ); + } $mask = $mask << 1; } + + $app->sync if ( $_vram_counter++ % 10 == 0 ); +} + +=head2 mmap_pixel + +Draw pixel in memory map + + $self->mmap_pixel( $addr, $r, $g, $b ); + +=cut + +# keep accesses to memory +my $_mem_stat; + +sub mmap_pixel { + my ( $self, $addr, $r, $g, $b ) = @_; + return unless $self->show_mem && $self->app; + + my ( $x, $y ) = $self->mem_xy( $addr ); + warn sprintf "## mem %04x %02x %02x %02d*%02d\n", $addr, $r, $g, $x, $y if $self->debug; + + my $col = SDL::Color->new( -r => $r, -g => $g, -b => $b ); + $self->app->pixel( $x, $y, $col ); + + $_mem_stat++; + if ( $_mem_stat % 1000 == 0 ) { + $self->app->sync; + } +} + + +=head2 sync + + $self->sync; + +=cut + +sub sync { + $app->sync; +} + +=head2 render + + $self->render( @video_memory ); + +=cut + +sub render { + my $self = shift; + + die "this function isn't supported if scale isn't 1" unless $self->scale == 1; + + $app->lock; + + my ( $x, $y ) = ( 0,0 ); + + foreach my $b ( @_ ) { + foreach my $p ( split(//, unpack("B8",pack("C",$b)) ) ) { + $app->pixel( $x, $y, $p ? $white : $black ); + $x++; + } + if ( $x == 256 ) { + $x = 0; + $y++; + } + } + + $app->unlock; + $app->sync; + + warn "Screen::render over\n"; } +=head1 SEE ALSO + +L is sample implementation using this module + +=head1 AUTHOR + +Dobrica Pavlinusic, C<< >> + +=head1 COPYRIGHT & LICENSE + +Copyright 2007 Dobrica Pavlinusic, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut +1;