#! /usr/bin/perl

#  Makes a collection of font sample pages for the STIX fonts
#  
#  Usage:  ./makeTable

%fonts = (
  'STIXGeneral'                 => "font-family: STIXGeneral;",
  'STIXGeneral-Bold'            => "font-family: STIXGeneral; font-weight: bold;",
  'STIXGeneral-Bold-Italic'     => "font-family: STIXGeneral; font-style: italic; font-weight: bold;",
  'STIXGeneral-Italic'          => "font-family: STIXGeneral; font-style: italic;",
  'STIXIntegralsD'              => "font-family: STIXIntegralsD;",
  'STIXIntegralsD-Bold'         => "font-family: STIXIntegralsD; font-weight: bold;",
  'STIXIntegralsSm'             => "font-family: STIXIntegralsSm;",
  'STIXIntegralsSm-Bold'        => "font-family: STIXIntegralsSm; font-weight: bold;",
  'STIXIntegralsUp'             => "font-family: STIXIntegralsUp;",
  'STIXIntegralsUp-Bold'        => "font-family: STIXIntegralsUp; font-weight: bold;",
  'STIXIntegralsUpD'            => "font-family: STIXIntegralsUpD;",
  'STIXIntegralsUpD-Bold'       => "font-family: STIXIntegralsUpD; font-weight: bold;",
  'STIXIntegralsUpSm'           => "font-family: STIXIntegralsUpSm;",
  'STIXIntegralsUpSm-Bold'      => "font-family: STIXIntegralsUpSm; font-weight: bold;",
  'STIXNonUnicode'              => "font-family: STIXNonUnicode;",
  'STIXNonUnicode-Bold'         => "font-family: STIXNonUnicode; font-weight: bold;",
  'STIXNonUnicode-Bold-Italic'  => "font-family: STIXNonUnicode; font-style: italic; font-weight: bold;",
  'STIXNonUnicode-Italic'       => "font-family: STIXNonUnicode; font-style: italic;",
  'STIXSizeOneSym'              => "font-family: STIXSizeOneSym, STIXSize1;",
  'STIXSizeOneSym-Bold'         => "font-family: STIXSizeOneSym, STIXSize1; font-weight: bold;",
  'STIXSizeTwoSym'              => "font-family: STIXSizeTwoSym, STIXSize2;",
  'STIXSizeTwoSym-Bold'         => "font-family: STIXSizeTwoSym, STIXSize2; font-weight: bold;",
  'STIXSizeThreeSym'            => "font-family: STIXSizeThreeSym, STIXSize3;",
  'STIXSizeThreeSym-Bold'       => "font-family: STIXSizeThreeSym, STIXSize3; font-weight: bold;",
  'STIXSizeFourSym'             => "font-family: STIXSizeFourSym, STIXSize4;",
  'STIXSizeFourSym-Bold'        => "font-family: STIXSizeFourSym, STIXSize4; font-weight: bold;",
  'STIXSizeFiveSym'             => "font-family: STIXSizeFiveSym, STIXSize5;",
  'STIXVariants'                => "font-family: STIXVariants;",
  'STIXVariants-Bold'           => "font-family: STIXVariants; font-weight: bold;",
);

require "unicode.pl";

%num = ("One"=>1, "Two"=>2, "Three"=>3, "Four"=>4, "Five"=>5);
sub byName {
  my ($A,$B) = ($a,$b); $A =~ s/-Regular//; $B =~ s/-Regular//;
  if ($A =~ m/STIXSize/ && $B =~ m/STIXSize/) {
    my ($An,$Bn) = ($A =~ m/(One|Two|Three|Four|Five)/,$B =~ m/(One|Two|Three|Four|Five)/);
    $A =~ s/$An/$num{$An}/; $B =~ s/$Bn/$num{$Bn}/;
  }
  return $A cmp $B;
}

@fonts = sort byName (keys %fonts);


sub GetTableData {
  foreach $font (split(/\n/,`find -L ../../AFM/STIX/fonts -name "*.js"`)) {GetFileData($font)}
  CountRangeEntries();
}

sub GetFileData {
  my $file = shift;
  open(INFILE,$file);
  my @lines = <INFILE>;
  close(INFILE);
  chomp(@lines);
  FindChars(@lines);
}

