Bug fixes & added comments

This commit is contained in:
Leeland Heins 2019-01-15 12:53:14 -06:00 committed by GitHub
parent 7325623034
commit 2e3e94af52
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
11 changed files with 166 additions and 12 deletions

View File

@ -2,6 +2,14 @@
package DOS33;
#
# DOS33.pm:
#
# Module to access Apple II DOS 3.3 disk images.
#
# 20190115 LSH
#
use strict;
use DSK;

8
DSK.pm
View File

@ -2,6 +2,14 @@
package DSK;
#
# DSK.pm:
#
# Module for low level access to Apple II .DSK and .DO disk image file (DOS Order).
#
# 20190115 LSH
#
use strict;
use Exporter::Auto;

10
PO.pm
View File

@ -2,6 +2,14 @@
package PO;
#
# PO.pm:
#
# Module for low level access to Apple II .PO disk images (ProDOS Order)
#
# 20190115 LSH
#
use strict;
use Exporter::Auto;
@ -10,7 +18,7 @@ my $debug = 0;
my $min_blk = 0; # Minimum block number
my $max_blk = 280; # Maximum block number
my $blk_size = 512;
my $blk_size = 512; # Block size
#
# Read entire .po image.

View File

@ -2,6 +2,14 @@
package ProDOS;
#
# ProDOS.pm:
#
# Module to access Apple II ProDOS volumes.
#
# 20190115 LSH
#
use strict;
use PO;
@ -12,6 +20,8 @@ my $debug = 0;
# ProDOS file types
my %ftype = (
# $0x Types: General
# 00 Typeless file
0x00 => ' ',
# 01 BAD Bad block(s) file
@ -35,6 +45,8 @@ my %ftype = (
# f DIR Directory file
0x0f => 'DIR',
# $1x Types: Productivity
# 19 ADB AppleWorks data base file
0x19 => 'ADB',
# 1a AWP AppleWorks word processing file
@ -42,6 +54,8 @@ my %ftype = (
# 1b ASP AppleWorks spreadsheet file
0x1b => 'ASP',
# $2x Types: Code
# $20 TDM Desktop Manager File
0x20 => 'TDM',
# $21 IPS Instant Pascal Source
@ -64,11 +78,15 @@ my %ftype = (
# $2E P8C ProDOS 8 Code Module
0x2e => 'P8C',
# $4x Types: Miscellaneous
# $41 OCR Optical Character Recognition
0x41 => 'OCR',
# $42 FTD File Type Definitions
0x42 => 'FTD',
# $5x Types: Apple IIgs General
# $50 GWP Apple IIgs Word Processing
0x50 => 'GWP',
# $5445 - Teach
@ -123,6 +141,8 @@ my %ftype = (
# $5E DVU Development Utility
0x5e => 'DVU',
# $6x Types: PC Transporter
# $60 PRE PC Pre-Boot
0x60 => 'PRE',
# $6B BIO PC BIOS
@ -136,6 +156,8 @@ my %ftype = (
# $6F HDV PC Hard Disk Image
0x6f => 'HDV',
# $7x Types: Kreative Software
# $70 SN2 Sabine's Notebook 2.0
0x70 => 'SN2',
# $71 KMT
@ -174,6 +196,8 @@ my %ftype = (
# $7F JCP
0x7f => 'JCP',
# $8x Types: GEOS
# $80 GES System File
0x80 => 'GES',
# $81 GEA Desk Accessory
@ -199,6 +223,8 @@ my %ftype = (
# $8D GEW Formatting Data
0x8d => 'GEW',
# $Ax Types: Apple IIgs BASIC
# $A0 WP WordPerfect
0xa0 => 'WP ',
# $AB GSB Apple IIgs BASIC Program
@ -208,6 +234,8 @@ my %ftype = (
# $AD BDF Apple IIgs BASIC Data
0xad => 'BDF',
# $Bx Types: Apple IIgs System
# $B0 SRC Apple IIgs Source Code
0xb0 => 'SRC',
# $B1 OBJ Apple IIgs Object Code
@ -245,6 +273,8 @@ my %ftype = (
# $BF DOC Apple IIgs Document
0xbf => 'DOC',
# $Cx Types: Graphics
# $C0 PNT Apple IIgs Packed Super HiRes
0xc0 => 'PNT',
# $0001 - Packed Super HiRes
@ -277,6 +307,8 @@ my %ftype = (
# $CA ICN Apple IIgs Icon File
0xca => 'ICN',
# $Dx Types: Audio
# $D5 MUS Music
0xd5 => 'MUS',
# $D6 INS Instrument
@ -295,6 +327,9 @@ my %ftype = (
# $DB DBM DB Master Document
0xdb => 'DBM',
# $Ex Types: Miscellaneous
# $E0 LBR Archive
0xe0 => 'LBR',
# $0000 - ALU
@ -314,6 +349,8 @@ my %ftype = (
# ef PAS ProDOS PASCAL file
0xef => 'PAS',
# $Fx Types: System
# f0 CMD ProDOS added command file
0xf0 => 'CMD',
# f1-f8 User defined file types 1 through 8
@ -325,6 +362,10 @@ my %ftype = (
0xf6 => 'UD6',
0xf7 => 'UD7',
0xf8 => 'PRG',
# $F9 P16 ProDOS-16 System File
0xf9 => 'P16',
# fa INT Integer BASIC Program
0xfa => 'INT',
# fb IVR Integer BASIC Variables
@ -339,6 +380,9 @@ my %ftype = (
0xff => 'SYS',
);
#
# Months for catalog date format.
#
my %months = (
1, 'JAN',
2, 'FEB',
@ -354,6 +398,7 @@ my %months = (
12, 'DEC',
);
# Default key volume directory block.
my $key_vol_dir_blk = 2;
#

21
README
View File

@ -1,12 +1,15 @@
TODO:
catalog -- mostly working
read -- mostly working for simple text files
write
umlock
lock
rename
delete
copy
disk zap/sector editor -- partially working
catalog.pl -- mostly working
freemap.pl -- mostly working
dos33read.pl -- mostly working for simple text files
dos33write.pl
dos33umlock.pl
dos33lock.pl
dos33rename.pl
dos33delete.pl
dos33copy.pl
zap.pl -- partially working
prozap.pl -- partially working
procat.pl -- partially working

View File

@ -1,5 +1,13 @@
#!/usr/bin/perl -w
#
# catalog.pl:
#
# Utility to get a 'catalog' (directory) of an Apple II DOS 3.3 disk image.
#
# 20190115 LSH
#
use strict;
use DOS33;

View File

@ -1,5 +1,13 @@
#!/usr/bin/perl -w
#
# dos33read.pl:
#
# Utility to read a file out of an Apple II DOS 3.3 disk image.
#
# 20190115 LSH
#
use strict;
use DOS33;
@ -9,19 +17,25 @@ my $conv = 1;
my $debug = 0;
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
# Mode
if ($ARGV[0] eq '-m' && defined $ARGV[1] && $ARGV[1] ne '') {
# Text
if ($ARGV[1] eq 'T') {
$mode = 'T';
$conv = 1;
# Integer BASIC
} elsif ($ARGV[1] eq 'I') {
$mode = 'I';
$conv = 0;
# Applesoft
} elsif ($ARGV[1] eq 'A') {
$mode = 'A';
$conv = 0;
# Binary
} elsif ($ARGV[1] eq 'B') {
$mode = 'B';
$conv = 0;
# S
} elsif ($ARGV[1] eq 'S') {
$mode = 'S';
$conv = 0;
@ -30,9 +44,11 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
}
shift;
shift;
# Convert (carriage return to linefeed)
} elsif ($ARGV[0] eq '-c') {
$conv = 0;
shift;
# Debug
} elsif ($ARGV[0] eq '-d') {
$debug = 1;
shift;

View File

@ -1,5 +1,13 @@
#!/usr/bin/perl -w
#
# freemap.pl:
#
# Utility to get a free sector map of an Apple II DOS 3.3 disk image.
#
# 20190115 LSH
#
use strict;
use DOS33;

View File

@ -1,5 +1,13 @@
#!/usr/bin/perl -w
#
# procat.pl:
#
# Utility to get a 'catalog' (directory listing) of an Apple II ProDOS volume.
#
# 20190115 LSH
#
use strict;
use ProDOS;

View File

@ -1,5 +1,13 @@
#!/usr/bin/perl -w
#
# prozap.pl:
#
# Utility to edit a ProDOS block (.PO image).
#
# 20190115 LSH
#
use strict;
use PO;
@ -13,17 +21,21 @@ my $write = 0;
my @mods = ();
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
# Debug
if ($ARGV[0] eq '-d') {
$debug = 1;
shift;
# Block to read
} elsif ($ARGV[0] eq '-b' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
$blk = $ARGV[1];
shift;
shift;
# Destination block
} elsif ($ARGV[0] eq '-db' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
$dst_blk = $ARGV[1];
shift;
shift;
# Allow modifying data.
} elsif ($ARGV[0] =~ /^-m([ahA])/ && defined $ARGV[1] && $ARGV[1] ne '') {
my $typ = $1;
print "$ARGV[1] typ=$typ\n" if $debug;
@ -46,13 +58,18 @@ $dst_blk = $blk unless $dst_blk >= 0;
my $buf;
# Read the block
if (read_blk($pofile, $blk, \$buf)) {
# Display the data in the block.
dump_blk($buf);
# Allow modifying the data.
if ($write) {
print "WRITING $dst_blk\n" if $debug;
# Unpack the data in the block
my @bytes = unpack "C512", $buf;
# Process each modification.
foreach my $mod (@mods) {
my @mbytes = ();
if ($mod->{'typ'} eq 'a') {
@ -76,10 +93,14 @@ if (read_blk($pofile, $blk, \$buf)) {
}
}
my $buf = pack "C*", @bytes;
# Re-pack the data in the block
$buf = pack "C*", @bytes;
# Write the destination block (default to block read).
if (write_blk($pofile, $dst_blk, $buf)) {
# Read the block back in.
if (read_blk($pofile, $dst_blk, \$buf)) {
# Display the data in the modified block.
dump_blk($buf);
} else {
print "Failed final read!\n";

23
zap.pl
View File

@ -1,5 +1,13 @@
#!/usr/bin/perl -w
#
# zap.pl:
#
# Utility to edit a DOS 3.3 sector (.DSK or .DO disk image).
#
# 20190115 LSH
#
use strict;
use DSK;
@ -15,25 +23,31 @@ my $write = 0;
my @mods = ();
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
# Debug
if ($ARGV[0] eq '-d') {
$debug = 1;
shift;
# Track
} elsif ($ARGV[0] eq '-t' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
$trk = $ARGV[1];
shift;
shift;
# Sector
} elsif ($ARGV[0] eq '-s' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
$sec = $ARGV[1];
shift;
shift;
# Destination track
} elsif ($ARGV[0] eq '-dt' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
$dst_trk = $ARGV[1];
shift;
shift;
# Destination sector
} elsif ($ARGV[0] eq '-ds' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
$dst_sec = $ARGV[1];
shift;
shift;
# Allow modifying data.
} elsif ($ARGV[0] =~ /^-m([ahA])/ && defined $ARGV[1] && $ARGV[1] ne '') {
my $typ = $1;
print "$ARGV[1] typ=$typ\n" if $debug;
@ -59,10 +73,13 @@ $dst_sec = $sec unless $dst_sec >= 0;
my $buf;
if (rts($dskfile, $trk, $sec, \$buf)) {
# Display the data in the sector.
dump_sec($buf);
# Allow modifying data.
if ($write) {
print "WRITING $dst_trk $dst_sec\n" if $debug;
# Unpack the data in the sector.
my @bytes = unpack "C256", $buf;
foreach my $mod (@mods) {
@ -88,10 +105,14 @@ if (rts($dskfile, $trk, $sec, \$buf)) {
}
}
my $buf = pack "C*", @bytes;
# Re-pack the data in the sector.
$buf = pack "C*", @bytes;
# Write the sector.
if (wts($dskfile, $dst_trk, $dst_sec, $buf)) {
# Read the sector back in.
if (rts($dskfile, $dst_trk, $dst_sec, \$buf)) {
# Display the data in the modified sector.
dump_sec($buf);
} else {
print "Failed final read!\n";