Bug fixes & added comments
This commit is contained in:
Leeland Heins
GitHub
parent
7325623034
commit
2e3e94af52
8
DOS33.pm
8
DOS33.pm
|
|
@ -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
8
DSK.pm
|
|
@ -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
10
PO.pm
|
|
@ -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.
|
||||
|
|
|
|||
45
ProDOS.pm
45
ProDOS.pm
|
|
@ -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
21
README
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
16
dos33read.pl
16
dos33read.pl
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
23
prozap.pl
23
prozap.pl
|
|
@ -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
23
zap.pl
|
|
@ -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";
|
||||
|
|
|
|||
Loading…
Reference in New Issue