sub FindChars {
  my $font = ""; my $char;
  foreach my $line (@_) {
    if ($line =~ m/FONTDATA.FONTS\['([^']*)'\]/) {
      $font = $1; $font =~ s/bold/Bold/; $font =~ s/italic/Italic/;
    } elsif ($line =~ m/^ +0x([A-F0-9]*):/) {
      $char = sprintf("%05X",hex($1));
      $CHAR{$char}{$font} = 1 unless $char ge "0E000" && $char le "0F7FF" && $font !~ m/NonUni/;
    }
  }
}

sub CountRangeEntries {
  foreach my $range (@ranges) {
    my ($name,$start,$end) = @{$range};
    my $N = 0;
    foreach my $font (@fonts) {
      my $n = 0;
      foreach $c ($start..$end) {
	my $C = sprintf("%05X",$c);
	$n++ if $CHAR{$C} && $CHAR{$C}{$font};
      }
      $N += $n;
      $count{$font} += $n;
      $frcount{$font}{$name} = $n;
      $frcount{$font}{STIXAll} += $n;
    }
    $count{STIXAll} += $N;
    $frcount{STIXAll}{$name} = $N;
  }
}

sub MakeHeader {
  my $FONT = shift; my $range = (shift) || "";
  @HEADER = (
    '<HTML>',
    '<HEAD>',
    '<TITLE>STIX Font Table for '.($FONT || "All Fonts").$range.'</TITLE>',
    '<STYLE TYPE="text/css">',
    '  .header {font-weight: bold; padding: 3px}',
    '  .space  {width: 2px}',
    '  .blank  {padding: 10}',
    '  .label  {padding: 5; font-family: monospace; text-align: right; font-size: 80%}',
    '  .NA     {padding: 10; background: white; border: solid #F4F4F4 1px}',
    '  .other  {padding: 10; background: #CCCCCC}',
    '  .hidden {visibility: hidden}',
    '  .STIX   {padding: 10; font-size: 133%; background: #F0F0F0}',
    ($FONT ?
      '  .'.$FONT.' {'.$fonts{$FONT}.'}' :
      (map {'  .'.$_.' {'.$fonts{$_}.'}'} @fonts)
    ),
    '  .caption TD {font-family: monospace; font-size: 80%; text-align: center}',
    '  .small  {font-size: 80%; vertical-align: .15em}',
    '  .tt     {font-family: monospace; margin: 0px -.125em}',
    '  A       {text-decoration: none}',
    '  .combine {font-family: STIXGeneral}',
    '  .navigation {position: fixed; top:5; right:0; width:auto}',
    '  @media print {.navigation {display: none}}',
    '</STYLE>',
    '</HEAD>',
    '<BODY>',
    '<BR>',
    '<CENTER>',
    '<H1>'.($FONT || "STIX Font").' Character Tables</H1>',
  );
}

@FOOTER = (
  '</CENTER>',
  '</BODY>',
  '</HTML>',
);

@TABLEstart = (
  '<TABLE BORDER="0" CELLSPACING="2" CELLPADDING="0">',
  '',
  '<TR ALIGN="CENTER"><TD CLASS="blank"></TD><TD CLASS="space"></TD><TD CLASS="header" COLSPAN="17">',
);
@TABLEhead = (
  '</TR>',
  '',
  '<TR CLASS="caption">',
  '<TD CLASS="blank"></TD>',
  '<TD CLASS="space"></TD>',
  '<TD>0</TD><TD>1</TD><TD>2</TD><TD>3</TD><TD>4</TD><TD>5</TD><TD>6</TD><TD>7</TD>',
  '<TD CLASS="space"></TD>',
  '<TD>8</TD><TD>9</TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD>',
  '</TR>',
);
@TABLEfoot = (
  '</TABLE>',
  '<p>'
);

@ROWstart = ('<TR ALIGN="CENTER">');
@ROWend   = ('</TR>');

