--- M6502/Orao.pm 2007/08/02 18:01:51 103 +++ M6502/Orao.pm 2007/08/02 21:55:06 105 @@ -8,7 +8,6 @@ #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); @@ -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 @@ -307,6 +299,8 @@ =cut +my $keyboard_none = 255; + my $keyboard = { 0x87FC => { 'right' => 16, @@ -319,10 +313,13 @@ my ( $self, $key ) = @_; if ( $key eq 'return' ) { M6502::_write( 0xfc, 13 ); + warn "return\n"; return 0; - } elsif ( $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) { + } 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, @@ -335,13 +332,15 @@ 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 => { @@ -375,11 +374,11 @@ 'l' => 224, }, 0x87BF => { - ',' => 32, - '.' => 16, + ',' => 32, # < + '.' => 16, # > }, 0x877E => { - 'y' => 16, + 'z' => 16, # hr:y 's' => 128, 'a' => 192, 'd' => 224, @@ -399,22 +398,20 @@ 'v' => 16, }, 0x85FE => { - ';' => sub { $_[0]->key_down('left shift') ? 16 : 224 }, - '\\' => 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, @@ -422,8 +419,6 @@ }, }; -my $keyboard_none = 255; - sub read { my $self = shift; my ($addr) = @_; @@ -433,7 +428,7 @@ # 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) ) { @@ -441,20 +436,16 @@ my $r = $keyboard->{$addr} || confess "no definition for keyboard port found"; if ( ref($r) eq 'CODE' ) { $ret = $r->($self, $key); - } elsif ( $ret = $r->{$key} ) { + } elsif ( defined($r->{$key}) ) { + $ret = $r->{$key}; if ( ref($ret) eq 'CODE' ) { $ret = $ret->($self); - warn "executed $key and got: $ret\n"; - } else { - warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret); } - $mem[$addr] = $ret; - warn "keypress: $key = $ret\n"; - 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; }