/[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 124 by dpavlin, Sat Aug 4 14:13:28 2007 UTC revision 132 by dpavlin, Sat Aug 4 21:04:05 2007 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use Carp qw/confess/;  use Carp qw/confess/;
 use lib './lib';  
 #use Time::HiRes qw(time);  
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/;
11    
12  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);
13  #__PACKAGE__->mk_accessors(qw());  #__PACKAGE__->mk_accessors(qw());
# Line 19  Orao - Orao emulator Line 18  Orao - Orao emulator
18    
19  =head1 VERSION  =head1 VERSION
20    
21  Version 0.04  Version 0.05
22    
23  =cut  =cut
24    
25  our $VERSION = '0.04';  our $VERSION = '0.05';
26    
27  =head1 SUMMARY  =head1 SUMMARY
28    
# Line 33  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 58  sub boot { Line 53  sub boot {
53    
54          warn "emulating ", $#mem, " bytes of memory\n";          warn "emulating ", $#mem, " bytes of memory\n";
55    
56    #       $self->scale( 2 );
57    
58          $self->open_screen;          $self->open_screen;
59          $self->load_rom({          $self->load_rom({
60  #               0x1000 => 'dump/SCRINV.BIN',  #               0x1000 => 'dump/SCRINV.BIN',
61                  # should be 0x6000, but oraoemu has 2 byte prefix                  # should be 0x6000, but oraoemu has 2 byte prefix
62  #               0x5FFE => 'dump/screen.dmp',  #               0x5FFE => '/home/dpavlin/orao/dump/screen.dmp',
63  #               0xC000 => 'rom/Orao/BAS12.ROM',  #               0xC000 => 'rom/Orao/BAS12.ROM',
64  #               0xE000 => 'rom/Orao/CRT12.ROM',  #               0xE000 => 'rom/Orao/CRT12.ROM',
65                  0xC000 => 'rom/Orao/BAS13.ROM',                  0xC000 => 'rom/Orao/BAS13.ROM',
# Line 83  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 116  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  
   
   $emu->run;  
117    
118  =cut          $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    
 sub run {  
         my $self = shift;  
126    
127          $self->boot if ( ! $self->booted );  =head1 Helper functions
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 158  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 188  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 361  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 424  sub write { Line 400  sub write {
400          return;          return;
401  }  }
402    
403    =head2 render_vram
404    
405    Render one frame of video ram
406    
407      $self->render_vram;
408    
409    =cut
410    
411    my @flip;
412    
413    foreach my $i ( 0 .. 255 ) {
414            my $t = 0;
415            $i & 0b00000001 and $t = $t | 0b10000000;
416            $i & 0b00000010 and $t = $t | 0b01000000;
417            $i & 0b00000100 and $t = $t | 0b00100000;
418            $i & 0b00001000 and $t = $t | 0b00010000;
419            $i & 0b00010000 and $t = $t | 0b00001000;
420            $i & 0b00100000 and $t = $t | 0b00000100;
421            $i & 0b01000000 and $t = $t | 0b00000010;
422            $i & 0b10000000 and $t = $t | 0b00000001;
423            #warn "$i = $t\n";
424            $flip[$i] = $t;
425    }
426    
427    
428    sub render_vram {
429            my $self = shift;
430    
431            my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
432    
433            my $vram = SDL::Surface->new(
434                    -width => 256,
435                    -height => 256,
436                    -depth => 1,    # 1 bit per pixel
437                    -pitch => 32,   # bytes per line
438                    -from => $pixels,
439            );
440            $vram->set_colors( 0, $black, $white );
441    
442            $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.124  
changed lines
  Added in v.132
  ViewVC Help
Powered by ViewVC 1.1.26