%%% ====================================================================
%%%  @TeX-file{
%%%     author          = "Alan Jeffrey",
%%%     version         = "0.02",
%%%     date            = "04 February 1993",
%%%     time            = "12:36:16 GMT",
%%%     filename        = "vpltool.tex",
%%%     address         = "School of Cognitive and Computing Sciences
%%%                        University of Sussex
%%%                        Brighton BN1 9QH
%%%                        UK",
%%%     telephone       = "+44 273 606755 x 3238",
%%%     FAX             = "+44 273 678188",
%%%     checksum        = "31660 604 1746 19663",
%%%     email           = "alanje@cogs.sussex.ac.uk",
%%%     codetable       = "ISO/ASCII",
%%%     keywords        = "vpl, vf, virtual fonts, TeX",
%%%     supported       = "no",
%%%     abstract        = "This is a simpler parser for virtual fonts,
%%%                        which I wrote as a possible VPL tool, until
%%%                        I ran it and discovered how slow it was!
%%%                        If anyone wants to maintain this file,
%%%                        you're welcome to it...",
%%%     docstring       = "The checksum field above contains a CRC-16
%%%                        checksum as the first value, followed by the
%%%                        equivalent of the standard UNIX wc (word
%%%                        count) utility output of lines, words, and
%%%                        characters.  This is produced by Robert
%%%                        Solovay's checksum utility.",
%%%     package         = "stands alone",
%%%     dependencies    = "none",
%%%  }
%%% ====================================================================

