/[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 191 - (show annotations)
Sat Apr 12 13:54:53 2008 UTC (16 years ago) by dpavlin
File size: 2171 byte(s)
implemented tape loader from Orao based on pascal source
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 my $bits = '';
41
42 sub read_tape {
43 my $self = shift;
44 if ( ! $self->tape ) {
45 _warn "please load tape!";
46 return 0;
47 }
48 my $pos = $self->tape_pos;
49 my $tape = $self->tape;
50 if ( $pos > length( $tape ) ) {
51 _warn "end of tape [$pos]";
52 return -1;
53 }
54
55 if ( $c_0 ) {
56 $c_0--;
57 $bits .= ".";
58 return 0;
59 }
60 if ( $c_1 ) {
61 $c_1--;
62 $bits .= "X";
63 return 255;
64 }
65
66 $mask = $mask << 1;
67 if ( $mask > 0x80 ) {
68 $pos++;
69 $self->tape_pos( $pos );
70 $mask = 1;
71
72 warn "# $bits\n";
73 $bits = '';
74 };
75
76 my $byte = ord( substr($self->tape,$pos,1) );
77 my $bit = $byte & $mask;
78 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
102
103 $self->load_tape( '/path/to/file' );
104
105 =cut
106
107 sub load_tape {
108 my $self = shift;
109 my $path = shift || return;
110
111 my $tape = read_file( $path ) || confess "can't load $path: $!";
112 $self->tape_path( $path );
113
114 $self->tape_pos( 0 );
115 $self->tape( $tape );
116 warn "loaded tape $path ", -s $path, " bytes\n";
117 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;

  ViewVC Help
Powered by ViewVC 1.1.26