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

Contents of /Tape.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 215 - (show annotations)
Thu Sep 3 10:23:27 2009 UTC (9 years, 8 months ago) by dpavlin
File size: 2245 byte(s)
don't die if tape is unavailable
1 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 __PACKAGE__->mk_accessors(qw(tape tape_path tape_pos trace));
10
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 my $byte = $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 my $c_0 = 0;
37 my $c_1 = 0;
38 my $mask = 1;
39
40 sub read_tape {
41 my $self = shift;
42
43 my $pos = $self->tape_pos;
44 my $tape = $self->tape;
45
46 if ( ! $tape ) {
47 _warn "please load tape!";
48 return 0;
49 }
50
51 if ( $c_0 ) {
52 $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]";
74 }
75
76 my $bit = $byte & $mask;
77
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 );
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
102
103 $self->load_tape( '/path/to/file', $position );
104
105 =cut
106
107 sub load_tape {
108 my $self = shift;
109 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: $!";
115 $self->tape_path( $path );
116
117 $self->tape_pos( $pos );
118 $self->tape( $tape );
119 warn "loaded tape $path ", -s $path, " bytes at $pos\n";
120 return 1;
121 }
122
123 =head2 tape_status
124
125 print $self->tape_status;
126
127 =cut
128
129 sub tape_status {
130 my $self = shift;
131
132 return "No tape in (simulated) drive" unless $self->tape;
133
134 my $size = length( $self->tape );
135
136 return sprintf(
137 "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
138 $self->tape_path, $size, $size, $self->tape_pos, $self->tape_pos,
139 );
140 }
141
142 =head1 SEE ALSO
143
144 L<VRac>
145
146 =cut
147
148 1;

  ViewVC Help
Powered by ViewVC 1.1.26