--- M6502/Tape.pm	2007/08/03 10:29:33	109
+++ Tape.pm	2008/04/12 16:18:09	193
@@ -6,7 +6,7 @@
 use warnings;
 
 use base qw/Class::Accessor/;
-__PACKAGE__->mk_accessors(qw(tape tape_pos));
+__PACKAGE__->mk_accessors(qw(tape tape_path tape_pos trace));
 
 use File::Slurp;
 use Carp qw/confess/;
@@ -19,7 +19,7 @@
 
 =head2 read_tape
 
-  $self->read_tape;
+  my $byte = $self->read_tape;
 
 =cut
 
@@ -33,21 +33,69 @@
 	}
 }
 
+my $c_0 = 0;
+my $c_1 = 0;
+my $mask = 1;
+
 sub read_tape {
 	my $self = shift;
-	if ( ! $self->tape ) {
+
+	my $pos = $self->tape_pos;
+	my $tape = $self->tape;
+
+	if ( ! $tape ) {
 		_warn "please load tape!";
 		return 0;
 	}
-	my $pos = $self->tape_pos;
-	my $tape = $self->tape;
-	if ( $pos > length( $tape ) ) {
+
+	if ( $c_0 ) {
+		$c_0--;
+		return 0;
+	}
+	if ( $c_1 ) {
+		$c_1--;
+		return 255;
+	}
+
+	$mask = $mask << 1;
+	if ( $mask > 0x80 ) {
+		$pos++;
+		$self->tape_pos( $pos );
+		$mask = 1;
+	}
+
+	my $byte = 0;
+	my $tape_len = length( $tape );
+
+	if ( $pos <= $tape_len ) {
+		$byte = ord( substr($self->tape,$pos,1) );
+		warn sprintf("## tape pos %d/%d %.02f%% 0x%04x = %02x\n", $pos, $tape_len, ($pos * 100) / $tape_len, $pos, $byte);
+	} elsif ( $pos  == $tape_len ) {
 		_warn "end of tape [$pos]";
-		return -1;
 	}
-	my $byte = substr($self->tape,$pos++,1);
-	$self->tape_pos( $pos );
-	return ord($byte);
+
+	my $bit = $byte & $mask;
+	#warn sprintf("## tape pos %d 0x%04x mask %02x and %02x = %d\n", $pos, $pos, $mask, $byte, $bit); # if $self->trace;
+
+	( $c_0, $c_1 ) = ( 0x17, 0x17 );
+	( $c_0, $c_1 ) = ( 0x30, 0x30 ) if $bit;
+
+	return 0;
+}
+
+=head2 write_tape
+
+  $self->write_tape( $byte );
+
+=cut
+
+
+sub write_tape {
+	my ( $self, $byte ) = @_;
+
+	$self->append_to_file( 'tape.dmp', $byte );
+
+	return $byte;
 }
 
 =head2 load_tape
@@ -61,6 +109,7 @@
 	my $path = shift || return;
 
 	my $tape = read_file( $path ) || confess "can't load $path: $!";
+	$self->tape_path( $path );
 
 	$self->tape_pos( 0 );
 	$self->tape( $tape );
@@ -68,5 +117,29 @@
 	return 1;
 }
 
+=head2 tape_status
+
+  print $self->tape_status;
+
+=cut
+
+sub tape_status {
+	my $self = shift;
+
+	return "No tape in (simulated) drive" unless $self->tape;
+
+	my $size = length( $self->tape );
+
+	return sprintf(
+		"tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
+		$self->tape_path, $size, $size, $self->pos, $self->pos,
+	);
+}
+
+=head1 SEE ALSO
+
+L<VRac>
+
+=cut
 
 1;