--- M6502/Screen.pm 2007/07/31 13:56:50 55 +++ M6502/Screen.pm 2007/08/01 12:40:20 75 @@ -8,11 +8,13 @@ use SDL::App; use SDL::Rect; use SDL::Color; +use SDL::Constants; use Carp qw/confess/; +use Data::Dump qw/dump/; -use base qw(Class::Accessor); -#__PACKAGE__->mk_accessors(qw(debug scale show_mem trace app)); +use base qw(Class::Accessor Prefs); +__PACKAGE__->mk_accessors(qw(app)); =head1 NAME @@ -29,6 +31,8 @@ sub open_screen { my $self = shift; + $self->prefs; + if ( ! $self->scale ) { $self->scale( 1 ); warn "using default unscaled display\n"; @@ -39,7 +43,8 @@ -height => 256 * $self->scale, -depth => 16, ); - #$app->grab_input( 0 ); + #$app->grab_input( SDL_GRAB_QUERY ); + $app->grab_input( SDL_GRAB_OFF ); warn "# created SDL::App\n"; $self->app( $app ); @@ -164,6 +169,35 @@ $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; + + my $pixels = pack("C*", @_); + + my $vram = SDL::Surface->new( + -width => 256, + -height => 256, + -depth => 1, # 1 bit per pixel + -pitch => 32, # bytes per line + -from => $pixels, + ); + $vram->set_colors( 0, $black, $white, $red ); + $vram->display_format; + + my $rect = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 ); + $vram->blit( $rect, $app, $rect ); + + $app->sync; +} + =head1 SEE ALSO L is sample implementation using this module