--- M6502/Orao.pm	2007/07/30 17:56:13	30
+++ Orao.pm	2007/08/04 22:14:09	135
@@ -3,13 +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; # 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
 
@@ -17,11 +18,11 @@
 
 =head1 VERSION
 
-Version 0.02
+Version 0.05
 
 =cut
 
-our $VERSION = '0.02';
+our $VERSION = '0.05';
 
 =head1 SUMMARY
 
@@ -29,154 +30,427 @@
 
 =cut
 
-=head2 init
+=head1 FUNCTIONS
 
-Start emulator
+=head2 run
+
+Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
 
 =cut
 
-sub init {
+our $emu;
+
+sub run {
 	my $self = shift;
-	warn "call upstream init\n";
-	$self->SUPER::init( @_ );
 
-	warn "staring Orao $ORAO::VERSION emulation\n";
+	warn "Orao calling upstream init\n";
+	$self->SUPER::init(
+		read => sub { $self->read( @_ ) },
+		write => sub { $self->write( @_ ) },
+	);
+
+	warn "Orao $Orao::VERSION emulation starting\n";
+
+	warn "emulating ", $#mem, " bytes of memory\n";
+
+#	$self->scale( 2 );
 
 	$self->open_screen;
-	$self->load_rom;
-}
+	$self->load_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',
+	});
+
+#	$PC = 0xDD11;	# BC
+#	$PC = 0xC274;	# MC
+
+	$PC = 0xff89;
+
+	$emu = $self;
+
+#	$self->prompt( 0x1000 );
+
+	my ( $trace, $debug ) = ( $self->trace, $self->debug );
+	$self->trace( 0 );
+	$self->debug( 0 );
+
+	warn "rendering video memory\n";
+	$self->render_vram;
+
+	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',
+		);
 
-my $loaded_files = {
-	0xC000 => 'rom/BAS12.ROM',
-	0xE000 => 'rom/CRT12.ROM',
+	}
+	$self->sync;
+	$self->trace( $trace );
+	$self->debug( $debug );
+
+	warn "Orao boot finished",
+		$self->trace ? ' trace' : '',
+		$self->debug ? ' debug' : '',
+		"\n";
+
+	M6502::reset();
+
+#	$self->load_tape( '../oraoigre/bdash.tap' );
+
+	$self->loop( sub {
+		my $run_for = shift;
+		warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
+		M6502::exec( $run_for );
+		$self->render_vram;
+	});
 };
 
-=head2 load_rom
 
-called to init memory and load initial rom images
+=head1 Helper functions
+
+=head2 write_chunk
+
+Write chunk directly into memory, updateing vram if needed
 
-  $orao->load_rom;
+  $emu->write_chunk( 0x1000, $chunk_data );
 
 =cut
 
-sub load_rom {
-    my ($self) = @_;
+sub write_chunk {
+	my $self = shift;
+	my ( $addr, $chunk ) = @_;
+	$self->SUPER::write_chunk( $addr, $chunk );
+	my $end = $addr + length($chunk);
+	my ( $f, $t ) = ( 0x6000, 0x7fff );
 
-    #my $time_base = time();
+	if ( $end < $f || $addr >= $t ) {
+		warn "skip vram update\n";
+		return;
+	};
 
-	foreach my $addr ( sort keys %$loaded_files ) {
-		my $path = $loaded_files->{$addr};
-		printf "loading '%s' at %04x\n", $path, $addr;
-		$self->load_oraoemu( $path, $addr );
-	}
+	$f = $addr if ( $addr > $f );
+	$t = $end if ( $end < $t );
+
+	warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
+	$self->render_vram;
+	$self->render_mem( @mem );
 }
 
+=head2 load_image
+
+Load binary files, ROM images and Orao Emulator files
 
-=head2 load_oraoemu
+  $emu->load_image( '/path/to/file', 0x1000 );
+
+Returns true on success.
 
 =cut
 
-sub load_oraoemu {
+sub load_image {
 	my $self = shift;
 	my ( $path, $addr ) = @_;
 
-	my $size = -s $path || die "no size for $path: $!";
+	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 );
 
 	if ( $size == 65538 ) {
 		$addr = 0;
-		printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
+		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;
+		return 1;
 	} elsif ( $size == 32800 ) {
 		$addr = 0;
-		printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
-		#$self->write_chunk( $addr, substr($buff,0x20) );
-		$self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
-		return;
+		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) );
+		return 1;
 	}
