--- M6502/Orao.pm 2007/08/02 16:21:17 99 +++ M6502/Orao.pm 2007/08/03 10:29:33 109 @@ -8,10 +8,9 @@ #use Time::HiRes qw(time); use File::Slurp; use Data::Dump qw/dump/; -use List::Util qw/first/; use M6502; -use base qw(Class::Accessor M6502 Screen Prefs); +use base qw(Class::Accessor M6502 Screen Prefs Tape); __PACKAGE__->mk_accessors(qw(booted)); =head1 NAME @@ -32,13 +31,6 @@ =cut -my @kbd_ports = ( - 0x87FC,0x87FD,0x87FA,0x87FB,0x87F6,0x87F7, - 0x87EE,0x87EF,0x87DE,0x87DF,0x87BE,0x87BF, - 0x877E,0x877F,0x86FE,0x86FF,0x85FE,0x85FF, - 0x83FE,0x83FF, -); - =head1 FUNCTIONS =head2 boot @@ -71,8 +63,10 @@ 0x1000 => 'dump/SCRINV.BIN', # should be 0x6000, but oraoemu has 2 byte prefix 0x5FFE => 'dump/screen.dmp', - 0xC000 => 'rom/BAS12.ROM', - 0xE000 => 'rom/CRT12.ROM', +# 0xC000 => 'rom/BAS12.ROM', +# 0xE000 => 'rom/CRT12.ROM', + 0xC000 => 'rom/BAS13.ROM', + 0xE000 => 'rom/CRT13.ROM', }); # $PC = 0xDD11; # BC @@ -88,7 +82,8 @@ $self->trace( 0 ); $self->debug( 0 ); - $self->render( @mem[ 0x6000 .. 0x7fff ] ); + warn "rendering video memory\n"; + $self->render_vram( @mem[ 0x6000 .. 0x7fff ] ); if ( $self->show_mem ) { @@ -107,11 +102,6 @@ 0xE000, 0xFFFF, 'sistemski ROM', ); - } else { - - warn "rendering video memory\n"; - $self->render( @mem[ 0x6000 .. 0x7fff ] ); - } $self->sync; $self->trace( $trace ); @@ -140,8 +130,6 @@ sub run { my $self = shift; - $self->show_mem( 1 ); - $self->boot if ( ! $self->booted ); $self->loop; }; @@ -184,10 +172,7 @@ $t = $end if ( $end < $t ); warn sprintf("refresh video ram %04x-%04x\n", $f, $t); -# foreach my $a ( $f .. $t ) { -# $self->vram( $a - 0x6000 , $mem[ $a ] ); -# } - $self->render( @mem[ 0x6000 .. 0x7fff ] ); + $self->render_vram( @mem[ 0x6000 .. 0x7fff ] ); $self->render_mem( @mem ) if $self->show_mem; } @@ -307,6 +292,8 @@ =cut +my $keyboard_none = 255; + my $keyboard = { 0x87FC => { 'right' => 16, @@ -315,13 +302,17 @@ 'left' => 224, 'backspace' => 224, }, - 0x87FD => { - 'return' => sub { - M6502::write( 0xfc, 13 ); + 0x87FD => sub { + my ( $self, $key ) = @_; + if ( $key eq 'return' ) { + M6502::_write( 0xfc, 13 ); + warn "return\n"; return 0; - }, - 'left ctrl' => 16, - 'right ctrl' => 16, + } elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) { + warn "ctrl\n"; + return 16; + } + return $keyboard_none; }, 0x87FA => { 'f4' => 16, @@ -329,15 +320,20 @@ 'f2' => 192, 'f1' => 224, }, - 0x87FB => { - 'space' => 32, - 'left shift' => 16, - 'right shift' => 16, + 0x87FB => sub { + my ( $self, $key ) = @_; + if ( $key eq 'space' ) { + return 32; + } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) { + warn "shift\n"; + return 16; + } + return $keyboard_none; }, 0x87F6 => { '6' => 16, 't' => 128, - 'z' => 192, + 'y' => 192, # hr: z 'r' => 224, }, 0x87F7 => { @@ -371,11 +367,11 @@ 'l' => 224, }, 0x87BF => { - ',' => 32, - '.' => 16, + ',' => 32, # < + '.' => 16, # > }, 0x877E => { - 'y' => 16, + 'z' => 16, # hr:y 's' => 128, 'a' => 192, 'd' => 224, @@ -392,25 +388,23 @@ }, 0x86FF => { 'b' => 32, - 'c' => 16, + 'v' => 16, }, 0x85FE => { - ':' => 16, - '\\' => 128, - '\'' => 192, - ';' => 224, - '8' => 16, # FIXME? + '<' => 16, # : + '\\' => 128, # ¾ + '\'' => 192, # æ + ';' => 224, # è }, 0x85FF => { '/' => 32, - '6' => 16, # FIXME? + 'f11' => 16, # ^ }, 0x83FE => { - ';' => 16, - '[' => 128, - ']' => 192, + 'f12' => 16, # ; + '[' => 128, # ¹ + ']' => 192, # ð 'p' => 224, - '=' => 16, # FIXME? }, 0x83FF => { '-' => 32, @@ -418,7 +412,6 @@ }, }; - sub read { my $self = shift; my ($addr) = @_; @@ -428,25 +421,30 @@ # keyboard - if ( first { $addr == $_ } @kbd_ports ) { + 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 ( my $ret = $r->{$key} ) { + if ( ref($r) eq 'CODE' ) { + $ret = $r->($self, $key); + } elsif ( defined($r->{$key}) ) { + $ret = $r->{$key}; if ( ref($ret) eq 'CODE' ) { - $ret = $ret->(); - warn "executed $key and got: $ret\n"; - } else { - warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret); + $ret = $ret->($self); } - $mem[$addr] = $ret; - return $ret; } else { warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug; } - warn sprintf("keyboard port: %04x %s\n",$addr,dump( $r )) if $self->trace; + warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none ); + return $ret; } + return $keyboard_none; + } + + if ( $addr == 0x87ff ) { + return $self->read_tape; } $self->mmap_pixel( $addr, 0, $byte, 0 ); @@ -466,10 +464,6 @@ my ($addr,$byte) = @_; warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace; - if ( $addr >= 0x6000 && $addr < 0x8000 ) { - $self->vram( $addr - 0x6000 , $byte ); - } - if ( $addr == 0x8800 ) { warn sprintf "sound ignored: %x\n", $byte; } @@ -589,7 +583,7 @@ print "run_for $run_for instructions\n"; $show_R = 1; last; - } elsif ( $c =~ m/^(u|j)/ ) { + } elsif ( $c =~ m/^(u|j)/i ) { my $to = $v || $a; printf "set pc to %04x\n", $to; $PC = $to; # remember for restart @@ -597,11 +591,20 @@ $last = "r $run_for"; $show_R = 1; last; - } elsif ( $c =~ m/^t/ ) { + } elsif ( $c =~ m/^tape/ ) { + if ( ! $v ) { + warn "ERROR: please specify tape name!\n"; + } elsif ( ! -e $v ) { + warn "ERROR: tape $v: $!\n"; + } else { + $self->load_tape( $v ); + } + $last = ''; + } elsif ( $c =~ m/^t/i ) { $self->trace( not $self->trace ); print "trace ", $self->trace ? 'on' : 'off', "\n"; $last = ''; - } elsif ( $c =~ m/^d/ ) { + } elsif ( $c =~ m/^d/i ) { $self->debug( not $self->debug ); print "debug ", $self->debug ? 'on' : 'off', "\n"; $last = '';