#!/usr/bin/perl -w
# pbmtopam.pl - Don Yang (uguu.org)
#
# Convert PBM image to PAM, since not everyone has the latest version of netpbm.

use strict;

# Parse header, expecting pbmraw with no comments
my $header = <>;
$header =~ /^P4/ or die;
my $size = <>;
$size =~ /^(\d+) (\d+)/ or die;
my ($width, $height) = ($1, $2);

# Output header
print <<"EOT";
P7
WIDTH $width
HEIGHT $height
DEPTH 1
MAXVAL 1
TUPLTYPE BLACKANDWHITE
ENDHDR
EOT

# Build mapping to expand packed bits
my @map;
for(my $i = 0; $i < 256; $i++)
{
   my $pixels = "";
   for(my $bit = 0; $bit < 8; $bit++)
   {
      if( ($i & (1 << $bit)) == 0 )
      {
         $pixels = chr(1) . $pixels;
      }
      else
      {
         $pixels = chr(0) . $pixels;
      }
   }
   push @map, $pixels;
}

# Translate bytes
if( ($width % 8) == 0 )
{
   # All scanlines end at byte boundaries
   while( my $block = <> )
   {
      foreach my $pixel (unpack 'C*', $block)
      {
         print $map[$pixel];
      }
   }
}
else
{
   # Scanlines do not end at byte boundaries
   my $x = 0;
   while( my $block = <> )
   {
      foreach my $pixel (unpack 'C*', $block)
      {
         $x++;
         if( $x == $width )
         {
            # Truncate lower order bits
            print substr($map[$pixel], 0, $width % 8);
            $x = 0;
         }
         else
         {
            print $map[$pixel];
         }
      }
   }
}