mirror of
https://github.com/softwarejanitor/DOS33.git
synced 2024-06-05 07:29:27 +00:00
Moved to ProDOS
This commit is contained in:
parent
0cf9107e78
commit
9df5fc4ae2
119
prozap.pl
119
prozap.pl
|
@ -1,119 +0,0 @@
|
||||||
#!/usr/bin/perl -w
|
|
||||||
|
|
||||||
#
|
|
||||||
# prozap.pl:
|
|
||||||
#
|
|
||||||
# Utility to edit a ProDOS block (.PO image).
|
|
||||||
#
|
|
||||||
# 20190115 LSH
|
|
||||||
#
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
use PO;
|
|
||||||
|
|
||||||
my $debug = 0;
|
|
||||||
|
|
||||||
my $blk = -1;
|
|
||||||
my $dst_blk = -1;
|
|
||||||
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;
|
|
||||||
if ($ARGV[1] =~ /^([0-9a-fA-F]+):\s*(.+)$/) {
|
|
||||||
print "1=$1 2=$2\n" if $debug;
|
|
||||||
push @mods, { 'typ' => $typ, 'addr' => $1, 'vals' => $2 };
|
|
||||||
}
|
|
||||||
shift;
|
|
||||||
shift;
|
|
||||||
} elsif ($ARGV[0] eq "-w") {
|
|
||||||
$write = 1;
|
|
||||||
shift;
|
|
||||||
} else {
|
|
||||||
die "Unknown command line argument $ARGV[0]\n";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
my $pofile = shift or die "Must supply .po filename\n";
|
|
||||||
die "Must supply block number 0-280\n" unless $blk >= 0 && $blk <= 280;
|
|
||||||
|
|
||||||
$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') {
|
|
||||||
print "ASCII vals=$mod->{'vals'}\n" if $debug;
|
|
||||||
# Normal ASCII
|
|
||||||
@mbytes = map { pack('C', ord($_)) } ($mod->{'vals'} =~ /(.)/g);
|
|
||||||
} elsif ($mod->{'typ'} eq 'A') {
|
|
||||||
print "HEX vals=$mod->{'vals'}\n" if $debug;
|
|
||||||
# Apple II ASCII
|
|
||||||
@mbytes = map { pack('C', ord($_) | 0x80) } ($mod->{'vals'} =~ /(.)/g);
|
|
||||||
} elsif ($mod->{'typ'} eq 'h') {
|
|
||||||
print "A2 ASCII vals=$mod->{'vals'}\n" if $debug;
|
|
||||||
# HEX
|
|
||||||
@mbytes = map { pack('C', hex(lc($_))) } ($mod->{'vals'} =~ /(..)/g);
|
|
||||||
}
|
|
||||||
my $addr = hex($mod->{'addr'});
|
|
||||||
print "addr=$addr\n" if $debug;
|
|
||||||
foreach my $byte (@mbytes) {
|
|
||||||
print sprintf("byte=%02x\n", ord($byte)) if $debug;
|
|
||||||
$bytes[$addr++] = ord($byte);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# 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";
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
print "Failed write!\n";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
print "Failed initial read!\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user