--- M6502/Orao.pm	2007/08/02 14:07:52	97
+++ 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,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) = @_;
@@ -316,53 +428,26 @@
 
 	# keyboard
 
-	if ( first { $addr == $_ } @kbd_ports ) {
+	if ( defined( $keyboard->{$addr} ) ) {
 		warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
-	} 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
+		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 );