/[VRac]/Tape.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /Tape.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

M6502/Tape.pm revision 109 by dpavlin, Fri Aug 3 10:29:33 2007 UTC Tape.pm revision 192 by dpavlin, Sat Apr 12 14:20:01 2008 UTC
# Line 6  use strict; Line 6  use strict;
6  use warnings;  use warnings;
7    
8  use base qw/Class::Accessor/;  use base qw/Class::Accessor/;
9  __PACKAGE__->mk_accessors(qw(tape tape_pos));  __PACKAGE__->mk_accessors(qw(tape tape_path tape_pos trace));
10    
11  use File::Slurp;  use File::Slurp;
12  use Carp qw/confess/;  use Carp qw/confess/;
# Line 19  Tape - implement tape reader/recorder Line 19  Tape - implement tape reader/recorder
19    
20  =head2 read_tape  =head2 read_tape
21    
22    $self->read_tape;    my $byte = $self->read_tape;
23    
24  =cut  =cut
25    
# Line 33  sub _warn { Line 33  sub _warn {
33          }          }
34  }  }
35    
36    my $c_0 = 0;
37    my $c_1 = 0;
38    my $mask = 1;
39    
40  sub read_tape {  sub read_tape {
41          my $self = shift;          my $self = shift;
42          if ( ! $self->tape ) {          if ( ! $self->tape ) {
# Line 45  sub read_tape { Line 49  sub read_tape {
49                  _warn "end of tape [$pos]";                  _warn "end of tape [$pos]";
50                  return -1;                  return -1;
51          }          }
52          my $byte = substr($self->tape,$pos++,1);  
53          $self->tape_pos( $pos );          if ( $c_0 ) {
54          return ord($byte);                  $c_0--;
55                    return 0;
56            }
57            if ( $c_1 ) {
58                    $c_1--;
59                    return 255;
60            }
61    
62            $mask = $mask << 1;
63            if ( $mask > 0x80 ) {
64                    $pos++;
65                    $self->tape_pos( $pos );
66                    $mask = 1;
67            };
68    
69            my $byte = ord( substr($self->tape,$pos,1) );
70            my $bit = $byte & $mask;
71    #       warn sprintf("## tape pos %d 0x%04x mask %02x and %02x = %d\n", $pos, $pos, $mask, $byte, $bit); # if $self->trace;
72    
73            ( $c_0, $c_1 ) = ( 0x17, 0x17 );
74            ( $c_0, $c_1 ) = ( 0x30, 0x30 ) if $bit;
75    
76            return 0;
77    }
78    
79    =head2 write_tape
80    
81      $self->write_tape( $byte );
82    
83    =cut
84    
85    
86    sub write_tape {
87            my ( $self, $byte ) = @_;
88    
89            $self->append_to_file( 'tape.dmp', $byte );
90    
91            return $byte;
92  }  }
93    
94  =head2 load_tape  =head2 load_tape
# Line 61  sub load_tape { Line 102  sub load_tape {
102          my $path = shift || return;          my $path = shift || return;
103    
104          my $tape = read_file( $path ) || confess "can't load $path: $!";          my $tape = read_file( $path ) || confess "can't load $path: $!";
105            $self->tape_path( $path );
106    
107          $self->tape_pos( 0 );          $self->tape_pos( 0 );
108          $self->tape( $tape );          $self->tape( $tape );
# Line 68  sub load_tape { Line 110  sub load_tape {
110          return 1;          return 1;
111  }  }
112    
113    =head2 tape_status
114    
115      print $self->tape_status;
116    
117    =cut
118    
119    sub tape_status {
120            my $self = shift;
121    
122            return "No tape in (simulated) drive" unless $self->tape;
123    
124            my $size = length( $self->tape );
125    
126            return sprintf(
127                    "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
128                    $self->tape_path, $size, $size, $self->pos, $self->pos,
129            );
130    }
131    
132    =head1 SEE ALSO
133    
134    L<VRac>
135    
136    =cut
137    
138  1;  1;
Legend:
Removed from v.109  
changed lines
  Added in v.192
  ViewVC Help
Powered by ViewVC 1.1.26