--- M6502/Orao.pm	2007/08/02 16:01:16	98
+++ M6502/Orao.pm	2007/08/03 08:44:45	106
@@ -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
@@ -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
@@ -140,8 +134,6 @@
 sub run {
 	my $self = shift;
 
-	$self->show_mem( 1 );
-
 	$self->boot if ( ! $self->booted );
 	$self->loop;
 };
@@ -307,6 +299,8 @@
 
 =cut
 
+my $keyboard_none = 255;
+
 my $keyboard = {
 	0x87FC => {
 		'right'		=> 16,
@@ -315,13 +309,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 +327,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 +374,11 @@
 		'l' => 224,
 	},
 	0x87BF => {
-		',' => 32,
-		'.' => 16,
+		',' => 32,	# <
+		'.' => 16,	# >
 	},
 	0x877E => {
-		'y' => 16,
+		'z' => 16,	# hr:y
 		's' => 128,
 		'a' => 192,
 		'd' => 224,
@@ -392,25 +395,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 +419,6 @@
 	},
 };
 
-
 sub read {
 	my $self = shift;
 	my ($addr) = @_;
@@ -428,24 +428,26 @@
 
 	# keyboard
 
-	if ( first { $addr == $_ } @kbd_ports ) {
+	if ( defined( $keyboard->{$addr} ) ) {
 		warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
-		if ( my $key = $self->key_pressed ) {
+		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);
+				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;
 	}
 
 	$self->mmap_pixel( $addr, 0, $byte, 0 );
@@ -466,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 ) {