/[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

revision 177 by dpavlin, Sat Sep 29 12:03:56 2007 UTC revision 215 by dpavlin, Thu Sep 3 10:23:27 2009 UTC
# 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 ) {  
43            my $pos = $self->tape_pos;
44            my $tape = $self->tape;
45    
46            if ( ! $tape ) {
47                  _warn "please load tape!";                  _warn "please load tape!";
48                  return 0;                  return 0;
49          }          }
50          my $pos = $self->tape_pos;  
51          my $tape = $self->tape;          if ( $c_0 ) {
52          if ( $pos > length( $tape ) ) {                  $c_0--;
53                    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++;
63                    $self->tape_pos( $pos );
64                    $mask = 1;
65            }
66    
67            my $byte = 0;
68            my $tape_len = length( $tape );
69    
70            if ( $pos <= $tape_len ) {
71                    $byte = ord( substr($self->tape,$pos,1) );
72            } elsif ( $pos  == $tape_len ) {
73                  _warn "end of tape [$pos]";                  _warn "end of tape [$pos]";
                 return -1;  
74          }          }
75    
76          my $byte = ord( substr($self->tape,$pos,1) );          my $bit = $byte & $mask;
         warn sprintf("tape pos %d = %02x\n", $pos, $byte); # if $self->trace;  
77    
78          $pos++;          warn sprintf("## tape pos %d/%d %.02f%% 0x%04x = %02x\n", $pos, $tape_len, ($pos * 100) / $tape_len, $pos, $byte) if $mask == 1;
         $self->tape_pos( $pos );  
79    
80          return $byte;          ( $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  =head2 write_tape
# Line 65  sub read_tape { Line 93  sub read_tape {
93  sub write_tape {  sub write_tape {
94          my ( $self, $byte ) = @_;          my ( $self, $byte ) = @_;
95    
96          $self->append_to_file( 'tape.dmp', chr($byte) );          $self->append_to_file( 'tape.dmp', $byte );
97    
98          return $byte;          return $byte;
99  }  }
100    
101  =head2 load_tape  =head2 load_tape
102    
103    $self->load_tape( '/path/to/file' );    $self->load_tape( '/path/to/file', $position );
104    
105  =cut  =cut
106    
107  sub load_tape {  sub load_tape {
108          my $self = shift;          my $self = shift;
109          my $path = shift || return;          my $path = shift || return;
110            my $pos = shift || 0;
111    
112            return unless -e $path;
113    
114          my $tape = read_file( $path ) || confess "can't load $path: $!";          my $tape = read_file( $path ) || confess "can't load $path: $!";
115          $self->tape_path( $path );          $self->tape_path( $path );
116    
117          $self->tape_pos( 0 );          $self->tape_pos( $pos );
118          $self->tape( $tape );          $self->tape( $tape );
119          warn "loaded tape $path ", -s $path, " bytes\n";          warn "loaded tape $path ", -s $path, " bytes at $pos\n";
120          return 1;          return 1;
121  }  }
122    
# Line 104  sub tape_status { Line 135  sub tape_status {
135    
136          return sprintf(          return sprintf(
137                  "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",                  "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
138                  $self->tape_path, $size, $size, $self->pos, $self->pos,                  $self->tape_path, $size, $size, $self->tape_pos, $self->tape_pos,
139          );          );
140  }  }
141    
Legend:
Removed from v.177  
changed lines
  Added in v.215
  ViewVC Help
Powered by ViewVC 1.1.26