/[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 161 by dpavlin, Sun Aug 5 19:44:20 2007 UTC revision 183 by dpavlin, Sun Sep 30 19:31:14 2007 UTC
# Line 14  use Carp qw/confess/; Line 14  use Carp qw/confess/;
14  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
15    
16  use Exporter 'import';  use Exporter 'import';
17  our @EXPORT = qw'$white $black';  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));
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          $app = SDL::App->new(          $app = SDL::App->new(
83                  -width  => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ),                  -width  => $self->screen_width * $self->scale + ( $self->show_mem ? 256 : 0 ),
84                  -height => 256 * $self->scale,                  -height => $self->screen_height * $self->scale,
85                  -depth  => 16,                  -depth  => 16,
86                  -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,                  -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
87          );          );
# Line 83  sub open_screen { Line 94  sub open_screen {
94          my $event = SDL::Event->new();          my $event = SDL::Event->new();
95          $self->event( $event );          $self->event( $event );
96    
97          warn "# created SDL::App\n";          warn "# created SDL::App with screen ", $self->screen_width, "x", $self->screen_height, "\n";
98  }  }
99    
100  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 116  sub mem_xy {
116          my $self = shift;          my $self = shift;
117          my $offset = shift;          my $offset = shift;
118          my $x = $offset & 0xff;          my $x = $offset & 0xff;
119          $x += 256 * $self->scale;          $x += $self->screen_width * $self->scale;
120          my $y = $offset >> 8;          my $y = $offset >> 8;
121          return ($x,$y);          return ($x,$y);
122  }  }
# Line 181  sub render_frame { Line 192  sub render_frame {
192    
193          my $scale = $self->scale || confess "no scale?";          my $scale = $self->scale || confess "no scale?";
194    
195          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
196          my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );          );
197            my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width * $scale, -height => $self->screen_height * $scale );
198    
199          if ( $scale > 1 ) {          if ( $scale > 1 ) {
200                  use SDL::Tool::Graphic;                  use SDL::Tool::Graphic;
# Line 223  sub render_mem { Line 235  sub render_mem {
235    
236          $vram->display_format;          $vram->display_format;
237    
238          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->screen_height );
239          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 );
240    
241          $vram->blit( $rect, $app, $rect_mem );          $vram->blit( $rect, $app, $rect_mem );
242    
# Line 245  Check SDL event loop if there are any pe Line 257  Check SDL event loop if there are any pe
257  =cut  =cut
258    
259  my $pending_key;  my $pending_key;
260    my $key_active;
261  my $run_for = 2000;  my $run_for = 2000;
262    
263  sub key_pressed {  sub key_pressed {
# Line 262  sub key_pressed { Line 275  sub key_pressed {
275                          if ( $state ) {                          if ( $state ) {
276                                  $pending_key = $key;                                  $pending_key = $key;
277                                  $self->key_down( $key );                                  $self->key_down( $key );
278                                    $key_active->{$key} = 1;
279                          } else {                          } else {
280                                  undef $pending_key;                                  undef $pending_key;
281                                  $self->key_up( $key );                                  $self->key_up( $key );
282                                    $key_active->{$key} = 0;
283                          }                          }
284                  }                  }
285                  return $pending_key;                  return $pending_key;
# Line 286  sub key_pressed { Line 301  sub key_pressed {
301                          warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";                          warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";
302                          $pending_key = $k;                          $pending_key = $k;
303                          $self->key_down( $k );                          $self->key_down( $k );
304                            $key_active->{$k} = 1;
305                          $self->record_session('key_pressed', { $k => 1 });                          $self->record_session('key_pressed', { $k => 1 });
306                  }                  }
307          } elsif ( $type == SDL_KEYUP ) {          } elsif ( $type == SDL_KEYUP ) {
308                  my $up = $event->key_name();                  my $up = $event->key_name();
309                  warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";                  warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";
310                  $self->key_up( $up );                  $self->key_up( $up );
311                    $key_active->{$up} = 0;
312                  $self->record_session('key_pressed', { $up => 0 });                  $self->record_session('key_pressed', { $up => 0 });
313                  undef $pending_key;                  undef $pending_key;
314          }          }
# Line 301  sub key_pressed { Line 318  sub key_pressed {
318          return $pending_key;          return $pending_key;
319  }  }
320    
321    =head2 key_active
322    
323    Is key currently pressed on keyboard or in session?
324    
325      $self->key_active( 'left shift', 'right shift', 'a' );
326    
327    =cut
328    
329    sub key_active {
330            my $self = shift;
331            my @keys = @_;
332            confess "Regexp is no longer supported" if ref($_[0]) eq 'Regexp';
333    
334            my $active = 0;
335            foreach my $key ( @keys ) {
336                    $active++ if $key_active->{$key};
337            }
338    
339            warn "## key_active(",dump(@keys),") = $active\n" if $active;
340            return $active;
341    }
342    
343  =head2 loop  =head2 loop
344    
345  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 365  sub loop {
365          }          }
366  }  }
367    
368    # helper array to flip bytes for display
369    our @flip;
370    
371    foreach my $i ( 0 .. 255 ) {
372            my $t = 0;
373            $i & 0b00000001 and $t = $t | 0b10000000;
374            $i & 0b00000010 and $t = $t | 0b01000000;
375            $i & 0b00000100 and $t = $t | 0b00100000;
376            $i & 0b00001000 and $t = $t | 0b00010000;
377            $i & 0b00010000 and $t = $t | 0b00001000;
378            $i & 0b00100000 and $t = $t | 0b00000100;
379            $i & 0b01000000 and $t = $t | 0b00000010;
380            $i & 0b10000000 and $t = $t | 0b00000001;
381            #warn "$i = $t\n";
382            $flip[$i] = $t;
383    }
384    
385  =head1 SEE ALSO  =head1 SEE ALSO
386    
387  L<Orao> is sample implementation using this module  L<Orao> is sample implementation using this module
Legend:
Removed from v.161  
changed lines
  Added in v.183
  ViewVC Help
Powered by ViewVC 1.1.26