/[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!

Diff of /Orao.pm

Parent Directory | Revision Log | View Patch Patch

-revision 124 by dpavlin,
Sat Aug  4 14:13:28 2007 UTC
+revision 138 by dpavlin,
Sat Aug  4 22:47:32 2007 UTC
 Line 4 
 use warnings;
  use strict;
  use Carp qw/confess/;
- use lib './lib';
- #use Time::HiRes qw(time);
  use File::Slurp;
  use Data::Dump qw/dump/;
- use M6502;
+ use M6502; # import @mem $PC and friends
+ use Screen qw/$white $black/;
  use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);
  #__PACKAGE__->mk_accessors(qw());
-Line 19 
 Orao - Orao emulator
+Line 18 
 Orao - Orao emulator
  =head1 VERSION
- Version 0.04
+ Version 0.05
  =cut
- our $VERSION = '0.04';
+ our $VERSION = '0.05';
  =head1 SUMMARY
-Line 33 
 Emulator or Orao 8-bit 6502 machine popu
+Line 32 
 Emulator or Orao 8-bit 6502 machine popu
  =head1 FUNCTIONS
- =head2 boot
+ =head2 run
- Start emulator, open L<Screen>, load initial ROM images, and render memory
-   my $emu = Orao->new({});
+ Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
-   $emu->boot;
  =cut
  our $emu;