sub PrintTOC {
  mkdir "STIX" unless -d "STIX";
  open(HTML,">STIX/index.html");
  PrintHTML(
    '<HTML>',
    '<HEAD>',
    '<TITLE>STIX Fonts Unicode Block Table of Contents</TITLE>',
    '<STYLE TYPE="text/css">',
    '  .tlabel {background: #CCCCCC; text-align: center; font-size: 80%; padding:1px 2px}',
    '  .llabel {text-align: right}',
    '  .space  {width: 2px}',
    '  .hspace {height: 2px}',
    '  .blank  {}',
    '  .count  {background: #F0F0F0; padding: 3px}',
    '  .tcount {background: #E4E4E4; padding: 3px}',
    '  .bold   {font-weight: bold}',
    '  .italic {font-style: italic}',
    '  A {text-decoration: none}',
    '</STYLE>',
    '</HEAD>',
    '<BODY>',
    '<CENTER>',
    '<TABLE BORDER="0" CELLSPACING="2" CELLPADDING="0">',
    '<TR ALIGN="CENTER"><TD></TD><TD></TD><TD COLSPAN="35">',
    '<H1>STIX Fonts Unicode Block<BR>Table of Contents</H1>',
    '</TD></TR>',
  );

  my @names = ('General','Integrals','IntegralsUp','NonUnicode','Size<I>n</I>Symbols','Variants','All');
  my @rows  = (2,1,0,2,1,2,3); my @columns = (4,4,6,4,9,2,1);
  my $rows = scalar(@ranges) + 6;

  print HTML "<TR>\n";
  print HTML '<TD CLASS="blank" ROWSPAN="4"></TD>',"\n";
  foreach my $i (0..$#names) {
    print HTML '<TD CLASS="space" ROWSPAN="',$rows,'"></TD>',"\n" if $rows[$i];
    print HTML '<TD CLASS="tlabel"',
      ($rows[$i] > 1 ? ' ROWSPAN="'.$rows[$i].'"' : ''),
      ($columns[$i] > 1 ? ' COLSPAN="'.$columns[$i].'"' : ''),
	'>',$names[$i],'</TD>',"\n";
  }
  print HTML "</TR>\n";

  print HTML "<TR>\n";
  foreach my $name ('Display','Small','','Display','Small','1','2','3','4','5')
    {print HTML '<TD CLASS="tlabel"',($name eq '5' ? '' : ' COLSPAN="2"'),'>',$name,'</TD>',"\n"}
  print HTML "</TR>\n";

  print HTML "<TR>\n";
  foreach my $name ('','B','BI','I','','B','','B','','B','','B','','B',
		    '','B','BI','I','','B','','B','','B','','B','','','B') {
    print HTML '<TD CLASS="tlabel',
      ($name =~ m/B/ ? ' bold' : ''),
      ($name =~ m/I/ ? ' italic' : ''),'">',$name,'</TD>',"\n";
  }
  print HTML "</TR>\n";

  print HTML '<TR><TD CLASS="hspace"></TD></TR>',"\n";

  foreach my $range (@ranges) {
    my ($name,$start,$end) = @{$range};
    next unless $frcount{STIXAll}{$name};
    my $file = sprintf("/%04X-%04X.html",$start,$end);
    print HTML '<TR ALIGN="RIGHT">',"\n";
    print HTML '<TD CLASS="llabel">',$name,'</TD>',"\n";
    foreach my $font (@fonts) {
      print HTML '<TD CLASS="count">',
	  ($frcount{$font}{$name} ? '<A HREF="'.substr($font,4).$file.'">'.$frcount{$font}{$name}.'</A>' : ''),
        '</TD>',"\n";
    }
    print HTML '<TD CLASS="tcount"><A HREF="All',$file,'">',$frcount{STIXAll}{$name},'</A></TD>';
    print HTML "</TR>\n";
  }

  print HTML '<TR><TD CLASS="hspace"></TD></TR>',"\n";
  print HTML '<TR ALIGN="RIGHT">',"\n";
  print HTML '<TD CLASS="llabel">All</TD>',"\n";
  foreach my $font (@fonts,"STIXAll") {
    print HTML '<TD CLASS="tcount"><A HREF="',substr($font,4),'/All.html">',$count{$font},'</A></TD>',"\n"

  }
  print HTML "</TR>\n";

  PrintHTML(
    '</CENTER>',
    '</BODY>',
    '</HTML>',
  );

  close(HTML);
}

