VRac/M6502/Tape.pm

package Tape;

# Dobrica Pavlinusic, <dpavlin@rot13.org> 08/03/07 11:11:56 CEST

use strict;
use warnings;

use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors(qw(tape tape_pos tape_rate));

use File::Slurp;
use Carp qw/confess/;

=head1 NAME

Tape - implement tape reader/recorder

=cut

=head2 read_tape

  $self->read_tape;

=cut

my $last_warn = '';

sub _warn {
        my $msg = shift;
        if ( $msg ne $last_warn ) {
                warn "$msg\n";
                $last_warn = $msg;
        }
}

my @tape_bits;

sub read_tape {
        my $self = shift;
        if ( ! $self->tape ) {
                _warn "please load tape!";
                return 0;
        }
        my $pos = $self->tape_pos;
        my $tape = $self->tape;
        if ( $pos > length( $tape ) ) {
                _warn "end of tape [$pos]";
                return -1;
        }

        if ( ! @tape_bits ) {
                my $byte = ord( substr($self->tape,$pos,1) );
                warn sprintf("tape pos %d = %02x\n", $pos, $byte);

                $pos++;
                $self->tape_pos( $pos );

                @tape_bits = split(//, unpack("B8",$byte) );
        }
        my $bit = shift @tape_bits ? 0xff : 0x00;
        warn "\t$bit\n";
        return $bit;
}

=head2 load_tape

  $self->load_tape( '/path/to/file' );

=cut

sub load_tape {
        my $self = shift;
        my $path = shift || return;

        my $tape = read_file( $path ) || confess "can't load $path: $!";

        $self->tape_pos( 0 );
        $self->tape( $tape );
        $self->tape_rate( 512 );
        warn "loaded tape $path ", -s $path, " bytes rate ", $self->tape_rate, "\n";
        return 1;
}


1;
1	dpavlin	109	package Tape;
2
3			# Dobrica Pavlinusic, <dpavlin@rot13.org> 08/03/07 11:11:56 CEST
4
5			use strict;
6			use warnings;
7
8			use base qw/Class::Accessor/;
9	dpavlin	110	__PACKAGE__->mk_accessors(qw(tape tape_pos tape_rate));
10	dpavlin	109
11			use File::Slurp;
12			use Carp qw/confess/;
13
14			=head1 NAME
15
16			Tape - implement tape reader/recorder
17
18			=cut
19
20			=head2 read_tape
21
22			$self->read_tape;
23
24			=cut
25
26			my $last_warn = '';
27
28			sub _warn {
29			my $msg = shift;
30			if ( $msg ne $last_warn ) {
31			warn "$msg\n";
32			$last_warn = $msg;
33			}
34			}
35
36	dpavlin	114	my @tape_bits;
37	dpavlin	110
38	dpavlin	109	sub read_tape {
39			my $self = shift;
40			if ( ! $self->tape ) {
41			_warn "please load tape!";
42			return 0;
43			}
44			my $pos = $self->tape_pos;
45			my $tape = $self->tape;
46			if ( $pos > length( $tape ) ) {
47			_warn "end of tape [$pos]";
48			return -1;
49			}
50	dpavlin	110
51	dpavlin	114	if ( ! @tape_bits ) {
52			my $byte = ord( substr($self->tape,$pos,1) );
53	dpavlin	110	warn sprintf("tape pos %d = %02x\n", $pos, $byte);
54	dpavlin	114
55	dpavlin	110	$pos++;
56			$self->tape_pos( $pos );
57	dpavlin	114
58			@tape_bits = split(//, unpack("B8",$byte) );
59	dpavlin	110	}
60	dpavlin	114	my $bit = shift @tape_bits ? 0xff : 0x00;
61			warn "\t$bit\n";
62			return $bit;
63	dpavlin	109	}
64
65			=head2 load_tape
66
67			$self->load_tape( '/path/to/file' );
68
69			=cut
70
71			sub load_tape {
72			my $self = shift;
73			my $path = shift \|\| return;
74
75			my $tape = read_file( $path ) \|\| confess "can't load $path: $!";
76
77			$self->tape_pos( 0 );
78			$self->tape( $tape );
79	dpavlin	110	$self->tape_rate( 512 );
80			warn "loaded tape $path ", -s $path, " bytes rate ", $self->tape_rate, "\n";
81	dpavlin	109	return 1;
82			}
83
84
85			1;