#!/usr/bin/perl
=head1 NAME
pnt2bmp - Converts "Tandy Personal Deskmate P(ai)NT files" to BMP
=head1 SYNOPSIS
B<pnt2bmp.pl> I<file.pnt>
=head1 DESCRIPTION
Converts "Tandy 1000 Personal Deskmate P(ai)NT files" to BMP. AFAIK, t
+hey are always 312x176. Did this without docs, so may not work on all
+.
Pixel data is stored in byte pairs, the first byte, two 4-bit pixels,
+and the second, a repeat count of the two pixel values
http://www.leeland.net/pnt2bmp.html
=head1 AUTHOR
Lee Pumphret
=cut
use strict;
use warnings;
my @tga_palette = map { pack( "CCC", reverse @$_ ) } (
[ 0x00, 0x00, 0x00 ], # Black
[ 0x00, 0x00, 0x99 ], # Dark Blue
[ 0x00, 0x99, 0x00 ], # Dark Green
[ 0x33, 0x99, 0x99 ], # Dark Cyan
[ 0x99, 0x00, 0x00 ], # Dark Red
[ 0xCC, 0x33, 0xCC ], # Dark Magenta
[ 0xCC, 0x66, 0x00 ], # Orange
[ 0x99, 0x99, 0x99 ], # Light Gray
[ 0x99, 0x66, 0x33 ], # Dark Gray
[ 0x66, 0x33, 0xFF ], # Light Blue
[ 0x33, 0xCC, 0x00 ], # Light Green
[ 0x66, 0xCC, 0xCC ], # Light Cyan
[ 0xFF, 0xCC, 0xCC ], # Light Red
[ 0xFF, 0x99, 0xFF ], # Light Magenta
[ 0xFF, 0xFF, 0x00 ], # Yellow
[ 0xFF, 0xFF, 0xFF ], #White
);
my @files = glob( shift @ARGV );
foreach my $file (@files) {
next and warn "Mismatched extension in filename [$file]... skippin
+g\n"
unless $file =~ /\.pnt$/i;
print "processing $file...\n";
open( IN, "<$file" ) or die "Couldn't open $file :$!";
binmode(IN);
my @imdata;
my $buffer;
my $PNT_HEADER_SIZE = 22; # .pnt file header size (I think)
# Read the header
( read( IN, $buffer, $PNT_HEADER_SIZE ) == $PNT_HEADER_SIZE )
or die "Error reading header data!";
warn unpack( "h*", $buffer ) . " $file\n";
my ( $ident, $other ) = unpack( "A4", $buffer );
unless ( $ident =~ m/PNT$/ ) {
die "Doesn't look like an PNT file! [$ident]";
}
my $count;
while ( read( IN, $buffer, 2 ) ) {
my ( $pindex, $run ) = unpack( "CC", $buffer );
my $p1 = ( $pindex >> 4 ) & 0x0f;
my $p2 = $pindex & 0x0f;
push @imdata, ( ( $tga_palette[$p1], $tga_palette[$p2] ) x ($r
+un) );
}
my $width = 312;
unless ( @imdata % $width == 0 ) {
# If short, pad it out, but probably damaged.
warn "Padding $file, may be damaged\n";
push @imdata,
( $tga_palette[0] ) x ( $width - ( @imdata % $width ) );
}
my ( $x, $y ) = ( $width, @imdata / $width );
# Write out the bmp file
( my $outfile = $file ) =~ s/pnt$/bmp/i;
my $written = $#imdata;
open( OUT, ">$outfile" ) or die "Couldn't open output!";
binmode(OUT);
# BMP 3.1 Header
print OUT pack "C C l a a a a l l l l s s l l l l l l", 0x42, 0x4D
+,
54 + ( $x * 3 ) * $y, 'l', 'e', 'e', 'p', 54, 0x28, $x, $y, 1, 2
+4, 0, 0,
0, 0, 0, 0;
# Write out the image data, bottom to top
while ( $written > 0 ) {
print OUT @imdata[ $written - ( $x - 1 ) .. $written ];
$written -= $x;
}
close OUT;
}
|