--- Orao.pm	2007/08/05 14:08:01	148
+++ Orao.pm	2008/04/14 18:19:06	207
@@ -6,8 +6,8 @@
 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 M6502 '0.0.3';
+use Screen;
 
 use base qw(Class::Accessor VRac M6502 Screen Prefs Tape Session);
 #__PACKAGE__->mk_accessors(qw());
@@ -43,6 +43,9 @@
 sub run {
 	my $self = shift;
 
+	M6502::reset();
+	$self->_init_callbacks;
+
 	warn "Orao calling upstream init\n";
 	$self->SUPER::init(
 		read => sub { $self->read( @_ ) },
@@ -54,7 +57,8 @@
 	warn "emulating ", $#mem, " bytes of memory\n";
 
 #	$self->scale( 2 );
-#	$self->show_mem( 1 );
+	$self->show_mem( 1 );
+	$self->load_session( 'sess/current' );
 
 	$self->open_screen;
 	$self->load_rom({
@@ -113,15 +117,17 @@
 		$self->debug ? ' debug' : '',
 		"\n";
 
-	M6502::reset();
+#	$self->load_tape( 'tapes/Orao/bdash.tap' );
+#	$self->load_tape( 'tapes/Orao/crtanje.tap' );
+	$self->load_tape( 'tapes/Orao/jjack.tap' );
 
-#	$self->load_tape( '../oraoigre/bdash.tap' );
+	$self->render_vram;
 
 	$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;
+#		$self->render_vram;
 	});
 };
 
@@ -223,12 +229,12 @@
 		'backspace' => 224,
 	},
 	0x87FD => sub {
-		my ( $self, $key ) = @_;
-		if ( $key eq 'return' ) {
-			M6502::_write( 0xfc, 13 );
+		my $self = shift;
+		if ( $self->key_active('return') ) {
+#			M6502::_write( 0xfc, 13 );
 			warn "return\n";
 			return 0;
-		} elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) {
+		} elsif ( $self->key_active('left ctrl','right ctrl') ) {
 			warn "ctrl\n";
 			return 16;
 		}
@@ -241,10 +247,11 @@
 		'f1' => 224,
 	},
 	0x87FB => sub {
-		my ( $self, $key ) = @_;
-		if ( $key eq 'space' ) {
+		my $self = shift;
+		if ( $self->key_active('space') ) {
+			warn "space\n";
 			return 32;
-		} elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) {
+		} elsif ( $self->key_active('left shift','right shift') ) {
 			warn "shift\n";
 			return 16;
 #		} elsif ( $self->tape ) {
@@ -338,7 +345,7 @@
 sub read {
 	my $self = shift;
 	my ($addr) = @_;
-	return if ( $addr > 0xffff );
+	die "address over 64k: $addr" 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;
@@ -347,24 +354,23 @@
 
 	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);
+	
+		my $ret = $keyboard_none;
+		my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
+		if ( ref($r) eq 'CODE' ) {
+			$ret = $r->($self);
+		} else {
+			foreach my $k ( keys %$r ) {
+				my $return = 0;
+				if ( $self->key_active($k) ) {
+					warn "key '$k' is active\n";
+					$return ||= $r->{$k};
 				}
-			} else {
-				warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug;
+				$ret = $return if $return;
 			}
-			warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none );
-			return $ret;
 		}
-		return $keyboard_none;
+		warn sprintf("keyboard port: %04x code: %d\n",$addr,$ret) if ( $ret != $keyboard_none );
+		return $ret;
 	}
 
 	if ( $addr == 0x87ff ) {
@@ -397,6 +403,8 @@
 		confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
 	}
 
+	$self->render_vram if ( $addr >= 0x6000 && $addr <= 0x7fff );
+
 	$self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
 	$mem[$addr] = $byte;
 	return;
@@ -412,23 +420,6 @@
 
 =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;
 
@@ -444,6 +435,8 @@
 	$vram->set_colors( 0, $black, $white );
 
 	$self->render_frame( $vram );
+
+	print '.';
 }
 
 =head2 cpu_PC
@@ -461,6 +454,36 @@
 	return $PC;
 }
 
+
+=head2 _init_callbacks
+
+Mark memory areas for which we want to get callbacks to perl
+
+=cut
+
+sub _init_callbacks {
+	my $self = shift;
+	warn "set calbacks to perl for memory areas...\n";
+
+	# don't call for anything
+	M6502::set_all_callbacks( 0x00 );
+
+	# video ram
+	M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x7fff );
+	# keyboard
+	M6502::set_read_callback( $_ ) foreach ( keys %$keyboard );
+	# tape
+	M6502::set_read_callback( 0x87ff );
+	M6502::set_write_callback( 0x8800 );
+
+	my $map = '';
+	foreach ( 0 .. 0xffff ) {
+		my $cb = M6502::get_callback( $_ );
+		$map .= sprintf( "%04x: %02x\n", $_, $cb ) if $cb;
+	}
+	warn "callback map:\n$map\n";
+}
+
 =head1 SEE ALSO
 
 L<VRac>, L<M6502>, L<Screen>, L<Tape>