/[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 132 by dpavlin, Sat Aug 4 21:04:05 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 117  sub boot { Line 113  sub boot {
113    
114          M6502::reset();          M6502::reset();
115    
116          $self->booted( 1 );  #       $self->load_tape( '../oraoigre/bdash.tap' );
 }  
   
 =head2 run  
   
 Run interactive emulation loop  
117    
118    $emu->run;          $self->loop( sub {
119                    my $run_for = shift;
120                    warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
121                    M6502::exec( $run_for );
122                    $self->render_vram;
123            });
124    };
125    
 =cut  
126    
127  sub run {  =head1 Helper functions
         my $self = shift;  
   
         $self->boot if ( ! $self->booted );  
128    
129  #       $self->load_tape( '../oraoigre/bdash.tap' );  =head2 write_chunk
130    
131          $self->loop;  Write chunk directly into memory, updateing vram if needed
 };  
132    
133  =head1 Helper functions    $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 159  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 189  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 362  my $keyboard = { Line 336  my $keyboard = {
336  sub read {  sub read {
337          my $self = shift;          my $self = shift;
338          my ($addr) = @_;          my ($addr) = @_;
339            return if ( $addr > 0xffff );
340          my $byte = $mem[$addr];          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;
# Line 429  sub write { Line 404  sub write {
404    
405  Render one frame of video ram  Render one frame of video ram
406    
407    $self->render_vram( @video_memory );    $self->render_vram;
408    
409  =cut  =cut
410    
# Line 453  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    
431          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[$_] } @_);  
432    
433          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
434                  -width => 256,                  -width => 256,
# 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.125  
changed lines
  Added in v.132
  ViewVC Help
Powered by ViewVC 1.1.26