/[VRac]/Orao.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 /Orao.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 213 by dpavlin, Mon Apr 14 21:27:19 2008 UTC
# Line 6  use strict; Line 6  use strict;
6  use Carp qw/confess/;  use Carp qw/confess/;
7  use File::Slurp;  use File::Slurp;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9  use M6502;  use M6502 '0.0.3';
10  use Screen;  use Screen;
11    
12  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape Session);  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape Session);
# Line 43  our $emu; Line 43  our $emu;
43  sub run {  sub run {
44          my $self = shift;          my $self = shift;
45    
46            M6502::reset();
47            $self->_init_callbacks;
48    
49          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
50          $self->SUPER::init(          $self->SUPER::init(
51                  read => sub { $self->read( @_ ) },                  read => sub { $self->read( @_ ) },
# Line 54  sub run { Line 57  sub run {
57          warn "emulating ", $#mem, " bytes of memory\n";          warn "emulating ", $#mem, " bytes of memory\n";
58    
59  #       $self->scale( 2 );  #       $self->scale( 2 );
60  #       $self->show_mem( 1 );          $self->show_mem( 1 );
61          $self->load_session( 'session.pl' );          $self->load_session( 'sess/current' );
62    
63          $self->open_screen;          $self->open_screen;
64          $self->load_rom({          $self->load_rom({
# Line 82  sub run { Line 85  sub run {
85          $self->debug( 0 );          $self->debug( 0 );
86    
87          warn "rendering memory\n";          warn "rendering memory\n";
88          $self->render_mem( @mem );          $self->render_mem( M6502::mem_peek_region(0x0000,0xffff) );
89    
90          if ( $self->show_mem ) {          if ( $self->show_mem ) {
91    
# Line 114  sub run { Line 117  sub run {
117                  $self->debug ? ' debug' : '',                  $self->debug ? ' debug' : '',
118                  "\n";                  "\n";
119    
120          M6502::reset();  #       $self->load_tape( 'tapes/Orao/bdash.tap' );
121    #       $self->load_tape( 'tapes/Orao/crtanje.tap' );
122    #       $self->load_tape( 'tapes/Orao/jjack.tap', 0x168 );
123            $self->load_tape( 'tapes/Orao/muzika.tap', 0x168 );
124    
125  #       $self->load_tape( '../oraoigre/bdash.tap' );          $self->render_vram;
126    
127          $self->loop( sub {          $self->loop( sub {
128                  my $run_for = shift;                  my $run_for = shift;
129                  warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;                  warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
130                  M6502::exec( $run_for );                  M6502::exec( $run_for );
131                  $self->render_vram;                  $self->render_vram;
132                    $self->render_mem( M6502::mem_peek_region(0x0000,0xffff) ) if $self->show_mem;
133          });          });
134  };  };
135    
# Line 224  my $keyboard = { Line 231  my $keyboard = {
231                  'backspace' => 224,                  'backspace' => 224,
232          },          },
233          0x87FD => sub {          0x87FD => sub {
234                  my ( $self, $key ) = @_;                  my $self = shift;
235                  if ( $key eq 'return' ) {                  if ( $self->key_active('return') ) {
236                          M6502::_write( 0xfc, 13 );  #                       M6502::_write( 0xfc, 13 );
237                          warn "return\n";                          warn "return\n";
238                          return 0;                          return 0;
239                  } elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) {                  } elsif ( $self->key_active('left ctrl','right ctrl') ) {
240                          warn "ctrl\n";                          warn "ctrl\n";
241                          return 16;                          return 16;
242                  }                  }
# Line 242  my $keyboard = { Line 249  my $keyboard = {
249                  'f1' => 224,                  'f1' => 224,
250          },          },
251          0x87FB => sub {          0x87FB => sub {
252                  my ( $self, $key ) = @_;                  my $self = shift;
253                  if ( $key eq 'space' ) {                  if ( $self->key_active('space') ) {
254                            warn "space\n";
255                          return 32;                          return 32;
256                  } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) {                  } elsif ( $self->key_active('left shift','right shift') ) {
257                          warn "shift\n";                          warn "shift\n";
258                          return 16;                          return 16;
259  #               } elsif ( $self->tape ) {  #               } elsif ( $self->tape ) {
# Line 339  my $keyboard = { Line 347  my $keyboard = {
347  sub read {  sub read {
348          my $self = shift;          my $self = shift;
349          my ($addr) = @_;          my ($addr) = @_;
350          return if ( $addr > 0xffff );          die "address over 64k: $addr" if ( $addr > 0xffff );
351          my $byte = $mem[$addr];          my $byte = $mem[$addr];
352          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
353          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
# Line 348  sub read { Line 356  sub read {
356    
357          if ( defined( $keyboard->{$addr} ) ) {          if ( defined( $keyboard->{$addr} ) ) {
358                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
359                  my $key = $self->key_pressed;          
360                  if ( defined($key) ) {                  my $ret = $keyboard_none;
361                          my $ret = $keyboard_none;                  my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
362                          my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";                  if ( ref($r) eq 'CODE' ) {
363                          if ( ref($r) eq 'CODE' ) {                          $ret = $r->($self);
364                                  $ret = $r->($self, $key);                  } else {
365                          } elsif ( defined($r->{$key}) ) {                          foreach my $k ( keys %$r ) {
366                                  $ret = $r->{$key};                                  my $return = 0;
367                                  if ( ref($ret) eq 'CODE' ) {                                  if ( $self->key_active($k) ) {
368                                          $ret = $ret->($self);                                          warn "key '$k' is active\n";
369                                            $return ||= $r->{$k};
370                                  }                                  }
371                          } else {                                  $ret = $return if $return;
                                 warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug;  
372                          }                          }
                         warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none );  
                         return $ret;  
373                  }                  }
374                  return $keyboard_none;                  warn sprintf("keyboard port: %04x code: %d\n",$addr,$ret) if ( $ret != $keyboard_none );
375                    return $ret;
376          }          }
377    
378          if ( $addr == 0x87ff ) {          if ( $addr == 0x87ff ) {
379                  return $self->read_tape;                  return $self->read_tape;
380          }          }
381    
382          $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;  #       $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
383          return $byte;          return $byte;
384  }  }
385    
# Line 398  sub write { Line 405  sub write {
405                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
406          }          }
407    
408            $self->render_vram if ( $addr >= 0x6000 && $addr <= 0x7fff );
409    
410          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
411          $mem[$addr] = $byte;  #       $mem[$addr] = $byte;
412          return;          return;
413  }  }
414    
# Line 416  Render one frame of video ram Line 425  Render one frame of video ram
425  sub render_vram {  sub render_vram {
426          my $self = shift;          my $self = shift;
427    
428          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);  #       my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
429    #       my $pixels = pack("C*", map { $flip[$_] } $self->ram( 0x6000, 0x7fff ));
430    #       my $pixels = M6502::mem_peek_region( 0x6000, 0x7fff );
431            my $pixels = pack('C*', map { $flip[$_] } unpack('C*', M6502::mem_peek_region( 0x6000, 0x7fff ) ) );
432    
433          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
434                  -width => 256,                  -width => 256,
# Line 445  sub cpu_PC { Line 457  sub cpu_PC {
457          return $PC;          return $PC;
458  }  }
459    
460    
461    =head2 _init_callbacks
462    
463    Mark memory areas for which we want to get callbacks to perl
464    
465    =cut
466    
467    sub _init_callbacks {
468            my $self = shift;
469            warn "set calbacks to perl for memory areas...\n";
470    
471            # don't call for anything
472            M6502::set_all_callbacks( 0x00 );
473    
474            # video ram
475    #       M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x7fff );
476            # keyboard
477            M6502::set_read_callback( $_ ) foreach ( keys %$keyboard );
478            # tape
479            M6502::set_read_callback( 0x87ff );
480            M6502::set_write_callback( 0x8800 );
481    
482            my $map = '';
483            foreach ( 0 .. 0xffff ) {
484                    my $cb = M6502::get_callback( $_ );
485                    $map .= sprintf( "%04x: %02x\n", $_, $cb ) if $cb;
486            }
487            warn "callback map:\n$map\n";
488    }
489    
490  =head1 SEE ALSO  =head1 SEE ALSO
491    
492  L<VRac>, L<M6502>, L<Screen>, L<Tape>  L<VRac>, L<M6502>, L<Screen>, L<Tape>
Legend:
Removed from v.165  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.26