pnt2bmp

#!/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, they 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

https://www.leeland.info/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 ( %chars, %chars_in_files );

my @files = glob( shift @ARGV );

foreach my $file (@files) {

    next and warn "Mismatched extension in filename [$file]... skipping\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 ($run) );

    }
    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, 24, 0, 0,
      0, 0, 0, 0;

    # Write out the image data, bottom to top

    while ( $written > 0 ) {
        no warnings;
        print OUT @imdata[ $written - ( $x - 1 ) .. $written ];

        $written -= $x;
    }

    close OUT;

}