#!/usr/bin/perl -w

use strict;
#use 5.005_60;				# Comments in templates
#use GD;

my $chars_in_row = 64;
my @col_width = (0) x $chars_in_row;
my @row_height;

# One parameters: ASCII typeout
# Two parameters: ASCII typeout
@ARGV <= 2 and @ARGV >= 1
  or die "Usage: $0 input.fnt [output.gif]\n";

my $file = shift or die;
open F, $file or die;
binmode F;
undef $/;
my $txt = <F>;
close F or die;
my $l = length $txt;

my $shift = 0;
my $num = 0;
my ($substr, $id, $len);
my($szFamilyname,
   $szFacename,
   $usRegistryId,
   $usCodePage,
   $yEmHeight,
   $yXHeight,
   $yMaxAscender,
   $yMaxDescender,
   $yLowerCaseAscent,
   $yLowerCaseDescent,
   $yInternalLeading,
   $yExternalLeading,
   $xAveCharWidth,
   $xMaxCharInc,
   $xEmInc,
   $yMaxBaselineExt,
   $sCharSlope,
   $sInlineDir,
   $sCharRot,
   $usWeightClass,
   $usWidthClass,
   $xDeviceRes,
   $yDeviceRes,
   $usFirstChar,
   $usLastChar,
   $usDefaultChar,
   $usBreakChar,
   $usNominalPointSize,
   $usMinimumPointSize,
   $usMaximumPointSize,
   $fsTypeFlags,
   $fsDefn,
   $fsSelectionFlags,
   $fsCapabilities,
   $ySubscriptXSize,
   $ySubscriptYSize,
   $ySubscriptXOffset,
   $ySubscriptYOffset,
   $ySuperscriptXSize,
   $ySuperscriptYSize,
   $ySuperscriptXOffset,
   $ySuperscriptYOffset,
   $yUnderscoreSize,
   $yUnderscorePosition,
   $yStrikeoutSize,
   $yStrikeoutPosition,
   $usKerningPairs,
   $sFamilyClass,
   $pszDeviceNameOffset);
my ($fsFontdef, $fsChardef, $usCellSize,
     $xCellWidth, $yCellHeight, $xCellIncrement,
     $xCellA, $xCellB, $xCellC, $pCellBaseOffset, $chars);
my $row_off;

sub output_char {
  my ($out, $fields, $h, $chardef_template, $cell) = @_;

  my $cwidth = $xCellWidth;
  my $cheight = $yCellHeight;
  my ($w, $lpix);

  printf "char=$cell, cell=%d\n", $usFirstChar+$cell;
  for my $i (0..$#$fields) {
    print "  $$fields[$i]=$$out[$i]\n";
  }

  # Here we print "actual" bitmaps (without a+b+c padding)

  $cheight = $$out[$$h{height}] if $fsChardef & 2;
  if (($fsChardef | $fsFontdef) & 0x10) {			# b
    if ($fsChardef & 0x10) {
      $cwidth = $$out[$$h{b}];
    } elsif ($fsFontdef & 0x10) {
      $cwidth = $xCellB;
    }
  } elsif ($fsChardef & 1) {			# width
    $cwidth = $$out[$$h{width}];
  }
  $w = int(($cwidth + 7)/8);
  $lpix = $w * $cheight;
  if ($fsChardef & 0x80) {	# XXX Need to check for being a pixmap too.
    my $bits = substr $txt, $$out[0], $lpix;
    for my $li (0..$cheight - 1) {
      my $line = '';
      for my $wi (0..$w - 1) {
        $line .= unpack 'B8', substr $bits, $cheight*$wi + $li, 1;
      }
      $line = substr $line, 0, $cwidth;
      print "   $line\n";
    }
  }
}

sub init_rows {
  my ($min_char, $max_char) = @_;
  $row_off = int($min_char/$chars_in_row);
  my $row_max = int($max_char/$chars_in_row);
  @row_height = (0) x ($row_max - $row_off + 1);
}

