--- M6502/Orao.pm	2007/08/02 12:23:18	90
+++ M6502/Orao.pm	2007/08/03 22:46:03	117
@@ -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));
+use base qw(Class::Accessor M6502 Screen Prefs Tape);
+__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,23 +31,18 @@
 
 =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
 
 Start emulator, open L<Screen>, load initial ROM images, and render memory
 
-  my $orao = Orao->new({});
-  $orao->boot;
+  my $emu = Orao->new({});
+  $emu->boot;
 
 =cut
 
-our $orao;
+our $emu;
 
 select(STDERR); $| = 1;
 
@@ -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
@@ -78,7 +74,7 @@
 
 	$PC = 0xff89;
 
-	$orao = $self;
+	$emu = $self;
 
 #	$self->prompt( 0x1000 );
 
@@ -86,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 ) {
 
@@ -105,11 +102,6 @@
 			0xE000, 0xFFFF, 'sistemski ROM',
 		);
 
-	} else {
-
-		warn "rendering video memory\n";
-		$self->render( @mem[ 0x6000 .. 0x7fff ] );
-	
 	}
 	$self->sync;
 	$self->trace( $trace );
@@ -124,13 +116,34 @@
 
 	M6502::reset();
 
+	$self->booted( 1 );
 }
 
+=head2 run
+
+Run interactive emulation loop
+
+  $emu->run;
+
+=cut
+
+sub run {
+	my $self = shift;
+
+	$self->boot if ( ! $self->booted );
+
+#	$self->load_tape( '../oraoigre/bdash.tap' );
+
+	$self->loop;
+};
+
+=head1 Helper functions
+
 =head2 load_rom
 
 called to init memory and load initial rom images
 
-  $orao->load_rom;
+  $emu->load_rom;
 
 =cut
 
@@ -141,7 +154,7 @@
 
 	foreach my $addr ( sort keys %$loaded_files ) {
 		my $path = $loaded_files->{$addr};
-		$self->load_oraoemu( $path, $addr );
+		$self->load_image( $path, $addr );
 	}
 }
 
@@ -162,24 +175,21 @@
 	$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;
 }
 
-=head2 load_oraoemu
+=head2 load_image
 
 Load binary files, ROM images and Orao Emulator files
 
-  $orao->load_oraoemu( '/path/to/file', 0x1000 );
+  $emu->load_image( '/path/to/file', 0x1000 );
 
 Returns true on success.
 
 =cut
 
-sub load_oraoemu {
+sub load_image {
 	my $self = shift;
 	my ( $path, $addr ) = @_;
 
@@ -228,7 +238,7 @@
 
 =head2 save_dump
 
-  $orao->save_dump( 'filename', $from, $to );
+  $emu->save_dump( 'filename', $from, $to );
 
 =cut
 
@@ -250,7 +260,7 @@
 
 =head2 hexdump
 
-  $orao->hexdump( $address );
+  $emu->hexdump( $address );
 
 =cut
 
@@ -285,6 +295,129 @@
 
 =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;
+#		} elsif ( $self->tape ) {
+#			warn "has tape!";
+#			return 0;
+		}
+		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 +427,30 @@
 
 	# 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;
+	}
+
+	if ( $addr == 0x87ff ) {
+		return $self->read_tape;
 	}
 
 	$self->mmap_pixel( $addr, 0, $byte, 0 );
@@ -360,10 +470,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;
 	}
@@ -385,7 +491,7 @@
 
 =head2 prompt
 
-  my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
+  my ( $entered_line, @p ) = $emu->prompt( $address, $last_command );
 
 =cut
 
@@ -395,7 +501,7 @@
 	my $self = shift;
 	$self->app->sync;
 	my $a = shift;
-	print STDERR $self->hexdump( $a ),
+	print $self->hexdump( $a ),
 		$last ? "[$last] " : '',
 		"> ";
 	my $in = <STDIN>;
@@ -408,7 +514,7 @@
 
 =head2 cli
 
-  $orao->cli();
+  $emu->cli();
 
 =cut
 
@@ -417,6 +523,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 +550,7 @@
 
 __USAGE__
 			warn $self->dump_R;
+			$last = '';
 		} elsif ( $c =~ m/^e/i ) {
 			$a = $v if defined($v);
 			my $to = shift @v;
@@ -471,17 +579,20 @@
 		} elsif ( $c =~ m/^l/i ) {
 			my $to = shift @v || 0x1000;
 			$a = $to;
-			$self->load_oraoemu( $v, $a );
+			$self->load_image( $v, $a );
 			$last = '';
 		} elsif ( $c =~ m/^s/i ) {
 			$self->save_dump( $v || 'mem.dump', @v );
 			$last = '';
-		} elsif ( $c =~ m/^r/i ) {
+		} elsif ( $c =~ m/^re/i ) { # reset
+			M6502::reset();
+			$last = 'r 1';
+		} elsif ( $c =~ m/^r/i ) {	# run
 			$run_for = $v || 1;
 			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
@@ -489,11 +600,23 @@
 			$last = "r $run_for";
 			$show_R = 1;
 			last;
-		} elsif ( $c =~ m/^t/ ) {
+		} elsif ( $c =~ m/^tape/ ) {
+			if ( $c =~ m/rate/ ) {
+				$self->tape_rate( $v );
+				warn "will read table with rate $v\n";
+			} elsif ( ! $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 = '';
@@ -503,6 +626,7 @@
 		}
 	}
 
+	return $run_for;
 }
 
 =head1 AUTHOR