Initial import
This commit is contained in:
parent
2d651c5e7d
commit
ceb090003b
|
@ -0,0 +1,242 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
#
|
||||
# a2hires2png.pl
|
||||
#
|
||||
# Convert Apple II HIRES grqphic image to a PNG image.
|
||||
#
|
||||
# 20190220 Leeland Heins
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
use GD;
|
||||
|
||||
sub HIGH {
|
||||
my ($bytes, $min, $x) = @_;
|
||||
|
||||
return ($bytes->[$min + ($x) / 7] & (1 << 7))
|
||||
}
|
||||
|
||||
sub process {
|
||||
my ($ifh) = @_;
|
||||
|
||||
# Create a new image.
|
||||
my $im = new GD::Image(280, 192);
|
||||
|
||||
# Allocate Apple II hires colors
|
||||
my $black = $im->colorAllocate(0x00, 0x00, 0x00);
|
||||
my $white = $im->colorAllocate(0xff, 0xff, 0xff);
|
||||
my $green = $im->colorAllocate(0x14, 0xfe, 0x3c);
|
||||
my $violet = $im->colorAllocate(0xff, 0x44, 0xfd);
|
||||
my $orange = $im->colorAllocate(0xff, 0x6a, 0x3c);
|
||||
my $blue = $im->colorAllocate(0x14, 0xcf, 0xfd);
|
||||
|
||||
# Fill the image black
|
||||
$im->filledRectangle(0, 0, 279, 191, $black);
|
||||
|
||||
my $maj = 0;
|
||||
my $min = 0;
|
||||
my $color = 0;
|
||||
|
||||
my @lines = (
|
||||
0x000,
|
||||
0x080,
|
||||
0x100,
|
||||
0x180,
|
||||
0x200,
|
||||
0x280,
|
||||
0x300,
|
||||
0x380,
|
||||
0x028,
|
||||
0x0a8,
|
||||
0x128,
|
||||
0x1a8,
|
||||
0x228,
|
||||
0x2a8,
|
||||
0x328,
|
||||
0x3a8,
|
||||
0x050,
|
||||
0x0d0,
|
||||
0x150,
|
||||
0x1d0,
|
||||
0x250,
|
||||
0x2d0,
|
||||
0x350,
|
||||
0x3d0
|
||||
);
|
||||
|
||||
my $buf;
|
||||
|
||||
# Read the Apple II hires data.
|
||||
read ($ifh, $buf, 8192);
|
||||
|
||||
# Unpack it into bytes.
|
||||
my @bytes = unpack "C*", $buf;
|
||||
|
||||
# Determine if this is a color or monochrome image.
|
||||
for ($maj = 0; $maj < 24; $maj++) {
|
||||
for ($min = $lines[$maj]; $min < $lines[$maj] + 8192; $min += 1024) {
|
||||
my $x;
|
||||
|
||||
for ($x = 0; $x < 40; $x++) {
|
||||
if (($bytes[$min + $x] & 0x80) &&
|
||||
($bytes[$min + $x] != 0xff) &&
|
||||
($bytes[$min + $x] != 0x80)) {
|
||||
$color = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $y = 0;
|
||||
|
||||
for ($maj = 0; $maj < 24; $maj++) {
|
||||
for ($min = $lines[$maj]; $min < $lines[$maj] + 8192; $min += 1024) {
|
||||
$y++;
|
||||
my $x;
|
||||
my @bits; # 280
|
||||
|
||||
for ($x = 0; $x < 280; $x++) {
|
||||
$bits[$x] = ($bytes[$min + $x / 7] & (1 << ($x % 7))) != 0;
|
||||
}
|
||||
|
||||
$x = 0;
|
||||
|
||||
# Left edge
|
||||
if ($color && ($bits[0] != $bits[1])) {
|
||||
if (HIGH(\@bytes, $min, 0)) {
|
||||
if ($bits[0]) {
|
||||
# Draw blue pixel
|
||||
$im->setPixel($x, $y, $blue);
|
||||
} else {
|
||||
# Draw orange pixel
|
||||
$im->setPixel($x, $y, $orange);
|
||||
}
|
||||
} else {
|
||||
if ($bits[0]) {
|
||||
# Draw violet pixel
|
||||
$im->setPixel($x, $y, $violet);
|
||||
} else {
|
||||
# Draw green pixel
|
||||
$im->setPixel($x, $y, $green);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if ($bits[0]) {
|
||||
# Draw white pixel
|
||||
$im->setPixel($x, $y, $white);
|
||||
} else {
|
||||
# Draw black pixel
|
||||
$im->setPixel($x, $y, $black);
|
||||
}
|
||||
}
|
||||
|
||||
# Middle
|
||||
for ($x = 1; $x < 279; $x++) {
|
||||
if ($color &&
|
||||
$bits[$x] != $bits[$x - 1] &&
|
||||
$bits[$x] != $bits[$x + 1]) {
|
||||
if ($x % 2 == 0) {
|
||||
if (HIGH(\@bytes, $min, $x)) {
|
||||
if ($bits[$x]) {
|
||||
# Draw blue pixel
|
||||
$im->setPixel($x, $y, $blue);
|
||||
} else {
|
||||
# Draw orange pixel
|
||||
$im->setPixel($x, $y, $orange);
|
||||
}
|
||||
} else {
|
||||
if ($bits[$x]) {
|
||||
# Draw violet pixel
|
||||
$im->setPixel($x, $y, $violet);
|
||||
} else {
|
||||
# Draw green pixel
|
||||
$im->setPixel($x, $y, $green);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (HIGH(\@bytes, $min, $x)) {
|
||||
if ($bits[$x]) {
|
||||
# Draw orange pixel
|
||||
$im->setPixel($x, $y, $orange);
|
||||
} else {
|
||||
# Draw blue pixel
|
||||
$im->setPixel($x, $y, $blue);
|
||||
}
|
||||
} else {
|
||||
if ($bits[$x]) {
|
||||
# Draw green pixel
|
||||
$im->setPixel($x, $y, $green);
|
||||
} else {
|
||||
# Draw violet pixel
|
||||
$im->setPixel($x, $y, $violet);
|
||||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if ($bits[$x]) {
|
||||
# Draw white pixel
|
||||
$im->setPixel($x, $y, $white);
|
||||
} else {
|
||||
# Draw black pixel
|
||||
$im->setPixel($x, $y, $black);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$x = 279;
|
||||
|
||||
# Right edge
|
||||
if ($color && ($bits[278] != $bits[279])) {
|
||||
if (HIGH(\@bytes, $min, 279)) {
|
||||
if ($bits[279]) {
|
||||
# Draw orange pixel
|
||||
$im->setPixel($x, $y, $orange);
|
||||
} else {
|
||||
# Draw blue pixel
|
||||
$im->setPixel($x, $y, $blue);
|
||||
}
|
||||
} else {
|
||||
if ($bits[279]) {
|
||||
# Draw green pixel
|
||||
$im->setPixel($x, $y, $green);
|
||||
} else {
|
||||
# Draw violet pixel
|
||||
$im->setPixel($x, $y, $violet);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if ($bits[279]) {
|
||||
# Draw white pixel
|
||||
$im->setPixel($x, $y, $white);
|
||||
} else {
|
||||
# Draw black pixel
|
||||
$im->setPixel($x, $y, $black);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $im;
|
||||
}
|
||||
|
||||
my $filename = shift or die "Must supply filename\n";
|
||||
|
||||
my $ifh;
|
||||
|
||||
if (open($ifh, "<$filename")) {
|
||||
my $im = process($ifh);
|
||||
|
||||
# make sure we are writing to a binary stream
|
||||
binmode STDOUT;
|
||||
|
||||
# Convert the image to PNG and print it on standard output
|
||||
print $im->png;
|
||||
} else {
|
||||
die "Unable to read $filename\n";
|
||||
}
|
||||
|
||||
1;
|
||||
|
Loading…
Reference in New Issue