/[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 165 by dpavlin, Mon Aug 6 07:04:40 2007 UTC revision 190 by dpavlin, Sun Sep 30 20:13:10 2007 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 223  sub render_mem { Line 244  sub render_mem {
244    
245          $vram->display_format;          $vram->display_format;
246    
247          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 );
248          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 );
249    
250          $vram->blit( $rect, $app, $rect_mem );          $vram->blit( $rect, $app, $rect_mem );
251    
# Line 245  Check SDL event loop if there are any pe Line 266  Check SDL event loop if there are any pe
266  =cut  =cut
267    
268  my $pending_key;  my $pending_key;
269    my $key_active;
270  my $run_for = 2000;  my $run_for = 2000;
271    
272  sub key_pressed {  sub key_pressed {
# Line 262  sub key_pressed { Line 284  sub key_pressed {
284                          if ( $state ) {                          if ( $state ) {
285                                  $pending_key = $key;                                  $pending_key = $key;
286                                  $self->key_down( $key );                                  $self->key_down( $key );
287                                    $key_active->{$key} = 1;
288                          } else {                          } else {
289                                  undef $pending_key;                                  undef $pending_key;
290                                  $self->key_up( $key );                                  $self->key_up( $key );
291                                    $key_active->{$key} = 0;
292                          }                          }
293                  }                  }
294                  return $pending_key;                  return $pending_key;
# Line 286  sub key_pressed { Line 310  sub key_pressed {
310                          warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";                          warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";
311                          $pending_key = $k;                          $pending_key = $k;
312                          $self->key_down( $k );                          $self->key_down( $k );
313                            $key_active->{$k} = 1;
314                          $self->record_session('key_pressed', { $k => 1 });                          $self->record_session('key_pressed', { $k => 1 });
315                  }                  }
316          } elsif ( $type == SDL_KEYUP ) {          } elsif ( $type == SDL_KEYUP ) {
317                  my $up = $event->key_name();                  my $up = $event->key_name();
318                  warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";                  warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";
319                  $self->key_up( $up );                  $self->key_up( $up );
320                    $key_active->{$up} = 0;
321                  $self->record_session('key_pressed', { $up => 0 });                  $self->record_session('key_pressed', { $up => 0 });
322                  undef $pending_key;                  undef $pending_key;
323          }          }
# Line 301  sub key_pressed { Line 327  sub key_pressed {
327          return $pending_key;          return $pending_key;
328  }  }
329    
330    =head2 key_active
331    
332    Is key currently pressed on keyboard or in session?
333    
334      $self->key_active( 'left shift', 'right shift', 'a' );
335    
336    =cut
337    
338    sub key_active {
339            my $self = shift;
340            my @keys = @_;
341            confess "Regexp is no longer supported" if ref($_[0]) eq 'Regexp';
342    
343            my $active = 0;
344            foreach my $key ( @keys ) {
345                    $active++ if $key_active->{$key};
346            }
347    
348            warn "## key_active(",dump(@keys),") = $active\n" if $active;
349            return $active;
350    }
351    
352  =head2 loop  =head2 loop
353    
354  Implement CPU run for C<$run_run> cycles inside SDL event loop  Implement CPU run for C<$run_run> cycles inside SDL event loop
# Line 326  sub loop { Line 374  sub loop {
374          }          }
375  }  }
376    
377  # helper array to flip bytes for display  =head2 @flip
378    
379    Exported helper array used to flip bytes (from character roms for example)
380    
381      my $flipped = $flip[ $byte ];
382    
383    =cut
384    
385  our @flip;  our @flip;
386    
387  foreach my $i ( 0 .. 255 ) {  foreach my $i ( 0 .. 255 ) {
Legend:
Removed from v.165  
changed lines
  Added in v.190
  ViewVC Help
Powered by ViewVC 1.1.26