--- M6502/Orao.pm	2007/07/30 21:34:30	34
+++ Orao.pm	2007/08/04 15:43:28	126
@@ -3,15 +3,14 @@
 use warnings;
 use strict;
 
-use Carp;
-use lib './lib';
-#use Time::HiRes qw(time);
+use Carp qw/confess/;
 use File::Slurp;
 use Data::Dump qw/dump/;
-use M6502;
+use M6502; # import @mem $PC and friends
+use Screen qw/$white $black/;
 
-use base qw(Class::Accessor M6502 Screen);
-__PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
+use base qw(Class::Accessor VRac M6502 Screen Prefs Tape);
+#__PACKAGE__->mk_accessors(qw());
 
 =head1 NAME
 
@@ -19,11 +18,11 @@
 
 =head1 VERSION
 
-Version 0.02
+Version 0.05
 
 =cut
 
-our $VERSION = '0.02';
+our $VERSION = '0.05';
 
 =head1 SUMMARY
 
@@ -31,89 +30,161 @@
 
 =cut
 
-=head2 init
+=head1 FUNCTIONS
 
-Start emulator
+=head2 boot
+
+Start emulator, open L<Screen>, load initial ROM images, and render memory
+
+  my $emu = Orao->new({});
+  $emu->boot;
 
 =cut
 
-our $orao;
+our $emu;
 
-our $PC = 0x1000;
+select(STDERR); $| = 1;
 
