Apple-2-Tools/ProDOS-perl
1
0
Fork 0
mirror of https://github.com/softwarejanitor/ProDOS.git synced 2025-01-01 09:29:33 +00:00
Code Issues Projects Releases Wiki Activity

Bug fixes for proread.pl

Browse Source
This commit is contained in:
Leeland Heins 2019-02-27 12:34:55 -06:00 committed by GitHub
parent bba469de97
commit 6772292a52
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 49 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
ProDOS.pm
View File

@ -708,8 +708,8 @@ sub parse_subdir_hdr_blk {
for (my $i = 0; $i < 12; $i++) { for (my $i = 0; $i < 12; $i++) {
my $storage_type_name_length = shift @flds; my $storage_type_name_length = shift @flds;
my $storage_type = ($storage_type_name_length & 0xf0) >> 4; my $storage_type = ($storage_type_name_length & 0xf0) >> 4;
print sprintf("storage_type_name_length=%02x\n", $storage_type_name_length); print sprintf("storage_type_name_length=%02x\n", $storage_type_name_length) if $debug;
print sprintf("storage_type=%02x\n", $storage_type); print sprintf("storage_type=%02x\n", $storage_type) if $debug;
my $name_length = $storage_type_name_length & 0x0f; my $name_length = $storage_type_name_length & 0x0f;
print sprintf("name_length=%02x\n", $name_length) if $debug; print sprintf("name_length=%02x\n", $name_length) if $debug;
my $file_name = shift @flds; my $file_name = shift @flds;
@ -885,12 +885,12 @@ sub get_ind_blk {
if (read_blk($pofile, $ind_blk, \$buf)) { if (read_blk($pofile, $ind_blk, \$buf)) {
dump_blk($buf) if $debug; dump_blk($buf) if $debug;
my (@lo) = unpack "C256", $buf; my @lo = unpack "C256", $buf;
#foreach my $byte (@lo) { #foreach my $byte (@lo) {
# print sprintf("%02x ", $byte); # print sprintf("%02x ", $byte);
#} #}
#print "\n"; #print "\n";
my (@hi) = unpack "x256C256", $buf; my @hi = unpack "x256C256", $buf;
#foreach my $byte (@hi) { #foreach my $byte (@hi) {
# print sprintf("%02x ", $byte); # print sprintf("%02x ", $byte);
#} #}
@ -901,6 +901,14 @@ sub get_ind_blk {
#print sprintf("blk=%04x\n", $blk); #print sprintf("blk=%04x\n", $blk);
push @blocks, $blk; push @blocks, $blk;
} }
#print "blocks=\n";
#my $x = 0;
#foreach my $block (@blocks) {
# printf("%04x ", $block);
# $x++;
# print "\n" if !($x % 16);
#}
#print "\n";
} }
return @blocks; return @blocks;
@ -969,7 +977,7 @@ sub find_file {
# Read a file # Read a file
# #
sub read_file { sub read_file {
my ($pofile, $filename, $mode, $conv, $dbg) = @_; my ($pofile, $filename, $mode, $conv, $output_file, $dbg) = @_;
$debug = 1 if defined $dbg && $dbg; $debug = 1 if defined $dbg && $dbg;
@ -981,6 +989,16 @@ sub read_file {
my $buf; my $buf;
my $ofh;
if (! defined $output_file || $output_file eq '') {
$ofh = \*STDOUT;
} else {
if (!open($ofh, ">$output_file")) {
return 0;
}
}
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used\n" if $debug; print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used\n" if $debug;
# Seedling file, only 1 block # Seedling file, only 1 block
@ -1015,6 +1033,8 @@ sub read_file {
if (read_blk($pofile, $blk, \$buf2)) { if (read_blk($pofile, $blk, \$buf2)) {
dump_blk($buf2) if $debug; dump_blk($buf2) if $debug;
my @bytes = unpack "C*", $buf2; my @bytes = unpack "C*", $buf2;
#my $x = 0;
#print "bytes=\n";
foreach my $byte (@bytes) { foreach my $byte (@bytes) {
# For text file translation. # For text file translation.
last if $byte == 0x00 && $mode eq 'T'; last if $byte == 0x00 && $mode eq 'T';
@ -1023,8 +1043,15 @@ sub read_file {
# Convert Apple II ASCII to standard ASCII (clear high bit) # Convert Apple II ASCII to standard ASCII (clear high bit)
$byte &= 0x7f if $mode eq 'T'; $byte &= 0x7f if $mode eq 'T';
#print sprintf("%c", $byte & 0x7f); #print sprintf("%c", $byte & 0x7f);
print sprintf("%c", $byte); #print sprintf("%c", $byte);
#print $ofh ord($byte);
print $ofh sprintf("%c", $byte);
#$x++;
#printf("%02x ", $byte);
#print "\n" if !($x % 16);
} }
#print "\n";
#print "Wrote $x bytes\n";
} }
last if $blkno++ == $blocks_used - 1; last if $blkno++ == $blocks_used - 1;
} }
@ -1035,6 +1062,8 @@ sub read_file {
} else { } else {
print "Not a regular file!\n"; print "Not a regular file!\n";
} }
return 1;
} }
# #
@ -1110,7 +1139,7 @@ sub freemap {
my (@blocks) = get_vol_bit_map($pofile, $debug); my (@blocks) = get_vol_bit_map($pofile, $debug);
print " 12345678\n"; print " 01234567\n";
print " +--------\n"; print " +--------\n";
my $trk = 0; my $trk = 0;
@ -1123,5 +1152,11 @@ sub freemap {
print "\n"; print "\n";
} }
#
# Write a file
#
sub wriet_file {
}
1; 1;

2
README
View File

@ -4,7 +4,7 @@ prozap.pl -- partially working
procat.pl -- partially working procat.pl -- partially working
profree.pl -- partially working profree.pl -- partially working
proread.pl -- partially working proread.pl -- partially working
prowrite.pl prowrite.pl -- started
prorename.pl prorename.pl
prodelete.pl prodelete.pl
procopy.pl procopy.pl

9
proread.pl
View File

@ -12,8 +12,10 @@ use strict;
use ProDOS; use ProDOS;
my $mode = 'T'; # T=Text #my $mode = 'T'; # T=Text
my $conv = 1; # Convert \r to \n my $mode = 'B'; # B=Binary
#my $conv = 1; # Convert \r to \n
my $conv = 0; # Don't convert \r to \n
my $debug = 0; my $debug = 0;
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
@ -59,8 +61,9 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
my $pofile = shift or die "Must supply .po filename\n"; my $pofile = shift or die "Must supply .po filename\n";
my $filename = shift or die "Must supply filename (on disk image)\n"; my $filename = shift or die "Must supply filename (on disk image)\n";
my $output_file = shift;
read_file($pofile, $filename, $mode, $conv, $debug); read_file($pofile, $filename, $mode, $conv, $output_file, $debug);
1; 1;