% 30 Jan 1992, v0.01: Wrote the parser, ran it, discovered how slow it
%    was, gave up.
%
% 4 Feb 1992, v0.02: Commented the code.  Added the MAPFONT command,
%    and in doing so discovered that spaces are important in
%    vptovf---if you say ( MAPFONT D 0 ptmr ) then it maps font 0 to
%    `ptmr ' which causes all sorts of problems!  I fixed this by
%    writing every string as ( foo), yuk!  Sent it out to the world.

% Copyright 1993 Alan Jeffrey.

% This is a simpler parser for vpl files.  To run it you run tex on
% vpltool (or \input vpltool in your TeX document) then say
%
%    \parsevpl{FILENAME.vpl}
%
% to parse the file FILENAME.vpl.  This parses the vpl file and sets
% the following TeX variables:
%
%    \vtitle (token list)
%    \checksum (counter)
%    \designsize (dimension)
%    \designunits (dimension)
%    \codingscheme (token list)
%    \family (token list)
%    \face (counter)
%    \sevenbitsafeflag (token list)
%    \boundarychar (counter)
%    \mapfont (token list)
%
% In addition, for each character number X, there is a command
% \character-X which sets the following variables:
%
%    \charht (dimension)
%    \chardp (dimension)
%    \charwd (dimension)
%    \charic (dimension)
%    \nextlarger (counter)
%    \varchar (token list)
%    \map (token list)
%
% These can be set by saying:
%
%    \character{X}
%       ... read and write the above variables ...
%    \endcharacter
%
% The ligtable is kept as a linked list.  To insert some ligtable
% entries for character number X, say:
%
%    \currligtable{D X}
%
% Then to add a new ligature entry, say:
%
%    \snocligtable{LIGTABLE COMMAND}
%
% For example, to add a -0.1 kern between A and V you could say:
%
%    \currligtable{D 65} \snocligtable{KRN C V R -0.1}
%
% When you make a new \currligtable entry, it is placed at the end of
% the list.  If you reuse a \currligtable entry, its position will not
% change.  For example:
%
%    \currligtable{D 65} \snocligtable{KRN C V R -0.1}
%    \currligtable{D 86} \snocligtable{KRN C A R -0.1}
%    \currligtable{D 65} \snocligtable{KRN C v R -0.1}
%
% will produce a ligtable containing:
%
%    (LABEL D 65)
%    (KRN C V R -0.1)
%    (KRN C v R -0.1)
%    (LABEL D 86)
%    (KRN C A R -0.1)
%
% I've not done any error checking to make sure you can't declare
% diffent kern entries for the same pair, or to make sure that
% LIGTABLE and VARCHAR entries don't exist for the same character.
%
% Once you've set all of those variables, you can write out a vpl file
% by saying \writevpl{FILENAME.vpl}.  For example, to merge two
% vpl files, you can say:
%
%    \parsevpl{first.vpl} \parsevpl{second.vpl} \writevpl{result.vpl}
%
% And that's it...
%
% As I said, I doubt I'll use this much since it's soooo slow, but if
% anyone wants to do anything with it, drop me a line!
%
% I'm afraid most of this code is uncommented.  Good luck trying to
% use it!
%
% BUGS
%
% MAPFONT should be more flexible than just a token string.
%
% You are only allowed 22 FONTDIMENs.
%
% The string (COMMENT ...) is not allowed everywhere.
%
% IT'S SLOW!
%
% Alan Jeffrey.

\def\character#1{\currchar#1
   \charht0pt \chardp0pt \charwd0pt \charic0pt
   \nextlarger-1 \varchar{} \map{}
   \csname character-\the\currchar\endcsname}

\def\xcs#1#2{\expandafter#1\csname#2\endcsname}

% WORD LEVEL
%
% Commands:
%
%    \parsefile{FILE}
%    \endparse
%    \defletter{L}{COMMANDS}
%    \getword
%    \eofword
%
% For example if you say:
%
%    \defletter{`\(}{\wordsep(\wordsep}
%    \defletter{`\)}{\wordsep)\wordsep}
%    \defletter{`\ }{\wordsep}
%    \defletter{`\^^M}{\wordsep}
%
% and afile contains:
%
%    (HELLO WORLD)
%
% then \parsefile{afile} followed by some \getword's will give:
%
%    \currword -> (
%    \currword -> HELLO
%    \currword -> WORLD
%    \currword -> )
%    \currword -> \eofword
%
% For simplicity, I assume that the settings of \defletter are
% static.

% Variables:

\newtoks\atoks
\newtoks\deflettertoks
\newread\parsefileread

\def\currlist{}
\def\emptylist{}

% Commands:

\def\parsefile#1{\openin\parsefileread #1\relax}

\def\endparse{\closein\parsefileread}

\def\defletter#1#2{\deflettertoks
   \expandafter{\the\deflettertoks\activate{#1}{#2}}}
\def\activate#1#2{\catcode#1=\active
   \uccode`\~=#1 \uppercase{\def~}{#2}}

\def\wordsep{\iffalse{\fi}\do{\iffalse}\fi}

\def\eofword{\eofword}

\def\getlist{{\the\deflettertoks
   \ifeof\parsefileread
      \global\def\currlist{\do\eofword}\else
      \global\read\parsefileread to \currlist
      \def\do{\noexpand\do}\xdef\currlist{\do{\currlist}}\fi}}
\def\getelement{\ifx\currlist\emptylist\getlist\fi
   \headandtail\currword\currlist}
\def\getword{\getelement
   \ifx\currword\emptylist\expandafter\getword\fi}

\def\headandtail#1#2{\def\do##1{\gdef#1{##1}\let\do\gobble}#2
   \def\do##1##2\od{\gdef#2{##2}}#2\od}
\def\gobble#1{}

% TYPE LEVEL
%
% Commands:
%
%    \fail
%    \error{MESSAGE}
%    \switch
%       \case{WORD} ... \break
%       ...
%       \case{WORD} ... \break
%       \default ...
%    \endswitch
%
% For example, to parse the longest parenthesis-matched string in a
% file, and print out the parentheses, say:
%
% \def\paren{\switch
%    \case{(} \message{(} \paren \message {)} \word{)} \paren \break
%    \case{)} \fail \break
%    \case{\eofword} \break
%    \default \getword \paren
% \endswitch}
%
% The command \word{WORD} is an abbreviation for:
%
% \def\word#1{\switch
%    \case{#1} \break
%    \default \error{I was expecting #1 not \currword.}
% \endswitch}

\newif\ifsuccess
\successtrue

\def\first#1#2{#1}
\def\second#1#2{#2}

\let\fail\successfalse

\let\switch\relax

\def\case#1#2\break#3\endswitch{\ifsuccess\getword\successfalse\fi
   \def\temp{#1}\ifx\temp\currword\expandafter\first
   \else\expandafter\second
   \fi{\successtrue#2}{#3\endswitch}}

\def\default#1\endswitch{\successtrue#1}

\def\word#1{\switch
   \case{#1} \break
   \default \errmessage{I was expecting #1 not \currword}
\endswitch}

% VPL LEVEL
%
% Command: \parsevpl{FILE}

\defletter{`\ }{\wordsep}
\defletter{`\^^M}{\wordsep}
\defletter{`\(}{\wordsep(\wordsep}
\defletter{`\)}{\wordsep)\wordsep}

\newcount\currcount
\newdimen\currdimen
\newtoks\currtoks

\def\today{\number\day\space \ifcase\month\or
 January\or February\or March\or April\or May\or June\or
 July\or August\or September\or October\or November\or December\fi
 \space\number\year}

\edef\defaultvtitle{Generated with `tex \jobname' on \today.}

\newtoks\vtitle            \vtitle\expandafter{\defaultvtitle}
\newcount\checksum         \checksum 0
\newdimen\designsize       \designsize 10pt
\newdimen\designunits      \designunits 1pt
\newtoks\codingscheme      \codingscheme {UNSPECIFIED}
\newtoks\family            \family{UNSPECIFIED}
\newcount\face             \face 0
\newtoks\sevenbitsafeflag  \sevenbitsafeflag{FALSE}
\newcount\boundarychar     \boundarychar0
\newtoks\mapfont           \mapfont{}

\newcount\currchar
\newdimen\charht
\newdimen\charwd
\newdimen\chardp
\newdimen\charic
\newcount\nextlarger
\newtoks\varchar
\newtoks\map

\def\character#1{\currchar#1
   \charht0pt \chardp0pt \charwd0pt \charic0pt
   \nextlarger-1 \varchar{} \map{}
   \csname character-\the\currchar\endcsname}
\def\endcharacter{\xcs\edef{character-\the\currchar}{
   \noexpand\charht\the\charht
   \noexpand\chardp\the\chardp
   \noexpand\charwd\the\charwd
   \noexpand\charic\the\charic
   \noexpand\nextlarger\the\nextlarger
   \noexpand\varchar{\the\varchar}
   \noexpand\map{\the\map}
}}

\def\fontdimen#1{\csname fontdimen-#1\endcsname}
\expandafter\newdimen\csname fontdimen-1\endcsname
\expandafter\newdimen\csname fontdimen-2\endcsname
\expandafter\newdimen\csname fontdimen-3\endcsname
\expandafter\newdimen\csname fontdimen-4\endcsname
\expandafter\newdimen\csname fontdimen-5\endcsname
\expandafter\newdimen\csname fontdimen-6\endcsname
\expandafter\newdimen\csname fontdimen-7\endcsname
\expandafter\newdimen\csname fontdimen-8\endcsname
\expandafter\newdimen\csname fontdimen-9\endcsname
\expandafter\newdimen\csname fontdimen-10\endcsname
\expandafter\newdimen\csname fontdimen-11\endcsname
\expandafter\newdimen\csname fontdimen-12\endcsname
\expandafter\newdimen\csname fontdimen-13\endcsname
\expandafter\newdimen\csname fontdimen-14\endcsname
\expandafter\newdimen\csname fontdimen-15\endcsname
\expandafter\newdimen\csname fontdimen-16\endcsname
\expandafter\newdimen\csname fontdimen-17\endcsname
\expandafter\newdimen\csname fontdimen-18\endcsname
\expandafter\newdimen\csname fontdimen-19\endcsname
\expandafter\newdimen\csname fontdimen-20\endcsname
\expandafter\newdimen\csname fontdimen-21\endcsname
\expandafter\newdimen\csname fontdimen-22\endcsname

\def\parsevpl#1{\message{(Parsing #1}
   \parsefile{#1} \getvplfile \endparse \message{)}}

\def\getvplfile{\switch
   \case{(} \getvplcommand \word{)} \getvplfile \break
   \case{\eofword} \break
   \default \errmessage{I was expecting ( not \currword}
\endswitch}

\def\getvplcommand{\switch
   \case{CHARACTER} \getinteger \message{(\the\currcount)}
      \character\currcount \getcharacter \endcharacter \break
   \case{COMMENT} \getstring \break
   \case{VTITLE} \getstring \break
   \case{CHECKSUM} \getinteger \checksum\currcount \break
   \case{DESIGNSIZE} \getreal \designsize\currdimen \break
   \case{DESIGNUNITS} \getreal \designunits\currdimen \break
   \case{CODINGSCHEME} \getstring \codingscheme\currtoks \break
   \case{FAMILY} \getstring \family\currtoks \break
   \case{FACE} \getinteger \face\currcount \break
   \case{SEVENBITSAFEFLAG} \getstring \sevenbitsafeflag\currtoks \break
   \case{BOUNDARYCHAR} \getinteger \boundarychar\currcount \break
   \case{FONTDIMEN} \getfontdimen \break
   \case{LIGTABLE} \getligtable \break
   \case{MAPFONT} \fail \getstring
      \mapfont\expandafter\expandafter\expandafter
         {\expandafter\the\expandafter\mapfont
            \expandafter(\the\currtoks)}
   \break
   \default \errmessage{I was expecting a vpl command not \currword}
\endswitch}

\def\getligtable{\switch
   \case{(} \getligtablecommand \word{)} \getligtable \break
   \case{)} \fail \break
   \default \errmessage{I was expecting ( or ) not \currword}
\endswitch}

\def\getligtablecommand{\switch
   \case{LABEL} \getlabel \break
   \default \fail \getstring \snocligtable{\the\currtoks}
\endswitch}

\def\getlabel{\switch
   \case{BOUNDARYCHAR} \currligtable{BOUNDARYCHAR} \break
   \default \fail \getinteger \currligtable{D \the\currcount}
\endswitch}

\def\currlabel{FIRST}
\xcs\def{next-FIRST}{LAST}
\xcs\def{list-FIRST}{}

\def\snocligtable#1{\def\do{\noexpand\do}
   \xcs\edef{list-\currlabel}{\csname list-\currlabel\endcsname\do{#1}}}

\def\currligtable#1{\message{<#1>}
   \relax\xcs\ifx{list-#1}\relax
      \xcs\def{list-#1}{}
      \xcs\edef{next-#1}{\csname next-\currlabel\endcsname}
      \xcs\edef{next-\currlabel}{#1}
   \fi\edef\currlabel{#1}}

\def\getcharacter{\switch
   \case{(} \getcharactercommand \word{)} \getcharacter \break
   \case{)} \fail \break
   \default \errmessage{I was expecting ( or ) not \currword}
\endswitch}

\def\getcharactercommand{\switch
   \case{CHARWD} \getreal \charwd\currdimen \break
   \case{CHARHT} \getreal \charht\currdimen \break
   \case{CHARDP} \getreal \chardp\currdimen \break
   \case{CHARIC} \getreal \charic\currdimen \break
   \case{NEXTLARGER} \varchar{} \getinteger \nextlarger\currcount \break
   \case{VARCHAR} \nextlarger-1 \getstring \varchar\currtoks \break
   \case{MAP} \getstring \map\currtoks \break
   \case{COMMENT} \getstring \break
   \default \errmessage{I was expecting a CHARACTER command not \currword}
\endswitch}

\def\getfontdimen{\switch
   \case{(} \getfontdimencommand \word{)} \getfontdimen \break
   \case{)} \fail \break
   \default \errmessage{I was expecting ( or ) not \currword}
\endswitch}

\def\getfontdimencommand{\switch
   \case{PARAMETER}     \getinteger \setfontdimen{\the\currcount} \break
   \case{COMMENT}       \getstring        \break
   \case{SLANT}         \setfontdimen{1}  \break
   \case{SPACE}         \setfontdimen{2}  \break
   \case{STRETCH}       \setfontdimen{3}  \break
   \case{SHRINK}        \setfontdimen{4}  \break
   \case{XHEIGHT}       \setfontdimen{5}  \break
   \case{QUAD}          \setfontdimen{6}  \break
   \case{EXTRASPACE}    \setfontdimen{7}  \break
   \case{NUM1}          \setfontdimen{8}  \break
   \case{NUM2}          \setfontdimen{9}  \break
   \case{NUM3}          \setfontdimen{10} \break
   \case{DENOM1}        \setfontdimen{11} \break
   \case{DENOM2}        \setfontdimen{12} \break
   \case{SUP1}          \setfontdimen{13} \break
   \case{SUP2}          \setfontdimen{14} \break
   \case{SUP3}          \setfontdimen{15} \break
   \case{SUB1}          \setfontdimen{16} \break
   \case{SUB2}          \setfontdimen{17} \break
   \case{SUPDROP}       \setfontdimen{18} \break
   \case{SUBDROP}       \setfontdimen{19} \break
   \case{DELIM1}        \setfontdimen{20} \break
   \case{DELIM2}        \setfontdimen{21} \break
   \case{AXISHEIGHT}    \setfontdimen{22} \break
   \case{DEFAULTRULETHICKNESS} \setfontdimen{8} \break
   \case{BIGOPSPACING1} \setfontdimen{9} \break
   \case{BIGOPSPACING2} \setfontdimen{10} \break
   \case{BIGOPSPACING3} \setfontdimen{11} \break
   \case{BIGOPSPACING4} \setfontdimen{12} \break
   \case{BIGOPSPACING5} \setfontdimen{13} \break
   \default \errmessage{I was expecting a font dimen not \currword}
\endswitch}

\def\setfontdimen#1{\getreal \fontdimen{#1}\currdimen}

\def\getreal{\switch
   \case{R} \getword \currdimen=\currword pt \break
   \case{D} \getword \currdimen=\currword pt \break
   \case{O} \getword \currdimen='\currword pt \break
   \case{H} \getword \currdimen="\currword pt \break
   \case{COMMENT} \getstring \break
   \default \currdimen=0 \errmessage{I was expecting a real not \currword}
\endswitch}

\def\getinteger{\switch
   \case{C} \getword \currcount=\xcs`\currword \break
   \case{D} \getword \currcount=\currword \break
   \case{O} \getword \currcount='\currword \break
   \case{H} \getword \currcount="\currword \break
   \case{F} \getfacecode \break
   \case{COMMENT} \getstring \break
   \default \currcount=0 \errmessage{I was expecting an integer not \currword}
\endswitch}

\def\getfacecode{\switch
   \case{MRR} \currcount=0 \break
   \case{MIR} \currcount=1 \break
   \case{BRR} \currcount=2 \break
   \case{BIR} \currcount=3 \break
   \case{LRR} \currcount=4 \break
   \case{LIR} \currcount=5 \break
   \case{MRC} \currcount=6 \break
   \case{MIC} \currcount=7 \break
   \case{BRC} \currcount=8 \break
   \case{BIC} \currcount=9 \break
   \case{LRC} \currcount=10 \break
   \case{LIC} \currcount=11 \break
   \case{MRE} \currcount=12 \break
   \case{BRE} \currcount=13 \break
   \case{BRE} \currcount=14 \break
   \case{BIE} \currcount=15 \break
   \case{LRE} \currcount=16 \break
   \case{LIE} \currcount=17 \break
   \case{COMMENT} \getstring \break
   \default \currcount=0 \errmessage{I was expecting a face not \currword}
\endswitch}

\def\getstring{\currtoks{}\getmorestring}

\def\getmorestring{\switch
   \case{(} \snoctoks\currtoks(
            \getmorestring \word{)}
            \snoctoks\currtoks)
            \getmorestring
            \break
   \case{)} \fail \break
   \default \snoctoks\currtoks{ \currword} \getmorestring
\endswitch}

\def\snoctoks#1#2{\edef\temp{\the#1#2}#1\expandafter{\temp}}

% Writing out a VPL file.

\newwrite\vploutput

\def\writeline#1{\immediate\write\vploutput{#1}}

\def\thereal#1{\expandafter\onlynumber\the#1}
{\catcode`\p=12 \catcode`\t=12 \gdef\onlynumber#1pt{#1}}

\def\writevpl#1{\immediate\openout\vploutput #1
   \writeline {(VTITLE \the\vtitle)}
   \writeline {(CHECKSUM D \the\checksum)}
   \writeline {(DESIGNSIZE R \thereal\designsize)}
   \writeline {(DESIGNUNITS R \thereal\designunits)}
   \writeline {(CODINGSCHEME \the\codingscheme)}
   \writeline {(FAMILY \the\family)}
   \writeline {(FACE D \the\face)}
   \writeline {(SEVENBITSAFEFLAG \the\sevenbitsafeflag)}
   \writeline {(BOUNDARYCHAR D \the\boundarychar)}
   \writeline {\the\mapfont}
   \writefontdimen
   \writeligtable
   \writecharacters
   \immediate\closeout\vploutput
}

\def\writefontdimen{
   \writeline{(FONTDIMEN}
   \currcount=0
   \loop\ifnum\currcount<22
      \advance\currcount by 1
      \ifnum\fontdimen{\the\currcount}=0\else
         \writeline{\space\space\space(PARAMETER D \the\currcount\space
            R \expandafter\thereal\fontdimen{\the\currcount})}\fi
   \repeat
   \writeline{\space\space\space)}
}

\def\writeligtable{
   \writeline{(LIGTABLE}
   \def\currlabel{FIRST}
   \def\lastlabel{LAST}
   \def\do##1{\writeline{\space\space\space(##1)}}
   \writeligcommands
   \writeline{\space\space\space)}}

\def\writeligcommands{
   \xcs\ifx{next-\currlabel}\lastlabel
   \else\edef\currlabel{\csname next-\currlabel\endcsname}
      \writeline{\space\space\space(LABEL \currlabel)}
      \csname list-\currlabel\endcsname
      \expandafter\writeligcommands
   \fi}

\def\writecharacters{
   \currcount=-1
   \loop\ifnum\currcount<255
      \advance\currcount by 1
      \xcs\ifx{character-\the\currcount}\relax\else
         \character\currcount
         \writeline{(CHARACTER D \the\currcount}
         \ifnum\charwd=0\else
             \writeline{\space\space\space(CHARWD R \thereal\charwd)}\fi
         \ifnum\chardp=0\else
            \writeline{\space\space\space(CHARDP R \thereal\chardp)}\fi
         \ifnum\charht=0\else
            \writeline{\space\space\space(CHARHT R \thereal\charht)}\fi
         \ifnum\charic=0\else
            \writeline{\space\space\space(CHARIC R \thereal\charic)}\fi
         \ifnum\nextlarger>0
            \writeline{\space\space\space(NEXTLARGER D \the\nextlarger)}\fi
         \if\relax\the\varchar\relax\else
            \writeline{\space\space\space(VARCHAR \the\varchar)}\fi
         \if\relax\the\map\relax\else
            \writeline{\space\space\space(MAP \the\map)}\fi
         \writeline{\space\space\space)}
   \fi\repeat}


