/[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 73 by dpavlin, Tue Jul 31 21:43:57 2007 UTC revision 107 by dpavlin, Fri Aug 3 08:57:37 2007 UTC
# Line 8  use warnings; Line 8  use warnings;
8  use SDL::App;  use SDL::App;
9  use SDL::Rect;  use SDL::Rect;
10  use SDL::Color;  use SDL::Color;
11    use SDL::Constants;
12    
13  use Carp qw/confess/;  use Carp qw/confess/;
14    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));  __PACKAGE__->mk_accessors(qw(app event));
19    
20  =head1 NAME  =head1 NAME
21    
# Line 41  sub open_screen { Line 44  sub open_screen {
44                  -height => 256 * $self->scale,                  -height => 256 * $self->scale,
45                  -depth  => 16,                  -depth  => 16,
46          );          );
47          #$app->grab_input( 0 );          #$app->grab_input( SDL_GRAB_QUERY );
48            $app->grab_input( SDL_GRAB_OFF );
49    
         warn "# created SDL::App\n";  
50          $self->app( $app );          $self->app( $app );
51    
52            my $event = SDL::Event->new();
53            $self->event( $event );
54    
55            warn "# created SDL::App\n";
56  }  }
57    
58  my $white       = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );  my $white       = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
# Line 54  my $red                = SDL::Color->new( -r => 0xff, Line 62  my $red                = SDL::Color->new( -r => 0xff,
62  my $green       = SDL::Color->new( -r => 0x00, -g => 0xff, -b => 0x00 );  my $green       = SDL::Color->new( -r => 0x00, -g => 0xff, -b => 0x00 );
63  my $blue        = SDL::Color->new( -r => 0x00, -g => 0x00, -b => 0xff );  my $blue        = SDL::Color->new( -r => 0x00, -g => 0x00, -b => 0xff );
64    
65    my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 );
66    my $rect_mem = SDL::Rect->new( -x => 256, -y => 0, -width => 256, -height => 256 );
67    
68  =head2 p  =head2 p
69    
70   $screen->p( $x, $y, 1 );   $screen->p( $x, $y, 1 );
# Line 96  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 166  sub sync { Line 145  sub sync {
145          $app->sync;          $app->sync;
146  }  }
147    
148  =head2 render  =head2 render_vram
149    
150    $self->render( @video_memory );  Render one frame of video ram
151    
152      $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          $app->lock;          confess "no data?" unless (@_);
181            confess "screen size not 256*256/8 but ",($#_+1) unless (($#_+1) == (256*256/8));
182    
         my ( $x, $y ) = ( 0,0 );  
183    
184          foreach my $b ( @_ ) {          my $pixels = pack("C*", map { $flip[$_] } @_);
185                  foreach my $p ( split(//, unpack("B8",pack("C",$b)) ) ) {  
186                          $app->pixel( $x, $y, $p ? $white : $black );          my $vram = SDL::Surface->new(
187                          $x++;                  -width => 256,
188                  }                  -height => 256,
189                  if ( $x == 256 ) {                  -depth => 1,    # 1 bit per pixel
190                          $x = 0;                  -pitch => 32,   # bytes per line
191                          $y++;                  -from => $pixels,
192            );
193            $vram->set_colors( 0, $black, $white, $red );
194            $vram->display_format;
195    
196            my $rect = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 );
197            $vram->blit( $rect, $app, $rect_screen );
198    
199            $app->sync;
200    }
201    
202    =head2 render_mem
203    
204      $self->render_mem( @ram );
205    
206    =cut
207    
208    sub render_mem {
209            my $self = shift;
210    
211            return unless $self->show_mem;
212    
213            my $pixels = pack("C*", @_);
214    
215            my $vram = SDL::Surface->new(
216                    -width => 256,
217                    -height => 256,
218                    -depth => 8,    # 1 bit per pixel
219                    -pitch => 256,  # bytes per line
220                    -from => $pixels,
221                    -Rmask => 0xffff00ff,
222                    -Gmask => 0xffff00ff,
223                    -Bmask => 0xffff00ff,
224            );
225    
226            $vram->display_format;
227    
228            my $rect = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 );
229            $vram->blit( $rect, $app, $rect_mem );
230    
231            $app->sync;
232    }
233    
234    =head2 key_pressed
235    
236    Check SDL event loop if there are any pending keys
237    
238      my $key = $self->key_pressed;
239    
240      if ( $self->key_pressed( 1 ) ) {
241            # just to check other events, don't process
242            # key
243      }
244    
245    =cut
246    
247    my $pending_key;
248    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 {
260            my $self = shift;
261    
262            # don't take key, just pull event
263            my $just_checking = shift || 0;
264    
265            my $event = $self->event || confess "no event?";
266    
267            $event->poll || return $pending_key;
268    
269            my $type = $event->type();
270    
271            exit if ($type == SDL_QUIT);
272    
273            my $k = $pending_key;
274    
275            if ($type == SDL_KEYDOWN) {
276                    $k = $event->key_name();
277                    $key_down->{$k}++;
278                    if ( $k eq 'escape' ) {
279                            $run_for = $self->cli;
280                            warn "will check event loop every $run_for cycles\n";
281                            $pending_key = '~';
282                    } else {
283                            warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";
284                            $pending_key = $k;
285                  }                  }
286            } elsif ( $type == SDL_KEYUP ) {
287                    my $up = $event->key_name();
288                    $key_down->{$up} = 0;
289                    warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";
290                    undef $pending_key;
291          }          }
292    
293          $app->unlock;          warn "key_pressed = $pending_key\n" if $pending_key;
         $app->sync;  
294    
295          warn "Screen::render over\n";          return $pending_key;
296    }
297    
298    =head2 loop
299    
300    Implement SDL event loop
301    
302    =cut
303    
304    sub loop {
305            my $self = shift;
306            my $event = SDL::Event->new();
307    
308    
309            MAIN_LOOP:
310            while ( 1 ) {
311                    $self->key_pressed( 1 );
312                    M6502::exec($run_for);
313                    $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
314            }
315  }  }
316    
317  =head1 SEE ALSO  =head1 SEE ALSO
Legend:
Removed from v.73  
changed lines
  Added in v.107
  ViewVC Help
Powered by ViewVC 1.1.26