/[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 98 by dpavlin, Thu Aug 2 16:01:16 2007 UTC revision 107 by dpavlin, Fri Aug 3 08:57:37 2007 UTC
# Line 12  use SDL::Constants; Line 12  use SDL::Constants;
12    
13  use Carp qw/confess/;  use Carp qw/confess/;
14  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
15    use M6502 qw'@mem';
16    
17  use base qw(Class::Accessor Prefs);  use base qw(Class::Accessor Prefs);
18  __PACKAGE__->mk_accessors(qw(app event));  __PACKAGE__->mk_accessors(qw(app event));
# Line 106  sub mem_xy { Line 107  sub mem_xy {
107          return ($x,$y);          return ($x,$y);
108  }  }
109    
 =head2 vram  
   
 Push byte to video memory and draw it  
   
   $screen->vram( $offset, $byte );  
   
 =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 ) {  
                 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 );  
 }  
   
110  =head2 mmap_pixel  =head2 mmap_pixel
111    
112  Draw pixel in memory map  Draw pixel in memory map
# Line 176  sub sync { Line 145  sub sync {
145          $app->sync;          $app->sync;
146  }  }
147    
148  =head2 render  =head2 render_vram
149    
150  Render one frame of video ram  Render one frame of video ram
151    
152    $self->render( @video_memory );    $self->render_vram( @video_memory );
153    
154  =cut  =cut
155    
156  sub render {  my @flip;
157    
158    foreach my $i ( 0 .. 255 ) {
159            my $t = 0;
160            $i & 0b00000001 and $t = $t | 0b10000000;
161            $i & 0b00000010 and $t = $t | 0b01000000;
162            $i & 0b00000100 and $t = $t | 0b00100000;
163            $i & 0b00001000 and $t = $t | 0b00010000;
164            $i & 0b00010000 and $t = $t | 0b00001000;
165            $i & 0b00100000 and $t = $t | 0b00000100;
166            $i & 0b01000000 and $t = $t | 0b00000010;
167            $i & 0b10000000 and $t = $t | 0b00000001;
168            warn "$i = $t\n";
169            $flip[$i] = $t;
170    }
171    
172    
173    sub render_vram {
174          my $self = shift;          my $self = shift;
175    
176            return unless $self->booted;
177    
178          die "this function isn't supported if scale isn't 1" unless $self->scale == 1;          die "this function isn't supported if scale isn't 1" unless $self->scale == 1;
179    
180          my $pixels = pack("C*", @_);          confess "no data?" unless (@_);
181            confess "screen size not 256*256/8 but ",($#_+1) unless (($#_+1) == (256*256/8));
182    
183    
184            my $pixels = pack("C*", map { $flip[$_] } @_);
185    
186          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
187                  -width => 256,                  -width => 256,
# Line 255  Check SDL event loop if there are any pe Line 247  Check SDL event loop if there are any pe
247  my $pending_key;  my $pending_key;
248  my $run_for = 2000;  my $run_for = 2000;
249    
250    my $key_down;
251    
252    sub key_down {
253            my $self = shift;
254            my $key = shift;
255            warn "key_down($key) = ",$key_down->{$key}, "\n" if $self->debug;
256            return $key_down->{$key};
257    }
258    
259  sub key_pressed {  sub key_pressed {
260          my $self = shift;          my $self = shift;
261    
262          # don't take key, just pull event          # don't take key, just pull event
263          my $just_checking = shift;          my $just_checking = shift || 0;
   
         if ( defined($pending_key) ) {  
                 my $k = $pending_key;  
                 undef $pending_key unless $just_checking;  
                 return $k;  
         }  
264    
265          my $event = $self->event || confess "no event?";          my $event = $self->event || confess "no event?";
266    
267          $event->poll || return;          $event->poll || return $pending_key;
268    
269          my $type = $event->type();          my $type = $event->type();
270    
271          exit if ($type == SDL_QUIT);          exit if ($type == SDL_QUIT);
272    
273          my $k;          my $k = $pending_key;
274    
275          if ($type == SDL_KEYDOWN) {          if ($type == SDL_KEYDOWN) {
276                  $k = $event->key_name();                  $k = $event->key_name();
277                    $key_down->{$k}++;
278                  if ( $k eq 'escape' ) {                  if ( $k eq 'escape' ) {
279                          $run_for = $self->cli;                          $run_for = $self->cli;
280                          warn "will check event loop every $run_for cycles\n";                          warn "will check event loop every $run_for cycles\n";
281                            $pending_key = '~';
282                  } else {                  } else {
283                          warn "SDL_KEYDOWN ($type) = '$k'\n";                          warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";
284                          $pending_key = $k if $just_checking;                          $pending_key = $k;
285                  }                  }
286          } elsif ( $type == SDL_KEYUP ) {          } elsif ( $type == SDL_KEYUP ) {
287                  my $up = $event->key_name();                  my $up = $event->key_name();
288                  warn "SDL_KEYUP ($type) = '$up'\n";                  $key_down->{$up} = 0;
289                    warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";
290                    undef $pending_key;
291          }          }
292    
293          return $k;          warn "key_pressed = $pending_key\n" if $pending_key;
294    
295            return $pending_key;
296  }  }
297    
298  =head2 loop  =head2 loop
# Line 309  sub loop { Line 310  sub loop {
310          while ( 1 ) {          while ( 1 ) {
311                  $self->key_pressed( 1 );                  $self->key_pressed( 1 );
312                  M6502::exec($run_for);                  M6502::exec($run_for);
313                    $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
314          }          }
315  }  }
316    
Legend:
Removed from v.98  
changed lines
  Added in v.107
  ViewVC Help
Powered by ViewVC 1.1.26