sub calculate_sizes {
  my ($out, $fields, $h, $chardef_template, $cell) = @_;

  my $cheight = $yCellHeight;
  $cheight = $$out[$$h{height}] if $fsChardef & 2;

  my $cwidth;
  if (($fsChardef | $fsFontdef) & 0x10) {	# b
    $cwidth = 0;
    my @global = ($xCellA, $xCellB, $xCellC);
    my @local = @$out[@$h{qw(a b c)}];
    my @mask = (0x8, 0x10, 0x20);

    for my $n (0..2) {
      if ($fsChardef & $mask[$n]) {			# b
        $cwidth += $local[$n];
      } elsif ($fsFontdef & $mask[$n]) {
        $cwidth += $global[$n];
      }
    }
  } elsif ($fsChardef & 1) {			# width
    $cwidth = $$out[$$h{width}];
  } else {
    $cwidth = $xCellWidth;
  }

  my $c = $usFirstChar+$cell;
  my $row = int($c/$chars_in_row) - $row_off;
  my $col = $c % $chars_in_row;
  $col_width[$col] = $cwidth if $col_width[$col] < $cwidth;
  #print "c=$c cell=$cell row=$row maxrow=$#row_height\n"
  #  unless defined $row_height[$row];
  $row_height[$row] = $cheight if $row_height[$row] < $cheight;
}

my (@col_pos, @row_pos);
my ($im, $white, $black, $gray, $red);

sub init_gif {
  require GD;
  my ($pos, $i);

  ($pos, $i) = (0, 0);
  while ($i <= @col_width) {		# One extra
    push @col_pos, $pos;
    $pos += 1 + $col_width[$i] unless $i == @col_width;
    $i++;
  }

  ($pos, $i) = (0, 0);
  while ($i <= @row_height) {		# One extra
    push @row_pos, $pos;
    $pos += 1 + $row_height[$i] unless $i == @row_height;
    $i++;
  }

  $im = GD::Image->new($col_pos[-1]+1, $row_pos[-1]+1);
  $white = $im->colorAllocate(255,255,255);
  $black = $im->colorAllocate(0,0,0);
  $gray = $im->colorAllocate(191,191,191);
  $red = $im->colorAllocate(255,0,0);
  $im->filledRectangle(0,0,$col_pos[-1], $row_pos[-1], $gray);
#  $im->fill($gray);

  for $i (@row_pos) {
    $im->line(0,$i,$col_pos[-1], $i, $red);
  }
  for $i (@col_pos) {
    $im->line($i,0,$i,$row_pos[-1], $red);
  }
}

sub char_to_gif {
  my ($out, $fields, $h, $chardef_template, $cell) = @_;

  my $cwidth = $xCellWidth;
  my $cheight = $yCellHeight;
  my ($w, $lpix);

  printf "char=$cell, cell=%d\n", $usFirstChar+$cell;
  for my $i (0..$#$fields) {
    print "  $$fields[$i]=$$out[$i]\n";
  }

  # Here we print "actual" bitmaps (without a+b+c padding)

  $cheight = $$out[$$h{height}] if $fsChardef & 2;
  if (($fsChardef | $fsFontdef) & 0x10) {			# b
    if ($fsChardef & 0x10) {
      $cwidth = $$out[$$h{b}];
    } elsif ($fsFontdef & 0x10) {
      $cwidth = $xCellB;
    }
  } elsif ($fsChardef & 1) {			# width
    $cwidth = $$out[$$h{width}];
  }
  $w = int(($cwidth + 7)/8);
  $lpix = $w * $cheight;

  my $c = $usFirstChar+$cell;
  my $row = int($c/$chars_in_row) - $row_off;
  my $col = $c % $chars_in_row;

  if ($fsChardef & 0x80) {	# XXX Need to check for being a pixmap too.
    my $x = $col_pos[$col] + 1;
    my $y = $row_pos[$row] + 1;

    my $bits = substr $txt, $$out[0], $lpix;
    my $byteN = 0;
    my $minbit = 0;
    my $last_w = $cwidth % 8;
    $last_w = 8 if $last_w == 0;

    for my $ccol (1..$w) {
      $minbit = 8 - $last_w if $ccol == $w;
      for my $li (0..$cheight - 1) {
        my $byte = ord substr $bits, $byteN++, 1;
        for my $bit ($minbit..7) {
	  $im->setPixel($x + 7 - $bit, $y + $li,
			($byte >> $bit) & 1 ? $black : $white);
        }
      }
      $x += 8;
    }
  }
}

