/[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 126 by dpavlin, Sat Aug 4 15:43:28 2007 UTC revision 127 by dpavlin, Sat Aug 4 20:27:59 2007 UTC
# 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 117  sub boot { Line 113  sub boot {
113    
114          M6502::reset();          M6502::reset();
115    
         $self->booted( 1 );  
 }  
   
 =head2 run  
   
 Run interactive emulation loop  
   
   $emu->run;  
   
 =cut  
   
 sub run {  
         my $self = shift;  
   
         $self->boot if ( ! $self->booted );  
   
116  #       $self->load_tape( '../oraoigre/bdash.tap' );  #       $self->load_tape( '../oraoigre/bdash.tap' );
117    
118          $self->loop( sub {          $self->loop( sub {
119                  M6502::exec( $_[0] );                  my $run_for = shift;
120    #               warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for);
121                    M6502::exec( $run_for );
122                  $self->render_vram;                  $self->render_vram;
123          });          });
124  };  };
125    
126    
127  =head1 Helper functions  =head1 Helper functions
128    
129    =head2 write_chunk
130    
131    Write chunk directly into memory, updateing vram if needed
132    
133      $emu->write_chunk( 0x1000, $chunk_data );
134    
135  =cut  =cut
136    
137  # write chunk directly into memory, updateing vram if needed  sub write_chunk {
 sub _write_chunk {  
138          my $self = shift;          my $self = shift;
139          my ( $addr, $chunk ) = @_;          my ( $addr, $chunk ) = @_;
140          $self->write_chunk( $addr, $chunk );          $self->SUPER::write_chunk( $addr, $chunk );
141          my $end = $addr + length($chunk);          my $end = $addr + length($chunk);
142          my ( $f, $t ) = ( 0x6000, 0x7fff );          my ( $f, $t ) = ( 0x6000, 0x7fff );
143    
# Line 162  sub _write_chunk { Line 150  sub _write_chunk {
150          $t = $end if ( $end < $t );          $t = $end if ( $end < $t );
151    
152          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
153          $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );          $self->render_vram;
154          $self->render_mem( @mem ) if $self->show_mem;          $self->render_mem( @mem ) if $self->show_mem;
155  }  }
156    
# Line 192  sub load_image { Line 180  sub load_image {
180          if ( $size == 65538 ) {          if ( $size == 65538 ) {
181                  $addr = 0;                  $addr = 0;
182                  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;
183                  $self->_write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
184                  return 1;                  return 1;
185          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
186                  $addr = 0;                  $addr = 0;
187                  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;
188                  $self->_write_chunk( $addr, substr($buff,0x20) );                  $self->write_chunk( $addr, substr($buff,0x20) );
189                  return 1;                  return 1;
190          }          }
         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 );  
191    
192            printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
193            $self->write_chunk( $addr, $buff );
194          return 1;          return 1;
195  };  };
196    
# Line 365  my $keyboard = { Line 336  my $keyboard = {
336  sub read {  sub read {
337          my $self = shift;          my $self = shift;
338          my ($addr) = @_;          my ($addr) = @_;
339          my $byte = $mem[$addr];          return if ( $addr > 0xffff );
340            my $byte = @mem[$addr];
341          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);
342          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
343    
# Line 456  foreach my $i ( 0 .. 255 ) { Line 428  foreach my $i ( 0 .. 255 ) {
428  sub render_vram {  sub render_vram {
429          my $self = shift;          my $self = shift;
430    
         return unless $self->booted;  
   
431          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
432    
433          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
# Line 472  sub render_vram { Line 442  sub render_vram {
442          $self->render_frame( $vram );          $self->render_frame( $vram );
443  }  }
444    
445    =head2 cpu_PC
446    
447    =cut
448    
449    sub cpu_PC {
450            my ( $self, $addr ) = @_;
451            if ( defined($addr) ) {
452                    $PC = $addr;
453                    warn sprintf("running from PC %04x\n", $PC);
454            };
455            return $PC;
456    }
457    
458  =head1 AUTHOR  =head1 AUTHOR
459    
460  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.126  
changed lines
  Added in v.127
  ViewVC Help
Powered by ViewVC 1.1.26