- select(STDERR); $| = 1;
+ sub run {
- sub boot {
          my $self = shift;
          warn "Orao calling upstream init\n";
          $self->SUPER::init(
                  read => sub { $self->read( @_ ) },
-Line 58 
 sub boot {
+Line 53 
 sub boot {
          warn "emulating ", $#mem, " bytes of memory\n";
+ #       $self->scale( 2 );
+         $self->show_mem( 1 );
          $self->open_screen;
          $self->load_rom({
  #               0x1000 => 'dump/SCRINV.BIN',
                  # should be 0x6000, but oraoemu has 2 byte prefix
- #               0x5FFE => 'dump/screen.dmp',
+ #               0x5FFE => '/home/dpavlin/orao/dump/screen.dmp',
  #               0xC000 => 'rom/Orao/BAS12.ROM',
  #               0xE000 => 'rom/Orao/CRT12.ROM',
 xC000 => 'rom/Orao/BAS13.ROM',
-Line 82 
 sub boot {
+Line 80 
 sub boot {
          $self->trace( 0 );
          $self->debug( 0 );
-         warn "rendering video memory\n";
+         warn "rendering memory\n";
-         $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
+         $self->render_mem( @mem );
          if ( $self->show_mem ) {
-                 warn "rendering memory map\n";
-                 $self->render_mem( @mem );
                  my @mmap = (
 x0000, 0x03FF, 'nulti blok',
 x0400, 0x5FFF, 'korisni�ki RAM (23K)',
-Line 102 
 sub boot {
+Line 96 
 sub boot {
 xE000, 0xFFFF, 'sistemski ROM',
                  );
+                 print "Orao memory map:";
+                 while ( @mmap ) {
+                         my ( $from, $to, $desc ) = splice(@mmap, 0, 3);
+                         printf("%04x-%04x %s\n", $from, $to, $desc);
+                 }
          }
-         $self->sync;
          $self->trace( $trace );
          $self->debug( $debug );
-         #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
          warn "Orao boot finished",
                  $self->trace ? ' trace' : '',
                  $self->debug ? ' debug' : '',
-Line 116 
 sub boot {
+Line 115 
 sub boot {
          M6502::reset();
-         $self->booted( 1 );
+ #       $self->load_tape( '../oraoigre/bdash.tap' );
- }
- =head2 run
- Run interactive emulation loop
-   $emu->run;
- =cut
+         $self->loop( sub {
+                 my $run_for = shift;
+                 warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
+                 M6502::exec( $run_for );
+                 $self->render_vram;
+         });
+ };
- sub run {
-         my $self = shift;
-         $self->boot if ( ! $self->booted );
+ =head1 Helper functions
- #       $self->load_tape( '../oraoigre/bdash.tap' );
+ =head2 write_chunk
-         $self->loop;
+ Write chunk directly into memory, updateing vram if needed
- };
- =head1 Helper functions
+   $emu->write_chunk( 0x1000, $chunk_data );
  =cut
- # write chunk directly into memory, updateing vram if needed
+ sub write_chunk {
- sub _write_chunk {
          my $self = shift;
          my ( $addr, $chunk ) = @_;
-         $self->write_chunk( $addr, $chunk );
+         $self->SUPER::write_chunk( $addr, $chunk );
          my $end = $addr + length($chunk);
          my ( $f, $t ) = ( 0x6000, 0x7fff );
-Line 158 
 sub _write_chunk {
+Line 152 
 sub _write_chunk {
          $t = $end if ( $end < $t );
          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
-         $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
+         $self->render_vram;
-         $self->render_mem( @mem ) if $self->show_mem;
+         $self->render_mem( @mem );
  }
  =head2 load_image
-Line 188 
 sub load_image {
+Line 182 
 sub load_image {
          if ( $size == 65538 ) {
                  $addr = 0;
                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
-                 $self->_write_chunk( $addr, substr($buff,2) );
+                 $self->write_chunk( $addr, substr($buff,2) );
                  return 1;
          } elsif ( $size == 32800 ) {
                  $addr = 0;
                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
-                 $self->_write_chunk( $addr, substr($buff,0x20) );
+                 $self->write_chunk( $addr, substr($buff,0x20) );
                  return 1;
          }
-         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 );
+         printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
+         $self->write_chunk( $addr, $buff );
          return 1;
  };
-Line 361 
 my $keyboard = {
+Line 338 
 my $keyboard = {
  sub read {
          my $self = shift;
          my ($addr) = @_;
+         return if ( $addr > 0xffff );
          my $byte = $mem[$addr];
          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
-Line 393 
 sub read {
+Line 371 
 sub read {
                  return $self->read_tape;
          }
-         $self->mmap_pixel( $addr, 0, $byte, 0 );
+         $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
          return $byte;
  }
-Line 418 
 sub write {
+Line 396 
 sub write {
                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
          }
-         $self->mmap_pixel( $addr, $byte, 0, 0 );
+         $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
          $mem[$addr] = $byte;
          return;
  }
+ =head1 Architecture specific
+ =head2 render_vram
+ Render one frame of video ram
+   $self->render_vram;
+ =cut
+ my @flip;
+ foreach my $i ( 0 .. 255 ) {
+         my $t = 0;
+         $i & 0b00000001 and $t = $t | 0b10000000;
+         $i & 0b00000010 and $t = $t | 0b01000000;
+         $i & 0b00000100 and $t = $t | 0b00100000;
+         $i & 0b00001000 and $t = $t | 0b00010000;
+         $i & 0b00010000 and $t = $t | 0b00001000;
+         $i & 0b00100000 and $t = $t | 0b00000100;
+         $i & 0b01000000 and $t = $t | 0b00000010;
+         $i & 0b10000000 and $t = $t | 0b00000001;
+         #warn "$i = $t\n";
+         $flip[$i] = $t;
+ }
+ sub render_vram {
+         my $self = shift;
+         my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
+         my $vram = SDL::Surface->new(
+                 -width => 256,
+                 -height => 256,
+                 -depth => 1,    # 1 bit per pixel
+                 -pitch => 32,   # bytes per line
+                 -from => $pixels,
+         );
+         $vram->set_colors( 0, $black, $white );
+         $self->render_frame( $vram );
+ }
+ =head2 cpu_PC
+ Helper metod to set or get PC for current architecture
+ =cut
+ sub cpu_PC {
+         my ( $self, $addr ) = @_;
+         if ( defined($addr) ) {
+                 $PC = $addr;
+                 warn sprintf("running from PC %04x\n", $PC);
+         };
+         return $PC;
+ }
  =head1 AUTHOR
  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

 Legend:



Removed from v.124
 


changed lines


 
Added in v.138
 Legend:



Removed from v.124
 


changed lines


 
Added in v.138
-Removed from v.124
+Added in v.138

	ViewVC Help
Powered by ViewVC 1.1.26