/[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 114 by dpavlin, Fri Aug 3 20:01:51 2007 UTC Tape.pm revision 193 by dpavlin, Sat Apr 12 16:18:09 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 tape_rate));  __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 @tape_bits;  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 ) {  
                 _warn "please load tape!";  
                 return 0;  
         }  
43          my $pos = $self->tape_pos;          my $pos = $self->tape_pos;
44          my $tape = $self->tape;          my $tape = $self->tape;
45          if ( $pos > length( $tape ) ) {  
46                  _warn "end of tape [$pos]";          if ( ! $tape ) {
47                  return -1;                  _warn "please load tape!";
48                    return 0;
49          }          }
50    
51          if ( ! @tape_bits ) {          if ( $c_0 ) {
52                  my $byte = ord( substr($self->tape,$pos,1) );                  $c_0--;
53                  warn sprintf("tape pos %d = %02x\n", $pos, $byte);                  return 0;
54            }
55            if ( $c_1 ) {
56                    $c_1--;
57                    return 255;
58            }
59    
60            $mask = $mask << 1;
61            if ( $mask > 0x80 ) {
62                  $pos++;                  $pos++;
63                  $self->tape_pos( $pos );                  $self->tape_pos( $pos );
64                    $mask = 1;
65            }
66    
67            my $byte = 0;
68            my $tape_len = length( $tape );
69    
70                  @tape_bits = split(//, unpack("B8",$byte) );          if ( $pos <= $tape_len ) {
71                    $byte = ord( substr($self->tape,$pos,1) );
72                    warn sprintf("## tape pos %d/%d %.02f%% 0x%04x = %02x\n", $pos, $tape_len, ($pos * 100) / $tape_len, $pos, $byte);
73            } elsif ( $pos  == $tape_len ) {
74                    _warn "end of tape [$pos]";
75          }          }
76          my $bit = shift @tape_bits ? 0xff : 0x00;  
77          warn "\t$bit\n";          my $bit = $byte & $mask;
78          return $bit;          #warn sprintf("## tape pos %d 0x%04x mask %02x and %02x = %d\n", $pos, $pos, $mask, $byte, $bit); # if $self->trace;
79    
80            ( $c_0, $c_1 ) = ( 0x17, 0x17 );
81            ( $c_0, $c_1 ) = ( 0x30, 0x30 ) if $bit;
82    
83            return 0;
84    }
85    
86    =head2 write_tape
87    
88      $self->write_tape( $byte );
89    
90    =cut
91    
92    
93    sub write_tape {
94            my ( $self, $byte ) = @_;
95    
96            $self->append_to_file( 'tape.dmp', $byte );
97    
98            return $byte;
99  }  }
100    
101  =head2 load_tape  =head2 load_tape
# Line 73  sub load_tape { Line 109  sub load_tape {
109          my $path = shift || return;          my $path = shift || return;
110    
111          my $tape = read_file( $path ) || confess "can't load $path: $!";          my $tape = read_file( $path ) || confess "can't load $path: $!";
112            $self->tape_path( $path );
113    
114          $self->tape_pos( 0 );          $self->tape_pos( 0 );
115          $self->tape( $tape );          $self->tape( $tape );
116          $self->tape_rate( 512 );          warn "loaded tape $path ", -s $path, " bytes\n";
         warn "loaded tape $path ", -s $path, " bytes rate ", $self->tape_rate, "\n";  
117          return 1;          return 1;
118  }  }
119    
120    =head2 tape_status
121    
122      print $self->tape_status;
123    
124    =cut
125    
126    sub tape_status {
127            my $self = shift;
128    
129            return "No tape in (simulated) drive" unless $self->tape;
130    
131            my $size = length( $self->tape );
132    
133            return sprintf(
134                    "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
135                    $self->tape_path, $size, $size, $self->pos, $self->pos,
136            );
137    }
138    
139    =head1 SEE ALSO
140    
141    L<VRac>
142    
143    =cut
144    
145  1;  1;
Legend:
Removed from v.114  
changed lines
  Added in v.193
  ViewVC Help
Powered by ViewVC 1.1.26