/[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 209 by dpavlin, Mon Apr 14 19:55:29 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' );
123    
124  #       $self->load_tape( '../oraoigre/bdash.tap' );          $self->render_vram;
125    
126          $self->loop( sub {          $self->loop( sub {
127                  my $run_for = shift;                  my $run_for = shift;
# Line 224  my $keyboard = { Line 229  my $keyboard = {
229                  'backspace' => 224,                  'backspace' => 224,
230          },          },
231          0x87FD => sub {          0x87FD => sub {
232                  my ( $self, $key ) = @_;                  my $self = shift;
233                  if ( $key eq 'return' ) {                  if ( $self->key_active('return') ) {
234                          M6502::_write( 0xfc, 13 );  #                       M6502::_write( 0xfc, 13 );
235                          warn "return\n";                          warn "return\n";
236                          return 0;                          return 0;
237                  } elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) {                  } elsif ( $self->key_active('left ctrl','right ctrl') ) {
238                          warn "ctrl\n";                          warn "ctrl\n";
239                          return 16;                          return 16;
240                  }                  }
# Line 242  my $keyboard = { Line 247  my $keyboard = {
247                  'f1' => 224,                  'f1' => 224,
248          },          },
249          0x87FB => sub {          0x87FB => sub {
250                  my ( $self, $key ) = @_;                  my $self = shift;
251                  if ( $key eq 'space' ) {                  if ( $self->key_active('space') ) {
252                            warn "space\n";
253                          return 32;                          return 32;
254                  } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) {                  } elsif ( $self->key_active('left shift','right shift') ) {
255                          warn "shift\n";                          warn "shift\n";
256                          return 16;                          return 16;
257  #               } elsif ( $self->tape ) {  #               } elsif ( $self->tape ) {
# Line 339  my $keyboard = { Line 345  my $keyboard = {
345  sub read {  sub read {
346          my $self = shift;          my $self = shift;
347          my ($addr) = @_;          my ($addr) = @_;
348          return if ( $addr > 0xffff );          die "address over 64k: $addr" if ( $addr > 0xffff );
349          my $byte = $mem[$addr];          my $byte = $mem[$addr];
350          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);
351          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 354  sub read {
354    
355          if ( defined( $keyboard->{$addr} ) ) {          if ( defined( $keyboard->{$addr} ) ) {
356                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
357                  my $key = $self->key_pressed;          
358                  if ( defined($key) ) {                  my $ret = $keyboard_none;
359                          my $ret = $keyboard_none;                  my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
360                          my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";                  if ( ref($r) eq 'CODE' ) {
361                          if ( ref($r) eq 'CODE' ) {                          $ret = $r->($self);
362                                  $ret = $r->($self, $key);                  } else {
363                          } elsif ( defined($r->{$key}) ) {                          foreach my $k ( keys %$r ) {
364                                  $ret = $r->{$key};                                  my $return = 0;
365                                  if ( ref($ret) eq 'CODE' ) {                                  if ( $self->key_active($k) ) {
366                                          $ret = $ret->($self);                                          warn "key '$k' is active\n";
367                                            $return ||= $r->{$k};
368                                  }                                  }
369                          } else {                                  $ret = $return if $return;
                                 warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug;  
370                          }                          }
                         warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none );  
                         return $ret;  
371                  }                  }
372                  return $keyboard_none;                  warn sprintf("keyboard port: %04x code: %d\n",$addr,$ret) if ( $ret != $keyboard_none );
373                    return $ret;
374          }          }
375    
376          if ( $addr == 0x87ff ) {          if ( $addr == 0x87ff ) {
# Line 398  sub write { Line 403  sub write {
403                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
404          }          }
405    
406            $self->render_vram if ( $addr >= 0x6000 && $addr <= 0x7fff );
407    
408          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
409          $mem[$addr] = $byte;  #       $mem[$addr] = $byte;
410          return;          return;
411  }  }
412    
# Line 416  Render one frame of video ram Line 423  Render one frame of video ram
423  sub render_vram {  sub render_vram {
424          my $self = shift;          my $self = shift;
425    
426          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);  #       my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
427    #       my $pixels = pack("C*", map { $flip[$_] } $self->ram( 0x6000, 0x7fff ));
428            my $pixels = M6502::mem_peek_region( 0x6000, 0x7fff );
429    
430          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
431                  -width => 256,                  -width => 256,
# Line 445  sub cpu_PC { Line 454  sub cpu_PC {
454          return $PC;          return $PC;
455  }  }
456    
457    
458    =head2 _init_callbacks
459    
460    Mark memory areas for which we want to get callbacks to perl
461    
462    =cut
463    
464    sub _init_callbacks {
465            my $self = shift;
466            warn "set calbacks to perl for memory areas...\n";
467    
468            # don't call for anything
469            M6502::set_all_callbacks( 0x00 );
470    
471            # video ram
472    #       M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x7fff );
473            # keyboard
474            M6502::set_read_callback( $_ ) foreach ( keys %$keyboard );
475            # tape
476            M6502::set_read_callback( 0x87ff );
477            M6502::set_write_callback( 0x8800 );
478    
479            my $map = '';
480            foreach ( 0 .. 0xffff ) {
481                    my $cb = M6502::get_callback( $_ );
482                    $map .= sprintf( "%04x: %02x\n", $_, $cb ) if $cb;
483            }
484            warn "callback map:\n$map\n";
485    }
486    
487  =head1 SEE ALSO  =head1 SEE ALSO
488    
489  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.209
  ViewVC Help
Powered by ViewVC 1.1.26