/[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 191 by dpavlin, Sat Apr 12 13:54:53 2008 UTC revision 215 by dpavlin, Thu Sep 3 10:23:27 2009 UTC
# Line 37  my $c_0 = 0; Line 37  my $c_0 = 0;
37  my $c_1 = 0;  my $c_1 = 0;
38  my $mask = 1;  my $mask = 1;
39    
 my $bits = '';  
   
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 ( $c_0 ) {          if ( $c_0 ) {
52                  $c_0--;                  $c_0--;
                 $bits .= ".";  
53                  return 0;                  return 0;
54          }          }
55          if ( $c_1 ) {          if ( $c_1 ) {
56                  $c_1--;                  $c_1--;
                 $bits .= "X";  
57                  return 255;                  return 255;
58          }          }
59    
# Line 68  sub read_tape { Line 62  sub read_tape {
62                  $pos++;                  $pos++;
63                  $self->tape_pos( $pos );                  $self->tape_pos( $pos );
64                  $mask = 1;                  $mask = 1;
65            }
66    
67                  warn "# $bits\n";          my $byte = 0;
68                  $bits = '';          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]";
74            }
75    
         my $byte = ord( substr($self->tape,$pos,1) );  
76          my $bit = $byte & $mask;          my $bit = $byte & $mask;
77          warn sprintf("tape pos %d 0x%04x mask %02x and %02x = %d\n", $pos, $pos, $mask, $byte, $bit); # if $self->trace;  
78            warn sprintf("## tape pos %d/%d %.02f%% 0x%04x = %02x\n", $pos, $tape_len, ($pos * 100) / $tape_len, $pos, $byte) if $mask == 1;
79    
80          ( $c_0, $c_1 ) = ( 0x17, 0x17 );          ( $c_0, $c_1 ) = ( 0x17, 0x17 );
81          ( $c_0, $c_1 ) = ( 0x30, 0x30 ) if $bit;          ( $c_0, $c_1 ) = ( 0x30, 0x30 ) if $bit;
# Line 100  sub write_tape { Line 100  sub write_tape {
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 132  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.191  
changed lines
  Added in v.215
  ViewVC Help
Powered by ViewVC 1.1.26