-sub init {
+sub boot {
 	my $self = shift;
 	warn "Orao calling upstream init\n";
-	$self->SUPER::init( $self, @_ );
+	$self->SUPER::init(
+		read => sub { $self->read( @_ ) },
+		write => sub { $self->write( @_ ) },
+	);
 
-	warn "staring Orao $Orao::VERSION emulation\n";
+	warn "Orao $Orao::VERSION emulation starting\n";
+
+	warn "emulating ", $#mem, " bytes of memory\n";
+
+#	$self->scale( 2 );
 
 	$self->open_screen;
 	$self->load_rom({
-		0x1000 => 'dump/SCRINV.BIN',
-		0xC000 => 'rom/BAS12.ROM',
-		0xE000 => 'rom/CRT12.ROM',
+#		0x1000 => 'dump/SCRINV.BIN',
+		# should be 0x6000, but oraoemu has 2 byte prefix
+#		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',
 	});
 
-	$orao = $self;
+#	$PC = 0xDD11;	# BC
+#	$PC = 0xC274;	# MC
 
-#	$self->prompt( 0x1000 );
+	$PC = 0xff89;
 
-	warn "rendering memory map\n";
+	$emu = $self;
 
-	my @mmap = (
-		0x0000, 0x03FF, 'nulti blok',
-		0x0400, 0x5FFF, 'korisnički RAM (23K)',
-		0x6000, 0x7FFF, 'video RAM',
-		0x8000, 0x9FFF, 'sistemske lokacije',
-		0xA000, 0xAFFF, 'ekstenzija',
-		0xB000, 0xBFFF, 'DOS',
-		0xC000, 0xDFFF, 'BASIC ROM',
-		0xE000, 0xFFFF, 'sistemski ROM',
-	);
+#	$self->prompt( 0x1000 );
+
+	my ( $trace, $debug ) = ( $self->trace, $self->debug );
+	$self->trace( 0 );
+	$self->debug( 0 );
+
+	warn "rendering video memory\n";
+	$self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
+
+	if ( $self->show_mem ) {
+
+		warn "rendering memory map\n";
+
+		$self->render_mem( @mem );
+
+		my @mmap = (
+			0x0000, 0x03FF, 'nulti blok',
+			0x0400, 0x5FFF, 'korisnički RAM (23K)',
+			0x6000, 0x7FFF, 'video RAM',
+			0x8000, 0x9FFF, 'sistemske lokacije',
+			0xA000, 0xAFFF, 'ekstenzija',
+			0xB000, 0xBFFF, 'DOS',
+			0xC000, 0xDFFF, 'BASIC ROM',
+			0xE000, 0xFFFF, 'sistemski ROM',
+		);
 
-	foreach my $i ( 0 .. $#mmap / 3 ) {
-		my $o = $i * 3;
-		my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
-		printf "%04x - %04x - %s\n", $from, $to, $desc;
-		for my $a ( $from .. $to ) {
-			$orao->read( $a );
-		}
-		$self->sync;
 	}
+	$self->sync;
+	$self->trace( $trace );
+	$self->debug( $debug );
+
+	#( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
+
+	warn "Orao boot finished",
+		$self->trace ? ' trace' : '',
+		$self->debug ? ' debug' : '',
+		"\n";
 
-	warn "Orao init finished\n";
+	M6502::reset();
 
+	$self->booted( 1 );
 }
 
-=head2 load_rom
+=head2 run
 
-called to init memory and load initial rom images
+Run interactive emulation loop
 
-  $orao->load_rom;
+  $emu->run;
 
 =cut
 
-sub load_rom {
-    my ($self, $loaded_files) = @_;
+sub run {
+	my $self = shift;
 
-    #my $time_base = time();
+	$self->boot if ( ! $self->booted );
 
-	foreach my $addr ( sort keys %$loaded_files ) {
-		my $path = $loaded_files->{$addr};
-		$self->load_oraoemu( $path, $addr );
-	}
+#	$self->load_tape( '../oraoigre/bdash.tap' );
+
+	$self->loop( sub {
+		M6502::exec( $_[0] );
+		$self->render_vram;
+	});
+};
+
+=head1 Helper functions
+
+=cut
+
+# write chunk directly into memory, updateing vram if needed
+sub _write_chunk {
+	my $self = shift;
+	my ( $addr, $chunk ) = @_;
+	$self->write_chunk( $addr, $chunk );
+	my $end = $addr + length($chunk);
+	my ( $f, $t ) = ( 0x6000, 0x7fff );
+
+	if ( $end < $f || $addr >= $t ) {
+		warn "skip vram update\n";
+		return;
+	};
+
+	$f = $addr if ( $addr > $f );
+	$t = $end if ( $end < $t );
+
+	warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
+	$self->render_vram( @mem[ 0x6000 .. 0x7fff ] );
+	$self->render_mem( @mem ) if $self->show_mem;
 }
 
+=head2 load_image
 
-=head2 load_oraoemu
+Load binary files, ROM images and Orao Emulator files
+
+  $emu->load_image( '/path/to/file', 0x1000 );
+
+Returns true on success.
 
 =cut
 
-sub load_oraoemu {
+sub load_image {
 	my $self = shift;
 	my ( $path, $addr ) = @_;
 
+	if ( ! -e $path ) {
+		warn "ERROR: file $path doesn't exist\n";
+		return;
+	}
+
 	my $size = -s $path || confess "no size for $path: $!";
 
 	my $buff = read_file( $path );
@@ -121,18 +192,17 @@
 	if ( $size == 65538 ) {
 		$addr = 0;
 		warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
-		$self->write_chunk( $addr, substr($buff,2) );
-		return;
+		$self->_write_chunk( $addr, substr($buff,2) );
+		return 1;
 	} elsif ( $size == 32800 ) {
 		$addr = 0;
 		warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
-		#$self->write_chunk( $addr, substr($buff,0x20) );
-		$self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
-		return;
+		$self->_write_chunk( $addr, substr($buff,0x20) );
+		return 1;
 	}
 	printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
-	return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
-	return $self->write_chunk( $addr, $buff );
+	$self->_write_chunk( $addr, $buff );
+	return 1;
 
 	my $chunk;
 
@@ -148,69 +218,11 @@
 		$pos += 4;
 	}
 
-	$self->write_chunk( $addr, $chunk );
+	$self->_write_chunk( $addr, $chunk );
 
+	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 {
-				sprintf( "%02x", $_ )
-			} $self->ram( $a, $a+8 )
-		)
-	);
-}
-
-=head2 prompt
-
-  $orao->prompt( $address, $last_command );
-
-=cut
-
-sub prompt {
-	my $self = shift;
-	my $a = shift;
-	my $last = shift;
-	print STDERR $self->hexdump( $a ),
-		$last ? "[$last] " : '',
-		"> ";
-	my $in = <STDIN>;
-	chomp($in);
-	$in ||= $last;
-	$last = $in;
-	return split(/\s+/, $in) if $in;
-}
 
 =head1 Memory management
 
@@ -227,11 +239,164 @@
 
 =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) = @_;
 	my $byte = $mem[$addr];
-	warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
+	confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
+	warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
+
+	# keyboard
+
+	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 );
 	return $byte;
 }
@@ -246,26 +411,66 @@
 
 sub write {
 	my $self = shift;
-	warn "# Orao::write(",dump(@_),")\n" if $self->debug;
 	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;
 	}
 
 	if ( $addr > 0xafff ) {
-		warn sprintf "access to %04x above affff aborting\n", $addr;
-		return -1;
-	}
-	if ( $addr == 0x8800 ) {
-		warn sprintf "sound ignored: %x\n", $byte;
+		confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
 	}
 
 	$self->mmap_pixel( $addr, $byte, 0, 0 );
 
 	$mem[$addr] = $byte;
+	return;
 }
 
+=head2 render_vram
+
+Render one frame of video ram
+
+  $self->render_vram;
+
+=cut
+
+my @flip;
+
+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;
+}
+
+
+sub render_vram {
+	my $self = shift;
+
+	return unless $self->booted;
+
+	my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
+
+	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 );
+
+	$self->render_frame( $vram );
+}
 
 =head1 AUTHOR