/[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 172 - (show annotations)
Mon Aug 6 11:49:37 2007 UTC (13 years, 3 months ago) by dpavlin
File size: 1763 byte(s)
bugfix: removed obsolete accessor
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 sub read_tape {
37 my $self = shift;
38 if ( ! $self->tape ) {
39 _warn "please load tape!";
40 return 0;
41 }
42 my $pos = $self->tape_pos;
43 my $tape = $self->tape;
44 if ( $pos > length( $tape ) ) {
45 _warn "end of tape [$pos]";
46 return -1;
47 }
48
49 my $byte = ord( substr($self->tape,$pos,1) );
50 warn sprintf("tape pos %d = %02x\n", $pos, $byte); # if $self->trace;
51
52 $pos++;
53 $self->tape_pos( $pos );
54
55 return $byte;
56 }
57
58 =head2 write_tape
59
60 $self->write_tape( $byte );
61
62 =cut
63
64
65 sub write_tape {
66 my ( $self, $byte ) = @_;
67
68 $self->append_to_file( 'tape.dmp', chr($byte) );
69
70 return $byte;
71 }
72
73 =head2 load_tape
74
75 $self->load_tape( '/path/to/file' );
76
77 =cut
78
79 sub load_tape {
80 my $self = shift;
81 my $path = shift || return;
82
83 my $tape = read_file( $path ) || confess "can't load $path: $!";
84 $self->tape_path( $path );
85
86 $self->tape_pos( 0 );
87 $self->tape( $tape );
88 warn "loaded tape $path ", -s $path, " bytes\n";
89 return 1;
90 }
91
92 =head tape_status
93
94 print $self->tape_status;
95
96 =cut
97
98 sub tape_status {
99 my $self = shift;
100
101 return "No tape in (simulated) drive" unless $self->tape;
102
103 my $size = length( $self->tape );
104
105 return sprintf(
106 "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
107 $self->tape_path, $size, $size, $self->pos, $self->pos,
108 );
109 }
110
111 =head1 SEE ALSO
112
113 L<VRac>
114
115 =cut
116
117 1;

  ViewVC Help
Powered by ViewVC 1.1.26