/[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

M6502/Screen.pm revision 73 by dpavlin, Tue Jul 31 21:43:57 2007 UTC Screen.pm revision 124 by dpavlin, Sat Aug 4 14:13:28 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_mem = SDL::Rect->new( -x => 256, -y => 0, -width => 256, -height => 256 );
66    
67  =head2 p  =head2 p
68    
69   $screen->p( $x, $y, 1 );   $screen->p( $x, $y, 1 );
# Line 96  sub mem_xy { Line 106  sub mem_xy {
106          return ($x,$y);          return ($x,$y);
107  }  }
108    
 =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 );  
 }  
   
109  =head2 mmap_pixel  =head2 mmap_pixel
110    
111  Draw pixel in memory map  Draw pixel in memory map
# Line 166  sub sync { Line 144  sub sync {
144          $app->sync;          $app->sync;
145  }  }
146    
147  =head2 render  =head2 render_vram
148    
149    Render one frame of video ram
150    
151    $self->render( @video_memory );    $self->render_vram( @video_memory );
152    
153  =cut  =cut
154    
155  sub render {  my @flip;
156    
157    foreach my $i ( 0 .. 255 ) {
158            my $t = 0;
159            $i & 0b00000001 and $t = $t | 0b10000000;
160            $i & 0b00000010 and $t = $t | 0b01000000;
161            $i & 0b00000100 and $t = $t | 0b00100000;
162            $i & 0b00001000 and $t = $t | 0b00010000;
163            $i & 0b00010000 and $t = $t | 0b00001000;
164            $i & 0b00100000 and $t = $t | 0b00000100;
165            $i & 0b01000000 and $t = $t | 0b00000010;
166            $i & 0b10000000 and $t = $t | 0b00000001;
167            #warn "$i = $t\n";
168            $flip[$i] = $t;
169    }
170    
171    
172    sub render_vram {
173          my $self = shift;          my $self = shift;
174    
175          die "this function isn't supported if scale isn't 1" unless $self->scale == 1;          return unless $self->booted;
176    
177          $app->lock;          confess "no data?" unless (@_);
178            confess "screen size not 256*256/8 but ",($#_+1) unless (($#_+1) == (256*256/8));
179    
180          my ( $x, $y ) = ( 0,0 );          my $pixels = pack("C*", map { $flip[$_] } @_);
181    
182          foreach my $b ( @_ ) {          my $vram = SDL::Surface->new(
183                  foreach my $p ( split(//, unpack("B8",pack("C",$b)) ) ) {                  -width => 256,
184                          $app->pixel( $x, $y, $p ? $white : $black );                  -height => 256,
185                          $x++;                  -depth => 1,    # 1 bit per pixel
186                  }                  -pitch => 32,   # bytes per line
187                  if ( $x == 256 ) {                  -from => $pixels,
188                          $x = 0;          );
189                          $y++;          $vram->set_colors( 0, $black, $white, $red );
190                  }          $vram->display_format;
191    
192            my $scale = $self->scale;
193    
194            my $rect                = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );
195            my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );
196    
197            if ( $scale > 1 ) {
198                    use SDL::Tool::Graphic;
199                    # last parametar is anti-alias
200                    my $zoomed = SDL::Tool::Graphic->zoom( $vram, $self->scale, $self->scale, 1 );
201                    $zoomed->blit( $rect, $app, $rect_screen );
202            } else {
203                    $vram->blit( $rect, $app, $rect_screen );
204          }          }
205    
         $app->unlock;  
206          $app->sync;          $app->sync;
207    }
208    
209    =head2 render_mem
210    
211      $self->render_mem( @ram );
212    
213    =cut
214    
215    sub render_mem {
216            my $self = shift;
217    
218            return unless $self->show_mem;
219    
220            my $pixels = pack("C*", @_);
221    
222            my $vram = SDL::Surface->new(
223                    -width => 256,
224                    -height => 256,
225                    -depth => 8,    # 1 bit per pixel
226                    -pitch => 256,  # bytes per line
227                    -from => $pixels,
228                    -Rmask => 0xffff00ff,
229                    -Gmask => 0xffff00ff,
230                    -Bmask => 0xffff00ff,
231            );
232    
233            $vram->display_format;
234    
235            my $rect = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 );
236            $vram->blit( $rect, $app, $rect_mem );
237    
238            $app->sync;
239    }
240    
241    =head2 key_pressed
242    
243    Check SDL event loop if there are any pending keys
244    
245      my $key = $self->key_pressed;
246    
247      if ( $self->key_pressed( 1 ) ) {
248            # just to check other events, don't process
249            # key
250      }
251    
252    =cut
253    
254    my $pending_key;
255    my $run_for = 2000;
256    
257    my $key_down;
258    
259    sub key_down {
260            my $self = shift;
261            my $key = shift;
262            warn "key_down($key) = ",$key_down->{$key}, "\n" if $self->debug;
263            return $key_down->{$key};
264    }
265    
266    sub key_pressed {
267            my $self = shift;
268    
269            # don't take key, just pull event
270            my $just_checking = shift || 0;
271    
272          warn "Screen::render over\n";          my $event = $self->event || confess "no event?";
273    
274            $event->poll || return $pending_key;
275    
276            my $type = $event->type();
277    
278            exit if ($type == SDL_QUIT);
279    
280            my $k = $pending_key;
281    
282            if ($type == SDL_KEYDOWN) {
283                    $k = $event->key_name();
284                    $key_down->{$k}++;
285                    if ( $k eq 'escape' ) {
286                            $run_for = $self->cli;
287                            warn "will check event loop every $run_for cycles\n";
288                            $pending_key = '~';
289                    } else {
290                            warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n";
291                            $pending_key = $k;
292                    }
293            } elsif ( $type == SDL_KEYUP ) {
294                    my $up = $event->key_name();
295                    $key_down->{$up} = 0;
296                    warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n";
297                    undef $pending_key;
298            }
299    
300            warn "key_pressed = $pending_key\n" if $pending_key;
301    
302            return $pending_key;
303    }
304    
305    =head2 loop
306    
307    Implement SDL event loop
308    
309    =cut
310    
311    sub loop {
312            my $self = shift;
313            my $event = SDL::Event->new();
314    
315    
316            MAIN_LOOP:
317            while ( 1 ) {
318                    $self->key_pressed( 1 );
319                    M6502::exec($run_for);
320                    $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
321            }
322  }  }
323    
324  =head1 SEE ALSO  =head1 SEE ALSO
Legend:
Removed from v.73  
changed lines
  Added in v.124
  ViewVC Help
Powered by ViewVC 1.1.26