/[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 125 by dpavlin, Sat Aug 4 15:09:44 2007 UTC revision 135 by dpavlin, Sat Aug 4 22:14:09 2007 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; # import @mem $PC and friends
10  use Screen qw/$white $black/;  use Screen qw/$white $black/;
11    
12  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);
# Line 32  Emulator or Orao 8-bit 6502 machine popu Line 32  Emulator or Orao 8-bit 6502 machine popu
32    
33  =head1 FUNCTIONS  =head1 FUNCTIONS
34    
35  =head2 boot  =head2 run
   
 Start emulator, open L<Screen>, load initial ROM images, and render memory  
36    
37    my $emu = Orao->new({});  Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
   $emu->boot;  
38    
39  =cut  =cut
40    
41  our $emu;  our $emu;
42    
43  select(STDERR); $| = 1;  sub run {
   
 sub boot {  
44          my $self = shift;          my $self = shift;
45    
46          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
47          $self->SUPER::init(          $self->SUPER::init(
48                  read => sub { $self->read( @_ ) },                  read => sub { $self->read( @_ ) },
# Line 84  sub boot { Line 80  sub boot {
80          $self->debug( 0 );          $self->debug( 0 );
81    
82          warn "rendering video memory\n";          warn "rendering video memory\n";
83          $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );          $self->render_vram;
84    
85          if ( $self->show_mem ) {          if ( $self->show_mem ) {
86    
# Line 108  sub boot { Line 104  sub boot {
104          $self->trace( $trace );          $self->trace( $trace );
105          $self->debug( $debug );          $self->debug( $debug );
106    
         #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );  
   
107          warn "Orao boot finished",          warn "Orao boot finished",
108                  $self->trace ? ' trace' : '',                  $self->trace ? ' trace' : '',
109                  $self->debug ? ' debug' : '',                  $self->debug ? ' debug' : '',
# Line 117  sub boot { Line 111  sub boot {
111    
112          M6502::reset();          M6502::reset();
113    
114          $self->booted( 1 );  #       $self->load_tape( '../oraoigre/bdash.tap' );
 }  
   
 =head2 run  
   
 Run interactive emulation loop  
115    
116    $emu->run;          $self->loop( sub {
117                    my $run_for = shift;
118                    warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
119                    M6502::exec( $run_for );
120                    $self->render_vram;
121            });
122    };
123    
 =cut  
124    
125  sub run {  =head1 Helper functions
         my $self = shift;  
   
         $self->boot if ( ! $self->booted );  
126    
127  #       $self->load_tape( '../oraoigre/bdash.tap' );  =head2 write_chunk
128    
129          $self->loop;  Write chunk directly into memory, updateing vram if needed
 };  
130    
131  =head1 Helper functions    $emu->write_chunk( 0x1000, $chunk_data );
132    
133  =cut  =cut
134    
135  # write chunk directly into memory, updateing vram if needed  sub write_chunk {
 sub _write_chunk {  
136          my $self = shift;          my $self = shift;
137          my ( $addr, $chunk ) = @_;          my ( $addr, $chunk ) = @_;
138          $self->write_chunk( $addr, $chunk );          $self->SUPER::write_chunk( $addr, $chunk );
139          my $end = $addr + length($chunk);          my $end = $addr + length($chunk);
140          my ( $f, $t ) = ( 0x6000, 0x7fff );          my ( $f, $t ) = ( 0x6000, 0x7fff );
141    
# Line 159  sub _write_chunk { Line 148  sub _write_chunk {
148          $t = $end if ( $end < $t );          $t = $end if ( $end < $t );
149    
150          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
151          $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );          $self->render_vram;
152          $self->render_mem( @mem ) if $self->show_mem;          $self->render_mem( @mem );
153  }  }
154    
155  =head2 load_image  =head2 load_image
# Line 189  sub load_image { Line 178  sub load_image {
178          if ( $size == 65538 ) {          if ( $size == 65538 ) {
179                  $addr = 0;                  $addr = 0;
180                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
181                  $self->_write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
182                  return 1;                  return 1;
183          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
184                  $addr = 0;                  $addr = 0;
185                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
186                  $self->_write_chunk( $addr, substr($buff,0x20) );                  $self->write_chunk( $addr, substr($buff,0x20) );
187                  return 1;                  return 1;
188          }          }
         printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;  
         $self->_write_chunk( $addr, $buff );  
         return 1;  
   
         my $chunk;  
   
         my $pos = 0;  
   
         while ( my $long = substr($buff,$pos,4) ) {  
                 my @b = split(//, $long, 4);  
                 $chunk .=  
                         ( $b[3] || '' ) .  
                         ( $b[2] || '' ) .  
                         ( $b[1] || '' ) .  
                         ( $b[0] || '' );  
                 $pos += 4;  
         }  
   
         $self->_write_chunk( $addr, $chunk );  
189    
190            printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
191            $self->write_chunk( $addr, $buff );
192          return 1;          return 1;
193  };  };
194    
# Line 362  my $keyboard = { Line 334  my $keyboard = {
334  sub read {  sub read {
335          my $self = shift;          my $self = shift;
336          my ($addr) = @_;          my ($addr) = @_;
337            return if ( $addr > 0xffff );
338          my $byte = $mem[$addr];          my $byte = $mem[$addr];
339          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);
340          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 394  sub read { Line 367  sub read {
367                  return $self->read_tape;                  return $self->read_tape;
368          }          }
369    
370          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
371          return $byte;          return $byte;
372  }  }
373    
# Line 419  sub write { Line 392  sub write {
392                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
393          }          }
394    
395          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
   
396          $mem[$addr] = $byte;          $mem[$addr] = $byte;
397          return;          return;
398  }  }
# Line 429  sub write { Line 401  sub write {
401    
402  Render one frame of video ram  Render one frame of video ram
403    
404    $self->render_vram( @video_memory );    $self->render_vram;
405    
406  =cut  =cut
407    
# Line 453  foreach my $i ( 0 .. 255 ) { Line 425  foreach my $i ( 0 .. 255 ) {
425  sub render_vram {  sub render_vram {
426          my $self = shift;          my $self = shift;
427    
428          confess "no data?" unless (@_);          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
         confess "screen size not 256*256/8 but ",($#_+1) unless (($#_+1) == (256*256/8));  
   
         return unless $self->booted;  
   
         my $pixels = pack("C*", map { $flip[$_] } @_);  
429    
430          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
431                  -width => 256,                  -width => 256,
# Line 472  sub render_vram { Line 439  sub render_vram {
439          $self->render_frame( $vram );          $self->render_frame( $vram );
440  }  }
441    
442    =head2 cpu_PC
443    
444    =cut
445    
446    sub cpu_PC {
447            my ( $self, $addr ) = @_;
448            if ( defined($addr) ) {
449                    $PC = $addr;
450                    warn sprintf("running from PC %04x\n", $PC);
451            };
452            return $PC;
453    }
454    
455  =head1 AUTHOR  =head1 AUTHOR
456    
457  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.125  
changed lines
  Added in v.135
  ViewVC Help
Powered by ViewVC 1.1.26