sub finish_gif {
  print "Output to $ARGV[0].\n";
  open O, ">$ARGV[0]" or die;
  binmode O or die;
  print O $im->gif;
  close O or die;
}

while (1) {
  die unless $shift + 8 <= $l;
  $substr = substr $txt, $shift, 8;
  ($id, $len) = unpack 'L2', $substr;
  die unless $shift + $len <= $l;
  $substr = substr $txt, $shift, $len;
  if ($num == 0) {
    # first record
    die unless $id == 0xfffffffe and $len == 20;
    (undef, undef, my $type) = unpack 'LLa*', $substr;
    print "Type '$type'\n";
  } elsif ($id == 1) {	# Font definition header
    (undef, undef,
        $szFamilyname,
        $szFacename,
        $usRegistryId,
        $usCodePage,
        $yEmHeight,
        $yXHeight,
        $yMaxAscender,
        $yMaxDescender,
        $yLowerCaseAscent,
        $yLowerCaseDescent,
        $yInternalLeading,
        $yExternalLeading,
        $xAveCharWidth,
        $xMaxCharInc,
        $xEmInc,
        $yMaxBaselineExt,
        $sCharSlope,
        $sInlineDir,
        $sCharRot,
        $usWeightClass,
        $usWidthClass,
        $xDeviceRes,
        $yDeviceRes,
        $usFirstChar,
        $usLastChar,
        $usDefaultChar,
        $usBreakChar,
        $usNominalPointSize,
        $usMinimumPointSize,
        $usMaximumPointSize,
        $fsTypeFlags,
        $fsDefn,
        $fsSelectionFlags,
        $fsCapabilities,
        $ySubscriptXSize,
        $ySubscriptYSize,
        $ySubscriptXOffset,
        $ySubscriptYOffset,
        $ySuperscriptXSize,
        $ySuperscriptYSize,
        $ySuperscriptXOffset,
        $ySuperscriptYOffset,
        $yUnderscoreSize,
        $yUnderscorePosition,
        $yStrikeoutSize,
        $yStrikeoutPosition,
        $usKerningPairs,
        $sFamilyClass,
        $pszDeviceNameOffset)
            = unpack 'L2 a32 a32 s17 S2 s27 L', $substr;
     printf <<EOP,
szFamilyname %s,
szFacename %s,
usRegistryId %d,
usCodePage %d,
yEmHeight %d,
yXHeight %d,
yMaxAscender %d,
yMaxDescender %d,
yLowerCaseAscent %d,
yLowerCaseDescent %d,
yInternalLeading %d,
yExternalLeading %d,
xAveCharWidth %d,
xMaxCharInc %d,
xEmInc %d,
yMaxBaselineExt %d,
sCharSlope %d,
sInlineDir %d,
sCharRot %d,
usWeightClass %d,
usWidthClass %d,
xDeviceRes %d,
yDeviceRes %d,
usFirstChar %d,
usLastChar %d,
usDefaultChar %d,
usBreakChar %d,
usNominalPointSize %d,
usMinimumPointSize %d,
usMaximumPointSize %d,
fsTypeFlags %d,
fsDefn %d,
fsSelectionFlags %d,
fsCapabilities %d,
ySubscriptXSize %d,
ySubscriptYSize %d,
ySubscriptXOffset %d,
ySubscriptYOffset %d,
ySuperscriptXSize %d,
ySuperscriptYSize %d,
ySuperscriptXOffset %d,
ySuperscriptYOffset %d,
yUnderscoreSize %d,
yUnderscorePosition %d,
yStrikeoutSize %d,
yStrikeoutPosition %d,
usKerningPairs %d,
sFamilyClass %d,
pszDeviceNameOffset %d
EOP
        $szFamilyname,
        $szFacename,
        $usRegistryId,
        $usCodePage,
        $yEmHeight,
        $yXHeight,
        $yMaxAscender,
        $yMaxDescender,
        $yLowerCaseAscent,
        $yLowerCaseDescent,
        $yInternalLeading,
        $yExternalLeading,
        $xAveCharWidth,
        $xMaxCharInc,
        $xEmInc,
        $yMaxBaselineExt,
        $sCharSlope,
        $sInlineDir,
        $sCharRot,
        $usWeightClass,
        $usWidthClass,
        $xDeviceRes,
        $yDeviceRes,
        $usFirstChar,
        $usLastChar,
        $usDefaultChar,
        $usBreakChar,
        $usNominalPointSize,
        $usMinimumPointSize,
        $usMaximumPointSize,
        $fsTypeFlags,
        $fsDefn,
        $fsSelectionFlags,
        $fsCapabilities,
        $ySubscriptXSize,
        $ySubscriptYSize,
        $ySubscriptXOffset,
        $ySubscriptYOffset,
        $ySuperscriptXSize,
        $ySuperscriptYSize,
        $ySuperscriptXOffset,
        $ySuperscriptYOffset,
        $yUnderscoreSize,
        $yUnderscorePosition,
        $yStrikeoutSize,
        $yStrikeoutPosition,
        $usKerningPairs,
        $sFamilyClass,
        $pszDeviceNameOffset;
  } elsif ($id == 2) {	# Char definition header
    (undef, undef,
     $fsFontdef, $fsChardef, $usCellSize,
     $xCellWidth, $yCellHeight, $xCellIncrement,
     $xCellA, $xCellB, $xCellC, $pCellBaseOffset, $chars)
	= unpack 'L2 s10 A*', $substr;
    # printf "SIZE $len.\n";
    printf "fsFontdef %#x, fsChardef %#x, usCellSize $usCellSize,\n", $fsFontdef, $fsChardef;
    print "xCellWidth $xCellWidth, yCellHeight $yCellHeight, xCellIncrement $xCellIncrement,\n";
    print "xCellA $xCellA, xCellB $xCellB, xCellC $xCellC, pCellBaseOffset $pCellBaseOffset.\n";

    my $chardef_template = '';
    $chardef_template .= 'L ' if $fsChardef & 0x80;	# offset to bitmap
    $chardef_template .= 'S ' if $fsChardef & 1;	# width
    $chardef_template .= 'S ' if $fsChardef & 2;	# height
    $chardef_template .= 'S ' if $fsChardef & 4;	# increment
    $chardef_template .= 'S ' if $fsChardef & 8;	# a
    $chardef_template .= 'S ' if $fsChardef & 0x10;	# b
    $chardef_template .= 'S ' if $fsChardef & 0x20;	# c
    $chardef_template .= 'S ' if $fsChardef & 0x40;	# base offset

    my @fields = ();
    push @fields, 'bitmap_offset' if $fsChardef & 0x80;	# offset to bitmap
    push @fields, 'width' if $fsChardef & 1;	# width
    push @fields, 'height' if $fsChardef & 2;	# height
    push @fields, 'increment' if $fsChardef & 4;	# increment
    push @fields, 'a' if $fsChardef & 8;	# a
    push @fields, 'b' if $fsChardef & 0x10;	# b
    push @fields, 'c' if $fsChardef & 0x20;	# c
    push @fields, 'base offset' if $fsChardef & 0x40;	# base offset

    my %h;
    @h{@fields} = (0..$#fields);

    my $cwidth = $xCellWidth;
    my $cheight = $yCellHeight;
    my ($w, $lpix);

    init_rows($usFirstChar, $usFirstChar+$usLastChar+1);
    my $o;
    my $do_gif = @ARGV;

    # There is a dummy width=8 whitespace char at end, we include it
    if ($do_gif) {
      $o = 0;
      for my $cell (0 .. $usLastChar + 1) {
        my @out = unpack $chardef_template, substr $chars, $o, $usCellSize;
        $o += $usCellSize;

        calculate_sizes(\@out, \@fields, \%h, $chardef_template, $cell);
      }

      init_gif();
    }

    $o = 0;
    for my $cell (0 .. $usLastChar + 1) {
      my @out = unpack $chardef_template, substr $chars, $o, $usCellSize;
      $o += $usCellSize;

      if ($do_gif) {
        char_to_gif(\@out, \@fields, \%h, $chardef_template, $cell);
      } else {
        output_char(\@out, \@fields, \%h, $chardef_template, $cell);
      }
    }
    finish_gif() if $do_gif;
  } else {	# Char definition header
    print "id $id, size $len.\n";
  }
  $shift += $len;
  last if $shift == $l;
  $num++;
}

# last record
die unless $id == 0xffffffff and $len == 8;


__END__