--- M6502/Orao.pm	2007/08/02 18:01:51	103
+++ Orao.pm	2007/08/04 15:43:28	126
@@ -4,15 +4,13 @@
 use strict;
 
 use Carp qw/confess/;
-use lib './lib';
-#use Time::HiRes qw(time);
 use File::Slurp;
 use Data::Dump qw/dump/;
-use List::Util qw/first/;
-use M6502;
+use M6502; # import @mem $PC and friends
+use Screen qw/$white $black/;
 
-use base qw(Class::Accessor M6502 Screen Prefs);
-__PACKAGE__->mk_accessors(qw(booted));
+use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);
+#__PACKAGE__->mk_accessors(qw());
 
 =head1 NAME
 
@@ -20,11 +18,11 @@
 
 =head1 VERSION
 
-Version 0.04
+Version 0.05
 
 =cut
 
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 
 =head1 SUMMARY
 
@@ -32,25 +30,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;
 
@@ -66,13 +57,17 @@
 
 	warn "emulating ", $#mem, " bytes of memory\n";
 
+#	$self->scale( 2 );
+
 	$self->open_screen;
 	$self->load_rom({
-		0x1000 => 'dump/SCRINV.BIN',
+#		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',
+#		0x5FFE => '/home/dpavlin/orao/dump/screen.dmp',
+#		0xC000 => 'rom/Orao/BAS12.ROM',
+#		0xE000 => 'rom/Orao/CRT12.ROM',
+		0xC000 => 'rom/Orao/BAS13.ROM',
+		0xE000 => 'rom/Orao/CRT13.ROM',
 	});
 
 #	$PC = 0xDD11;	# BC
@@ -80,7 +75,7 @@
 
 	$PC = 0xff89;
 
-	$orao = $self;
+	$emu = $self;
 
 #	$self->prompt( 0x1000 );
 
@@ -88,7 +83,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 ) {
 
@@ -107,11 +103,6 @@
 			0xE000, 0xFFFF, 'sistemski ROM',
 		);
 
-	} else {
-
-		warn "rendering video memory\n";
-		$self->render( @mem[ 0x6000 .. 0x7fff ] );
-	
 	}
 	$self->sync;
 	$self->trace( $trace );
@@ -133,40 +124,27 @@
 
 Run interactive emulation loop
 
-  $orao->run;
+  $emu->run;
 
 =cut
 
 sub run {
 	my $self = shift;
 
-	$self->show_mem( 1 );
-
 	$self->boot if ( ! $self->booted );
-	$self->loop;
-};
-
-=head1 Helper functions
 
-=head2 load_rom
+#	$self->load_tape( '../oraoigre/bdash.tap' );
 
-called to init memory and load initial rom images
+	$self->loop( sub {
+		M6502::exec( $_[0] );
+		$self->render_vram;
+	});
+};
 
-  $orao->load_rom;
+=head1 Helper functions
 
 =cut
 
-sub load_rom {
-    my ($self, $loaded_files) = @_;
-
-    #my $time_base = time();
-
-	foreach my $addr ( sort keys %$loaded_files ) {
-		my $path = $loaded_files->{$addr};
-		$self->load_image( $path, $addr );
-	}
-}
-
 # write chunk directly into memory, updateing vram if needed
 sub _write_chunk {
 	my $self = shift;
@@ -184,10 +162,7 @@
 	$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;
 }
 
@@ -195,7 +170,7 @@
 
 Load binary files, ROM images and Orao Emulator files
 
-  $orao->load_image( '/path/to/file', 0x1000 );
+  $emu->load_image( '/path/to/file', 0x1000 );
 
 Returns true on success.
 
@@ -248,49 +223,6 @@
 	return 1;
 };
 
-=head2 save_dump
-
-  $orao->save_dump( 'filename', $from, $to );
-
-=cut
-
-sub save_dump {
-	my $self = shift;
-
-	my ( $path, $from, $to ) = @_;
-
-	$from ||= 0;
-	$to ||= 0xffff;
-
-	open(my $fh, '>', $path) || die "can't open $path: $!";
-	print $fh $self->read_chunk( $from, $to );
-	close($fh);
-
-	my $size = -s $path;
-	warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
-}
-
-=head2 hexdump
-
-  $orao->hexdump( $address );
-
-=cut
-
-sub hexdump {
-	my $self = shift;
-	my $a = shift;
-	return sprintf(" %04x %s\n", $a,
-		join(" ",
-			map {
-				if ( defined($_) ) {
-					sprintf( "%02x", $_ )
-				} else {
-					'  '
-				}
-			} @mem[ $a .. $a+8 ]
-		)
-	);
-}
 
 =head1 Memory management
 
@@ -307,6 +239,8 @@
 
 =cut
 
+my $keyboard_none = 255;
+
 my $keyboard = {
 	0x87FC => {
 		'right'		=> 16,
@@ -319,10 +253,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 +272,18 @@
 		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,
-		'z' => 192,
+		'y' => 192,	# hr: z
 		'r' => 224,
 	},
 	0x87F7 => {
@@ -375,11 +317,11 @@
 		'l' => 224,
 	},
 	0x87BF => {
-		',' => 32,
-		'.' => 16,
+		',' => 32,	# <
+		'.' => 16,	# >
 	},
 	0x877E => {
-		'y' => 16,
+		'z' => 16,	# hr:y
 		's' => 128,
 		'a' => 192,
 		'd' => 224,
@@ -399,22 +341,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 +362,6 @@
 	},
 };
 