-	printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
-	return $self->write_chunk( $addr, $buff );
 
-	my $chunk;
+	printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
+	$self->write_chunk( $addr, $buff );
+	return 1;
+};
 
-	my $pos = 0;
 
-	while ( my $long = substr($buff,$pos,4) ) {
-		my @b = split(//, $long, 4);
-		$chunk .=
-			( $b[3] || '' ) .
-			( $b[2] || '' ) .
-			( $b[1] || '' ) .
-			( $b[0] || '' );
-		$pos += 4;
-	}
+=head1 Memory management
 
-	$self->write_chunk( $addr, $chunk );
+Orao implements all I/O using mmap addresses. This was main reason why
+L<Acme::6502> was just too slow to handle it.
 
-};
+=cut
+
+=head2 read
 
-=head2 save_dump
+Read from memory
 
-  $orao->save_dump( 'filename', $from, $to );
+  $byte = read( $address );
 
 =cut
 
-sub save_dump {
-	my $self = shift;
+my $keyboard_none = 255;
 
-	my ( $path, $from, $to ) = @_;
+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,
+	},
+};
 
-	$from ||= 0;
-	$to ||= 0xffff;
+sub read {
+	my $self = shift;
+	my ($addr) = @_;
+	return if ( $addr > 0xffff );
+	my $byte = $mem[$addr];
+	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;
+	}
 
-	open(my $fh, '>', $path) || die "can't open $path: $!";
-	print $fh $self->read_chunk( $from, $to );
-	close($fh);
+	if ( $addr == 0x87ff ) {
+		return $self->read_tape;
+	}
 
-	my $size = -s $path;
-	printf "saved %s %d %x bytes\n", $path, $size, $size;
+	$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
+	return $byte;
 }
 
-=head2 hexdump
+=head2 write
+
+Write into emory
 
-  $orao->hexdump( $address );
+  write( $address, $byte );
 
 =cut
 
-sub hexdump {
+sub write {
 	my $self = shift;
-	my $a = shift;
-	return sprintf(" %04x %s\n", $a,
-		join(" ",
-			map {
-				sprintf( "%02x", $_ )
-			} $self->ram( $a, $a+8 )
-		)
-	);
+	my ($addr,$byte) = @_;
+	warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
+
+	if ( $addr == 0x8800 ) {
+		warn sprintf "sound ignored: %x\n", $byte;
+	}
+
+	if ( $addr > 0xafff ) {
+		confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
+	}
+
+	$self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
+	$mem[$addr] = $byte;
+	return;
 }
 
-=head2 prompt
+=head2 render_vram
+
+Render one frame of video ram
 
-  $orao->prompt( $address, $last_command );
+  $self->render_vram;
 
 =cut
 
-sub prompt {
+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;
-	my $a = shift;
-	my $last = shift;
-	print $self->hexdump( $a ),
-		$last ? "[$last] " : '',
-		"> ";
-	my $in = <STDIN>;
-	chomp($in);
-	$in ||= $last;
-	$last = $in;
-	return split(/\s+/, $in) if $in;
+
+	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 );
 }
 
+=head2 cpu_PC
+
+=cut
+
+sub cpu_PC {
+	my ( $self, $addr ) = @_;
+	if ( defined($addr) ) {
+		$PC = $addr;
+		warn sprintf("running from PC %04x\n", $PC);
+	};
+	return $PC;
+}
 
 =head1 AUTHOR