#!/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;

}
[download]