Initial import

This commit is contained in:
Leeland Heins 2019-02-13 14:19:40 -06:00 committed by GitHub
parent 431308d76f
commit 335680289a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

193
applesoft_detokenizer.pl Normal file
View File

@ -0,0 +1,193 @@
#!/usr/bin/perl -w
use strict;
my %tokens = (
128 => "END",
129 => "FOR",
130 => "NEXT",
131 => "DATA",
132 => "INPUT",
133 => "DEL",
134 => "DIM",
135 => "READ",
136 => "GR",
137 => "TEXT",
138 => "PR#",
139 => "IN#",
140 => "CALL",
141 => "PLOT",
142 => "HLIN",
143 => "VLIN",
144 => "HGR2",
145 => "HGR",
146 => "HCOLOR=",
147 => "HPLOT",
148 => "DRAW",
149 => "XDRAW",
150 => "HTAB",
151 => "HOME",
152 => "ROT=",
153 => "SCALE=",
154 => "SHLOAD",
155 => "TRACE",
156 => "NOTRACE",
157 => "NORMAL",
158 => "INVERSE",
159 => "FLASH",
160 => "COLOR=",
161 => "POP",
162 => "VTAB",
163 => "HIMEM:",
164 => "LOMEM:",
165 => "ONERR",
166 => "RESUME",
167 => "RECALL",
168 => "STORE",
169 => "SPEED=",
170 => "LET",
171 => "GOTO",
172 => "RUN",
173 => "IF",
174 => "RESTORE",
175 => "&",
176 => "GOSUB",
177 => "RETURN",
178 => "REM",
179 => "STOP",
180 => "ON",
181 => "WAIT",
182 => "LOAD",
183 => "SAVE",
184 => "DEF",
185 => "POKE",
186 => "PRINT",
187 => "CONT",
188 => "LIST",
189 => "CLEAR",
190 => "GET",
191 => "NEW",
192 => "TAB",
193 => "TO",
194 => "FN",
195 => "SPC(",
196 => "THEN",
197 => "AT",
198 => "NOT",
199 => "STEP",
200 => "+",
201 => "-",
202 => "*",
203 => "/",
204 => "^",
205 => "AND",
206 => "OR",
207 => ">",
208 => "=",
209 => "<",
210 => "SGN",
211 => "INT",
212 => "ABS",
213 => "USR",
214 => "FRE",
215 => "SCRN",
216 => "PDL",
217 => "POS",
218 => "SQR",
219 => "RND",
220 => "LOG",
221 => "EXP",
222 => "COS",
223 => "SIN",
224 => "TAN",
225 => "ATN",
226 => "PEEK",
227 => "LEN",
228 => "STR\$",
229 => "VAL",
230 => "ASC",
231 => "CHR\$",
232 => "LEFT\$",
233 => "RIGHT\$",
234 => "MID\$",
);
sub detokenize {
my ($fp) = @_;
my $prevptr = 0;
my $skip = getc($fp);
$skip = getc($fp);
while (1) {
my $lo;
my $hi;
my $tok;
$lo = getc($fp); # Ignore low byte of pointer to next line
$hi = getc($fp); # Ignore high byte of pointer to next line
if (! defined $lo || ! defined $hi) {
die "Premature EOF\n";
}
if (ord($lo) == 0 && ord($hi) == 0) {
my $tok = getc($fp);
#if (defined $tok) {
# warn sprintf("Extraneous data after 0/0 EOF tokens\n");
#}
return;
}
my $curptr = ord($lo) + 256 * ord($hi);
if ($curptr < 2048) {
die sprintf("Invalid pointer %d\n", $curptr);
}
if ($curptr < $prevptr) {
die sprintf("Line pointer %d < prev %d\n", $curptr, $prevptr);
}
$prevptr = $curptr;
$lo = getc($fp); # low byte of line number
$hi = getc($fp); # high byte of line number
if (! defined $lo || ! defined $hi) {
die "Premature EOF\n";
}
print sprintf("%d ", ord($lo) + 256 * ord($hi));
while (defined ($tok = getc($fp))) {
last if (ord($tok) == 0);
if (ord($tok) > 127) {
if (defined $tokens{ord($tok)}) {
print sprintf(" %s ", $tokens{ord($tok)});
} else {
print " ??? ";
}
} else {
print sprintf("%c", ord($tok));
}
}
if (!defined $tok) {
die "Premature EOF\n";
}
print "\n";
}
}
my $filename = shift or die "Must supply filename\n";
my $fp;
if (open($fp, "<$filename")) {
detokenize($fp);
close($fp);
}
1;