sub PrintFullTable {
  my $i = shift; my $FONT = ($i ne '' ? $fonts[$i] : '');
  my $dir = "STIX/".(substr($FONT,4) || "All");
  my $file = "$dir/All.html";
  mkdir "STIX" unless -d "STIX";
  mkdir $dir unless -d $dir;
  open(HTML,">",$file);
  MakeHeader($FONT);
  PrintHTML(@HEADER);
  foreach my $j (0..$#ranges) {PrintRange($i,$j)}
  PrintNavigation($i,'');
  PrintHTML(@FOOTER);
  close(HTML);
}

sub PrintRangeTable {
  my $i = shift; my $j = shift;
  my $FONT = ($i ne '' ? $fonts[$i] : '');
  my ($name,$start,$end) = @{$ranges[$j]};
  return if $frcount{($i eq '' ? "STIXAll" : $FONT)}{$name} == 0;
  my $chars = sprintf("%04X-%04X",$start,$end);
  my $dir = "STIX/".($FONT ? substr($FONT,4) : "All");
  my $file = "$dir/$chars.html";
  mkdir "STIX" unless -d "STIX";
  mkdir $dir unless -d $dir;
  open(HTML,">",$file);
  MakeHeader($FONT," ($chars)");
  PrintHTML(@HEADER);
  PrintRange($i,$j);
  PrintNavigation($i,$j);
  PrintHTML(@FOOTER);
  close(HTML);
}

sub PrintRange {
  my $i = shift; my $j = shift;
  my $FONT = ($i ne '' ? $fonts[$i] : '');
  my ($name,$start,$end) = @{$ranges[$j]};
  return if $frcount{($i eq '' ? "STIXAll" : $FONT)}{$name} == 0;
  PrintHTML(@TABLEstart);
  print HTML sprintf("%s: %04X - %04X",$name,$start,$end);
  PrintHTML(@TABLEhead);
  while ($start < $end && !defined($CHAR{sprintf("%05X",$start)})) {$start++}
  while ($end > $start && !defined($CHAR{sprintf("%05X",$end)})) {$end--}
  foreach my $row (int($start/0x10)..int($end/0x10))
    {PrintRow($FONT,$row,(($name =~ m/Combining/i) ? 'a' : ''))}
  PrintHTML(@TABLEfoot);
}

sub PrintRow {
  my $FONT = shift; my $row = shift;
  my $combine = shift;  $combine = '<SPAN CLASS="combine">'.$combine.'</SPAN>' if $combine;
  my $r = sprintf("%03X",$row); $row *= 0x10;
  PrintHTML(@ROWstart);
  print HTML '<TD CLASS="label">'.$r.'</TD><TD CLASS="space""></TD>',"\n";
  foreach my $i (0x00..0x0F) {
    my $c = sprintf("%05X",$row+$i);
    if (defined($CHAR{$c})) {
      my $title = $CHARNAME{$c}." (".sprintf("0x%X",$row+$i).")";
      if ($FONT) {
        if ($CHAR{$c}{$FONT}) {
	  print HTML '<TD CLASS="STIX '.$FONT.'" TITLE="'.$title.'">'.$combine.'&#x'.$c.';'.$combine.'</TD>'."\n";
        } else {
	  print HTML '<TD CLASS="other" TITLE="'.$title.'">&nbsp;</TD>'."\n";
        }
      } else {
	print HTML '<TD CLASS="STIX" VALIGN="TOP">';
	foreach my $font (sort byName (keys %{$CHAR{$c}})) {
	  print HTML '<SPAN CLASS="'.$font.'" TITLE="'.$title." ".$font.'">'.
                         $combine.'&#x'.$c.';'.$combine.'</SPAN><BR>';
	}
	print HTML '</TD>'."\n";
      }
    } else {
      print HTML '<TD CLASS="NA">&nbsp;</TD>'."\n";
    }
    print HTML '<TD CLASS="space"></TD>'."\n" if $i == 7;
  }
  PrintHTML(@ROWend);
}

sub PrintNavigation {
  my $i = shift; my $j = shift;
  my $FONT = ($i ne '' ? $fonts[$i] : 'STIXAll');
  my ($name,$start,$end) = ($j ne '' ? @{$ranges[$j]} : ('STIXAll',0,0));
  my ($pfont,$nfont,$prange,$nrange);
  my ($pi,$ni,$pj,$nj);

  if ($i ne "") {
    ($pi,$ni) = ($i-1,$i+1); ($pfont,$nfont) = ($fonts[$pi],$fonts[$ni]);
    while ($j && $ni <= $#fonts && $frcount{$nfont}{$name} == 0) {$nfont = $fonts[++$ni]}
  } else {
    $pi = $#fonts; $pfont = $fonts[$#fonts]; $ni = 0; $nfont = "";
  }
  while ($j && $pi >= 0 && $frcount{$pfont}{$name} == 0) {$pfont = $fonts[--$pi]}
  $pfont = "" if $pi < 0; $nfont = "STIXAll" if $ni > $#fonts;
  $pfont = substr($pfont,4); $nfont = substr($nfont,4);
  my $pfurl = "../".$pfont.($j ne '' ? sprintf("/%04X-%04X.html",$start,$end) : '/All.html');
  my $nfurl = "../".$nfont.($j ne '' ? sprintf("/%04X-%04X.html",$start,$end) : '/All.html');

  if ($j ne "") {
    ($pj,$nj) = ($j-1,$j+1); ($prange,$nrange) = ($ranges[$pj],$ranges[$nj]);
    while ($nj <= $#ranges && $frcount{$FONT}{$nrange->[0]} == 0) {$nrange = $ranges[++$nj]}
  } else {
    $pj = $#ranges; $prange = $ranges[$pj]; $nj = 0; $nrange = ['',0,0];
  }
  while ($pj >= 0 && $frcount{$FONT}{$prange->[0]} == 0) {$prange = $ranges[--$pj]}
  $prange = ['',0,0] if $pj < 0; $nrange = ['All',0,0] if $nj > $#ranges;
  my $prurl = sprintf("%04X-%04X.html",$prange->[1],$prange->[2]);
  my $nrurl = ($nrange->[2] ? sprintf("%04X-%04X.html",$nrange->[1],$nrange->[2]) : "All.html");

  PrintHTML(
    '<DIV CLASS="navigation">',
    '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" STYLE="width:25.75em">',
    '<TR>',
    '<TD COLSPAN="3" ALIGN="CENTER">',
    ($prange->[0] ?
      ('<A CLASS="small" HREF="'.$prurl.'">'.$prange->[0].'</A><BR>'.
       '<SPAN CLASS="tt">/</SPAN><SPAN CLASS="tt">\</SPAN>') : '..'),

    '</TD>', '</TR>', '<TR>',
    '<TD STYLE="width:12em" ALIGN="RIGHT">',
    ($pfont ?
      ('<A CLASS="small" HREF="'.$pfurl.'">'.$pfont.'</A>&nbsp;',
       '<SPAN CLASS="tt">&lt;</SPAN>') : ':'),
    '</TD>',
    '<TD STYLE="width:1.75em" ALIGN="CENTER"><A HREF="../index.html">O</A></TD>',
    '<TD STYLE="width:12em" ALIGN="LEFT">',
    ($nfont ?
      ('<SPAN CLASS="tt">&gt;</SPAN>&nbsp;',
       '<A CLASS="small" HREF="'.$nfurl.'">'.$nfont.'</A>') : ':'),
    '</TD>', '</TR>', '<TR>',
    '<TD COLSPAN="3" ALIGN="CENTER">',
    ($nrange->[0] ?
      ('<SPAN CLASS="tt">\</SPAN><SPAN CLASS="tt">/</SPAN><BR>'.
       '<A CLASS="small" HREF="'.$nrurl.'">'.$nrange->[0].'</A>') :
       '<SPAN STYLE="position:relative"><SPAN STYLE="position:relative; top:-.5em">..</SPAN></SPAN>'),
    '</TD>', '</TR>',
    '</TABLE>',
    '</DIV>',
  );
}

sub PrintHTML {
  print HTML join("\n",@_),"\n";
}

sub PrintAllTables {
  foreach my $font (0..$#fonts) {
    foreach my $range (0..$#ranges) {PrintRangeTable($font,$range)}
    PrintFullTable($font);
  }
  foreach my $range (0..$#ranges) {PrintRangeTable('',$range)}
  PrintFullTable('');
}

GetTableData();
PrintTOC();
PrintAllTables();

1;