/[VRac]/Screen.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /Screen.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 171 by dpavlin, Mon Aug 6 11:40:21 2007 UTC revision 209 by dpavlin, Mon Apr 14 19:55:29 2008 UTC
# Line 17  use Exporter 'import'; Line 17  use Exporter 'import';
17  our @EXPORT = qw'$white $black @flip';  our @EXPORT = qw'$white $black @flip';
18    
19  use base qw(Class::Accessor Prefs);  use base qw(Class::Accessor Prefs);
20  __PACKAGE__->mk_accessors(qw(app event));  __PACKAGE__->mk_accessors(qw(app event screen_width screen_height window_width window_height));
21    
22  =head1 NAME  =head1 NAME
23    
24  Screen - simulated 256*256 pixels monochrome screen using SDL  Screen - simulated monochrome screen using SDL
25    
26  =head1 Architecture dependent  =head1 Architecture dependent
27    
28  You may override following methods if you want to implement keyboard on each  You may override following methods if you want to implement keyboard on each
29  keypress event. Alternative is to use <read> hook and trap memory access.  keypress event. Alternative is to use <read> hook and trap memory access.
30    
31    =head2 screen_width
32    
33    Width of emulated screen (256 by default)
34    
35    =head2 screen_height
36    
37    Height of emulated screen (256 by default)
38    
39  =head2 key_down  =head2 key_down
40    
41    $self->key_down( 'a' );    $self->key_down( 'a' );
# Line 68  sub open_screen { Line 76  sub open_screen {
76                  warn "using default unscaled display\n";                  warn "using default unscaled display\n";
77          }          }
78    
79            $self->screen_width( 256 ) unless defined $self->screen_width;
80            $self->screen_height( 256 ) unless defined $self->screen_height;
81    
82            my $w = $self->screen_width * $self->scale + ( $self->show_mem ? 256 : 0 );
83            $self->window_width( $w );
84    
85            my $h = $self->screen_height;
86            # expand screen size to show whole 64k 256*256 memory map
87            $h = 256 if $self->show_mem && $h < 256;
88            $h *= $self->scale;
89            $self->window_height( $h );
90    
91          $app = SDL::App->new(          $app = SDL::App->new(
92                  -width  => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ),                  -width  => $w,
93                  -height => 256 * $self->scale,                  -height => $h,
94                  -depth  => 16,                  -depth  => 16,
95                  -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,                  -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
96          );          );
# Line 83  sub open_screen { Line 103  sub open_screen {
103          my $event = SDL::Event->new();          my $event = SDL::Event->new();
104          $self->event( $event );          $self->event( $event );
105    
106          warn "# created SDL::App\n";          warn "# created SDL::App with screen ", $self->screen_width, "x", $self->screen_height, " in window ",
107                    $self->window_width, "x", $self->window_height, "\n";
108  }  }
109    
110  our $white      = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );  our $white      = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
# Line 105  sub mem_xy { Line 126  sub mem_xy {
126          my $self = shift;          my $self = shift;
127          my $offset = shift;          my $offset = shift;
128          my $x = $offset & 0xff;          my $x = $offset & 0xff;
129          $x += 256 * $self->scale;          $x += $self->screen_width * $self->scale;
130          my $y = $offset >> 8;          my $y = $offset >> 8;
131          return ($x,$y);          return ($x,$y);
132  }  }
# Line 181  sub render_frame { Line 202  sub render_frame {
202    
203          my $scale = $self->scale || confess "no scale?";          my $scale = $self->scale || confess "no scale?";
204    
205          my $rect        = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );          my $rect        = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width * $scale, -height => $self->screen_height * $scale );
206          my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );          my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width * $scale, -height => $self->screen_height * $scale );
207    
208          if ( $scale > 1 ) {          if ( $scale > 1 ) {
209                  use SDL::Tool::Graphic;                  use SDL::Tool::Graphic;
# Line 200  sub render_frame { Line 221  sub render_frame {
221  =head2 render_mem  =head2 render_mem
222    
223    $self->render_mem( @mem );    $self->render_mem( @mem );
224      $self->render_mem( $memory_bytes );
225    
226  =cut  =cut
227    
# Line 208  sub render_mem { Line 230  sub render_mem {
230    
231          return unless $self->show_mem;          return unless $self->show_mem;
232    
233          my $pixels = pack("C*", @_);          my $pixels;
234            if ( $# > 0 ) {
235                    $pixels = pack("C*", @_);
236            } else {
237                    $pixels = shift;
238            }
239    
240          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
241                  -width => 256,                  -width => 256,
# Line 223  sub render_mem { Line 250  sub render_mem {
250    
251          $vram->display_format;          $vram->display_format;
252    
253          my $rect     = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 );          my $rect     = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width, -height => $self->window_height );
254          my $rect_mem = SDL::Rect->new( -x => 256 * $self->scale, -y => 0, -width => 256, -height => 256 );          my $rect_mem = SDL::Rect->new( -x => $self->screen_width * $self->scale, -y => 0, -width => 256, -height => 256 );
255    
256          $vram->blit( $rect, $app, $rect_mem );          $vram->blit( $rect, $app, $rect_mem );
257    
# Line 353  sub loop { Line 380  sub loop {
380          }          }
381  }  }
382    
383  # helper array to flip bytes for display  =head2 @flip
384    
385    Exported helper array used to flip bytes (from character roms for example)
386    
387      my $flipped = $flip[ $byte ];
388    
389    =cut
390    
391  our @flip;  our @flip;
392    
393  foreach my $i ( 0 .. 255 ) {  foreach my $i ( 0 .. 255 ) {
Legend:
Removed from v.171  
changed lines
  Added in v.209
  ViewVC Help
Powered by ViewVC 1.1.26