#!/usr/bin/perl -CDS

#
# Font proof generator for Tsukurimashou
# Copyright (C) 2011  Matthew Skala
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, version 3.
#
# As a special exception, if you create a document which uses this font, and
# embed this font or unaltered portions of this font into the document, this
# font does not by itself cause the resulting document to be covered by the
# GNU General Public License. This exception does not however invalidate any
# other reasons why the document might be covered by the GNU General Public
# License. If you modify this font, you may extend this exception to your
# version of the font, but you are not obligated to do so. If you do not
# wish to do so, delete this exception statement from your version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Matthew Skala
# http://ansuz.sooke.bc.ca/
# mskala@ansuz.sooke.bc.ca
#

use utf8;

$prefix=$0;
$prefix=~s!/make-proof$!!;

%priority=(
  'preintro'=>100,

  'tsuku-at'=>200,
  'tsuku-bk'=>200,
  'tsuku-kg'=>200,
  'tsuku-mg'=>200,
  'tsuku-mi'=>200,
  'tsuku-tn'=>200,
  'tsuku-ps'=>210,

  'intro'=>300,

  'frac-intro'=>400,
  'latin-intro'=>400,

  'buildkanji'=>800,
  'leftrad'=>800,
  'radical'=>800,
  'toprad'=>800,
  'gradeone'=>801,
  'gradetwo'=>802,
  'gradethree'=>803,
  'gradefour'=>804,
  'gradefive'=>805,
  'gradesix'=>806,
  'gradeseven'=>807,
  'gradeeight'=>808,
  'gradenine'=>809,
  'gradeten'=>810,
  'rare'=>850,
);

%partbefore=(
  100=>'Resources',
  1000=>'U+0000 to U+2FFF',
  1048=>'U+3000 to U+4DFF',
%   1078=>'U+4E00 to U+61FF',
%   1098=>'U+6200 to U+75FF',
  1078=>'U+4E00 to U+75FF',
%   1117=>'U+7600 to U+89FF',
%   1137=>'U+8A00 to U+9FFF',
  1117=>'U+7600 to U+9FFF',
  1247=>'U+A000 to U+10FFFF',
);

