--- M6502/Orao.pm 2007/08/02 13:04:29 94 +++ M6502/Orao.pm 2007/08/03 08:44:45 106 @@ -8,11 +8,10 @@ #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); -__PACKAGE__->mk_accessors(qw(run_for)); +__PACKAGE__->mk_accessors(qw(booted)); =head1 NAME @@ -20,11 +19,11 @@ =head1 VERSION -Version 0.03 +Version 0.04 =cut -our $VERSION = '0.03'; +our $VERSION = '0.04'; =head1 SUMMARY @@ -32,12 +31,7 @@ =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 @@ -69,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 @@ -124,8 +120,26 @@ M6502::reset(); + $self->booted( 1 ); } +=head2 run + +Run interactive emulation loop + + $orao->run; + +=cut + +sub run { + my $self = shift; + + $self->boot if ( ! $self->booted ); + $self->loop; +}; + +=head1 Helper functions + =head2 load_rom called to init memory and load initial rom images @@ -285,6 +299,126 @@ =cut +my $keyboard_none = 255; + +my $keyboard = { + 0x87FC => { + 'right' => 16, + 'down' => 128, + 'up' => 192, + 'left' => 224, + 'backspace' => 224, + }, + 0x87FD => sub { + my ( $self, $key ) = @_; + if ( $key eq 'return' ) { + M6502::_write( 0xfc, 13 ); + warn "return\n"; + return 0; + } 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, + 'f3' => 128, + 'f2' => 192, + 'f1' => 224, + }, + 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, + 'y' => 192, # hr: z + 'r' => 224, + }, + 0x87F7 => { + '5' => 32, + '4' => 16, + }, + 0x87EE => { + '7' => 16, + 'u' => 128, + 'i' => 192, + 'o' => 224, + }, + 0x87EF => { + '8' => 32, + '9' => 16, + }, + 0x87DE => { + '1' => 16, + 'w' => 128, + 'q' => 192, + 'e' => 224, + }, + 0x87DF => { + '2' => 32, + '3' => 16, + }, + 0x87BE => { + 'm' => 16, + 'k' => 128, + 'j' => 192, + 'l' => 224, + }, + 0x87BF => { + ',' => 32, # < + '.' => 16, # > + }, + 0x877E => { + 'z' => 16, # hr:y + 's' => 128, + 'a' => 192, + 'd' => 224, + }, + 0x877F => { + 'x' => 32, + 'c' => 16, + }, + 0x86FE => { + 'n' => 16, + 'g' => 128, + 'h' => 192, + 'f' => 224, + }, + 0x86FF => { + 'b' => 32, + 'v' => 16, + }, + 0x85FE => { + '<' => 16, # : + '\\' => 128, # ¾ + '\'' => 192, # æ + ';' => 224, # è + }, + 0x85FF => { + '/' => 32, + 'f11' => 16, # ^ + }, + 0x83FE => { + 'f12' => 16, # ; + '[' => 128, # ¹ + ']' => 192, # ð + 'p' => 224, + }, + 0x83FF => { + '-' => 32, + '0' => 16, + }, +}; + sub read { my $self = shift; my ($addr) = @_; @@ -294,53 +428,26 @@ # keyboard - if ( first { $addr == $_ } @kbd_ports ) { - warn sprintf("keyboard port: %04x\n",$addr); - } elsif ( $addr == 0x87fc ) { - warn "0x87fc - arrows/back\n"; -=for pascal - if VKey=VK_RIGHT then Result:=16; - if VKey=VK_DOWN then Result:=128; - if VKey=VK_UP then Result:=192; - if VKey=VK_LEFT then Result:=224; - if Ord(KeyPressed)=VK_BACK then Result:=224; -=cut - } elsif ( $addr == 0x87fd ) { - warn "0x87fd - enter\n"; -=for pascal - if KeyPressed=Chr(13) then begin - Mem[$FC]:=13; - Result:=0; - end; -=cut - } elsif ( $addr == 0x87fa ) { - warn "0x87fa = F1 - F4\n"; -=for pascal - if VKey=VK_F4 then Result:=16; - if VKey=VK_F3 then Result:=128; - if VKey=VK_F2 then Result:=192; - if VKey=VK_F1 then Result:=224; -=cut - } elsif ( $addr == 0x87fb ) { - warn "0x87fb\n"; -=for pascal - if KeyPressed=Chr(32) then Result:=32; - if KeyPressed='"' then Result:=16; - if KeyPressed='!' then Result:=16; - if KeyPressed='$' then Result:=16; - if KeyPressed='%' then Result:=16; - if KeyPressed='&' then Result:=16; - if KeyPressed='(' then Result:=16; - if KeyPressed=')' then Result:=16; - if KeyPressed='=' then Result:=16; - if KeyPressed='#' then Result:=16; - if KeyPressed='+' then Result:=16; - if KeyPressed='*' then Result:=16; - if KeyPressed='?' then Result:=16; - if KeyPressed='<' then Result:=16; - if KeyPressed='>' then Result:=16; - if VKey=191 then Result:=16; -=cut + 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); + } + } else { + warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug; + } + warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none ); + return $ret; + } + return $keyboard_none; } $self->mmap_pixel( $addr, 0, $byte, 0 ); @@ -361,7 +468,7 @@ warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace; if ( $addr >= 0x6000 && $addr < 0x8000 ) { - $self->vram( $addr - 0x6000 , $byte ); +# $self->vram( $addr - 0x6000 , $byte ); } if ( $addr == 0x8800 ) { @@ -395,7 +502,7 @@ my $self = shift; $self->app->sync; my $a = shift; - print STDERR $self->hexdump( $a ), + print $self->hexdump( $a ), $last ? "[$last] " : '', "> "; my $in = ; @@ -417,6 +524,7 @@ sub cli { my $self = shift; my $a = $PC || confess "no pc?"; + my $run_for = 0; warn $self->dump_R() if $show_R; while ( my ($line, @v) = $self->prompt( $a, $last ) ) { my $c = shift @v; @@ -443,6 +551,7 @@ __USAGE__ warn $self->dump_R; + $last = ''; } elsif ( $c =~ m/^e/i ) { $a = $v if defined($v); my $to = shift @v; @@ -503,6 +612,7 @@ } } + return $run_for; } =head1 AUTHOR