-my $keyboard_none = 255;
-
 sub read {
 	my $self = shift;
 	my ($addr) = @_;
@@ -433,7 +371,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,24 +379,24 @@
 			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;
 	}
 
+	if ( $addr == 0x87ff ) {
+		return $self->read_tape;
+	}
+
 	$self->mmap_pixel( $addr, 0, $byte, 0 );
 	return $byte;
 }
@@ -476,10 +414,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;
 	}
@@ -494,134 +428,48 @@
 	return;
 }
 
-=head1 Command Line
+=head2 render_vram
 
-Command-line debugging intrerface is implemented for communication with
-emulated device
+Render one frame of video ram
 
-=head2 prompt
-
-  my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
+  $self->render_vram;
 
 =cut
 
-my $last = 'r 1';
+my @flip;
 
-sub prompt {
-	my $self = shift;
-	$self->app->sync;
-	my $a = shift;
-	print $self->hexdump( $a ),
-		$last ? "[$last] " : '',
-		"> ";
-	my $in = <STDIN>;
-	chomp($in);
-	warn "## prompt got: $in\n" if $self->debug;
-	$in ||= $last;
-	$last = $in;
-	return ( $in, split(/\s+/, $in) ) if $in;
+foreach my $i ( 0 .. 255 ) {
+	my $t = 0;
+	$i & 0b00000001 and $t = $t | 0b10000000;
+	$i & 0b00000010 and $t = $t | 0b01000000;
+	$i & 0b00000100 and $t = $t | 0b00100000;
+	$i & 0b00001000 and $t = $t | 0b00010000;
+	$i & 0b00010000 and $t = $t | 0b00001000;
+	$i & 0b00100000 and $t = $t | 0b00000100;
+	$i & 0b01000000 and $t = $t | 0b00000010;
+	$i & 0b10000000 and $t = $t | 0b00000001;
+	#warn "$i = $t\n";
+	$flip[$i] = $t;
 }
 
-=head2 cli
 
-  $orao->cli();
+sub render_vram {
+	my $self = shift;
 
-=cut
+	return unless $self->booted;
 
-my $show_R = 0;
+	my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
 
-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;
-		next unless defined($c);
-		my $v = shift @v;
-		$v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
-		@v = map { hex($_) } @v;
-		printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
-		if ( $c =~ m/^[qx]/i ) {
-			exit;
-		} elsif ( $c eq '?' ) {
-			my $t = $self->trace ? 'on' : 'off' ;
-			my $d = $self->debug ? 'on' : 'off' ;
-			warn <<__USAGE__;
-Usage:
-
-x|q\t\texit
-e 6000 6010\tdump memory, +/- to walk forward/backward
-m 1000 ff 00\tput ff 00 on 1000
-j|u 1000\t\tjump (change pc)
-r 42\t\trun 42 instruction opcodes
-t\t\ttrace [$t]
-d\t\tdebug [$d]
-
-__USAGE__
-			warn $self->dump_R;
-			$last = '';
-		} elsif ( $c =~ m/^e/i ) {
-			$a = $v if defined($v);
-			my $to = shift @v;
-			$to = $a + 32 if ( ! $to || $to <= $a );
-			$to = 0xffff if ( $to > 0xffff );
-			my $lines = int( ($to - $a + 8) / 8 );
-			printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
-			while ( --$lines ) {
-				print $self->hexdump( $a );
-				$a += 8;
-			}
-			$last = '+';
-			$show_R = 0;
-		} elsif ( $c =~ m/^\+/ ) {
-			$a += 8;
-			$show_R = 0;
-		} elsif ( $c =~ m/^\-/ ) {
-			$a -= 8;
-			$show_R = 0;
-		} elsif ( $c =~ m/^m/i ) {
-			$a = $v if defined($v);
-			$self->poke_code( $a, @v );
-			printf "poke %d bytes at %04x\n", $#v + 1, $a;
-			$last = '+';
-			$show_R = 0;
-		} elsif ( $c =~ m/^l/i ) {
-			my $to = shift @v || 0x1000;
-			$a = $to;
-			$self->load_image( $v, $a );
-			$last = '';
-		} elsif ( $c =~ m/^s/i ) {
-			$self->save_dump( $v || 'mem.dump', @v );
-			$last = '';
-		} elsif ( $c =~ m/^r/i ) {
-			$run_for = $v || 1;
-			print "run_for $run_for instructions\n";
-			$show_R = 1;
-			last;
-		} elsif ( $c =~ m/^(u|j)/ ) {
-			my $to = $v || $a;
-			printf "set pc to %04x\n", $to;
-			$PC = $to;	# remember for restart
-			$run_for = 1;
-			$last = "r $run_for";
-			$show_R = 1;
-			last;
-		} elsif ( $c =~ m/^t/ ) {
-			$self->trace( not $self->trace );
-			print "trace ", $self->trace ? 'on' : 'off', "\n";
-			$last = '';
-		} elsif ( $c =~ m/^d/ ) {
-			$self->debug( not $self->debug );
-			print "debug ", $self->debug ? 'on' : 'off', "\n";
-			$last = '';
-		} else {
-			warn "# ignored $line\n" if ($line);
-			$last = '';
-		}
-	}
+	my $vram = SDL::Surface->new(
+		-width => 256,
+		-height => 256,
+		-depth => 1,	# 1 bit per pixel
+		-pitch => 32,	# bytes per line
+		-from => $pixels,
+	);
+	$vram->set_colors( 0, $black, $white );
 
-	return $run_for;
+	$self->render_frame( $vram );
 }
 
 =head1 AUTHOR