--- Orao.pm 2007/08/04 20:27:59 127 +++ Orao.pm 2007/08/06 11:40:21 171 @@ -6,10 +6,10 @@ use Carp qw/confess/; use File::Slurp; use Data::Dump qw/dump/; -use M6502; # import @mem $PC and friends -use Screen qw/$white $black/; +use M6502; +use Screen; -use base qw(Class::Accessor VRac M6502 Screen Prefs Tape); +use base qw(Class::Accessor VRac M6502 Screen Prefs Tape Session); #__PACKAGE__->mk_accessors(qw()); =head1 NAME @@ -18,15 +18,15 @@ =head1 VERSION -Version 0.05 +Version 0.06 =cut -our $VERSION = '0.05'; +our $VERSION = '0.06'; =head1 SUMMARY -Emulator or Orao 8-bit 6502 machine popular in Croatia +Emulator for Orao 8-bit 6502 machine popular in Croatia (especially schools) =cut @@ -54,6 +54,8 @@ warn "emulating ", $#mem, " bytes of memory\n"; # $self->scale( 2 ); +# $self->show_mem( 1 ); + $self->load_session( 'sess/current' ); $self->open_screen; $self->load_rom({ @@ -79,15 +81,11 @@ $self->trace( 0 ); $self->debug( 0 ); - warn "rendering video memory\n"; - $self->render_vram; + warn "rendering memory\n"; + $self->render_mem( @mem ); if ( $self->show_mem ) { - warn "rendering memory map\n"; - - $self->render_mem( @mem ); - my @mmap = ( 0x0000, 0x03FF, 'nulti blok', 0x0400, 0x5FFF, 'korisnički RAM (23K)', @@ -99,13 +97,18 @@ 0xE000, 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' : '', @@ -117,7 +120,7 @@ $self->loop( sub { my $run_for = shift; -# warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for); + 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; }); @@ -151,7 +154,7 @@ warn sprintf("refresh video ram %04x-%04x\n", $f, $t); $self->render_vram; - $self->render_mem( @mem ) if $self->show_mem; + $self->render_mem( @mem ); } =head2 load_image @@ -221,12 +224,12 @@ 'backspace' => 224, }, 0x87FD => sub { - my ( $self, $key ) = @_; - if ( $key eq 'return' ) { + my $self = shift; + if ( $self->key_active('return') ) { M6502::_write( 0xfc, 13 ); warn "return\n"; return 0; - } elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) { + } elsif ( $self->key_active('left ctrl','right ctrl') ) { warn "ctrl\n"; return 16; } @@ -239,10 +242,11 @@ 'f1' => 224, }, 0x87FB => sub { - my ( $self, $key ) = @_; - if ( $key eq 'space' ) { + my $self = shift; + if ( $self->key_active('space') ) { + warn "space\n"; return 32; - } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) { + } elsif ( $self->key_active('left shift','right shift') ) { warn "shift\n"; return 16; # } elsif ( $self->tape ) { @@ -337,7 +341,7 @@ my $self = shift; my ($addr) = @_; return if ( $addr > 0xffff ); - my $byte = @mem[$addr]; + 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; @@ -345,31 +349,30 @@ if ( defined( $keyboard->{$addr} ) ) { warn sprintf("keyboard port: %04x\n",$addr) if $self->trace; - my $key = $self->key_pressed; - if ( defined($key) ) { - my $ret = $keyboard_none; - my $r = $keyboard->{$addr} || confess "no definition for keyboard port found"; - if ( ref($r) eq 'CODE' ) { - $ret = $r->($self, $key); - } elsif ( defined($r->{$key}) ) { - $ret = $r->{$key}; - if ( ref($ret) eq 'CODE' ) { - $ret = $ret->($self); + + my $ret = $keyboard_none; + my $r = $keyboard->{$addr} || confess "no definition for keyboard port found"; + if ( ref($r) eq 'CODE' ) { + $ret = $r->($self); + } else { + foreach my $k ( keys %$r ) { + my $return = 0; + if ( $self->key_active($k) ) { + warn "key '$k' is active\n"; + $return ||= $r->{$k}; } - } else { - warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug; + $ret = $return if $return; } - warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none ); - return $ret; } - return $keyboard_none; + warn sprintf("keyboard port: %04x code: %d\n",$addr,$ret) if ( $ret != $keyboard_none ); + return $ret; } if ( $addr == 0x87ff ) { return $self->read_tape; } - $self->mmap_pixel( $addr, 0, $byte, 0 ); + $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem; return $byte; } @@ -387,6 +390,7 @@ warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace; if ( $addr == 0x8800 ) { + $self->write_tape( $byte ); warn sprintf "sound ignored: %x\n", $byte; } @@ -394,12 +398,13 @@ 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 @@ -408,23 +413,6 @@ =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; @@ -444,6 +432,8 @@ =head2 cpu_PC +Helper metod to set or get PC for current architecture + =cut sub cpu_PC { @@ -455,12 +445,14 @@ return $PC; } +=head1 SEE ALSO + +L, L, L, L + =head1 AUTHOR Dobrica Pavlinusic, C<< >> -=head1 BUGS - =head1 ACKNOWLEDGEMENTS See also L which is source of all