while (<$prefix/mp/*.mp>) {
  m!mp/(.*)\.mp!;
  $base=$1;
  if ($base=~/^tsuku-([0-9a-f]{2,3})$/) {
    $pri=1000+hex("0x$1");
    $priority{$base}=$pri;
  } elsif (defined $priority{$base}) {
    $pri=$priority{$base};
  } else {
    $pri=500;
    $priority{$base}=500;
  }
  $filelist{$pri}.="$base\n";
}

$_='';
foreach $key (sort {$a<=>$b} keys %filelist) {
  $_.=$filelist{$key};
}
@files=split("\n",$_);

while (<prf/tsuku-kg-*.prf>) {
  next if /-ps/;
  open(PRF,$_);
  while (<PRF>) {
    chomp;
    if (/^BEGINGLYPH '(.*)' \d+$/) {
      $glname=$1;
      $glnames{$1}=1;
    } elsif (/^BLOBCENTRE (\d+) (\S+) (\S+)$/) {
      $kg_blob{$glname}{$1}=sprintf('%.04f,%.04f',$2/100,$3/100);
    } elsif (/^SEGMENT (\d+) (\S+) (\S+)$/) {
      $prev=-1;
      for ($i=$2;;$i=int($i+1)) {
        $i=$3 if $i>$3;
        $kg_segment{$glname}{$1*1000+$prev}=$1*1000+$i if $prev>=0;
        last if $i==$3;
        $prev=$i;
      }
    } elsif (/^POINT (\d+) (\S+) (\S+) (\S+)$/) {
      $kg_points{$glname}{1000*$1+$2}=sprintf('%.04f,%.04f',$3/100,$4/100);
      $any_points{$glname}{1000*$1+$2}=1;
    } elsif (/^PBOX (\d+) ((\S+ ){8}'.+')$/) {
      $pboxes{$glname}.="$2\n";
    } elsif (/^SERIF (\S+) (\S+)/) {
      # ignore for Kaku
    } elsif (/^ENDGLYPH (\S+) (\S+)$/) {
      $leftside{$glname}=$1/100;
      $rightside{$glname}=$2/100;
    } else {
      print STDERR "Bad line in proof file: $_\n";
    }
  }
  close(PRF);
}

while (<prf/tsuku-mi-*.prf>) {
  next if /-ps/;
  open(PRF,$_);
  while (<PRF>) {
    chomp;
    if (/^BEGINGLYPH '(.*)' \d+$/) {
      $glname=$1;
      $glnames{$1}=1;
    } elsif (/^BLOBCENTRE (\d+) (\S+) (\S+)$/) {
      $mi_blob{$glname}{$1}=sprintf('%.04f,%.04f',$2/100,$3/100);
    } elsif (/^SEGMENT (\d+) (\S+) (\S+)$/) {
      $prev=-1;
      for ($i=$2;;$i=int($i+1)) {
        $i=$3 if $i>$3;
        $mi_segment{$glname}{$1*1000+$prev}=$1*1000+$i if $prev>=0;
        last if $i==$3;
        $prev=$i;
      }
    } elsif (/^POINT (\d+) (\S+) (\S+) (\S+)$/) {
      $mi_points{$glname}{1000*$1+$2}=sprintf('%.04f,%.04f',$3/100,$4/100);
      $any_points{$glname}{1000*$1+$2}=1;
    } elsif (/^PBOX (\d+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) '(.+)'$/) {
      # ignore for Mincho
    } elsif (/^SERIF (\S+) (\S+),(\S+)/) {
      $mi_serif{$glname}{sprintf('%.03f,%.03f',$2/100,$3/100)}=$1;
    } elsif (/^ENDGLYPH (\S+) (\S+)$/) {
      $leftside{$glname}=$1/100;
      $rightside{$glname}=$2/100;
    } else {
      print STDERR "Bad line in proof file: $_\n";
    }
  }
  close(PRF);
}

foreach $glyph (keys %glnames) {
  $xpicture='';
  $bpicture='';
  $lpicture='';
  $ppicture='';
  foreach $_ (split("\n",$pboxes{$glyph})) {
    s/'//g;
    s/_/\\_/g;
    @x=split(/ /);
    $x=pop @x;
    $xpicture.=("\\PBx{$x}{".join('}{',map {sprintf('%.04f',$_/100)} @x)."}");
  }
  foreach $blob (sort {$a<=>$b} keys %{$kg_blob{$glyph}}) {
    $blwide=$blob;
    $blwide=~tr/0123456789/０１２３４５６７８９/ if length($blwide)==1;
    if ($kg_blob{$glyph}{$blob} eq $mi_blob{$glyph}{$blob}) {
      $bpicture.="\\BBl{$kg_blob{$glyph}{$blob}}{$blwide}";
    } else {
      $bpicture.="\\Lkr{$kg_blob{$glyph}{$blob}}{$mi_blob{$glyph}{$blob}}";
      $bpicture.="\\KBl{$kg_blob{$glyph}{$blob}}{$blwide}";
      $bpicture.="\\MBl{$mi_blob{$glyph}{$blob}}{$blwide}";
    }
  }
  foreach $idx (sort {$a<=>$b} keys %{$any_points{$glyph}}) {
    $idwide=int($idx/1000);
    $idwide=~tr/0123456789/０１２３４５６７８９/ if length($idwide)==1;
    if ((defined $kg_points{$glyph}{$idx})
     && (defined $mi_points{$glyph}{$idx})) {
      if ($kg_points{$glyph}{$idx} eq $mi_points{$glyph}{$idx}) {
        $ppicture.="\\BPt{$kg_points{$glyph}{$idx}}{$idwide}";
      } else {
        $ppicture.="\\Lkr{$kg_points{$glyph}{$idx}}{$mi_points{$glyph}{$idx}}";
        $ppicture.="\\KPt{$kg_points{$glyph}{$idx}}{$idwide}";
        $ppicture.="\\MPt{$mi_points{$glyph}{$idx}}{$idwide}";
      }
      if ((defined $kg_segment{$glyph}{$idx})
       && (defined $mi_segment{$glyph}{$idx})
       && ($kg_segment{$glyph}{$idx} eq $mi_segment{$glyph}{$idx})
       && ($kg_points{$glyph}{$idx}
        eq $mi_points{$glyph}{$idx})
       && ($kg_points{$glyph}{$kg_segment{$glyph}{$idx}}
        eq $mi_points{$glyph}{$mi_segment{$glyph}{$idx}})) {
        $lpicture.=("\\BSg{$kg_points{$glyph}{$idx}}"
                   ."{$kg_points{$glyph}{$kg_segment{$glyph}{$idx}}}");
      } else {
        if (defined $kg_segment{$glyph}{$idx}) {
          $lpicture.=("\\KSg{$kg_points{$glyph}{$idx}}"
                     ."{$kg_points{$glyph}{$kg_segment{$glyph}{$idx}}}");
        }
        if (defined $mi_segment{$glyph}{$idx}) {
          $lpicture.=("\\MSg{$mi_points{$glyph}{$idx}}"
                     ."{$mi_points{$glyph}{$mi_segment{$glyph}{$idx}}}");
        }
      }
    } else {
      if (defined $kg_points{$glyph}{$idx}) {
        $bpicture.="\\KPt{$kg_points{$glyph}{$idx}}{$idwide}";
        if (defined $kg_segment{$glyph}{$idx}) {
          $lpicture.=("\\KSg{$kg_points{$glyph}{$idx}}"
                     ."{$kg_points{$glyph}{$kg_segment{$glyph}{$idx}}}");
        }
      }
      if (defined $mi_points{$glyph}{$idx}) {
        $bpicture.="\\MPt{$mi_points{$glyph}{$idx}}{$idwide}";
        if (defined $mi_segment{$glyph}{$idx}) {
          $lpicture.=("\\MSg{$mi_points{$glyph}{$idx}}"
                     ."{$mi_points{$glyph}{$mi_segment{$glyph}{$idx}}}");
        }
      }
    }
    foreach $coords (sort {$a<=>$b} keys %{$mi_serif{$glyph}}) {
      $serifwide=$mi_serif{$glyph}{$coords};
      $serifwide=~tr/0123456789/０１２３４５６７８９/;
      $lpicture.="\\Srf{$coords}{$serifwide}";
    }
  }
  $picture{$glyph}=$xpicture.$lpicture.$bpicture.$ppicture;
}

%deflbls=();
$nxtlbl='aaa';
foreach $file (@files) {
  $page=hex("0x$1") if $file=~/^tsuku-([0-9a-f]+)$/;
  open(MP,"$prefix/mp/$file.mp");
  $state=4;
  while (<MP>) {
    chomp;
    $state++;
    if (/^(var)?def\s+([a-z0-9_\.]+)\b/ && !defined $deflbls{$2}) {
      $deflbls{$2}="md:$nxtlbl";
      $nxtlbl++;
    }
    if (/^\s*begintsuglyph\("(.*)",(\d+)\);$/) {
      $cname=$1;
      $state=0;
      $codepoint{$1}=($page<<8)+$2;
    }
    if ($state==1) {
      if (/^\s+(tsu_curve\.[a-z0-9\_\.]+);$/) {
        $mname=$1;
      } else {
        $state=4;
      }
    }
    $state=4 if ($state==2) && !/^\s+tsu_render;$/;
    if ($state==3) {
      if (/^\s*endtsuglyph;$/ &&
          (($rightside{$cname}>6) || !defined $moved_picture{$mname})) {
        delete $moved_picture{$moved_picture{$mname}}
          if defined $moved_picture{$mname};
        $moved_picture{$mname}=$cname;
        $moved_picture{$cname}=$mname;
      }
    }
  }
  close(MP);
}

print "% GENERATED FILE - edit the source in make-proof instead!\n\n";

$partarab=1;

foreach $file (@files) {
  $newsubsec='';
  if (defined $partbefore{$priority{$file}}) {
    print "\n\\fi\n\n" if $partarab!=1;
    print "\n\\FileGroup{$partbefore{$priority{$file}}}{$partarab}\n";
    print "\\def\\tmpmac{$partarab}\\ifx\\tmpmac\\partarab\\relax\n\n";
    $partarab++;
  }
  print "\\File{$file.mp}\n\n";
  if ($file=~/-([0-9a-f]+)/) {
    $page=$1;
    $page=~tr/a-f/A-F/;
    $pnum=hex("0x$page");
  }
  open(MP,"$prefix/mp/$file.mp");
  $lineno=0;
  $firstblank=-1;
  while (<MP>) {
    chomp;
    $lineno++;
    
    if (/^begintsuglyph\("(.*)",(\d+)\)/) {
      if (!defined $moved_picture{$1}) {
        printf "\n\\Picture{%s}{%s%02X}",$1,$page,$2;
        if ($pnum>=256) {
          printf "{%c}{%d}{%d}%%\n  {%s}\n\n",
            ($pnum<<8)+$2,$leftside{$1},$rightside{$1},$picture{$1};
        } else {
          printf "{\\char\"%04X}{%d}{%d}%%\n  {%s}\n\n",
            ($pnum<<8)+$2,$leftside{$1},$rightside{$1},$picture{$1};
        }
      }
    }
    if (/^make_hexagram\((\d+),/) {
      printf "\n\\Picture{iching%02d}{%s%02X}",$1,$page,191+$1;
      printf "{\\char\"%04X}{%d}{%d}%%\n  {%s}\n\n",
        ($pnum<<8)+191+$1,0,10,$picture{sprintf('iching%02d',$1)};
    }
    if (/^vardef ([a-z0-9\_\.]+) =/ && defined $moved_picture{$1}) {
      $mp=$moved_picture{$1};
      if ($codepoint{$mp}>=0x10000) {
        printf "\n\\Picture{%s}{%04X}{%c}{%d}{%d}%%\n  {%s}\n\n",
          $mp,$codepoint{$mp},$codepoint{$mp},$leftside{$mp},
          $rightside{$mp},$picture{$mp};
      } else {
        printf "\n\\Picture{%s}{%04X}{\\char\"%04X}{%d}{%d}%%\n  {%s}\n\n",
          $mp,$codepoint{$mp},$codepoint{$mp},$leftside{$mp},
          $rightside{$mp},$picture{$mp};
      }
    }
    
    if (!/^%/) {
      if ($comments=~
          /\\Comment\{\d+\}\{\ This\ program\ is\ free\ software:.*
           \\Comment\{\d+\}\{\ mskala\@ansuz\.sooke\.bc\.ca\}\n
           \\Comment\{\d+\}\{\}/sx) {
        if ($seen_copyright_flag) {
          $comments=~
          s/\\Comment\{(\d+)\}\{\ This\ program\ is\ free\ software:[^}]+\}.*
            \\Comment\{\d+\}\{\ mskala\@ansuz\.sooke\.bc\.ca\}\n
            \\Comment\{(\d+)\}\{\}/\\CopyrightNotice{$1}{$2}/sx;
        } else {
          $comments=~
            s/\\Comment\{(\d+)\}\{\ (This\ program\ is\ free\ software):
              ([^}]+)\}
             /\\Comment\{$1\}\{\ \\hypertarget\{cpynotice\}\{$2\}:$3\}/sx;
          $seen_copyright_flag=1;
        }
      }
      if ($newsubsec ne '') {
        print "\\Subhead{$newsubsec}{sh:$newsublbl}\n";
        $newsubsec='';
      }
      print $comments;
      $comments='';
    }
    if (/\S/) {
      if ($firstblank>0) {
        if ($firstblank<$lastblank) {
          print "\\BlankLines{$firstblank}{$lastblank}\n";
        } else {
          print "\\BlankLine{$firstblank}\n";
        }
        $firstblank=-1;
      }
    }

    if (!/\S/) {
      $firstblank=$lineno unless $firstblank>0;
      $lastblank=$lineno;
      next;
    }
    if (/^%{20,}$/) {
      print "\\PercentLine{$lineno}\n";
      next;
    }
    if (/^%(.*)$/) {
      $_=$1;
      if (/^[ %]*([^%a-z]+?)[ %]*$/ && (length($1)>2) &&
        ($1 ne 'AUTODEPS') && !/^\s*BACKGROUND /) {
        $newsubsec=$1;
        $newsubsec=~s/\b([A-Z]+)\b/ucfirst(lc($1))/ge;
        $newsublbl=$nxtlbl;
        $nxtlbl++;
      }
      s/\\/\\textbackslash{}/g;
      s/_/\\_/g;
      s/%/\\%/g;
      s/#/\\#/g;
      s/&/\\&/g;
      s/\{/\\{/g;
      s/\}/\\}/g;
      $comments.="\\Comment{$lineno}{$_}\n";
      next;
    }
    
    if ($newsubsec ne '') {
    }
    
    s/\\/\\textbackslash{}/g;
    s/%/\\%/g;
    s/#/\\#/g;
    s/&/\\&/g;
    s/\{/\\{/g;
    s/\}/\\}/g;
    if (/^((var)?def ([a-z0-9_\.]+))\b/ && !defined $linked{$3}) {
      $linked{$3}=1;
      s/def ([a-z0-9_\.]+)\b/defined($deflbls{$1})?
        "def \\phantomsection\\label{$deflbls{$1}}$1":"def $1"/ge;
    } else {
      s/\b([a-z0-9_\.]+)\b/
        defined($deflbls{$1})?"\\hyperref[$deflbls{$1}]{$1}":$1/ge;
    }
    s/_/\\_/g;
    s/^( +)/"~"x(length($1))/e;
    if (/begintsuglyph\}?\("(.*)",\d+\)/ && defined $moved_picture{$1}) {
      $_.="\\IlR{$deflbls{$moved_picture{$1}}}";
    }
    print "\\CodeLine{$lineno}{$_}\n";
  }
  print "\n";
  close(MP);
}

print "\\fi\n\n" if $partarab!=1;
