pnt2bmp

2008.02.10
pnt2bmp
Been going through my old floppies and came across a bunch of drawings I did on my Tandy 1000HX 4mhz 8086 with Deskmate. Apparently, no one ever bothered to make a converter so if your one of the few people in the world in need of such a beast, here ya go!

Ah, back in the days of 16 color fixed palettes and no mouse.

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

http://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;

}
Scroll to top