diff options
Diffstat (limited to 'macros/text1/compugraphics_8600')
20 files changed, 7387 insertions, 0 deletions
diff --git a/macros/text1/compugraphics_8600/et10.textext b/macros/text1/compugraphics_8600/et10.textext new file mode 100644 index 0000000000..5b2e237237 --- /dev/null +++ b/macros/text1/compugraphics_8600/et10.textext @@ -0,0 +1,37 @@ +\font\cgetXrm=etr at 10pt\font\cgetXit=eti at 10pt +\font\cgetXbd=etb at 10pt \font\cgetXmi=mthit at 10pt +\font\cgetXsy=symbola at 10pt \font\cgetXex=ext at 10pt +\font\cgetXbi=etbi at 10pt \font\cgetXtt=elite at 10pt +\font\cgetXcc=etsc at 10pt\font\cgetXmrm=mthrm at 10pt +\expandafter\newdimen\csname\the\naMEtok ilsxet\endcsname +\global\csname\the\naMEtok ilsxet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsxet\endcsname=0pt +\csname\the\naMEtok ilsxet\endcsname=12pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetXrm}% + \def\noexpand\mi{\fam1\cgetXmi}% + \def\noexpand\sy{\fam2\cgetXsy}% + \def\noexpand\ex{\fam3\cgetXex}% + \textfont0=\cgetXmrm \textfont1=\cgetXmi + \textfont2=\cgetXsy \textfont3=\cgetXex + \textfont\itfam=\cgetXit\textfont\bifam=\cgetXbi + \textfont\ttfam=\cgetXtt \textfont\bffam=\cgetXbd + \textfont\ccfam=\cgetXcc + \def\noexpand\bd{\fam\bffam\cgetXbd}% + \def\noexpand\it{\fam\itfam\cgetXit}% + \def\noexpand\bi{\fam\bifam\cgetXbi}% + \def\noexpand\tt{\fam\ttfam\cgetXtt}% + \def\noexpand\cc{\fam\ccfam\cgetXcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsxet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/et11.textext b/macros/text1/compugraphics_8600/et11.textext new file mode 100644 index 0000000000..2cc84b4c7b --- /dev/null +++ b/macros/text1/compugraphics_8600/et11.textext @@ -0,0 +1,37 @@ +\font\cgetXIrm=etr at 11pt\font\cgetXIit=eti at 11pt +\font\cgetXIbd=etb at 11pt \font\cgetXImi=mthit at 11pt +\font\cgetXIsy=symbola at 11pt \font\cgetXIex=ext at 11pt +\font\cgetXIbi=etbi at 11pt \font\cgetXItt=elite at 11pt +\font\cgetXIcc=etsc at 11pt\font\cgetXImrm=mthrm at 11pt +\expandafter\newdimen\csname\the\naMEtok ilsxiet\endcsname +\global\csname\the\naMEtok ilsxiet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsxiet\endcsname=0pt +\csname\the\naMEtok ilsxiet\endcsname=13pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetXIrm}% + \def\noexpand\mi{\fam1\cgetXImi}% + \def\noexpand\sy{\fam2\cgetXIsy}% + \def\noexpand\ex{\fam3\cgetXIex}% + \textfont0=\cgetXImrm \textfont1=\cgetXImi + \textfont2=\cgetXIsy \textfont3=\cgetXIex + \textfont\itfam=\cgetXIit\textfont\bifam=\cgetXIbi + \textfont\ttfam=\cgetXItt \textfont\bffam=\cgetXIbd + \textfont\ccfam=\cgetXIcc + \def\noexpand\bd{\fam\bffam\cgetXIbd}% + \def\noexpand\it{\fam\itfam\cgetXIit}% + \def\noexpand\bi{\fam\bifam\cgetXIbi}% + \def\noexpand\tt{\fam\ttfam\cgetXItt}% + \def\noexpand\cc{\fam\ccfam\cgetXIcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsxiet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/et12.textext b/macros/text1/compugraphics_8600/et12.textext new file mode 100644 index 0000000000..85c9acc6f7 --- /dev/null +++ b/macros/text1/compugraphics_8600/et12.textext @@ -0,0 +1,37 @@ +\font\cgetXIIrm=etr at 12pt\font\cgetXIIit=eti at 12pt +\font\cgetXIIbd=etb at 12pt \font\cgetXIImi=mthit at 12pt +\font\cgetXIIsy=symbola at 12pt \font\cgetXIIex=ext at 12pt +\font\cgetXIIbi=etbi at 12pt \font\cgetXIItt=elite at 12pt +\font\cgetXIIcc=etsc at 12pt\font\cgetXIImrm=mthrm at 12pt +\expandafter\newdimen\csname\the\naMEtok ilsxiiet\endcsname +\global\csname\the\naMEtok ilsxiiet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsxiiet\endcsname=0pt +\csname\the\naMEtok ilsxiiet\endcsname=14pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetXIIrm}% + \def\noexpand\mi{\fam1\cgetXIImi}% + \def\noexpand\sy{\fam2\cgetXIIsy}% + \def\noexpand\ex{\fam3\cgetXIIex}% + \textfont0=\cgetXIImrm \textfont1=\cgetXIImi + \textfont2=\cgetXIIsy \textfont3=\cgetXIIex + \textfont\itfam=\cgetXIIit\textfont\bifam=\cgetXIIbi + \textfont\ttfam=\cgetXIItt \textfont\bffam=\cgetXIIbd + \textfont\ccfam=\cgetXIIcc + \def\noexpand\bd{\fam\bffam\cgetXIIbd}% + \def\noexpand\it{\fam\itfam\cgetXIIit}% + \def\noexpand\bi{\fam\bifam\cgetXIIbi}% + \def\noexpand\tt{\fam\ttfam\cgetXIItt}% + \def\noexpand\cc{\fam\ccfam\cgetXIIcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsxiiet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/et14.textext b/macros/text1/compugraphics_8600/et14.textext new file mode 100644 index 0000000000..01a5295803 --- /dev/null +++ b/macros/text1/compugraphics_8600/et14.textext @@ -0,0 +1,37 @@ +\font\cgetXIVrm=etr at 14pt\font\cgetXIVit=eti at 14pt +\font\cgetXIVbd=etb at 14pt \font\cgetXIVmi=mthit at 14pt +\font\cgetXIVsy=symbola at 14pt \font\cgetXIVex=ext at 14pt +\font\cgetXIVbi=etbi at 14pt \font\cgetXIVtt=elite at 14pt +\font\cgetXIVcc=etsc at 14pt\font\cgetXIVmrm=mthrm at 14pt +\expandafter\newdimen\csname\the\naMEtok ilsxivet\endcsname +\global\csname\the\naMEtok ilsxivet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsxivet\endcsname=0pt +\csname\the\naMEtok ilsxivet\endcsname=16pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetXIVrm}% + \def\noexpand\mi{\fam1\cgetXIVmi}% + \def\noexpand\sy{\fam2\cgetXIVsy}% + \def\noexpand\ex{\fam3\cgetXIVex}% + \textfont0=\cgetXIVmrm \textfont1=\cgetXIVmi + \textfont2=\cgetXIVsy \textfont3=\cgetXIVex + \textfont\itfam=\cgetXIVit\textfont\bifam=\cgetXIVbi + \textfont\ttfam=\cgetXIVtt \textfont\bffam=\cgetXIVbd + \textfont\ccfam=\cgetXIVcc + \def\noexpand\bd{\fam\bffam\cgetXIVbd}% + \def\noexpand\it{\fam\itfam\cgetXIVit}% + \def\noexpand\bi{\fam\bifam\cgetXIVbi}% + \def\noexpand\tt{\fam\ttfam\cgetXIVtt}% + \def\noexpand\cc{\fam\ccfam\cgetXIVcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsxivet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/et18.textext b/macros/text1/compugraphics_8600/et18.textext new file mode 100644 index 0000000000..e59a1bc47e --- /dev/null +++ b/macros/text1/compugraphics_8600/et18.textext @@ -0,0 +1,37 @@ +\font\cgetXVIIIrm=etr at 18pt\font\cgetXVIIIit=eti at 18pt +\font\cgetXVIIIbd=etb at 18pt \font\cgetXVIIImi=mthit at 18pt +\font\cgetXVIIIsy=symbola at 18pt \font\cgetXVIIIex=ext at 18pt +\font\cgetXVIIIbi=etbi at 18pt \font\cgetXVIIItt=elite at 18pt +\font\cgetXVIIIcc=etsc at 18pt\font\cgetXVIIImrm=mthrm at 18pt +\expandafter\newdimen\csname\the\naMEtok ilsxviiiet\endcsname +\global\csname\the\naMEtok ilsxviiiet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsxviiiet\endcsname=0pt +\csname\the\naMEtok ilsxviiiet\endcsname=20pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetXVIIIrm}% + \def\noexpand\mi{\fam1\cgetXVIIImi}% + \def\noexpand\sy{\fam2\cgetXVIIIsy}% + \def\noexpand\ex{\fam3\cgetXVIIIex}% + \textfont0=\cgetXVIIImrm \textfont1=\cgetXVIIImi + \textfont2=\cgetXVIIIsy \textfont3=\cgetXVIIIex + \textfont\itfam=\cgetXVIIIit\textfont\bifam=\cgetXVIIIbi + \textfont\ttfam=\cgetXVIIItt \textfont\bffam=\cgetXVIIIbd + \textfont\ccfam=\cgetXVIIIcc + \def\noexpand\bd{\fam\bffam\cgetXVIIIbd}% + \def\noexpand\it{\fam\itfam\cgetXVIIIit}% + \def\noexpand\bi{\fam\bifam\cgetXVIIIbi}% + \def\noexpand\tt{\fam\ttfam\cgetXVIIItt}% + \def\noexpand\cc{\fam\ccfam\cgetXVIIIcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsxviiiet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/et8.textext b/macros/text1/compugraphics_8600/et8.textext new file mode 100644 index 0000000000..ad30284fa6 --- /dev/null +++ b/macros/text1/compugraphics_8600/et8.textext @@ -0,0 +1,37 @@ +\font\cgetVIIIrm=etr at 8pt\font\cgetVIIIit=eti at 8pt +\font\cgetVIIIbd=etb at 8pt \font\cgetVIIImi=mthit at 8pt +\font\cgetVIIIsy=symbola at 8pt \font\cgetVIIIex=ext at 8pt +\font\cgetVIIIbi=etbi at 8pt \font\cgetVIIItt=elite at 8pt +\font\cgetVIIIcc=etsc at 8pt\font\cgetVIIImrm=mthrm at 8pt +\expandafter\newdimen\csname\the\naMEtok ilsviiiet\endcsname +\global\csname\the\naMEtok ilsviiiet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsviiiet\endcsname=0pt +\csname\the\naMEtok ilsviiiet\endcsname=10pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetVIIIrm}% + \def\noexpand\mi{\fam1\cgetVIIImi}% + \def\noexpand\sy{\fam2\cgetVIIIsy}% + \def\noexpand\ex{\fam3\cgetVIIIex}% + \textfont0=\cgetVIIImrm \textfont1=\cgetVIIImi + \textfont2=\cgetVIIIsy \textfont3=\cgetVIIIex + \textfont\itfam=\cgetVIIIit\textfont\bifam=\cgetVIIIbi + \textfont\ttfam=\cgetVIIItt \textfont\bffam=\cgetVIIIbd + \textfont\ccfam=\cgetVIIIcc + \def\noexpand\bd{\fam\bffam\cgetVIIIbd}% + \def\noexpand\it{\fam\itfam\cgetVIIIit}% + \def\noexpand\bi{\fam\bifam\cgetVIIIbi}% + \def\noexpand\tt{\fam\ttfam\cgetVIIItt}% + \def\noexpand\cc{\fam\ccfam\cgetVIIIcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsviiiet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/et9.textext b/macros/text1/compugraphics_8600/et9.textext new file mode 100644 index 0000000000..ed560d4d5b --- /dev/null +++ b/macros/text1/compugraphics_8600/et9.textext @@ -0,0 +1,37 @@ +\font\cgetIXrm=etr at 9pt\font\cgetIXit=eti at 9pt +\font\cgetIXbd=etb at 9pt \font\cgetIXmi=mthit at 9pt +\font\cgetIXsy=symbola at 9pt \font\cgetIXex=ext at 9pt +\font\cgetIXbi=etbi at 9pt \font\cgetIXtt=elite at 9pt +\font\cgetIXcc=etsc at 9pt\font\cgetIXmrm=mthrm at 9pt +\expandafter\newdimen\csname\the\naMEtok ilsixet\endcsname +\global\csname\the\naMEtok ilsixet\endcsname=\bAseSkip +\ifdim\csname\the\naMEtok ilsixet\endcsname=0pt +\csname\the\naMEtok ilsixet\endcsname=11pt\fi% +\expandafter\xdef\csname\the\naMEtok\endcsname{% + \def\noexpand\rm{\fam0\cgetIXrm}% + \def\noexpand\mi{\fam1\cgetIXmi}% + \def\noexpand\sy{\fam2\cgetIXsy}% + \def\noexpand\ex{\fam3\cgetIXex}% + \textfont0=\cgetIXmrm \textfont1=\cgetIXmi + \textfont2=\cgetIXsy \textfont3=\cgetIXex + \textfont\itfam=\cgetIXit\textfont\bifam=\cgetIXbi + \textfont\ttfam=\cgetIXtt \textfont\bffam=\cgetIXbd + \textfont\ccfam=\cgetIXcc + \def\noexpand\bd{\fam\bffam\cgetIXbd}% + \def\noexpand\it{\fam\itfam\cgetIXit}% + \def\noexpand\bi{\fam\bifam\cgetIXbi}% + \def\noexpand\tt{\fam\ttfam\cgetIXtt}% + \def\noexpand\cc{\fam\ccfam\cgetIXcc}% +\noexpand\rm% +\noexpand\nonIBM% +\noexpand\let\noexpand\italic=\noexpand\it +\noexpand\let\noexpand\bold=\noexpand\bd +\noexpand\let\noexpand\bolditalic=\noexpand\bi% +\noexpand\let\noexpand\caps=\noexpand\cc +\noexpand\let\noexpand\typewriter=\noexpand\tt% +\noexpand\let\noexpand\roman=\noexpand\rm +\noexpand\let\noexpand\symbol=\noexpand\sy% +\noexpand\let\noexpand\mathitalic=\noexpand\mi% +\noexpand\let\noexpand\extension=\noexpand\ex% +\noexpand\interlineskip{% +\noexpand\csname\the\naMEtok ilsixet\noexpand\endcsname}}% diff --git a/macros/text1/compugraphics_8600/etb.fontinfo b/macros/text1/compugraphics_8600/etb.fontinfo new file mode 100644 index 0000000000..3a9571f163 --- /dev/null +++ b/macros/text1/compugraphics_8600/etb.fontinfo @@ -0,0 +1,236 @@ +* TEX font info -- commerical font format -- English Times Bold 4/25/85 +* CG 5039 Layout, and 1614 Complement, typeface 707 +* +HUNITS 1/54 +VUNITS 1/64 +DEFFONT 032 +DEFWIDTH 1 +SLANT 0 +SPACE 15/54 +SPSTRETCH 12/54 +SPSHRINK 5/54 +XHEIGHT 30/64 +QUAD 1 +EXTRASPACE 1/10 +FONTNAME ETB +* +* WIDTH HEIGHT DEPTH 8600 Decimal +$ +1/2 54 45 0 au,97 +1/4 54 45 0 au,98 +3/4 54 45 0 au,99 +1/3 54 45 3 au,104 +2/3 54 45 0 au,105 +enbul 27 40 0 au,40 +cent 27 40 0 au,36 +openbox 54 45 0 au,37 +1/8 54 45 0 au,100 +3/8 54 45 0 au,101 +5/8 54 45 0 au,102 +ff LIGATURE f+f 33 45 0 au,120 +fi LIGATURE f+i 30 45 0 au,118 +fl LIGATURE f+l 30 45 0 au,119 +ffi LIGATURE ff+i 45 45 0 au,121 +ffl LIGATURE ff+l 45 45 0 au,122 +dotless-i 15 35 0 au,127 +undef 27 0 0 30 +grave 13 45 0 au,82 +acute 13 45 0 au,81 +invertcircum 14 45 0 f195,37 +breve 13 45 0 f195,26 +macron 14 45 0 f195,au,90 +circleaccent 14 45 0 f195,42 +cedila 13 5 10 au,93 +germanSS 30 45 0 au,30 +ae 42 35 0 f35,au,111 +oe 45 35 0 f35,11 +scano 30 35 5 f30,06 +AE 54 45 0 f35,64 +OE 54 45 0 f35,09 +ScanO 42 45 5 f30,au,07 +PolishSl 18 35 0 vmf3,45,vmr3 +! 21 45 0 40 +right" LIGATURE '+' 20 45 0 39,hml2,39 +# 27 45 0 au,114 +dollar 27 45 5 au,35 +% 54 45 0 au,49 +& 39 45 0 91 +' 12 45 0 39 +( 18 45 5 58 +) 18 45 5 59 +* 27 45 0 92 ++ 36 45 0 F186,Au,46 +, 18 10 10 44 +hyphen 18 20 0 45 +. 18 10 0 46 +/ 27 45 0 au,33 +0 27 45 0 48 +1 27 45 0 49 +2 27 45 0 50 +3 27 45 0 51 +4 27 45 0 52 +5 27 45 0 53 +6 27 45 0 54 +7 27 45 0 55 +8 27 45 0 56 +9 27 45 0 57 +: 18 35 0 35 +; 18 35 10 32 +invert! 21 45 5 41 += 36 45 0 F186,Au,43 +invert? 24 45 5 37 +? 27 45 0 36 +@ 54 45 0 f38,93 +A 42 45 0 65 +B 36 45 0 66 +C 39 45 0 67 +D 42 45 0 68 +E 36 45 0 69 +F 33 45 0 70 +G 42 45 0 71 +H 45 45 0 72 +I 21 45 0 73 +J 27 45 0 74 +K 39 45 0 75 +L 36 45 0 76 +M 51 45 0 77 +N 42 45 0 78 +O 42 45 0 79 +P 36 45 0 80 +Q 42 45 15 81 +R 39 45 0 82 +S 30 45 0 83 +T 36 45 0 84 +U 42 45 0 85 +V 39 45 0 86 +W 54 45 0 87 +X 42 45 0 88 +Y 39 45 0 89 +Z 36 45 0 90 +[ 18 45 10 94 +left" LIGATURE l×+l× 20 45 0 38,hml2,38 +] 18 45 10 95 +circumflex 13 45 0 au,83 +raiseddot 14 45 0 f195,41 +l× 12 45 0 38 +a 27 35 0 97 +b 30 45 0 98 +c 24 35 0 99 +d 30 45 0 100 +e 24 35 0 101 +f 21 45 0 102 +g 27 35 10 103 +h 30 45 0 104 +i 15 45 0 105 +j 18 45 10 106 +k 30 45 0 107 +l 15 45 0 108 +m 45 35 0 109 +n 30 35 0 110 +o 30 35 0 111 +p 30 35 10 112 +q 30 35 10 113 +r 21 35 0 114 +s 21 35 0 115 +t 18 45 0 116 +u 30 35 0 117 +v 27 35 0 118 +w 39 35 0 119 +x 27 35 0 120 +y 27 35 10 121 +z 24 35 0 122 +endash LIGATURE hyphen+hyphen 31 25 0 45,hml5,45,hmr5 +emdash LIGATURE endash+hyphen 54 25 0 47 +Hungarian 15 50 0 f189,au,116 +tilde 13 45 0 au,86 +umlaut 13 45 0 au,84 +kern a+v -54/36 +kern a+w -54/36 +kern a+y -54/36 +kern h+t -54/36 +kern h+u -54/36 +kern h+y -54/36 +kern k+e -54/36 +kern m+b -54/36 +kern m+u -54/36 +kern m+y -54/36 +kern n+t -54/36 +kern n+u -54/36 +kern n+v -54/36 +kern n+w -54/36 +kern n+y -54/36 +kern o+o 54/51 +kern o+v -54/36 +kern o+w -54/36 +kern o+x -54/36 +kern o+y -54/36 +kern t+w -54/36 +kern t+y -54/36 +kern v+e -54/36 +kern v+o -54/36 +kern w+a -54/36 +kern w+e -54/36 +kern w+o -54/36 +kern y+a -54/36 +kern y+e -54/36 +kern y+o -54/36 +kern A+T -54/14 +kern A+Y -54/10 +kern A+V -54/6 +kern A+v -54/28 +kern D+A -54/14 +kern D+V -54/14 +kern D+W -54/14 +kern D+Y -54/12 +kern F+a -54/18 +kern F+e -54/32 +kern F+o -54/18 +kern F+r -54/22 +kern F+u -54/18 +kern F+A -54/14 +kern F+O -54/18 +kern K+O -54/14 +kern L+O -54/14 +kern L+U -54/17 +kern L+Y -54/12 +kern O+A -54/14 +kern O+V -54/12 +kern O+W -54/14 +kern O+X -54/12 +kern O+Y -54/12 +kern P+A -54/16 +kern P+r -54/34 +kern R+O -54/14 +kern R+T -54/16 +kern R+U -54/18 +kern R+V -54/16 +kern R+Y -54/14 +kern T+a -54/14 +kern T+e -54/16 +kern T+o -54/14 +kern T+r -54/14 +kern T+u -54/14 +kern T+w -54/16 +kern T+A -54/16 +kern T+O -54/22 +kern V+a -54/16 +kern V+e -54/16 +kern V+o -54/16 +kern V+r -54/16 +kern V+u -54/16 +kern V+A -54/6 +kern V+O -54/18 +kern W+a -54/14 +kern W+e -54/14 +kern W+o -54/14 +kern W+r -54/15 +kern W+u -54/15 +kern W+A -54/10 +kern W+O -54/14 +kern X+O -54/12 +kern Y+a -54/12 +kern Y+e -54/12 +kern Y+o -54/12 +kern Y+r -54/14 +kern Y+u -54/12 +kern Y+A -54/14 diff --git a/macros/text1/compugraphics_8600/etbi.fontinfo b/macros/text1/compugraphics_8600/etbi.fontinfo new file mode 100644 index 0000000000..f2b7ae9d4f --- /dev/null +++ b/macros/text1/compugraphics_8600/etbi.fontinfo @@ -0,0 +1,233 @@ +* TEX font info--commerical font format--English Times Bold Italic 4/25/85 +* +HUNITS 1/54 +VUNITS 1/64 +DEFFONT 033 +DEFWIDTH 1 +SLANT 0 +SPACE 22/54 +SPSTRETCH 15/54 +SPSHRINK 13/54 +XHEIGHT 30/64 +QUAD 1 +EXTRASPACE 2/10 +fontname ETBI +* WIDTH HEIGHT DEPTH 8600 Decimal +$ +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +enbul 27 30 0 au,110 +dagger 27 45 5 au,31 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +section 27 45 5 60 +ff LIGATURE f+f 33 45 15 au,120 +fi LIGATURE f+i 30 45 15 au,118 +fl LIGATURE f+l 30 45 15 au,119 +ffi LIGATURE ff+i 45 45 15 au,121 +ffl LIGATURE ff+l 45 45 15 au,122 +iota 15 35 0 f193,105 +undef 0 0 0 30 +grave 15 45 0 au,82 +acute 15 45 0 au,81 +invertcircum 15 45 0 f195,37 +breve 15 45 0 f195,26 +macron 15 45 0 f195,au,90 +circleaccent 15 45 0 f195,42 +cedila 15 10 15 au,93 +Germanss 30 45 10 au,30 +ae 50 35 0 97,hml10,101,hmr10 +oe 52 35 0 111,hml11,101,hmr11 +pound 27 45 0 96 +AE 72 45 0 65,hml17,69,hmr17 +OE 75 45 0 79,hml16,69,hmr16 +SCANO 42 45 5 f30,au,07 +PolishSl 18 20 0 vmr2,hml1,45,hmr1,vmf1 +! 21 45 0 40 +right" LIGATURE '+' 24 45 0 39,hml2,39,hmr2 +litre 27 45 0 F188,au,111 +dollar 27 45 5 au,35 +% 54 45 0 au,49 +& 39 45 0 91 +' 12 45 0 39 +( 18 45 10 58 +) 18 45 10 59 +* 27 45 0 92 +plus 54 35 0 au,46 +, 18 10 10 44 +hyphen 18 15 15 45 +. 18 10 0 46 +/ 27 45 0 au,33 +0 27 45 0 48 +1 27 45 0 49 +2 27 45 0 50 +3 27 45 0 51 +4 27 45 0 52 +5 27 45 0 53 +6 27 45 0 54 +7 27 45 0 55 +8 27 45 0 56 +9 27 45 0 57 +: 18 30 0 35 +; 18 30 10 32 +invert! 21 35 15 41 += 54 25 0 Au,43 +invert? 27 35 15 37 +? 27 45 0 36 +undef 27 0 0 30 +A 42 45 0 65 +B 36 45 0 66 +C 39 45 5 67 +D 42 45 0 68 +E 36 45 0 69 +F 33 45 0 70 +G 42 45 0 71 +H 45 45 0 72 +I 21 45 0 73 +J 27 45 0 74 +K 39 45 0 75 +L 36 45 0 76 +M 51 45 0 77 +N 42 45 0 78 +O 42 45 0 79 +P 36 45 0 80 +Q 42 45 15 81 +R 39 45 0 82 +S 30 45 0 83 +T 36 45 0 84 +U 42 45 0 85 +V 39 45 20 86 +W 54 45 0 87 +X 42 45 0 88 +Y 39 45 0 89 +Z 36 45 0 90 +[ 18 45 10 94 +left" LIGATURE l×+l× 21 45 0 38,hml2,38,hmr2 +] 18 45 10 95 +circumflex 15 45 0 au,83 +raiseddot 15 45 0 f195,41 +l× 12 45 0 38 +a 27 30 0 97 +b 30 45 0 98 +c 24 30 0 99 +d 30 45 0 100 +e 24 30 0 101 +f 21 45 15 102 +g 27 30 10 103 +h 30 45 0 104 +i 15 45 0 105 +j 18 45 15 106 +k 30 45 0 107 +l 15 45 0 108 +m 45 30 0 109 +n 30 30 0 110 +o 30 30 0 111 +p 30 30 15 112 +q 30 30 15 113 +r 21 30 0 114 +s 21 30 0 115 +t 18 40 0 116 +u 30 30 0 117 +v 27 30 0 118 +w 39 30 0 119 +x 27 30 0 120 +y 27 30 10 121 +z 24 30 5 122 +endash LIGATURE hyphen+hyphen 27 20 0 Au,106 +emdash LIGATURE endash+hyphen 54 20 0 47 +Hungarian 18 50 0 f189,au,116 +tilde 15 45 0 au,86 +umlaut 15 45 0 au,84 +kern a+v -54/36 +kern a+v -54/36 +kern a+w -54/36 +kern a+y -54/36 +kern h+t -54/36 +kern h+u -54/36 +kern h+y -54/36 +kern k+e -54/36 +kern m+b -54/36 +kern m+u -54/36 +kern m+y -54/36 +kern n+t -54/36 +kern n+u -54/36 +kern n+v -54/36 +kern n+w -54/36 +kern n+y -54/36 +kern o+o 54/60 +kern o+v -54/36 +kern o+w -54/36 +kern o+x -54/36 +kern o+y -54/36 +kern t+w -54/36 +kern t+y -54/36 +kern v+e -54/36 +kern v+o -54/36 +kern w+a -54/36 +kern w+e -54/36 +kern w+o -54/36 +kern y+a -54/36 +kern y+e -54/36 +kern y+o -54/36 +kern A+T -54/16 +kern A+U -54/18 +kern A+Y -54/16 +kern A+V -54/12 +kern D+A -54/16 +kern D+V -54/14 +kern D+W -54/16 +kern D+Y -54/16 +kern F+a -54/20 +kern F+e -54/24 +kern F+o -54/18 +kern F+r -54/22 +kern F+u -54/20 +kern F+A -54/18 +kern F+O -54/18 +kern K+O -54/14 +kern L+O -54/18 +kern L+U -54/18 +kern L+Y -54/16 +kern O+A -54/18 +kern O+V -54/16 +kern O+W -54/16 +kern O+X -54/16 +kern O+Y -54/14 +kern P+A -54/18 +kern R+O -54/16 +kern R+T -54/18 +kern R+U -54/18 +kern R+V -54/16 +kern R+Y -54/16 +kern T+a -54/22 +kern T+e -54/22 +kern T+o -54/20 +kern T+r -54/18 +kern T+u -54/22 +kern T+A -54/16 +kern T+O -54/28 +kern V+a -54/18 +kern V+e -54/18 +kern V+o -54/18 +kern V+r -54/22 +kern V+u -54/20 +kern V+A -54/12 +kern V+O -54/16 +kern W+a -54/16 +kern W+e -54/18 +kern W+o -54/18 +kern W+r -54/20 +kern W+u -54/20 +kern W+A -54/10 +kern W+O -54/14 +kern X+O -54/14 +kern Y+a -54/18 +kern Y+e -54/18 +kern Y+o -54/18 +kern Y+r -54/22 +kern Y+u -54/20 +kern Y+A -54/14 diff --git a/macros/text1/compugraphics_8600/eti.fontinfo b/macros/text1/compugraphics_8600/eti.fontinfo new file mode 100644 index 0000000000..a5085be50d --- /dev/null +++ b/macros/text1/compugraphics_8600/eti.fontinfo @@ -0,0 +1,233 @@ +* TEX font info -- commerical font format -- English Times Italic 4/25/84 +* +HUNITS 1/54 +VUNITS 1/64 +DEFFONT 031 +DEFWIDTH 1 +SLANT 1/4 +SPACE 22/54 +SPSTRETCH 15/54 +SPSHRINK 13/54 +XHEIGHT 30/64 +QUAD 1 +EXTRASPACE 2/10 +fontname ETI +* WIDTH HEIGHT DEPTH 8600 Decimal +$ +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +enbul 27 30 0 au,110 +dagger 27 45 5 au,31 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +section 27 45 5 60 +ff LIGATURE f+f 33 45 15 au,120 +fi LIGATURE f+i 30 45 15 au,118 +fl LIGATURE f+l 30 45 15 au,119 +ffi LIGATURE ff+i 45 45 15 au,121 +ffl LIGATURE ff+l 45 45 15 au,122 +iota 15 35 0 f193,105 +undef 27 0 0 30 +grave 16 45 0 au,82 +acute 17 45 0 au,81 +invertcircum 13 45 0 f195,37 +breve 13 45 0 f195,26 +macron 13 45 0 f195,au,90 +circleaccent 15 45 0 f195,42 +cedila 14 10 15 au,93 +Germanss 30 45 10 au,30 +ae 42 35 0 f35,au,113 +oe 45 35 0 f35,10 +pound 27 45 0 96 +AE 54 45 0 f35,au,79 +OE 54 45 0 f35,08 +SCANO 42 45 5 f30,au,07 +PolishSl 15 20 0 vmr2,hml1,45,hmr1,vmf1 +! 21 45 0 40 +right" LIGATURE '+' 24 45 0 39,hml2,39,hmr2 +litre 27 45 0 F188,au,111 +dollar 27 45 5 au,35 +% 54 45 0 au,49 +& 39 45 0 91 +' 12 45 0 39 +( 18 45 10 58 +) 18 45 10 59 +* 27 45 0 92 +plus 54 35 0 au,46 +, 18 10 10 44 +hyphen 18 15 15 45 +. 18 10 0 46 +/ 27 45 0 au,33 +0 27 45 0 48 +1 27 45 0 49 +2 27 45 0 50 +3 27 45 0 51 +4 27 45 0 52 +5 27 45 0 53 +6 27 45 0 54 +7 27 45 0 55 +8 27 45 0 56 +9 27 45 0 57 +: 18 30 0 35 +; 18 30 10 32 +invert! 21 35 15 41 += 54 25 0 Au,43 +invert? 27 35 15 37 +? 27 45 0 36 +undef 27 0 0 30 +A 42 45 0 65 +B 36 45 0 66 +C 39 45 5 67 +D 42 45 0 68 +E 36 45 0 69 +F 33 45 0 70 +G 42 45 0 71 +H 45 45 0 72 +I 21 45 0 73 +J 27 45 0 74 +K 39 45 0 75 +L 36 45 0 76 +M 51 45 0 77 +N 42 45 0 78 +O 42 45 0 79 +P 36 45 0 80 +Q 42 45 15 81 +R 39 45 0 82 +S 30 45 0 83 +T 36 45 0 84 +U 42 45 0 85 +V 39 45 20 86 +W 54 45 0 87 +X 42 45 0 88 +Y 39 45 0 89 +Z 36 45 0 90 +[ 18 45 10 94 +left" LIGATURE l×+l× 21 45 0 38,hml2,38,hmr2 +] 18 45 10 95 +circumflex 17 45 0 au,83 +raiseddot 13 45 0 f195,41 +l× 12 45 0 38 +a 27 30 0 97 +b 30 45 0 98 +c 24 30 0 99 +d 30 45 0 100 +e 24 30 0 101 +f 21 45 15 102 +g 27 30 10 103 +h 30 45 0 104 +i 15 45 0 105 +j 18 45 15 106 +k 30 45 0 107 +l 15 45 0 108 +m 45 30 0 109 +n 30 30 0 110 +o 30 30 0 111 +p 30 30 15 112 +q 30 30 15 113 +r 21 30 0 114 +s 21 30 0 115 +t 18 40 0 116 +u 30 30 0 117 +v 27 30 0 118 +w 39 30 0 119 +x 27 30 0 120 +y 27 30 10 121 +z 24 30 5 122 +endash LIGATURE hyphen+hyphen 27 20 0 Au,106 +emdash LIGATURE endash+hyphen 54 20 0 47 +Hungarian 14 50 0 f189,au,116 +tilde 17 45 0 au,86 +umlaut 17 45 0 au,84 +kern a+v -54/36 +kern a+v -54/36 +kern a+w -54/36 +kern a+y -54/36 +kern h+t -54/36 +kern h+u -54/36 +kern h+y -54/36 +kern k+e -54/36 +kern m+b -54/36 +kern m+u -54/36 +kern m+y -54/36 +kern n+t -54/36 +kern n+u -54/36 +kern n+v -54/36 +kern n+w -54/36 +kern n+y -54/36 +kern o+o 54/60 +kern o+v -54/36 +kern o+w -54/36 +kern o+x -54/36 +kern o+y -54/36 +kern t+w -54/36 +kern t+y -54/36 +kern v+e -54/36 +kern v+o -54/36 +kern w+a -54/36 +kern w+e -54/36 +kern w+o -54/36 +kern y+a -54/36 +kern y+e -54/36 +kern y+o -54/36 +kern A+T -54/16 +kern A+U -54/18 +kern A+Y -54/16 +kern A+V -54/12 +kern D+A -54/16 +kern D+V -54/14 +kern D+W -54/16 +kern D+Y -54/16 +kern F+a -54/20 +kern F+e -54/24 +kern F+o -54/18 +kern F+r -54/22 +kern F+u -54/20 +kern F+A -54/18 +kern F+O -54/18 +kern K+O -54/14 +kern L+O -54/18 +kern L+U -54/18 +kern L+Y -54/16 +kern O+A -54/18 +kern O+V -54/16 +kern O+W -54/16 +kern O+X -54/16 +kern O+Y -54/14 +kern P+A -54/18 +kern R+O -54/16 +kern R+T -54/18 +kern R+U -54/18 +kern R+V -54/16 +kern R+Y -54/16 +kern T+a -54/22 +kern T+e -54/22 +kern T+o -54/20 +kern T+r -54/18 +kern T+u -54/22 +kern T+A -54/16 +kern T+O -54/28 +kern V+a -54/18 +kern V+e -54/18 +kern V+o -54/18 +kern V+r -54/22 +kern V+u -54/20 +kern V+A -54/12 +kern V+O -54/16 +kern W+a -54/16 +kern W+e -54/18 +kern W+o -54/18 +kern W+r -54/20 +kern W+u -54/20 +kern W+A -54/10 +kern W+O -54/14 +kern X+O -54/14 +kern Y+a -54/18 +kern Y+e -54/18 +kern Y+o -54/18 +kern Y+r -54/22 +kern Y+u -54/20 +kern Y+A -54/14 diff --git a/macros/text1/compugraphics_8600/etr.fontinfo b/macros/text1/compugraphics_8600/etr.fontinfo new file mode 100644 index 0000000000..e926b6626a --- /dev/null +++ b/macros/text1/compugraphics_8600/etr.fontinfo @@ -0,0 +1,236 @@ +* TEX font info -- commerical font format -- English Times Roman 4/25/85 +* CG 5039 Layout, and 1614 Compliment, typeface 705 +* +HUNITS 1/54 +VUNITS 1/64 +DEFFONT 030 +DEFWIDTH 1 +SLANT 0 +SPACE 15/54 +SPSTRETCH 12/54 +SPSHRINK 5/54 +XHEIGHT 30/64 +QUAD 1 +EXTRASPACE 1/10 +FONTNAME ETR +* +* WIDTH HEIGHT DEPTH 8600 Decimal +$ +1/2 54 45 0 au,97 +1/4 54 45 0 au,98 +3/4 54 45 0 au,99 +1/3 54 45 3 au,104 +2/3 54 45 0 au,105 +enbul 27 40 0 au,40 +cent 27 40 0 au,36 +openbox 54 45 0 au,37 +1/8 54 45 0 au,100 +3/8 54 45 0 au,101 +5/8 54 45 0 au,102 +ff LIGATURE f+f 33 45 0 au,120 +fi LIGATURE f+i 30 45 0 au,118 +fl LIGATURE f+l 30 45 0 au,119 +ffi LIGATURE ff+i 45 45 0 au,121 +ffl LIGATURE ff+l 45 45 0 au,122 +dotless-i 15 35 0 au,127 +undef 27 0 0 30 +grave 13 45 0 au,82 +acute 13 45 0 au,81 +invertcircum 13 45 0 f195,37 +breve 13 45 0 f195,26 +macron 13 45 0 f195,au,90 +circleaccent 13 45 0 f195,42 +cedila 13 5 10 au,93 +germanSS 30 45 0 au,30 +ae 42 35 0 f35,au,107 +oe 45 35 0 f35,au,116 +scano 30 35 5 06 +AE 54 45 0 f35,63 +OE 54 45 0 f35,au,80 +ScanO 42 45 5 au,07 +PolishSl 15 35 0 vmf3,hml8,45,hmr8,vmr3 +! 21 45 0 40 +right" LIGATURE '+' 20 45 0 39,hml2,39 +# 27 45 0 au,114 +dollar 27 45 5 au,35 +% 54 45 0 au,49 +& 39 45 0 91 +' 12 45 0 39 +( 18 45 5 58 +) 18 45 5 59 +* 27 45 0 92 ++ 36 45 0 F186,Au,46 +, 18 10 10 44 +hyphen 18 20 0 45 +. 18 10 0 46 +/ 27 45 0 au,33 +0 27 45 0 48 +1 27 45 0 49 +2 27 45 0 50 +3 27 45 0 51 +4 27 45 0 52 +5 27 45 0 53 +6 27 45 0 54 +7 27 45 0 55 +8 27 45 0 56 +9 27 45 0 57 +: 18 35 0 35 +; 18 35 10 32 +invert! 24 45 5 41 += 36 45 0 F186,Au,43 +invert? 24 45 5 37 +? 27 45 0 36 +@ 54 45 0 f38,93 +A 42 45 0 65 +B 36 45 0 66 +C 39 45 0 67 +D 42 45 0 68 +E 36 45 0 69 +F 33 45 0 70 +G 42 45 0 71 +H 45 45 0 72 +I 21 45 0 73 +J 27 45 0 74 +K 39 45 0 75 +L 36 45 0 76 +M 51 45 0 77 +N 42 45 0 78 +O 42 45 0 79 +P 36 45 0 80 +Q 42 45 15 81 +R 39 45 0 82 +S 30 45 0 83 +T 36 45 0 84 +U 42 45 0 85 +V 39 45 0 86 +W 54 45 0 87 +X 42 45 0 88 +Y 39 45 0 89 +Z 36 45 0 90 +[ 18 45 10 94 +left" LIGATURE l×+l× 20 45 0 38,hml2,38 +] 18 45 10 95 +circumflex 13 45 0 au,83 +raiseddot 15 45 0 f195,41 +l× 12 45 0 38 +a 27 35 0 97 +b 30 45 0 98 +c 24 35 0 99 +d 30 45 0 100 +e 24 35 0 101 +f 21 45 0 102 +g 27 35 10 103 +h 30 45 0 104 +i 15 45 0 105 +j 18 45 10 106 +k 30 45 0 107 +l 15 45 0 108 +m 45 35 0 109 +n 30 35 0 110 +o 30 35 0 111 +p 30 35 10 112 +q 30 35 10 113 +r 21 35 0 114 +s 21 35 0 115 +t 18 45 0 116 +u 30 35 0 117 +v 27 35 0 118 +w 39 35 0 119 +x 27 35 0 120 +y 27 35 10 121 +z 24 35 0 122 +endash LIGATURE hyphen+hyphen 31 25 0 45,hml5,45,hmr5 +emdash LIGATURE endash+hyphen 54 25 0 47 +Hungarian 15 50 0 f189,au,116 +tilde 13 45 0 au,86 +umlaut 13 45 0 au,84 +kern a+v -54/36 +kern a+w -54/36 +kern a+y -54/36 +kern h+t -54/36 +kern h+u -54/36 +kern h+y -54/36 +kern k+e -54/36 +kern m+b -54/36 +kern m+u -54/36 +kern m+y -54/36 +kern n+t -54/36 +kern n+u -54/36 +kern n+v -54/36 +kern n+w -54/36 +kern n+y -54/36 +kern o+o 54/51 +kern o+v -54/36 +kern o+w -54/36 +kern o+x -54/36 +kern o+y -54/36 +kern t+w -54/36 +kern t+y -54/36 +kern v+e -54/36 +kern v+o -54/36 +kern w+a -54/36 +kern w+e -54/36 +kern w+o -54/36 +kern y+a -54/36 +kern y+e -54/36 +kern y+o -54/36 +kern A+T -54/14 +kern A+Y -54/10 +kern A+V -54/6 +kern A+v -54/28 +kern D+A -54/14 +kern D+V -54/14 +kern D+W -54/14 +kern D+Y -54/12 +kern F+a -54/18 +kern F+e -54/32 +kern F+o -54/18 +kern F+r -54/22 +kern F+u -54/18 +kern F+A -54/14 +kern F+O -54/18 +kern K+O -54/14 +kern L+O -54/14 +kern L+U -54/17 +kern L+Y -54/12 +kern O+A -54/14 +kern O+V -54/12 +kern O+W -54/14 +kern O+X -54/12 +kern O+Y -54/12 +kern P+A -54/16 +kern P+r -54/34 +kern R+O -54/14 +kern R+T -54/16 +kern R+U -54/18 +kern R+V -54/16 +kern R+Y -54/14 +kern T+a -54/14 +kern T+e -54/16 +kern T+o -54/14 +kern T+r -54/14 +kern T+u -54/14 +kern T+w -54/16 +kern T+A -54/16 +kern T+O -54/22 +kern V+a -54/16 +kern V+e -54/16 +kern V+o -54/16 +kern V+r -54/16 +kern V+u -54/16 +kern V+A -54/6 +kern V+O -54/18 +kern W+a -54/14 +kern W+e -54/14 +kern W+o -54/14 +kern W+r -54/15 +kern W+u -54/15 +kern W+A -54/10 +kern W+O -54/14 +kern X+O -54/12 +kern Y+a -54/12 +kern Y+e -54/12 +kern Y+o -54/12 +kern Y+r -54/14 +kern Y+u -54/12 +kern Y+A -54/14 diff --git a/macros/text1/compugraphics_8600/etsc.fontinfo b/macros/text1/compugraphics_8600/etsc.fontinfo new file mode 100644 index 0000000000..a3c70a1297 --- /dev/null +++ b/macros/text1/compugraphics_8600/etsc.fontinfo @@ -0,0 +1,253 @@ +* TEX font info--commerical font format--English Times Small Caps 4/25/85 +* CG 5003 Compliment, typeface 705 +* +HUNITS 1/54 +VUNITS 1/64 +DEFFONT 038 +DEFWIDTH 1 +SLANT 0 +SPACE 22/54 +SPSTRETCH 15/54 +SPSHRINK 13/54 +XHEIGHT 30/64 +QUAD 1 +EXTRASPACE 2/10 +FONTNAME ETSC +* WIDTH HEIGHT DEPTH 8600 Decimal +$ +1/2 54 45 0 au,97 +1/4 54 45 0 au,98 +3/4 54 45 0 au,99 +1/3 54 45 3 au,104 +2/3 54 45 0 au,105 +undef 27 0 0 30 +undef 27 0 0 30 +dbldagger 27 45 0 au,32 +1/8 54 45 0 au,100 +3/8 54 45 0 au,101 +5/8 54 45 0 au,102 +7/8 54 45 0 au,103 +undef 27 0 0 30 +undef 27 0 0 30 +para 27 50 10 au,113 +trademark 33 50 0 au,54 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +! 21 45 0 40 +right" LIGATURE '+' 20 40 0 39,hml2,39,hmr2 +undef 27 0 0 30 +dollar 27 35 5 au,35 +undef 27 00 0 30 +& 30 30 0 91 +' 12 45 0 39 +( 18 45 15 58 +) 18 45 15 59 +* 27 45 0 92 +plus/minus 54 40 10 au,48 +, 18 10 10 44 +hyphen 18 20 0 45 +. 18 10 0 46 +fracbar/ 06 45 5 au,42 +0 27 30 0 48 +1 27 30 0 49 +2 27 30 0 50 +3 27 30 15 51 +4 27 30 15 52 +5 27 40 15 53 +6 27 45 0 54 +7 27 30 15 55 +8 27 45 0 56 +9 27 30 15 57 +: 18 30 0 35 +; 18 30 10 32 +undef 27 0 0 f195,30 +undef 27 0 0 f195,30 +undef 27 0 0 f195,30 +? 27 45 0 36 +atsign 54 45 5 93 +A 42 45 0 65 +B 36 45 0 66 +C 39 45 0 67 +D 42 45 0 68 +E 36 45 0 69 +F 33 45 0 70 +G 42 45 0 71 +H 45 45 0 72 +I 21 45 0 73 +J 27 45 0 74 +K 39 45 0 75 +L 36 45 0 76 +M 51 45 0 77 +N 42 45 0 78 +O 42 45 0 79 +P 36 45 0 80 +Q 42 45 15 81 +R 39 45 0 82 +S 30 45 0 83 +T 36 45 0 84 +U 42 45 0 85 +V 39 45 0 86 +W 54 45 0 87 +X 42 45 0 88 +Y 39 45 0 89 +Z 36 45 0 90 +undef 27 0 0 30 +left" LIGATURE ×+× 20 40 0 38,hml2,38,hmr2 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +× 12 45 0 38 +a 30 35 0 97 +b 27 35 0 98 +c 30 35 0 99 +d 33 35 0 100 +e 27 35 0 101 +f 24 35 0 102 +g 30 35 3 103 +h 33 35 0 104 +i 15 35 0 105 +j 18 35 0 106 +k 33 35 0 107 +l 24 35 0 108 +m 36 35 0 109 +n 33 35 0 110 +o 30 35 0 111 +p 27 35 0 112 +q 30 35 10 113 +r 30 45 0 114 +s 21 35 0 115 +t 27 35 0 116 +u 33 35 0 117 +v 30 35 0 118 +w 45 35 0 119 +x 30 35 0 120 +y 30 35 0 121 +z 27 35 0 122 +endash LIGATURE hyphen+hyphen 33 20 0 45,hml5,45,hmr5 +emdash LIGATURE endash+hyphen 54 20 0 47 +undef 27 0 0 30 +undef 27 0 0 30 +undef 27 0 0 30 +kern a+v -54/16 +kern a+t -54/28 +kern a+w -54/12 +kern a+y -54/12 +kern c+a -54/28 +kern h+b -54/24 +kern k+a -54/44 +kern k+c -54/24 +kern k+o -54/34 +kern m+b -54/48 +kern m+t -54/44 +kern m+v -54/26 +kern m+w -54/26 +kern m+y -54/36 +kern n+b -54/38 +kern o+o 54/44 +kern o+v -54/26 +kern o+w -54/26 +kern o+x -54/26 +kern o+y -54/22 +kern t+a -54/28 +kern t+w -54/36 +kern t+y -54/32 +kern v+c -54/36 +kern v+o -54/26 +kern w+a -54/8 +kern w+c -54/36 +kern y+a -54/16 +kern y+c -54/26 +kern y+e -54/44 +kern y+o -54/26 +kern A+U -54/18 +kern A+T -54/22 +kern A+V -54/8 +kern A+Y -54/10 +kern D+A -54/28 +kern D+V -54/28 +kern D+W -54/28 +kern D+X -54/28 +kern D+Y -54/28 +kern F+a -54/28 +kern F+r -54/28 +kern F+A -54/28 +kern F+C -54/28 +kern F+G -54/28 +kern F+O -54/28 +kern F+Q -54/28 +kern K+C -54/28 +kern K+G -54/28 +kern K+O -54/28 +kern K+Q -54/28 +kern L+C -54/28 +kern L+G -54/28 +kern L+O -54/28 +kern L+Q -54/28 +kern L+T -54/28 +kern L+U -54/28 +kern L+V -54/28 +kern L+W -54/28 +kern L+Y -54/18 +kern O+A -54/28 +kern O+F -54/32 +kern O+U -54/32 +kern O+V -54/28 +kern O+W -54/28 +kern O+X -54/28 +kern O+Y -54/28 +kern P+A -54/28 +kern R+C -54/28 +kern R+G -54/28 +kern R+O -54/28 +kern R+Q -54/28 +kern R+T -54/28 +kern R+U -54/28 +kern R+V -54/28 +kern R+W -54/28 +kern R+Y -54/28 +kern T+a -54/28 +kern T+o -54/28 +kern T+r -54/28 +kern T+u -54/28 +kern T+A -54/14 +kern T+O -54/28 +kern V+a -54/16 +kern V+e -54/28 +kern V+o -54/20 +kern V+A -54/14 +kern V+C -54/28 +kern V+G -54/28 +kern V+O -54/28 +kern V+Q -54/28 +kern W+a -54/8 +kern W+e -54/28 +kern W+o -54/28 +kern W+u -54/28 +kern W+A -54/8 +kern W+C -54/28 +kern W+G -54/28 +kern W+O -54/28 +kern W+Q -54/28 +kern X+C -54/28 +kern X+G -54/28 +kern X+O -54/28 +kern X+Q -54/28 +kern Y+a -54/16 +kern Y+e -54/28 +kern Y+o -54/28 +kern Y+A -54/20 diff --git a/macros/text1/compugraphics_8600/fonttex.cmschan b/macros/text1/compugraphics_8600/fonttex.cmschan new file mode 100644 index 0000000000..d863ceb0fc --- /dev/null +++ b/macros/text1/compugraphics_8600/fonttex.cmschan @@ -0,0 +1,5 @@ +@x +%test version +@y +%test version 1 +@z diff --git a/macros/text1/compugraphics_8600/fonttex.exec b/macros/text1/compugraphics_8600/fonttex.exec new file mode 100644 index 0000000000..5bc405cefa --- /dev/null +++ b/macros/text1/compugraphics_8600/fonttex.exec @@ -0,0 +1,23 @@ +/* FONTTEX EXEC + Note: This REXX exec is used to run the FontTeX driver program. + This exec will prompt the user for a filename if none was entered with + the call to the exec. +*/ + +Address 'COMMAND'; +Trace value 'n' +Parse Upper Arg inFn; +if inFn=' ' +then do + say 'Please enter filename of fontinfo file.' + pull inFn . +end +state inFn 'FONTINFO *' + if RC<>0 then do + say inFn 'FONTINFO file not found.' + exit + end +'FONTTEX' inFn +'REBLOCK' inFn 'TFM'; +'ERASE' inFn 'PRTFM'; +exit diff --git a/macros/text1/compugraphics_8600/fonttex.outchan b/macros/text1/compugraphics_8600/fonttex.outchan new file mode 100644 index 0000000000..8098645143 --- /dev/null +++ b/macros/text1/compugraphics_8600/fonttex.outchan @@ -0,0 +1,324 @@ +@x +%test version +@y +%out version 1 +@z + +@x +\font\twelvept=cmbx12 +\font\tentex=cmr10 +@y +\font\twelvept=cmbx12 +@z + +@x + @<Global Variables@>@/ +static@/ + @^system dependencies@> + com_table :packed array[0..18] of string(7);@/ +value@/ + com_table[0] := 'HDR'; {Header Record}@/ + com_table[1] := 'CHWIDTH';{Character Width}@/ + com_table[2] := 'RT'; {Reverse Type}@/ + com_table[3] := 'PS'; {Point Size}@/ + com_table[4] := 'SS'; {Set Size}@/ + com_table[5] := 'VMF'; {Vertical Move Forward}@/ + com_table[6] := 'VMR'; {Vertical Move Reverse}@/ + com_table[7] := 'RW'; {Rule Width}@/ + com_table[8] := 'RD'; {Rule Depth}@/ + com_table[9] := 'IR'; {Insert Rule}@/ + com_table[10] := 'SL'; {Slant Mode}@/ + com_table[11] := 'RTWT'; {Reverse Type Window Top}@/ + com_table[12] := 'RTWB'; {Reverse Type Window Bottom}@/ + com_table[13] := 'AU'; {Auxiliary Character Set}@/ + com_table[14] := 'F'; {Change Fonts}@/ + com_table[15] := 'HMR'; {Horizontal Move Right}@/ + com_table[16] := 'HML'; {Horizontal Move Left}@/ + com_table[17] := 'TTS'; {8600 character, in decimal}@/ + com_table[18] := 'MAXCMD';@/ +%include pasclib(asciicvt)@/ +@y +@<Global Variables@>@/ +static@/ +@!com_table :packed array[0..18] of string(7);@/ +@!ordx : packed array['00'xc..'FF'xc] of '00'x..'7f'x;@/ +@!chrx : packed array['00'x..'7F'x] of '00'xc..'FF'xc;@/ +value@/ + com_table[0] := 'HDR'; {Header Record}@/ + com_table[1] := 'CHWIDTH';{Character Width}@/ + com_table[2] := 'RT'; {Reverse Type}@/ + com_table[3] := 'PS'; {Point Size}@/ + com_table[4] := 'SS'; {Set Size}@/ + com_table[5] := 'VMF'; {Vertical Move Forward}@/ + com_table[6] := 'VMR'; {Vertical Move Reverse}@/ + com_table[7] := 'RW'; {Rule Width}@/ + com_table[8] := 'RD'; {Rule Depth}@/ + com_table[9] := 'IR'; {Insert Rule}@/ + com_table[10] := 'SL'; {Slant Mode}@/ + com_table[11] := 'RTWT'; {Reverse Type Window Top}@/ + com_table[12] := 'RTWB'; {Reverse Type Window Bottom}@/ + com_table[13] := 'AU'; {Auxiliary Character Set}@/ + com_table[14] := 'F'; {Change Fonts}@/ + com_table[15] := 'HMR'; {Horizontal Move Right}@/ + com_table[16] := 'HML'; {Horizontal Move Left}@/ + com_table[17] := 'TTS'; {8600 character, in decimal}@/ + com_table[18] := 'MAXCMD';@/ +{ EBCDIC to ASCII INTEGER and ASCII INTEGER to EBCDIC conversion } +{ EBCDIC char to ASCII integer } { ASCII INTEGER to EBCDIC char } +ordx['00'xc]:='00'x; { NUL NUL } chrx['00'x]:='00'xc; { NUL NUL } +ordx['01'xc]:='01'x; { SOH SOH } chrx['01'x]:='01'xc; { SOH SOH } +ordx['02'xc]:='02'x; { STX STX } chrx['02'x]:='02'xc; { STX STX } +ordx['03'xc]:='03'x; { ETX ETX } chrx['03'x]:='03'xc; { ETX ETX } +ordx['04'xc]:='00'x; { ... NUL } chrx['04'x]:='37'xc; { EOT EOT } +ordx['05'xc]:='09'x; { HT HT } chrx['05'x]:='2D'xc; { ENQ ENQ } +ordx['06'xc]:='00'x; { ... NUL } chrx['06'x]:='2E'xc; { ACK ACK } +ordx['07'xc]:='7F'x; { DEL DEL } chrx['07'x]:='2F'xc; { BEL BEL } +ordx['08'xc]:='00'x; { ... NUL } chrx['08'x]:='16'xc; { BS BS } +ordx['09'xc]:='00'x; { ... NUL } chrx['09'x]:='05'xc; { HT HT } +ordx['0A'xc]:='00'x; { ... NUL } chrx['0A'x]:='25'xc; { LF LF } +ordx['0B'xc]:='0B'x; { VT VT } chrx['0B'x]:='0B'xc; { VT VT } +ordx['0C'xc]:='0C'x; { FF FF } chrx['0C'x]:='0C'xc; { FF FF } +ordx['0D'xc]:='0D'x; { CR CR } chrx['0D'x]:='0D'xc; { CR CR } +ordx['0E'xc]:='0E'x; { SO SO } chrx['0E'x]:='0E'xc; { SO SO } +ordx['0F'xc]:='0F'x; { SI SI } chrx['0F'x]:='0F'xc; { SI SI } +ordx['10'xc]:='10'x; { DLE DLE } chrx['10'x]:='10'xc; { DLE DLE } +ordx['11'xc]:='11'x; { DC1 DC1 } chrx['11'x]:='11'xc; { DC1 DC1 } +ordx['12'xc]:='12'x; { DC2 DC2 } chrx['12'x]:='12'xc; { DC2 DC2 } +ordx['13'xc]:='13'x; { TM DC3 } chrx['13'x]:='13'xc; { DC3 TM } +ordx['14'xc]:='00'x; { ... NUL } chrx['14'x]:='3C'xc; { DC4 DC4 } +ordx['15'xc]:='00'x; { ... NUL } chrx['15'x]:='3D'xc; { NAK NAK } +ordx['16'xc]:='08'x; { BS BS } chrx['16'x]:='32'xc; { SYN SYN } +ordx['17'xc]:='00'x; { ... NUL } chrx['17'x]:='26'xc; { ETB ETB } +ordx['18'xc]:='18'x; { CAN CAN } chrx['18'x]:='18'xc; { CAN CAN } +ordx['19'xc]:='19'x; { EM EM } chrx['19'x]:='19'xc; { EM EM } +ordx['1A'xc]:='00'x; { ... NUL } chrx['1A'x]:='3F'xc; { SUB SUB } +ordx['1B'xc]:='00'x; { ... NUL } chrx['1B'x]:='27'xc; { ESC ESC } +ordx['1C'xc]:='1C'x; { IFS FS } chrx['1C'x]:='1C'xc; { FS IFS } +ordx['1D'xc]:='1D'x; { IGS GS } chrx['1D'x]:='1D'xc; { GS IGS } +ordx['1E'xc]:='1E'x; { IRS RS } chrx['1E'x]:='1E'xc; { RS IRS } +ordx['1F'xc]:='1F'x; { IUS US } chrx['1F'x]:='1F'xc; { US IUS } +ordx['20'xc]:='00'x; { ... NUL } chrx['20'x]:='40'xc; { SP SP } +ordx['21'xc]:='00'x; { ... NUL } chrx['21'x]:='5A'xc; { ! ! } +ordx['22'xc]:='00'x; { ... NUL } chrx['22'x]:='7F'xc; { " " } +ordx['23'xc]:='00'x; { ... NUL } chrx['23'x]:='7B'xc; { # # } +ordx['24'xc]:='00'x; { ... NUL } chrx['24'x]:='5B'xc; { $ $ } +ordx['25'xc]:='0A'x; { LF LF } chrx['25'x]:='6C'xc; { % % } +ordx['26'xc]:='17'x; { ETB ETB } chrx['26'x]:='50'xc; { & & } +ordx['27'xc]:='1B'x; { ESC ESC } chrx['27'x]:='7D'xc; { ' ' } +ordx['28'xc]:='00'x; { ... NUL } chrx['28'x]:='4D'xc; { ( ( } +ordx['29'xc]:='00'x; { ... NUL } chrx['29'x]:='5D'xc; { ) ) } +ordx['2A'xc]:='00'x; { ... NUL } chrx['2A'x]:='5C'xc; { * * } +ordx['2B'xc]:='00'x; { ... NUL } chrx['2B'x]:='4E'xc; { + + } +ordx['2C'xc]:='00'x; { ... NUL } chrx['2C'x]:='6B'xc; { , , } +ordx['2D'xc]:='05'x; { ENQ ENQ } chrx['2D'x]:='60'xc; { - - } +ordx['2E'xc]:='06'x; { ACK ACK } chrx['2E'x]:='4B'xc; { . . } +ordx['2F'xc]:='07'x; { BEL BEL } chrx['2F'x]:='61'xc; { / / } +ordx['30'xc]:='00'x; { ... NUL } chrx['30'x]:='F0'xc; { 0 0 } +ordx['31'xc]:='00'x; { ... NUL } chrx['31'x]:='F1'xc; { 1 1 } +ordx['32'xc]:='16'x; { SYN SYN } chrx['32'x]:='F2'xc; { 2 2 } +ordx['33'xc]:='00'x; { ... NUL } chrx['33'x]:='F3'xc; { 3 3 } +ordx['34'xc]:='00'x; { ... NUL } chrx['34'x]:='F4'xc; { 4 4 } +ordx['35'xc]:='00'x; { ... NUL } chrx['35'x]:='F5'xc; { 5 5 } +ordx['36'xc]:='00'x; { ... NUL } chrx['36'x]:='F6'xc; { 6 6 } +ordx['37'xc]:='04'x; { EOT EOT } chrx['37'x]:='F7'xc; { 7 7 } +ordx['38'xc]:='00'x; { ... NUL } chrx['38'x]:='F8'xc; { 8 8 } +ordx['39'xc]:='00'x; { ... NUL } chrx['39'x]:='F9'xc; { 9 9 } +ordx['3A'xc]:='00'x; { ... NUL } chrx['3A'x]:='7A'xc; { : : } +ordx['3B'xc]:='00'x; { ... NUL } chrx['3B'x]:='5E'xc; { ; ; } +ordx['3C'xc]:='14'x; { DC4 DC4 } chrx['3C'x]:='4C'xc; { < < } +ordx['3D'xc]:='15'x; { NAK NAK } chrx['3D'x]:='7E'xc; { = = } +ordx['3E'xc]:='00'x; { ... NUL } chrx['3E'x]:='6E'xc; { > > } +ordx['3F'xc]:='1A'x; { SUB SUB } chrx['3F'x]:='6F'xc; { ? ? } +ordx['40'xc]:='20'x; { SP SP } chrx['40'x]:='7C'xc; { @@ @@ } +ordx['41'xc]:='00'x; { ... NUL } chrx['41'x]:='C1'xc; { A A } +ordx['42'xc]:='00'x; { ... NUL } chrx['42'x]:='C2'xc; { B B } +ordx['43'xc]:='00'x; { ... NUL } chrx['43'x]:='C3'xc; { C C } +ordx['44'xc]:='00'x; { ... NUL } chrx['44'x]:='C4'xc; { D D } +ordx['45'xc]:='00'x; { ... NUL } chrx['45'x]:='C5'xc; { E E } +ordx['46'xc]:='00'x; { ... NUL } chrx['46'x]:='C6'xc; { F F } +ordx['47'xc]:='00'x; { ... NUL } chrx['47'x]:='C7'xc; { G G } +ordx['48'xc]:='00'x; { ... NUL } chrx['48'x]:='C8'xc; { H H } +ordx['49'xc]:='00'x; { ... NUL } chrx['49'x]:='C9'xc; { I I } +ordx['4A'xc]:='5E'x; { ã ã } chrx['4A'x]:='D1'xc; { J J } +ordx['4B'xc]:='2E'x; { . . } chrx['4B'x]:='D2'xc; { K K } +ordx['4C'xc]:='3C'x; { < < } chrx['4C'x]:='D3'xc; { L L } +ordx['4D'xc]:='28'x; { ( ( } chrx['4D'x]:='D4'xc; { M M } +ordx['4E'xc]:='2B'x; { + + } chrx['4E'x]:='D5'xc; { N N } +ordx['4F'xc]:='7C'x; { | | } chrx['4F'x]:='D6'xc; { O O } +ordx['50'xc]:='26'x; { & & } chrx['50'x]:='D7'xc; { P P } +ordx['51'xc]:='00'x; { ... NUL } chrx['51'x]:='D8'xc; { Q Q } +ordx['52'xc]:='00'x; { ... NUL } chrx['52'x]:='D9'xc; { R R } +ordx['53'xc]:='00'x; { ... NUL } chrx['53'x]:='E2'xc; { S S } +ordx['54'xc]:='00'x; { ... NUL } chrx['54'x]:='E3'xc; { T T } +ordx['55'xc]:='00'x; { ... NUL } chrx['55'x]:='E4'xc; { U U } +ordx['56'xc]:='00'x; { ... NUL } chrx['56'x]:='E5'xc; { V V } +ordx['57'xc]:='00'x; { ... NUL } chrx['57'x]:='E6'xc; { W W } +ordx['58'xc]:='00'x; { ... NUL } chrx['58'x]:='E7'xc; { X X } +ordx['59'xc]:='00'x; { ... NUL } chrx['59'x]:='E8'xc; { Y Y } +ordx['5A'xc]:='21'x; { ! ! } chrx['5A'x]:='E9'xc; { Z Z } +ordx['5B'xc]:='24'x; { $ $ } chrx['5B'x]:='AD'xc; { [ [ } +ordx['5C'xc]:='2A'x; { * * } chrx['5C'x]:='E0'xc; { \ \ } +ordx['5D'xc]:='29'x; { ) ) } chrx['5D'x]:='BD'xc; { ] ] } +ordx['5E'xc]:='3B'x; { ; ; } chrx['5E'x]:='4A'xc; { ã ã } +ordx['5F'xc]:='7E'x; { ^ ^ } chrx['5F'x]:='6D'xc; { _ _ } +ordx['60'xc]:='2D'x; { - - } chrx['60'x]:='79'xc; { ` ` } +ordx['61'xc]:='2F'x; { / / } chrx['61'x]:='81'xc; { a a } +ordx['62'xc]:='00'x; { ... NUL } chrx['62'x]:='82'xc; { b b } +ordx['63'xc]:='00'x; { ... NUL } chrx['63'x]:='83'xc; { c c } +ordx['64'xc]:='00'x; { ... NUL } chrx['64'x]:='84'xc; { d d } +ordx['65'xc]:='00'x; { ... NUL } chrx['65'x]:='85'xc; { e e } +ordx['66'xc]:='00'x; { ... NUL } chrx['66'x]:='86'xc; { f f } +ordx['67'xc]:='00'x; { ... NUL } chrx['67'x]:='87'xc; { g g } +ordx['68'xc]:='00'x; { ... NUL } chrx['68'x]:='88'xc; { h h } +ordx['69'xc]:='00'x; { ... NUL } chrx['69'x]:='89'xc; { i i } +ordx['6A'xc]:='00'x; { ... NUL } chrx['6A'x]:='91'xc; { j j } +ordx['6B'xc]:='2C'x; { , , } chrx['6B'x]:='92'xc; { k k } +ordx['6C'xc]:='25'x; { % % } chrx['6C'x]:='93'xc; { l l } +ordx['6D'xc]:='5F'x; { _ _ } chrx['6D'x]:='94'xc; { m m } +ordx['6E'xc]:='3E'x; { > > } chrx['6E'x]:='95'xc; { n n } +ordx['6F'xc]:='3F'x; { ? ? } chrx['6F'x]:='96'xc; { o o } +ordx['70'xc]:='00'x; { ... NUL } chrx['70'x]:='97'xc; { p p } +ordx['71'xc]:='00'x; { ... NUL } chrx['71'x]:='98'xc; { q q } +ordx['72'xc]:='00'x; { ... NUL } chrx['72'x]:='99'xc; { r r } +ordx['73'xc]:='00'x; { ... NUL } chrx['73'x]:='A2'xc; { s s } +ordx['74'xc]:='00'x; { ... NUL } chrx['74'x]:='A3'xc; { t t } +ordx['75'xc]:='00'x; { ... NUL } chrx['75'x]:='A4'xc; { u u } +ordx['76'xc]:='00'x; { ... NUL } chrx['76'x]:='A5'xc; { v v } +ordx['77'xc]:='00'x; { ... NUL } chrx['77'x]:='A6'xc; { w w } +ordx['78'xc]:='00'x; { ... NUL } chrx['78'x]:='A7'xc; { x x } +ordx['79'xc]:='60'x; { ` ` } chrx['79'x]:='A8'xc; { y y } +ordx['7A'xc]:='3A'x; { : : } chrx['7A'x]:='A9'xc; { z z } +ordx['7B'xc]:='23'x; { # # } chrx['7B'x]:='C0'xc; { lcurly } +ordx['7C'xc]:='40'x; { @@ @@ } chrx['7C'x]:='4F'xc; { | | } +ordx['7D'xc]:='27'x; { ' ' } chrx['7D'x]:='D0'xc; { rcurly } +ordx['7E'xc]:='3D'x; { = = } chrx['7E'x]:='9C'xc; { tilde } +ordx['7F'xc]:='22'x; { " " } chrx['7F'x]:='07'xc; { DEL DEL } +ordx['80'xc]:='00'x; { ... NUL } +ordx['81'xc]:='61'x; { a a } +ordx['82'xc]:='62'x; { b b } +ordx['83'xc]:='63'x; { c c } +ordx['84'xc]:='64'x; { d d } +ordx['85'xc]:='65'x; { e e } +ordx['86'xc]:='66'x; { f f } +ordx['87'xc]:='67'x; { g g } +ordx['88'xc]:='68'x; { h h } +ordx['89'xc]:='69'x; { i i } +ordx['8A'xc]:='00'x; { ... NUL } +ordx['8B'xc]:='00'x; { ... NUL } +ordx['8C'xc]:='00'x; { ... NUL } +ordx['8D'xc]:='00'x; { ... NUL } +ordx['8E'xc]:='00'x; { ... NUL } +ordx['8F'xc]:='00'x; { ... NUL } +ordx['90'xc]:='00'x; { ... NUL } +ordx['91'xc]:='6A'x; { j j } +ordx['92'xc]:='6B'x; { k k } +ordx['93'xc]:='6C'x; { l l } +ordx['94'xc]:='6D'x; { m m } +ordx['95'xc]:='6E'x; { n n } +ordx['96'xc]:='6F'x; { o o } +ordx['97'xc]:='70'x; { p p } +ordx['98'xc]:='71'x; { q q } +ordx['99'xc]:='72'x; { r r } +ordx['9A'xc]:='00'x; { ... NUL } +ordx['9B'xc]:='00'x; { ... NUL } +ordx['9C'xc]:='7E'x; { tilde } +ordx['9D'xc]:='00'x; { ... NUL } +ordx['9E'xc]:='00'x; { ... NUL } +ordx['9F'xc]:='00'x; { ... NUL } +ordx['A0'xc]:='00'x; { ... NUL } +ordx['A1'xc]:='1A'x; { ... SUB } +ordx['A2'xc]:='73'x; { s s } +ordx['A3'xc]:='74'x; { t t } +ordx['A4'xc]:='75'x; { u u } +ordx['A5'xc]:='76'x; { v v } +ordx['A6'xc]:='77'x; { w w } +ordx['A7'xc]:='78'x; { x x } +ordx['A8'xc]:='79'x; { y y } +ordx['A9'xc]:='7A'x; { z z } +ordx['AA'xc]:='00'x; { ... NUL } +ordx['AB'xc]:='00'x; { ... NUL } +ordx['AC'xc]:='00'x; { ... NUL } +ordx['AD'xc]:='5B'x; { [ [ } +ordx['AE'xc]:='00'x; { ... NUL } +ordx['AF'xc]:='00'x; { ... NUL } +ordx['B0'xc]:='00'x; { ... NUL } +ordx['B1'xc]:='00'x; { ... NUL } +ordx['B2'xc]:='00'x; { ... NUL } +ordx['B3'xc]:='00'x; { ... NUL } +ordx['B4'xc]:='00'x; { ... NUL } +ordx['B5'xc]:='00'x; { ... NUL } +ordx['B6'xc]:='00'x; { ... NUL } +ordx['B7'xc]:='00'x; { ... NUL } +ordx['B8'xc]:='00'x; { ... NUL } +ordx['B9'xc]:='00'x; { ... NUL } +ordx['BA'xc]:='00'x; { ... NUL } +ordx['BB'xc]:='00'x; { ... NUL } +ordx['BC'xc]:='00'x; { ... NUL } +ordx['BD'xc]:='5D'x; { ] ] } +ordx['BE'xc]:='00'x; { ... NUL } +ordx['BF'xc]:='00'x; { ... NUL } +ordx['C0'xc]:='7B'x; { lcurly } +ordx['C1'xc]:='41'x; { A A } +ordx['C2'xc]:='42'x; { B B } +ordx['C3'xc]:='43'x; { C C } +ordx['C4'xc]:='44'x; { D D } +ordx['C5'xc]:='45'x; { E E } +ordx['C6'xc]:='46'x; { F F } +ordx['C7'xc]:='47'x; { G G } +ordx['C8'xc]:='48'x; { H H } +ordx['C9'xc]:='49'x; { I I } +ordx['CA'xc]:='00'x; { ... NUL } +ordx['CB'xc]:='00'x; { ... NUL } +ordx['CC'xc]:='00'x; { ... NUL } +ordx['CD'xc]:='00'x; { ... NUL } +ordx['CE'xc]:='00'x; { ... NUL } +ordx['CF'xc]:='00'x; { ... NUL } +ordx['D0'xc]:='7D'x; { rcurly } +ordx['D1'xc]:='4A'x; { J J } +ordx['D2'xc]:='4B'x; { K K } +ordx['D3'xc]:='4C'x; { L L } +ordx['D4'xc]:='4D'x; { M M } +ordx['D5'xc]:='4E'x; { N N } +ordx['D6'xc]:='4F'x; { O O } +ordx['D7'xc]:='50'x; { P P } +ordx['D8'xc]:='51'x; { Q Q } +ordx['D9'xc]:='52'x; { R R } +ordx['DA'xc]:='00'x; { ... NUL } +ordx['DB'xc]:='00'x; { ... NUL } +ordx['DC'xc]:='00'x; { ... NUL } +ordx['DD'xc]:='00'x; { ... NUL } +ordx['DE'xc]:='00'x; { ... NUL } +ordx['DF'xc]:='00'x; { ... NUL } +ordx['E0'xc]:='5C'x; { \ \ } +ordx['E1'xc]:='00'x; { ... NUL } +ordx['E2'xc]:='53'x; { S S } +ordx['E3'xc]:='54'x; { T T } +ordx['E4'xc]:='55'x; { U U } +ordx['E5'xc]:='56'x; { V V } +ordx['E6'xc]:='57'x; { W W } +ordx['E7'xc]:='58'x; { X X } +ordx['E8'xc]:='59'x; { Y Y } +ordx['E9'xc]:='5A'x; { Z Z } +ordx['EA'xc]:='00'x; { ... NUL } +ordx['EB'xc]:='00'x; { ... NUL } +ordx['EC'xc]:='00'x; { ... NUL } +ordx['ED'xc]:='00'x; { ... NUL } +ordx['EE'xc]:='00'x; { ... NUL } +ordx['EF'xc]:='00'x; { ... NUL } +ordx['F0'xc]:='30'x; { 0 0 } +ordx['F1'xc]:='31'x; { 1 1 } +ordx['F2'xc]:='32'x; { 2 2 } +ordx['F3'xc]:='33'x; { 3 3 } +ordx['F4'xc]:='34'x; { 4 4 } +ordx['F5'xc]:='35'x; { 5 5 } +ordx['F6'xc]:='36'x; { 6 6 } +ordx['F7'xc]:='37'x; { 7 7 } +ordx['F8'xc]:='38'x; { 8 8 } +ordx['F9'xc]:='39'x; { 9 9 } +ordx['FA'xc]:='00'x; { ... NUL } +ordx['FB'xc]:='00'x; { ... NUL } +ordx['FC'xc]:='00'x; { ... NUL } +ordx['FD'xc]:='00'x; { ... NUL } +ordx['FE'xc]:='00'x; { ... NUL } +ordx['FF'xc]:='00'x; { ... NUL } +@z diff --git a/macros/text1/compugraphics_8600/fonttex.web b/macros/text1/compugraphics_8600/fonttex.web new file mode 100644 index 0000000000..6f2ce2858e --- /dev/null +++ b/macros/text1/compugraphics_8600/fonttex.web @@ -0,0 +1,1936 @@ +%test version +\font\twelvept=cmbx12 +\font\tentex=cmr10 +\def\topofcontents{\null + \def\titlepage{T} + \centerline{{\twelvept The FONTTEX Program}} + \vskip15pt + \centerline{Version 2, July 1986} + \hbox{\vbox{\hsize\the\hsize This work is + protected as an unpublished work under U.S. copyright laws. + Copyright $\copyright$ 1986 by WSUCSC. All rights Reserved.}} + \vskip18pt + \hbox{\vbox{\hsize\the\hsize This software is furnished under a + license for + use only on a single computer system and may be copied only + with the inclusion of the above copyright notice. + This software, or any other copies + thereof, may not be provided or otherwise made available to any + other person except for use on such system and to one who agrees to + these license terms. Title to and ownership of the software shall + at all times remain in WSUCSC.}} + \vfill} + +@* Introduction. + This version of fonttex writes font and driver information + into elements. Infile, a data file, must be assigned prior + the font data. + + Fonttex reads a font description source element, and creates + a \TeX\ font file (TFM) and an 8600 driver element. + + The font description source is divided into three sections. + The first section includes comments and parameters for the + entire font, the second describes the individual characters, + and the third provides information about ligatures, kerns, + linked math characters, and limit conventions on math + operators. Numeric information is given as integers, + or fractions depending on the context in which it + occurs. All sizes given will be scaled by the point size by + \TeX\ and so should reflect the sizes for 1-point + type. + + The first section can include comments, which begin with a + "*" in column one of the line. It also includes definitions + of numeric parameters for the \TeX\ and driver font files. + The parameter definitions consist of an alphabetic name + beginning in column 1 and ending with one or more blanks; + and a numeric value. Comments and parameters can be + interspersed. This section is ended by a line containing a + dollar sign in column 1. Although the order the parameters + are given in is not significant, we will discuss them in a + conventional order. The first two parameters are the + scaling factors for the heights, widths, and depths of the + characters given in section 2. These scaling factors are + called |HUNITS| and |VUNITS|. Both have real values. All + character widths are implicitly multiplied by |HUNITS|, and + all heights and depths by |VUNITS|. For the Compugraphic 8600 + we use |HUNITS|=1/54 and |VUNITS|=1/64, because of the internal + units used on the machine. The next several parameters give + information about the font needed by the 8600 driver. + |DEFFONT| specifies a font number on the typesetter. Unless + otherwise defined, all characters in this file come from + this font. |DEFWIDTH| gives the width multiplier. All + character widths are also multiplied by |DEFWIDTH|. Typically + |DEFWIDTH| is 1, but it could be less for condensed type and + more for expanded type. The remaining parameters are for + the \TeX\ font file. They all take real values. + + There should be 128 character entries in section two. + Information about character is given in free format columns, + which are separated by one or more blanks. Beginning in + column 1 is the character mnemonic. Most fonts use standard + ascii codes, so that character 65 is A, etc. For this + reason, any single character name will be checked to see + that it corresponds to the appropriate ascii value. If not a + warning is issued. + Following this may be the keyword + LIGATURE or BUILD describing ligatures and built-up math + delimiters. This is omitted for ordinary characters. The + ligature keyword indicates that this character should be + substituted for a combination of two other characters. + Following the keyword should be the names of the two + characters separated by a plus sign. For example, fi + LIGATURE f+i and: ff LIGATURE f+f ffl LIGATURE ff+l. + For the + BUILD keyword, the character will be made from pieces. + There can be a top, bottom, middle, and extension character. + All are optional except the extension character. This is + specified as BUILD keyword=charname,keyword=charname,... + For instance, bigparen BUILD + TOP=parentop,MID=parenmid,BOT=parenmid. + The third field of + information is the character width, the fourth the height, + and the fifth the depth. Widths are given relative to the + point size and are implicitly multiplied by the |HUNITS| + parameter. Likewise height and depth are relative and are + multiplied by |VUNITS|. For example, the typical value of + |HUNITS| is 1/54. Then a character width given as 27 means + that the character is 0.5 times the point size in width. The + point size will be determined when the file is referred to + in \TeX , and the character sizes will be multiplied by it as + the file is read into \TeX . The sixth column gives 8600 + commands and character codes. The commands have integer or + real parameters. Most characters will have a single character + code, and will be selected from the default font. An + alternate font can be specified by the F command. 8600 code + can also include point size commands, psuedo-italic + commands, etc. Refer to the module discussing ``Reading the + 8600 Codes.'' + + The final section specifies kerns, linked math characters, + and math operator conventions. A kern is an amount of + horizontal space to be subtracted between two characters. + It is specified as KERN A+W 5/100 for instance, to shave + 5/100 of the point size between occurences of A and W. + Linking occurs in math extension fonts where various sizes + of parentheses, brackets, and so forth occur. To link one + character to the next larger size of the same symbol, + specify LINK charname1 charname2 Finally, a character is + specified to be a mathop by the MATHOP keyword. (Common + mathops are sum and integral signs.) Following the keyword + is the character name and a real number. If the real number + is zero, limits for the operator will be centered above and + below it in display style. If non-zero, limits are set to + the right of the symbol, and the lower limit is moved left + by this amount. + + Some further detail on the methods and data structures used + by Fonttex. Widths, heights, depths, and italic corrections + are stored in arrays of reals (type realarray). Entry -1 + gives the highest numbered entry used so far. When a height, + depth, etc is read from the input file, procedure |AddToList| + is called to add the value to the array and return the index + of the entry in the array. If two or more characters have + the same dimension, the value is stored only once and the + characters have identical indices pointing to it. In the TFM + format font files, each character has an index into the + width, height, depth, italic correction arrays, and the + arrays of values are given separately. (See TUGboat volume + 2, no 1; or the comments in Sysdep at |ReadFontInfo| for more + details on the font file format.) + + Ligatures are specified by giving the name of the two + "component" characters of the ligature. These are saved in + an array of records, "lig" until the entire pre-file has + been read. Then a pass is made through these records to look + up all the names of the component characters, and a another + pass is made through the lig records to group them by the + first character of the ligature and add a pointer in the + outstuff array for that character pointing to the + ligature/kern program. The same is done with kern + specifications and the final pass over both is done + simultaneously. + + Extendible characters made from top, bottom, middle, and + extension pieces are marked at the character entry, and the + names of the pieces are saved in array ext until the file + has been read. The tag value and pointer into the ext array + are set in outstuff when the line is read in |ReadBuildStuff|, + but the character numbers for the ext array itself are not + found until after the entire file has been read. + + When records are written to the driver and font files they + can be displayed by compiling Fonttex with "drvdump" and + "dump" respectively set to true. + +@ Following are a few macros and definitions used throughout program: + +@d incr(#) == # := # + 1 +@d decr(#) == # := # - 1 +@d do_nothing == begin; end +@d ccat==@=||@> +@f static == var +@f value == var + +@ The beginning of the program. + +@p program fonttex(terminal,sysprint,fontpkt,drvpkt,infile); +const + @<Global Constants@>@/ +type + @<Global Types@>@/ +var + @<Global Variables@>@/ +static@/ + @^system dependencies@> + com_table :packed array[0..18] of string(7);@/ +value@/ + com_table[0] := 'HDR'; {Header Record}@/ + com_table[1] := 'CHWIDTH';{Character Width}@/ + com_table[2] := 'RT'; {Reverse Type}@/ + com_table[3] := 'PS'; {Point Size}@/ + com_table[4] := 'SS'; {Set Size}@/ + com_table[5] := 'VMF'; {Vertical Move Forward}@/ + com_table[6] := 'VMR'; {Vertical Move Reverse}@/ + com_table[7] := 'RW'; {Rule Width}@/ + com_table[8] := 'RD'; {Rule Depth}@/ + com_table[9] := 'IR'; {Insert Rule}@/ + com_table[10] := 'SL'; {Slant Mode}@/ + com_table[11] := 'RTWT'; {Reverse Type Window Top}@/ + com_table[12] := 'RTWB'; {Reverse Type Window Bottom}@/ + com_table[13] := 'AU'; {Auxiliary Character Set}@/ + com_table[14] := 'F'; {Change Fonts}@/ + com_table[15] := 'HMR'; {Horizontal Move Right}@/ + com_table[16] := 'HML'; {Horizontal Move Left}@/ + com_table[17] := 'TTS'; {8600 character, in decimal}@/ + com_table[18] := 'MAXCMD';@/ +%include pasclib(asciicvt)@/ + +@* Beginning section. +This section includes some basic functions for reading the DVI file +as well as a couple of procedures, like error and allcaps. Nothing +tricky or noteworthy in these. + +@<Global Constants@>= + maxkerns = 255; + num_entries = 128; {maximum number of characters entered} + +@ +@<Global Types@>= + oneoftwo = packed 1..2; + oneoffour = packed 1..4; + bytes4 = packed record + byte0 :packed 0..255; + byte1 :packed 0..255; + case oneoftwo of + 1 :(rhword :packed 0..65535); + 2 :(byte2 :packed 0..255; + byte3 :packed 0..255) + end; + charindex = 0..127;@\ + comm = (HDR,CHWIDTH,RT,PS,SS,VMF,VMR,RW,RD,IR,SL, + RTWT,RTWB,AU,F,HMR,HML,TTS,MAXCMD);@\ + driverrec = record + cmd :integer; + case oneoftwo of + 1 :(param :shortreal); + 2 :(code :integer); + end; + extrec = record + sourceline:integer; + topname,botname,extname,midname :string(40); + top,bot,mid,ext :charindex; + end; + fonttypes = (standard,mathex,mathsy); + halves2 = packed record + lhword :packed 0..65535; + case oneoftwo of + 1 :(rhword :packed 0..65535); + 2 :(byte2 :packed 0..255; + byte3 :packed 0..255) + end; + kernrec = record + frstchar :charindex; + scndchar :charindex; + kernslot :integer; + end; + ligrec = record + sourceline :integer; + firstname :string(40); + scndname :string(40); + frstchar :charindex; + scndchar :charindex; + ligcode :charindex; + end; + memoryword = packed record case oneoffour of + 1 :(pts :shortreal); + 2 :(int :integer); + 3 :(twohalves :halves2); + 4 :(fourbytes :bytes4) + end; + outarray = array[charindex] of memoryword; + parameter = (slant,spacee,spstretch,spshrink, + xheight,quad,extraspace, + raisen1,raisen2,raisen3, + denom1,denom2,sup1,sup2, + sup3,sub1,sub2,supdrop,subdrop, + dlims1,dlims2,axisheight, + defthickness,bgopsp1, + bgopsp2,bgopsp3, + bgopsp4,bgopsp5); + realarray = array[-1..num_entries] of real; + +@ This function will convert whatever is passed to it into +all capital letters. It translates lower case letters into upper case +letters. All other characters outside of the range +a$<$=character$<$=z are returned as their original value. + +@^system dependencies@> +@p function allcaps(instring :string(40)) :string(40); +var + i :integer; + character :char; + buildit :string(40); +static + chtable :packed array['81'xc..'e9'xc] of char; +value + chtable['81'xc] := 'A'; + chtable['82'xc] := 'B'; + chtable['83'xc] := 'C'; + chtable['84'xc] := 'D'; + chtable['85'xc] := 'E'; + chtable['86'xc] := 'F'; + chtable['87'xc] := 'G'; + chtable['88'xc] := 'H'; + chtable['89'xc] := 'I'; + chtable['91'xc] := 'J'; + chtable['92'xc] := 'K'; + chtable['93'xc] := 'L'; + chtable['94'xc] := 'M'; + chtable['95'xc] := 'N'; + chtable['96'xc] := 'O'; + chtable['97'xc] := 'P'; + chtable['98'xc] := 'Q'; + chtable['99'xc] := 'R'; + chtable['a2'xc] := 'S'; + chtable['a3'xc] := 'T'; + chtable['a4'xc] := 'U'; + chtable['a5'xc] := 'V'; + chtable['a6'xc] := 'W'; + chtable['a7'xc] := 'X'; + chtable['a8'xc] := 'Y'; + chtable['a9'xc] := 'Z'; +begin + buildit := ''; + for i := 1 to length(instring) do begin + readstr(substr(instring,i,1),character); + if character in ['a'..'z'] + then buildit := buildit || str(chtable[character]) + else buildit := buildit || str(character); + end; + allcaps := buildit; + end; + +@ This function receives an integer value and converts it to its +hex value and returns that value as a string. + +@^system dependencies@> +@p function hex(int :integer) :string(8); +var + i :integer; + j :integer; + k16 :integer; + stri :string(8); +static + hexarray :array[0..15] of string(1); +value + hexarray[0] := '0'; + hexarray[1] := '1'; + hexarray[2] := '2'; + hexarray[3] := '3'; + hexarray[4] := '4'; + hexarray[5] := '5'; + hexarray[6] := '6'; + hexarray[7] := '7'; + hexarray[8] := '8'; + hexarray[9] := '9'; + hexarray[10] := 'A'; + hexarray[11] := 'B'; + hexarray[12] := 'C'; + hexarray[13] := 'D'; + hexarray[14] := 'E'; + hexarray[15] := 'F'; +begin + stri := ''; + i := int; + if i < 0 then begin + stri := 'FF'; + i := 'FFFFFF'x + i + 1; + end; + k16 := 1048576; + repeat + if i >= k16 + then begin + j := i div k16; + stri := stri || hexarray[j]; + i := i - (j * k16); + end + else if length(stri) > 0 + then stri := stri || '0'; + k16 := k16 div 16; + until k16 = 1; + stri := stri || hexarray[i]; + i := length(stri); + if (i = 1) or (i = 3) or (i = 5) + then stri := '0' || stri; + hex := stri; + end; + +@ +@<Global Types@>= + oneofsix = 1..6; + +@ +@<Global Variables@>= + dump :boolean; + fontpkt :file of memoryword; + inx :integer; + name :array[0..127] of string(40); + outcount :integer; + outrec :memoryword; + +@ +@p procedure writeout(outrec :memoryword; + outtype :oneofsix); +var + length :integer; +begin + if dump then begin + write(outcount:6,': '); + case outtype of + 1 :writeln('Pts=',outrec.pts); + 2 :begin + writeln('Fix=',outrec.int); + end; + 3 :with outrec.twohalves do + writeln('lhword=',lhword,',rhword=',rhword); + 4 :with outrec.fourbytes do + writeln(' Byte0=',byte0:3,'=>"',hex(byte0),'"', + ',Byte1=',byte1:3,'=>"',hex(byte1),'"', + ',Byte2=',byte2:3,'=>"',hex(byte2),'"', + ',Byte3=',byte3:3,'=>"',hex(byte3),'"'); + 5 :with outrec.fourbytes do + writeln(' Width inx =',byte0:3, + ',Height inx= ',byte1 div 16:2, + ',Depth inx =',byte1 mod 16:2, + ',ItCor inx= ',byte2 div 4:2, + ',Tag =',byte2 mod 4:1, + ',Rem =',byte3:2, + ',chr="',name[inx],'"'); + 6 :writeln(outrec.int:1); + end;{case} + end;{if} + outcount := outcount + 1; {count it} + fontpkt@@ := outrec; + put(fontpkt); + end; {writeout} + +@ +@<Global Types@>= +@!error_severity = (fatal,notreallyfatal,overlookable); + +@ +@<Global Variables@>= +@!currchar :charindex; +@!errlin :integer; +@!errlstr :string(10); +@!errmax :integer; +@!errmin :integer; +@!errnum :integer; +@!errstr :string(133); +@!infile :text; +@!lenfile :integer; +@!lineno :integer; +@!sysprint :text; + +@ The error procedure. When a byte is read that does not jive with +what the program was expecting, it goes to this procedure with a +return code of some kind and an appropriate message is printed to user. + +@p procedure error(err :integer; + howbad :error_severity); +begin + if errlin = 0 then errlin := lineno; + {The caller can override the current line by setting errlin} + case err of + 0 :writeln('Empty input file'); + 1 :writeln('Unrecognized keyword :',errstr); + 2 :begin + write('Number of entries must be specified'); + writeln(' before the entries appear'); + end; + 4 :begin + write('Integer expected but not found: next char='); + if eoln(infile) + then writeln('end of line') + else writeln(infile@@); + end; + 5 :writeln('Too many unique widths, depths, or heights'); + 6 :begin + writeln('Entries in font file are out of sequence:'); + writeln('The entry labelled ',errstr[1], + ' has a sequence ', 'of ',currchar:3, + ', not its Ascii value ',ordx[errstr[1]]:3); + end; + 7 :writeln('Ran out of entries in font file prematurely'); + 8 :writeln('Real value given for parameter ',errstr, + ', but integer required'); + 9 :writeln('The character names in a ligature or kern ', + 'have to be separated by a "+"'); + 10 :writeln('Knave! No space should follow thine plus sign'); + 11 :writeln('We expected to see a keyword here, not ', + errstr,'. Perhaps you have too many ', + 'character entries, or (gasp!) a typo'); + 12 :writeln('You never specified "',errstr, + '" as a character name'); + 13 :writeln('Keyword should be TOP,BOT,MID,EXT, not "', + errstr:3,'"'); + 14 :writeln('You''ve specified parameters for both ', + 'mathex and mathsy fonts'); + 15 :writeln('Expected to write ',lenfile:3,' records, ', + 'but actually wrote ',outcount:3); + 16 :writeln('After character name should be BUILD, ', + 'LIGATURE, or integer, not ',errstr); + 17 :writeln('Invalid value for parameter ',errlstr,', ', + errnum,' is <',errmin,' or >',errmax); + 18 :writeln('TTS codes must be within 0 to 127'); + 19 :writeln(errlstr,' is not a valid 8600 command'); + 20 :writeln('There is no 8600 code given for character ', + errstr:1); + 21 :writeln('Bad character for 8600 code :',infile@@); + 24 :writeln('Major font number should be between 1 and ', + maxfont:3); + 27 :writeln('Fontname too long, truncated to 8 characters'); + 28 :writeln('Invalid input values for tracing, ', + 'record "',errlstr,'" skipped'); + otherwise writeln('Unspecified error number ',err:3); + end; {case} + if howbad = fatal + then begin + writeln('Fatal error ends program at input line', + errlin:4); + trace(sysprint); + halt; + end + else writeln('Error at input line',errlin:4); + if (not eof(infile)) and (howbad = overlookable) + then begin + readln(infile); + writeln('rest of this string has been overlooked'); + end; + errlin := 0; {reset default line to lineno} + end; {Error} + +@ +@p procedure skipblanks; +begin + while (infile@@=' ') and not eoln(infile) do + get(infile); {advance one character} + end; + +@ +@<Global Types@>= +@!chrset = set of char; + +@ This procedure reads a string from infile to be delimited by +a character in the set delimiters. + +@p procedure readmnemonic(var mn :string(40); + delimiters :chrset); +var + str :string(1); +begin + mn := ''; + while (length(mn) <= 40) and not (infile@@ in delimiters) do begin + read(infile,str); +{writeln('character="',str);} + mn := mn || str; + end; + errstr := mn; {save globally for error messages} + end; {readmnemonic} + +@ +@<Global Constants@>= + exspacekey = 'EXTRASPACE'; + quadkey = 'QUAD'; + slantkey = 'SLANT'; + spaceekey = 'SPACE'; + spshrkey = 'SPSHRINK'; + spstrkey = 'SPSTRETCH'; + xhtkey = 'XHEIGHT'; + +@ +@p procedure printparam(p :parameter); +begin + case p of + slant :write(slantkey:5); + spacee :write(spaceekey:6); + spstretch :write(spstrkey:9); + spshrink :write(spshrkey:8); + xheight :write(xhtkey:7); + quad :write(quadkey:4); + extraspace:write(exspacekey:10); + otherwise write(' next math parm'); + end; {case} + end; {printparam} + +@ This converts the byte to an integer, for further evaluation by +the program. + +@p procedure readinteger(var int :integer); +var + minusint :integer; +begin + skipblanks; + if not (infile@@ in ['0'..'9','-']) then error(4,fatal); + if infile@@ = '-' + then begin + get(infile); + readinteger(minusint); + int := 0 - minusint; + end + else read(infile,int); + end; {readinteger} + +@ Reads series of integers separated by * and /. Returns + value in fractional form: multiplier/divisor is the real value + +@p procedure readexpr(var multiplier :integer; + var divisor :integer); +var + op :char; + int :integer; +begin + skipblanks; + if infile@@ = ' ' then error(4,fatal); + op := '*'; + multiplier := 1; + divisor := 1; + while not (infile@@ in [' ',',']) do begin + readinteger(int); + if op = '*' + then multiplier := multiplier * int + else divisor := divisor * int; + if (infile@@ = '*') or (infile@@ = '/') + then read(infile,op); + end; {while} + end; {readexpr} + +@ +@p procedure readreal(var r :real); +var + mult :integer; + divs :integer; +begin + readexpr(mult,divs); + r := (1.0 * mult)/(1.0 * divs); + end; + +@ +@<Global Constants@>=@/ + axishtkey = 'AXISHEIGHT'; + bosp1key = 'BIGOPSPACE1'; + bosp2key = 'BIGOPSPACE2'; + bosp3key = 'BIGOPSPACE3'; + bosp4key = 'BIGOPSPACE4'; + bosp5key = 'BIGOPSPACE5'; + codingschemekey = 'CODINGSCHEME'; + deffontkey = 'DEFFONT'; + dethicknesskey = 'DEFTHICKNESS'; + dewidthkey = 'DEFWIDTH'; + dlims1key = 'DELIMSIZE1'; + dlims2key = 'DELIMSIZE2'; + denom1key = 'DENOMLOWER1'; + denom2key = 'DENOMLOWER2'; + fntnamekey = 'FONTNAME'; + hunitskey = 'HUNITS'; + raizen1key = 'NUMRAISE1'; + raizen2key = 'NUMRAISE2'; + raizen3key = 'NUMRAISE3'; + ptsizekey = 'POINTSIZE'; + subdrpkey = 'SUBDROP'; + sub1key = 'SUB1'; + sub2key = 'SUB2'; + supdrpkey = 'SUPDROP'; + sup1key = 'SUP1'; + sup2key = 'SUP2'; + sup3key = 'SUP3'; + vunitskey = 'VUNITS'; + maxfont = 255; + uninitialized = -5000.0; + +@ +@<Global Variables@>= + codescheme :string(40); + def_ft_stuff :driverrec; + def_width_stuff :driverrec; + fontname :string(40); + fontype :fonttypes; + hunits :real; + params :array[parameter] of real; + paramset :array[fonttypes] of set of parameter; + pointsize :integer; + uniquecode :integer; + vunits :real; + +@ +@p procedure read_the_parameters; +label 0; +var + mn :string(40); + int :integer; + realval :real; + mult :integer; + divs :integer; + isint :boolean; + pp :parameter; + parmerror :boolean; +begin + while infile@@ in ['A'..'Z','a'..'z','*'] do + if (infile@@ = '*') + then begin + readln(infile); + errlin := errlin + 1; + end + else begin + @<read vunits or hunits or parameter@> + {You can end the parameters with a '\$' line -- check it} + if infile@@ = '$' + then begin + readln(infile); {Skip end params marker} + errlin := errlin + 1; + end; + {now check that all parameters are given} +0: parmerror := false; + for pp := slant to bgopsp5 do + if (params[pp] = uninitialized) and + (pp in paramset[fontype]+paramset[standard]) + then begin + write('Parameter '); + printparam(pp); + writeln(' was not specified'); + parmerror := true; + end; + if parmerror then error(7,fatal); + end; {|read_the_parameters|} + +@ +@<read vunits or hunits or parameter@>= + readmnemonic(mn,[' ']); + if dump then write('Parameter ',mn); + mn := allcaps(mn); + if mn = 'ENDPARAMS' + @<endparams@> + if (mn <> fntnamekey) and (mn <> codingschemekey) + then readexpr(mult,divs); + if divs = 0 + then realval := 1.0 * mult + else realval := (1.0 * mult)/(1.0 * divs); + int := mult; + if divs = 1 + then isint := true + else isint := false; {only reals have divisor} + if mn = hunitskey + @<hunits@> + else if mn = vunitskey + @<vunits@> + else if mn = fntnamekey + @<fontname@> + else if mn = codingschemekey + @<codingscheme@> + else if mn = deffontkey + @<deffont@> + else if mn = dewidthkey + @<defwidth@> + else if mn = ptsizekey + @<pointsize@> + else begin + @<TEX standard parameter@> + readln(infile); + errlin := errlin + 1; + end; {else..begin} + +@ + @<endparams@>= + then begin + readln(infile); + errlin := errlin + 1; + goto 0; {marks end of parameters} + end; + +@ + @<hunits@>= + then begin + hunits := realval; + if dump then writeln(' = ',realval); + end + +@ + @<vunits@>= + then begin + vunits := realval; + if dump then writeln(' = ',realval); + end + +@ + @<fontname@>= + then begin + skipblanks; + readmnemonic(fontname,[' ','.']); + fontname := allcaps(fontname); + if dump then writeln(' = ',fontname); + end + +@ + @<codingscheme@>= + then begin + skipblanks; + readmnemonic(codescheme,[' ','.']); + codescheme := allcaps(codescheme); + if dump then writeln(' = ',codescheme); + end + +@ + @<deffont@>= + then {set up |def_ft_stuff| record} + with def_ft_stuff do begin + cmd := ord(F); {8600 font command} + if int > maxfont + then error(24,notreallyfatal); + code := int * 10; + uniquecode := int; + if dump then writeln(' = ',int); + end + +@ + @<defwidth@>= + then {set up |def_width_stuff| record} + with def_width_stuff do begin + {ratio of set width to point size} + cmd := ord(CHWIDTH); + param := realval; + if dump then writeln(' = ',realval); + end + +@ + @<pointsize@>= + then begin + pointsize := int; + if dump then writeln(' = ',int); + end + +@ + @<TEX standard parameter@>= + if mn = slantkey + then pp := slant + else if mn = spaceekey + then pp := spacee + else if mn = spstrkey + then pp := spstretch + else if mn = spshrkey + then pp := spshrink + else if mn = xhtkey + then pp := xheight + else if mn = quadkey + then pp := quad + else if mn = exspacekey + then pp := extraspace + @<TEX mathsy parameter@> + @<TEX mathex parameter@> + else error(1,fatal); + params[pp] := realval; {save value of it} + if dump then writeln(' = ',realval); + if pp in paramset[mathex] + then begin + if fontype = standard + then fontype := mathex + else if fontype <> mathex + then error(14,fatal); + end + else if pp in paramset[mathsy] + then begin + if fontype = standard + {change assumption} + then fontype := mathsy + else if fontype <> mathsy + then error(14,fatal); + end; {then..begin} + end; {else..begin TEX} + +@ + @<TEX mathsy parameter@>= + else if mn = raizen1key + then pp := raisen1 + else if mn = raizen2key + then pp := raisen2 + else if mn = raizen3key + then pp := raisen3 + else if mn = denom1key + then pp := denom1 + else if mn = denom2key + then pp := denom2 + else if mn = sup1key + then pp := sup1 + else if mn = sup2key + then pp := sup2 + else if mn = sup3key + then pp := sup3 + else if mn = sub1key + then pp := sub1 + else if mn = sub2key + then pp := sub2 + else if mn = supdrpkey + then pp := supdrop + else if mn = subdrpkey + then pp := subdrop + else if mn = dlims1key + then pp := dlims1 + else if mn = dlims2key + then pp := dlims2 + else if mn = axishtkey + then pp := axisheight + +@ + @<TEX mathex parameter@>= + else if mn = dethicknesskey + then pp := defthickness + else if mn = bosp1key + then pp := bgopsp1 + else if mn = bosp2key + then pp := bgopsp2 + else if mn = bosp3key + then pp := bgopsp3 + else if mn = bosp4key + then pp := bgopsp4 + else if mn = bosp5key + then pp := bgopsp5 + +@ finds entry in array list if present and returns its index + as slot. otherwise it adds it at the end of list (specified + by list[-1]) and returns that index as slot. + +@p procedure add_to_list(var list :realarray; + entry :real; + lmax :integer; + var slot :integer); +var + linx :integer; +begin + if entry = 0 then begin + slot := 0; + return; + end; + for linx := 1 to trunc(list[-1]) do + if entry = list[linx] + then begin + slot := linx; + return; + end; + {not found} + if trunc(list[-1]) = lmax then error(5,fatal); + list[-1] := list[-1] + 1.0; + list[trunc(list[-1])] := entry; + slot := trunc(list[-1]); + end; {|add_to_list|} + +@ +@<Global Variables@>= + max :array[comm] of integer; + min :array[comm] of integer; + +@ Sets up info needed to read driver file info from the input + file, and write it in proper format into the driver output file + +@p procedure init8600commands; +var + cmd :comm; +begin + for cmd := HDR to MAXCMD do begin {initialize 8600 commands} + if cmd in [PS,SS] then begin + min[cmd] := 0; + max[cmd] := 1275; + end + else if cmd in [VMF, VMR, RD] then begin + min[cmd] := 1; + max[cmd] := 1736; + end + else if cmd in [RW, HML, HMR] then begin + min[cmd] := 1; + max[cmd] := 14688; + end + else if cmd in [SL] then begin + min[cmd] := 0; + max[cmd] := 48; + end + else if cmd in [RTWT, RTWB] then begin + min[cmd] := 0; + max[cmd] := 1440; + end + else if cmd in [F] then begin + min[cmd] := 1; + max[cmd] := 255; + end + else begin {catch any others} + min[cmd] := 0; + max[cmd] := 65535; {largest 2 byte integer} + end; + end; {FOR..begin} + end; {init8600commands} + +@ +@<Global Variables@>= + depth :realarray; + drvdump :boolean; + drvpkt :file of driverrec; + drvoutcount :integer; + dumpval :boolean; + height :realarray; + inrec :string(30); + itcorr :realarray; + kernout :realarray; + numext :integer; + numkerns :integer; + numligs :integer; + numparams :array[fonttypes] of integer; + outstuff :outarray; + str1 :string(30); + str2 :string(30); + terminal :text; + width :realarray; + +@ +@p procedure initialize; +var + pp :parameter; + outinx :integer; +begin + fontname := trim(parms); + termout(terminal); + termout(output); + rewrite(fontpkt,'NAME='||fontname||'.PRTFM.A'); + rewrite(drvpkt,'NAME='||fontname||'.CGINFO.A'); + reset(infile,'NAME='||fontname||'.FONTINFO.*'); + dump := false; + drvdump := false; +{ + while not eof(terminal) do begin + readln(terminal,inrec); + inx := index(inrec,'='); + if inx < 1 + then begin + errstr := inrec; + error(28,notreallyfatal); + end + else begin + str1 := substr(inrec,1,inx-1); + str2 := substr(inrec,inx+1,length(inrec)-inx); + str1 := allcaps(ltrim(trim(str1))); + str2 := allcaps(ltrim(trim(str2))); + if str2 = 'false' + then dumpval := false + else if str2 = 'true' + then dumpval := true; + if ((str2 <> 'false') and (str2 <> 'true')) or + ((str1 <> 'DUMP') and (str1 <> 'DRVDUMP')) + then begin + errstr := inrec; + error(28,notreallyfatal); + end + else if str1 = 'DUMP' + then dump := dumpval + else drvdump := dumpval; + end; + end; +} + hunits := 1.0 / 54.0; + vunits := 1.0 / 8.0; + lineno := 1; + width[-1] := 0; + width[0] := 0.0; {for non-existent chars} + height[-1] := 0; + height[0] := 0.0; {for non-existent chars} + depth[-1] := 0; + depth[0] := 0.0; {for non-existent chars} + itcorr[-1] := 0; + itcorr[0] := 0.0; {for non-existent chars} + kernout[-1] := 0.0; + kernout[0] := 0.0; + {Set all tag values to 0 = vanilla} + for outinx := 0 to 127 do outstuff[outinx].fourbytes.byte2 := 0; + numkerns := -1; + numligs := -1; + numext := -1; + fontname := ' '; + codescheme := 'PARC TEXT'; + fontype := standard; + paramset[standard] := [slant..quad,extraspace]; + paramset[mathsy] := [raisen1..axisheight]; + paramset[mathex] := [defthickness..bgopsp5]; + pointsize := 1; + numparams[standard] := 7; + numparams[mathex] := 13; + numparams[mathsy] := 22; + for pp := slant to extraspace do params[pp] := uninitialized; + drvoutcount := 0; {no records to driver file yet} + init8600commands; + with def_ft_stuff do begin + cmd := ord(F); + code := 10; {font 1, fontlet 0 = def} + end; + with def_width_stuff do begin + cmd := ord(CHWIDTH); + param := 1.0; {normal width type is def} + end; + end;{initialize} + +@ +@p procedure readentry(var list :realarray; + lmax :integer; + var slot :integer; + units :real); +var + entry :real; + multiplier :integer; + divisor :integer; {save value in expression} +begin + readexpr(multiplier,divisor); + entry := (1.0 * multiplier) / (1.0 * divisor) * units; + if dump then writeln('entry read is ',multiplier:4,'/', + divisor:4,' * ',units:4:2, '=',entry); + add_to_list(list,entry,lmax,slot); + end; {readentry} + +@ +@<Global Variables@>= + lig :array[0..255] of ligrec; + +@ The keyword LIGATURE has just been scanned in the input for one of +characters 0 to 127. Now we expect to find blank separators followed +by the names of the two characters the ligature replaces. These will +be separated by a '+' sign. Since the characters in question may +not have been specified yet, the names will be saved for now, and +looked up after all 128 character entries have been read. + +@ +@p procedure read_ligature_stuff; +begin + skipblanks; + numligs := numligs+1; + with lig[numligs] do begin + sourceline := lineno; {save line for later error messages} + readmnemonic(firstname,[' ','+']); + if dump then writeln('first char of ligature is ',firstname); + if infile@@ <> '+' + then error(9,notreallyfatal) + else begin + get(infile); {skip plus sign} + if infile@@ = ' ' then error(10,overlookable); + skipblanks; {overlook} + readmnemonic(scndname,[' ']); {read second name} + if dump then writeln('second character of ligature', + ' is ',scndname); + end; {else..begin} + ligcode := currchar; + end; {with..begin} + end; {|read_ligature_stuff|} + +@ + @<Global Variables@>=@/ + charno :charindex; + +@ look up this name in the name array and tell where and if it was + +@p procedure lookup(lookee :string(40); + var charno :charindex; {where if found} + var found :boolean); {was it found} +var + inx :integer; +begin + found := false; + inx := 0; + while not found and (inx<128) do + if name[inx] = lookee + then found := true {found} + else inx := inx + 1; {check next} + if found + then charno := inx + else charno := 127; {not found, avoid out of range err} + if not found + then begin + errstr := lookee; {string for message} + error(12,notreallyfatal); + end; {then..begin} + end; {lookup} + +@ Set Tag value in lower 2 bits of byte 2 of outstuff record + +@p procedure set_tag_val(chinx :charindex; + tagval :integer); +begin + with outstuff[chinx].fourbytes do begin + if (byte2 mod 4) <> 0 + then writeln('Tag for char ',chinx:1, + ' already set to ',byte2 mod 4); + if tagval > 3 then error(25,fatal); + byte2 := (byte2 div 4 * 4) + tagval; + end; {with..begin} + end; {|set_tag_val|} + +@ Convert a real to a "FIX" which is a 32-bit number stored in the +leftmost 32 bits of a word. The first 12 bits are the integer part, and +the last 20 are the fraction. The left most bit is the sign + +@p function scaleout(r :real) :integer; +var + stri :string(8); + int :integer; +begin + int := round(r*'100000'x); + if dump then begin + stri := hex(int); + if length(stri) < 8 + then stri := substr('00000000',1,8-length(stri)) || stri; + writeln('FIX of ',r,' is ',int,', hex value="',stri,'"'); + end; + scaleout := int; + end; {scaleout} + +@ +@<Global Variables@>= + found :boolean; + kern :array[0..maxkerns] of kernrec; + mnem :string(40); + +@ The keyword KERN has been read: process the rest of the line + +@p procedure read_kern_stuff; +begin + numkerns := numkerns + 1; + skipblanks; + with kern[numkerns] do begin + readmnemonic(mnem,[' ','+']); + lookup(mnem,charno,found); + if found + then frstchar := charno + else begin + frstchar := 127; + error(12,notreallyfatal); + end; {else..begin} + if infile@@ = ' ' + then begin + error(9,notreallyfatal); + scndchar := 127; {put any old value there} + end + else begin + get(infile); {skip plus sign} + if infile@@ = ' ' + then error(10,overlookable); + skipblanks;{overlook it!} + readmnemonic(mnem,[' ','-']); + lookup(mnem,charno,found); + if found + then scndchar := charno + else scndchar := 127; + end; {else..begin} + readentry(kernout,maxkerns,kernslot,hunits); + end; {with} + readln(infile); + errlin := errlin + 1; + end; {|read_kern_stuff|} + +@ +@<Global Constants@>= + linktag = 2; + +@ +@p procedure read_link_stuff; +var + mn1 :string(40); + mn2 :string(40); + char1 :charindex; + char2 :charindex; + found :boolean; +begin + skipblanks; + readmnemonic(mn1,[' ']); + lookup(mn1,char1,found); + skipblanks; + readmnemonic(mn2,[' ']); + lookup(mn2,char2,found); + set_tag_val(char1,linktag); {set tag type for special info} + outstuff[char1].fourbytes.byte3 := char2; {next bigger char} + readln(infile); + errlin := errlin + 1; + end; + +@ +@<Global Constants@>= + maxitcorr = 63; + +@ +@p procedure read_mathop_stuff; +var + mn :string(40); + charno :charindex; + realval :real; + found :boolean; + slot :integer; {index into itcorr array for kerns} + tag :integer; {saves "tag" value from outstuff array} +begin + skipblanks; + readmnemonic(mn,[' ']); + lookup(mn,charno,found); + readreal(realval); + add_to_list(itcorr,realval,maxitcorr,slot); {add value to list} + with outstuff[charno].fourbytes do begin + tag := byte2 mod 4; {tag is lower 2 bits} + byte2 := slot * 4 + tag; {and ic index is upper 6 bits} + end;{with..begin} + readln(infile); + errlin := errlin + 1; + end; {|read_mathop_stuff|} + +@ +@<Global Constants@>= + botkey = 'BOT'; + extkey = 'EXT'; + midkey = 'MID'; + topkey = 'TOP'; + exttag = 3; + +@ +@<Global Variables@>= + ext :array[0..127] of extrec; + +@ Name and keyword BUILD already read. Now expect keyword=value, +keyword=value, ... Keywords are TOP, MID, BOT, EXT, and values are +char names. Add a miscellaneous entry and point to it from this +character record. initialize the four names in the ext record +and set the four character values to zero. Later we will look up the +names to determine the actual character numbers of the components. + +@p procedure read_build_stuff; +var + key :string(40); + charname :string(40); +begin + numext := numext + 1; + with ext[numext] do begin + sourceline := lineno; {save line for later error messages} + top := 0; + mid := 0; + bot := 0; + ext := 0; + topname := ''; + midname := ''; + botname := ''; + extname := ''; + end; + set_tag_val(currchar,exttag); + outstuff[currchar].fourbytes.byte3 := numext; {ptr into EXT array} + skipblanks; + repeat + if infile@@ = ',' then get(infile); {skip separator} + readmnemonic(key,['=']); + key := allcaps(key); + get(infile); {skip equal sign delimiter} + readmnemonic(charname,[',',' ']); + if key = topkey then ext[numext].topname := charname + else if key = midkey then ext[numext].midname := charname + else if key = botkey then ext[numext].botname := charname + else if key = extkey then ext[numext].extname := charname + else error(13,fatal); + until infile@@ <> ','; + end; {|read_build_stuff|} + +@ +@<Global Variables@>= + drvrec :driverrec; + +@ Print out the record about to be written to the driver file. This can + be turned on or off by setting constant 'drvdump' to true or false. + +@p procedure dump_driver_rec(cmdord :integer); +begin + with drvrec do begin + if drvoutcount = 0 + then writeln('*** Driver File Output ***'); + write(drvoutcount:3,': '); + drvoutcount := drvoutcount + 1; + write('Command=',com_table[cmdord],', Parameter='); + if (cmdord = ord(CHWIDTH)) or + ((cmdord >= ord(VMF)) and (cmdord <= ord(IR))) or + (cmdord = ord(RTWT)) or + (cmdord = ord(RTWB)) or + (cmdord = ord(HMR)) or + (cmdord = ord(HML)) + then writeln(param) + else writeln(code); + end; {with..begin} + end; {|dump_driver_rec|} + +@ +@<Global Variables@>= + stk :array [0..20] of driverrec; + +@ Push a record with an integer character code + +@p procedure pushcode(var stktop :integer); +var + icode :integer; +begin + readinteger(icode); + if icode > 127 then error(18,notreallyfatal); + stktop := stktop + 1; + with stk[stktop] do begin + cmd := ord(TTS); + code := icode; + end; {with..begin} + end; {pushcode} + +@ Reads a command or letter from the input file -- i.e., reads the + 1 to 4 char mnemonic and looks it up in array cmdname to find + the enumeration value of type "command" corresponding to it. + A letter is distinguished from a command because a letter has no + parameter whereas all one-character commands do. + +@p procedure readcmd(var cmd :comm); +label 99; +var + name :string(9); + ch :string(1); + cmdind :comm; +begin + name := ''; + while infile@@ in ['a'..'z','A'..'Z'] do begin + read(infile,ch); + name := name || ch; + end; + name := allcaps(name); + errlstr := name; {save name for error message (if needed)} + {cmd will be the command or MAXCMD if not found} + for cmdind := HDR to MAXCMD do + if name = com_table[ord(cmdind)] then goto 99; +99: cmd := cmdind; + if cmdind = MAXCMD then error(19,notreallyfatal); {bad command} + end; {readcmd} + +@ Read the command "cmnd" -- see if it has any parameters, and +if so read them. Push a record on the local stack for this command + +@p procedure readparams(var stktop :integer); +var + cmnd :comm; +begin + readcmd(cmnd); + stktop := stktop + 1; {push} + with stk[stktop] do begin + cmd := ord(cmnd); + if cmnd in [AU] {this one has no parameters} + then code := 0 + else begin {read integer parm, stuff it into record} + if cmnd in [IR,VMF,VMR,RW,RD,RTWT,RTWB,HMR,HML] + then begin + readreal(param); + if (round(param) < min[cmnd]) or + (round(param) > max[cmnd]) then begin + errlstr := com_table[ord(cmnd)]; + errnum := round(param); + errmax := max[cmnd]; + errmin := min[cmnd]; + error(17,notreallyfatal); + param := min[cmnd]; + end; {then..begin} + if cmnd in [VMF,VMR,RD] + then param := param * vunits + else param := param * hunits; + end {then..end} + else begin + readinteger(code); + if (code < min[cmnd]) or + (code > max[cmnd]) then begin + errlstr := com_table[ord(cmnd)]; + errnum := code; + errmax := max[cmnd]; + errmin := min[cmnd]; + error(17,notreallyfatal); + code := min[cmnd]; + end; {then..begin} + end; {else..begin} + end; {else..begin} + end; {with..begin} + end; {readparams} + +@* Read 8600 Codes. +The 8600 code info corresponding to this character will consist of 1 +or more entries separated by commas and containing no blanks. An entry +can be a decimal character code or an 8600 command in which case it +begins with a letter. The command name will be up to 4 letters long and +may be followed by a parameter. Some commands take integer parameters +and others take reals which will be given in the same format as widths, +etc: i.e., as products and quotients of integer values. +Following are listed the possible codes. +\settabs\+\indent&RTWB = &Reverse Type Window Bottom\quad&value=0--1440 +in 10ths of a point\cr +\+&PS\hfill =&Point Size\hfill&value=0--1275 in 10ths of a point.\cr +\+&SS\hfill =&Set Size\hfill&value=0--1275 in 10ths of a point.\cr +\+&VMF\hfill =&Vertical Move Forward\hfill&value=1--1736 in 8ths of a +point\cr +\+&VMR\hfill =&Vertical Move Reverse\hfill&value=1--1736 in 8ths of a +point\cr +\+&RD\hfill =&Rule Depth\hfill&value=1--1736 in 8ths of a point\cr +\+&RW\hfill =&Rule Width\hfill&value=1--1736 in 8ths of a point\cr +\+&HML\hfill =&Horizontal Move Left\hfill&value=1--14688 in 18ths of a +point\cr +\+&HMR\hfill =&Horizontal Move Right\hfill&value=1--14688 in 18ths of a +point\cr +\+&SL\hfill =&Slant\hfill&value=0 or 48\cr +\+&IR\hfill =&Insert Rule\cr +\+&AU\hfill =&Auxiliary Font\cr +\+&F\hfill =&Font\hfill&value=1--255\cr +\+&RTWT\hfill =&Reverse Type Window Top\hfill&value=0--1440 in 16ths of +a point\cr +\+&RTWB =&Reverse Type Window Bottom&value=0--1440 in 16ths of a point\cr + +@p procedure read8600codes; +var + more_to_come :boolean; + stktop :integer; {gives index of last used (initially 0)} + inx :integer; +begin + skipblanks; + stktop := -1; {no code yet} + if eoln(infile) + then error(20,notreallyfatal) {no code given} + else begin + {Repeat until next is no longer a comma, in which case it + had better be a blank!} + repeat + if infile@@ in ['0'..'9'] + then pushcode(stktop) {decimal character code} + else if infile@@ in ['A'..'Z','a'..'z'] + {read command and optional parms} + then readparams(stktop) + else error(21,notreallyfatal); + if infile@@ = ',' + then begin + more_to_come := true; + get(infile); + end {then..begin} + else more_to_come := false; + until not more_to_come; + end; {else..begin} + {put header record out} + drvrec.cmd := ord(HDR); + drvrec.code := stktop; {how many codes for this character} + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + {write out character width record} + drvrec.cmd := ord(CHWIDTH); + drvrec.param := width[outstuff[currchar].fourbytes.byte0]; + {nw for the current character indexes its width in points} + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + {Put out rec for each code or command} + for inx := 0 to stktop do begin + drvrec := stk[inx]; + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + end; {FOR..begin} + end; {read8600codes} + +@* MAIN PROGRAM. + +@<Global Constants@>= + buildkey = 'BUILD'; + kernkey = 'KERN'; + ligaturekey = 'LIGATURE'; + linkkey = 'LINK'; + mathopkey = 'MATHOP'; + maxdp = 15; + maxht = 15; + maxwd = 255; + ligkerntag = 1; + +@ +@<Global Variables@>= + chnum :0..127; + chrt :char; + first :boolean; + heightslot :integer; + iny :integer; + itc :real; + ligcnt :integer; + ligout :array[0..255] of memoryword; + pp :parameter; + slot :integer; + tag :integer; + +@ +@p begin + {--------------- initialize -----------------------} + initialize; + {---------------- read input -------------------------} + read_the_parameters; + {Write first three entries to driver file} + drvrec.cmd := ord(HDR); + drvrec.code := ord(MAXCMD); + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + drvrec := def_ft_stuff; + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + drvrec := def_width_stuff; + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + drvrec.cmd := ord(SL); + if params[slant] = uninitialized + then drvrec.code := 0 + else drvrec.code := trunc(params[slant]); + if drvdump then dump_driver_rec(drvrec.cmd); + drvpkt@@ := drvrec; + put(drvpkt); + {Now read entries...} + for currchar := 0 to num_entries-1 do begin + if eof(infile) then error(7,fatal); + with outstuff[currchar].fourbytes do + byte3 := 0; {set remainder to 0} + readmnemonic(mnem,[' ']); {if any} + if dump then writeln('** Processing font info for "',mnem,'"'); + name[currchar] := mnem; {save for later use!} + {one non-blank character -- check sequencing} + readstr(mnem,chrt); + if (length(mnem) = 1) and (ordx[chrt] <> currchar) + then error(6,notreallyfatal); + skipblanks; {look at next non-blank} + if infile@@ in ['A'..'Z','a'..'z'] + then begin + readmnemonic(mnem,[' ']); + mnem := allcaps(mnem); + if mnem = ligaturekey + then read_ligature_stuff + else if mnem = buildkey + then read_build_stuff + else error(16,fatal); + end; {then..begin} + readentry(width,maxwd,slot,hunits); {read width} + outstuff[currchar].fourbytes.byte0 := slot; {save wid index} + readentry(height,maxht,slot,vunits); {read height} + heightslot := slot; {remember ht slot until depth read} + itc := height[slot] * params[slant]; {it corr = ht * slant} + add_to_list(itcorr,itc,maxitcorr,slot); + with outstuff[currchar].fourbytes do begin + tag := byte2 mod 4; {save tag value} + byte2 := slot * 4 + tag; {put itcorr in 6 bits, tag in 2} + end; + readentry(depth,maxdp,slot,vunits); {read depth} + outstuff[currchar].fourbytes.byte1 := heightslot * 16 + slot; + {now read 8600 information...} + read8600codes; + if not eoln(infile) + then begin + readln(infile); + errlin := errlin + 1; + end; + end; {FOR..begin} + {character entries have all been read...remaining entries + must begin with a keyword: KERN, Link, MATHOP These supply + additional information about certain characters} + while not eof(infile) do begin + readmnemonic(mnem,[' ']); + mnem := allcaps(mnem); + if mnem = kernkey + then read_kern_stuff + else if mnem = linkkey + then read_link_stuff + else if mnem = mathopkey + then read_mathop_stuff + else error(11,fatal); + end; {while..begin} +@<look up lignames@>@/ +@<set up ligature info@>@/ +@<write font file@>@/ +end. + +@ +@<look up lignames@>= + for inx:= 0 to numligs do + with lig[inx] do begin + errlin := sourceline; + lookup(firstname,frstchar,found); + if not found + then begin + errlin := sourceline; + error(12,notreallyfatal); + frstchar := 127; + end; {then..begin} + lookup(scndname,scndchar,found); + if not found + then begin + errlin := sourceline; + error(12,notreallyfatal); + scndchar := 127; + end; {then..begin} + end; {with..begin} + for inx := 0 to numext do + with ext[inx] do begin + errlin := sourceline; + if topname <> '' then lookup(topname,top,found); + if midname <> '' then lookup(midname,mid,found); + if botname <> '' then lookup(botname,bot,found); + if extname <> '' then lookup(extname,ext,found); + end; {with..begin} + +@ +@<set up ligature info@>= + ligcnt := 0; + for chnum := 0 to 127 do begin + first := true; + for inx := 0 to numligs do + if lig[inx].frstchar = chnum + then begin + if first then begin + {ptr to first ligature} + outstuff[chnum].fourbytes.byte3 := ligcnt; + set_tag_val(chnum,ligkerntag); + first := false; + end; {then..begin} + with ligout[ligcnt].fourbytes, lig[inx] do + begin {transfer info into output records} + {byte0=1 if last ligature + byte1=next chararacter of ligature + byte2=0 for a ligature + byte3=code of ligature character} + byte0 := '00000000'B; + byte1 := scndchar; + byte2 := '00000000'B; + byte3 := ligcode; + end; {with..begin} + ligcnt := ligcnt+1; {ready for next one} + end; {then..begin} + {Now do same with kerns} + for inx := 0 to numkerns do + if kern[inx].frstchar = chnum + then begin + if first then begin + {link to ligature record} + outstuff[chnum].fourbytes.byte3 := ligcnt; + set_tag_val(chnum,ligkerntag); + first := false; {not anymore} + end; {then..begin} + with ligout[ligcnt].fourbytes, kern[inx] do + begin {transfer info into output records} + {byte0=1 if last kern + byte1=next chararacter of kern + byte2=1 for a kern + byte3=index of kern character} + byte0 := '00000000'B; + byte1 := scndchar; + byte2 := '10000000'B; + byte3 := kernslot; + end; {with..begin} + ligcnt := ligcnt + 1; + end; {FOR,then..begin} + if not first + then ligout[ligcnt-1].fourbytes.byte0 := '10000000'B; + {there was at least one record, so flag the last of 'em} + end; {FOR..begin} {that's all the characters} + +@ Now write out in TEX format. TUGboat vol 2, no 1 article + TEX FONT METRIC fileS says the first 12 half-words of the + file are lengths, and obey the following equation: + lenfile=6 + lh + (ec-be+1) + nw + nh + nd + ni + nk + nl + ne + np + lh=length of header=18 words ec=end character=127, + bc=beginning char=0, hence: + lenfile = 6 + 18 + 128 + nw + nh + nd + ni + nk + nl + ne + np + Calculate its value: + +@<write font file@>= + if not eof(infile) then error(7,fatal); + lenfile := 6 + 18 + 128 + trunc(width[-1]) + trunc(height[-1])@/ + + trunc(depth[-1]) + trunc(itcorr[-1])@/ + + numkerns + numligs + numext + trunc(kernout[-1])@/ + + numparams[fontype] {num parameters}@/ + + 8; {off by one on nw,nh,nd,ni,nk,nl,ne and kernout}@/ + if dump then writeln('Writing info to TEX-readable file'); + outcount := 0; {start counting} + writeln('Number of records is ',lenfile:4); + if dump then write('* lf, lh:'); + outrec.twohalves.lhword := lenfile; {len of file} + outrec.fourbytes.rhword := 18; {len of header} + writeout(outrec,3); + if dump then write('* bc, ec:'); + outrec.twohalves.lhword := 0; {first char code} + outrec.twohalves.rhword := 127; {last char code} + writeout(outrec,3); + if dump then write('* nw, nh:'); + outrec.twohalves.lhword := trunc(width[-1]+1); + outrec.twohalves.rhword := trunc(height[-1]+1); + writeout(outrec,3); + if dump then write('* nd, ni:'); + outrec.twohalves.lhword := trunc(depth[-1]+1); + outrec.twohalves.rhword := trunc(itcorr[-1]+1); + writeout(outrec,3); + if dump then write('* nl, nk:'); + outrec.twohalves.lhword := numligs + numkerns + 2; + outrec.twohalves.rhword := trunc(kernout[-1]+1); + writeout(outrec,3); + if dump then write('* ne, np:'); + outrec.twohalves.lhword := numext+1; + outrec.twohalves.rhword := numparams[fontype]; + writeout(outrec,3); + + if dump then writeln('*** Header info'); + outrec.int := uniquecode; + writeout(outrec,6); + outrec.int := scaleout(float(pointsize)); {def = 1 point} + writeout(outrec,2); + writeln('*** Coding Scheme = ',codescheme); + outrec.fourbytes.byte0 := length(codescheme); + for inx := 2 to 40 do begin + iny := inx mod 4; + if iny = 0 then iny := 4; + iny := iny - 1; + if inx-1 <= length(codescheme) + then readstr(substr(codescheme,inx-1,1),chrt) + else chrt := chrx['00'X]; + with outrec.fourbytes do case iny of + 0 :byte0 := ordx[chrt]; + 1 :byte1 := ordx[chrt]; + 2 :byte2 := ordx[chrt]; + 3 :begin + byte3 := ordx[chrt]; + writeout(outrec,4); + end; + otherwise error(99,fatal); + end; + end; + if length(fontname) > 8 + then begin + error(27,notreallyfatal); + fontname := substr(fontname,1,8); + end; + writeln('*** Font Name = ',fontname); + outrec.fourbytes.byte0 := length(fontname); + for inx := 2 to 20 do begin + iny := inx mod 4; + if iny = 0 then iny := 4; + iny := iny - 1; + if inx-1 <= length(fontname) + then readstr(substr(fontname,inx-1,1),chrt) + else chrt := chrx['00'X]; + with outrec.fourbytes do case iny of + 0 :byte0 := ordx[chrt]; + 1 :byte1 := ordx[chrt]; + 2 :byte2 := ordx[chrt]; + 3 :begin + byte3 := ordx[chrt]; + writeout(outrec,4); + end; + otherwise error(99,fatal); + end; + end; + outrec.int := 0; + writeout(outrec,6); {no Parc face byte now} + @<Write out FINFO part of font file@> + @<write out widths@> + @<write out heights@> + @<write out depths@> + @<write out itcorrs@> + @<write out ligature/kern programs@> + @<write out extension chars@> + @<write params@> + writeln('End of font file preprocessor'); + +@ + @<Write out FINFO part of font file@>= + for inx := 0 to num_entries-1 do writeout(outstuff[inx],5); + +@ + @<write out widths@>= + if dump then writeln('*** Widths'); + for inx := 0 to trunc(width[-1]) do begin + outrec.int := scaleout(width[inx]); + writeout(outrec,2); + end; + +@ + @<write out heights@>= + if dump then writeln('*** Heights'); + for inx := 0 to trunc(height[-1]) do begin + outrec.int := scaleout(height[inx]); + writeout(outrec,2); + end; + +@ + @<write out depths@>= + if dump then writeln('*** Depths'); + for inx := 0 to trunc(depth[-1]) do begin + outrec.int := scaleout(depth[inx]); + writeout(outrec,2); + end; + +@ + @<write out itcorrs@>= + if dump then writeln('*** itcorrs'); + for inx := 0 to trunc(itcorr[-1]) do begin + outrec.int := scaleout(itcorr[inx]); + writeout(outrec,2); + end; + +@ + @<write out ligature/kern programs@>= + if dump then writeln('*** Lig/Kern programs'); + for inx := 0 to numligs + numkerns + 1 do + writeout(ligout[inx],4); + {write out kern values as fixes} + if dump then writeln('*** Kern values'); + for inx := 0 to trunc(kernout[-1]) do begin + outrec.int := scaleout(kernout[inx]); + writeout(outrec,2); + end; + +@ + @<write out extension chars@>= + if dump then writeln('*** Extension chars'); + for inx := 0 to numext do + with ext[inx], outrec.fourbytes do begin + byte0 := top; + byte1 := mid; + byte2 := bot; + byte3 := ext; + writeout(outrec,4); + end; {with..begin} + +@ + @<write params@>= + if dump then writeln('*** Params'); + for pp := slant to bgopsp5 do + if pp in paramset[standard]+paramset[fontype] + then begin + if dump then begin + printparam(pp); + write(': '); + end; + outrec.int := scaleout(params[pp]); + writeout(outrec,2); + end; {then..begin} + +@* INDEX. diff --git a/macros/text1/compugraphics_8600/reblock.pascal b/macros/text1/compugraphics_8600/reblock.pascal new file mode 100644 index 0000000000..28c7dd6e8f --- /dev/null +++ b/macros/text1/compugraphics_8600/reblock.pascal @@ -0,0 +1,34 @@ + PROGRAM reblock(input,output); + VAR + outstring :STRING(1024); + instring :STRING(8); + fontname :STRING(8); + filetype :STRING(8); + parmstring :STRING(20); + i, fill :integer; + BEGIN + parmstring := TRIM(parms); + i := index(parmstring,' '); + fontname := SUBSTR(parmstring,1,i-1); + filetype := SUBSTR(parmstring,i+1); + RESET(input,'NAME='||fontname||'.PR'||filetype||'.A'); + REWRITE(output,'NAME='||fontname||'.'||filetype|| + '.A,LRECL=1024,RECFM=F'); + outstring := ''; + READLN(input,instring); + WHILE NOT EOF(input) DO BEGIN; + outstring := outstring || instring; + IF LENGTH(outstring) >= 1024 THEN BEGIN + WRITELN(output,outstring); + outstring := ''; + END; + READLN(input,instring); + END; + IF LENGTH(outstring) > 0 THEN BEGIN + IF LENGTH(outstring) < 1024 THEN + REPEAT + outstring := outstring || '00'xc; + UNTIL LENGTH(outstring) >= 1024; + WRITELN(output,outstring); + END; + END. diff --git a/macros/text1/compugraphics_8600/tex8600.cmschan b/macros/text1/compugraphics_8600/tex8600.cmschan new file mode 100644 index 0000000000..cd3acaba08 --- /dev/null +++ b/macros/text1/compugraphics_8600/tex8600.cmschan @@ -0,0 +1 @@ +% No change file needed generally diff --git a/macros/text1/compugraphics_8600/tex8600.outchan b/macros/text1/compugraphics_8600/tex8600.outchan new file mode 100644 index 0000000000..b2182cc794 --- /dev/null +++ b/macros/text1/compugraphics_8600/tex8600.outchan @@ -0,0 +1,580 @@ +@x +%test version +@y +%out version 1 +@z + +@x +\font\twelvept=cmbx12 +\font\tentex=cmr10 +@y +\font\twelvept=cmbx12 +@z + +@x +@p program tex8600(sysprint,addrline,setfile,cgfonts,infofile); +@y +@p program tex8600(sysprint,addrline,setfile,cgfonts); +@z + +@x +@<Global Variables@>@/ +static@/ +@!com_table :packed array[0..18] of string(7);@/ +value@/ + com_table[0] := 'HDR'; {Header Record}@/ + com_table[1] := 'CHWIDTH';{Character Width}@/ + com_table[2] := 'RT'; {Reverse Type}@/ + com_table[3] := 'PS'; {Point Size}@/ + com_table[4] := 'SS'; {Set Size}@/ + com_table[5] := 'VMF'; {Vertical Move Forward}@/ + com_table[6] := 'VMR'; {Vertical Move Reverse}@/ + com_table[7] := 'RW'; {Rule Width}@/ + com_table[8] := 'RD'; {Rule Depth}@/ + com_table[9] := 'IR'; {Insert Rule}@/ + com_table[10] := 'SL'; {Slant Mode}@/ + com_table[11] := 'RTWT'; {Reverse Type Window Top}@/ + com_table[12] := 'RTWB'; {Reverse Type Window Bottom}@/ + com_table[13] := 'AU'; {Auxiliary Character Set}@/ + com_table[14] := 'F'; {Change Fonts}@/ + com_table[15] := 'HMR'; {Horizontal Move Right}@/ + com_table[16] := 'HML'; {Horizontal Move Left}@/ + com_table[17] := 'TTS'; {8600 character, in decimal}@/ + com_table[18] := 'MAXCMD';@/ +%include pasclib(asciicvt)@/ +@y +@<Global Variables@>@/ +static@/ +@!com_table :packed array[0..18] of string(7);@/ +@!ordx : packed array['00'xc..'FF'xc] of '00'x..'7f'x;@/ +@!chrx : packed array['00'x..'7F'x] of '00'xc..'FF'xc;@/ +value@/ + com_table[0] := 'HDR'; {Header Record}@/ + com_table[1] := 'CHWIDTH';{Character Width}@/ + com_table[2] := 'RT'; {Reverse Type}@/ + com_table[3] := 'PS'; {Point Size}@/ + com_table[4] := 'SS'; {Set Size}@/ + com_table[5] := 'VMF'; {Vertical Move Forward}@/ + com_table[6] := 'VMR'; {Vertical Move Reverse}@/ + com_table[7] := 'RW'; {Rule Width}@/ + com_table[8] := 'RD'; {Rule Depth}@/ + com_table[9] := 'IR'; {Insert Rule}@/ + com_table[10] := 'SL'; {Slant Mode}@/ + com_table[11] := 'RTWT'; {Reverse Type Window Top}@/ + com_table[12] := 'RTWB'; {Reverse Type Window Bottom}@/ + com_table[13] := 'AU'; {Auxiliary Character Set}@/ + com_table[14] := 'F'; {Change Fonts}@/ + com_table[15] := 'HMR'; {Horizontal Move Right}@/ + com_table[16] := 'HML'; {Horizontal Move Left}@/ + com_table[17] := 'TTS'; {8600 character, in decimal}@/ + com_table[18] := 'MAXCMD';@/ +{ EBCDIC to ASCII INTEGER and ASCII INTEGER to EBCDIC conversion } +{ EBCDIC char to ASCII integer } { ASCII INTEGER to EBCDIC char } +ordx['00'xc]:='00'x; { NUL NUL } chrx['00'x]:='00'xc; { NUL NUL } +ordx['01'xc]:='01'x; { SOH SOH } chrx['01'x]:='01'xc; { SOH SOH } +ordx['02'xc]:='02'x; { STX STX } chrx['02'x]:='02'xc; { STX STX } +ordx['03'xc]:='03'x; { ETX ETX } chrx['03'x]:='03'xc; { ETX ETX } +ordx['04'xc]:='00'x; { ... NUL } chrx['04'x]:='37'xc; { EOT EOT } +ordx['05'xc]:='09'x; { HT HT } chrx['05'x]:='2D'xc; { ENQ ENQ } +ordx['06'xc]:='00'x; { ... NUL } chrx['06'x]:='2E'xc; { ACK ACK } +ordx['07'xc]:='7F'x; { DEL DEL } chrx['07'x]:='2F'xc; { BEL BEL } +ordx['08'xc]:='00'x; { ... NUL } chrx['08'x]:='16'xc; { BS BS } +ordx['09'xc]:='00'x; { ... NUL } chrx['09'x]:='05'xc; { HT HT } +ordx['0A'xc]:='00'x; { ... NUL } chrx['0A'x]:='25'xc; { LF LF } +ordx['0B'xc]:='0B'x; { VT VT } chrx['0B'x]:='0B'xc; { VT VT } +ordx['0C'xc]:='0C'x; { FF FF } chrx['0C'x]:='0C'xc; { FF FF } +ordx['0D'xc]:='0D'x; { CR CR } chrx['0D'x]:='0D'xc; { CR CR } +ordx['0E'xc]:='0E'x; { SO SO } chrx['0E'x]:='0E'xc; { SO SO } +ordx['0F'xc]:='0F'x; { SI SI } chrx['0F'x]:='0F'xc; { SI SI } +ordx['10'xc]:='10'x; { DLE DLE } chrx['10'x]:='10'xc; { DLE DLE } +ordx['11'xc]:='11'x; { DC1 DC1 } chrx['11'x]:='11'xc; { DC1 DC1 } +ordx['12'xc]:='12'x; { DC2 DC2 } chrx['12'x]:='12'xc; { DC2 DC2 } +ordx['13'xc]:='13'x; { TM DC3 } chrx['13'x]:='13'xc; { DC3 TM } +ordx['14'xc]:='00'x; { ... NUL } chrx['14'x]:='3C'xc; { DC4 DC4 } +ordx['15'xc]:='00'x; { ... NUL } chrx['15'x]:='3D'xc; { NAK NAK } +ordx['16'xc]:='08'x; { BS BS } chrx['16'x]:='32'xc; { SYN SYN } +ordx['17'xc]:='00'x; { ... NUL } chrx['17'x]:='26'xc; { ETB ETB } +ordx['18'xc]:='18'x; { CAN CAN } chrx['18'x]:='18'xc; { CAN CAN } +ordx['19'xc]:='19'x; { EM EM } chrx['19'x]:='19'xc; { EM EM } +ordx['1A'xc]:='00'x; { ... NUL } chrx['1A'x]:='3F'xc; { SUB SUB } +ordx['1B'xc]:='00'x; { ... NUL } chrx['1B'x]:='27'xc; { ESC ESC } +ordx['1C'xc]:='1C'x; { IFS FS } chrx['1C'x]:='1C'xc; { FS IFS } +ordx['1D'xc]:='1D'x; { IGS GS } chrx['1D'x]:='1D'xc; { GS IGS } +ordx['1E'xc]:='1E'x; { IRS RS } chrx['1E'x]:='1E'xc; { RS IRS } +ordx['1F'xc]:='1F'x; { IUS US } chrx['1F'x]:='1F'xc; { US IUS } +ordx['20'xc]:='00'x; { ... NUL } chrx['20'x]:='40'xc; { SP SP } +ordx['21'xc]:='00'x; { ... NUL } chrx['21'x]:='5A'xc; { ! ! } +ordx['22'xc]:='00'x; { ... NUL } chrx['22'x]:='7F'xc; { " " } +ordx['23'xc]:='00'x; { ... NUL } chrx['23'x]:='7B'xc; { # # } +ordx['24'xc]:='00'x; { ... NUL } chrx['24'x]:='5B'xc; { $ $ } +ordx['25'xc]:='0A'x; { LF LF } chrx['25'x]:='6C'xc; { % % } +ordx['26'xc]:='17'x; { ETB ETB } chrx['26'x]:='50'xc; { & & } +ordx['27'xc]:='1B'x; { ESC ESC } chrx['27'x]:='7D'xc; { ' ' } +ordx['28'xc]:='00'x; { ... NUL } chrx['28'x]:='4D'xc; { ( ( } +ordx['29'xc]:='00'x; { ... NUL } chrx['29'x]:='5D'xc; { ) ) } +ordx['2A'xc]:='00'x; { ... NUL } chrx['2A'x]:='5C'xc; { * * } +ordx['2B'xc]:='00'x; { ... NUL } chrx['2B'x]:='4E'xc; { + + } +ordx['2C'xc]:='00'x; { ... NUL } chrx['2C'x]:='6B'xc; { , , } +ordx['2D'xc]:='05'x; { ENQ ENQ } chrx['2D'x]:='60'xc; { - - } +ordx['2E'xc]:='06'x; { ACK ACK } chrx['2E'x]:='4B'xc; { . . } +ordx['2F'xc]:='07'x; { BEL BEL } chrx['2F'x]:='61'xc; { / / } +ordx['30'xc]:='00'x; { ... NUL } chrx['30'x]:='F0'xc; { 0 0 } +ordx['31'xc]:='00'x; { ... NUL } chrx['31'x]:='F1'xc; { 1 1 } +ordx['32'xc]:='16'x; { SYN SYN } chrx['32'x]:='F2'xc; { 2 2 } +ordx['33'xc]:='00'x; { ... NUL } chrx['33'x]:='F3'xc; { 3 3 } +ordx['34'xc]:='00'x; { ... NUL } chrx['34'x]:='F4'xc; { 4 4 } +ordx['35'xc]:='00'x; { ... NUL } chrx['35'x]:='F5'xc; { 5 5 } +ordx['36'xc]:='00'x; { ... NUL } chrx['36'x]:='F6'xc; { 6 6 } +ordx['37'xc]:='04'x; { EOT EOT } chrx['37'x]:='F7'xc; { 7 7 } +ordx['38'xc]:='00'x; { ... NUL } chrx['38'x]:='F8'xc; { 8 8 } +ordx['39'xc]:='00'x; { ... NUL } chrx['39'x]:='F9'xc; { 9 9 } +ordx['3A'xc]:='00'x; { ... NUL } chrx['3A'x]:='7A'xc; { : : } +ordx['3B'xc]:='00'x; { ... NUL } chrx['3B'x]:='5E'xc; { ; ; } +ordx['3C'xc]:='14'x; { DC4 DC4 } chrx['3C'x]:='4C'xc; { < < } +ordx['3D'xc]:='15'x; { NAK NAK } chrx['3D'x]:='7E'xc; { = = } +ordx['3E'xc]:='00'x; { ... NUL } chrx['3E'x]:='6E'xc; { > > } +ordx['3F'xc]:='1A'x; { SUB SUB } chrx['3F'x]:='6F'xc; { ? ? } +ordx['40'xc]:='20'x; { SP SP } chrx['40'x]:='7C'xc; { @@ @@ } +ordx['41'xc]:='00'x; { ... NUL } chrx['41'x]:='C1'xc; { A A } +ordx['42'xc]:='00'x; { ... NUL } chrx['42'x]:='C2'xc; { B B } +ordx['43'xc]:='00'x; { ... NUL } chrx['43'x]:='C3'xc; { C C } +ordx['44'xc]:='00'x; { ... NUL } chrx['44'x]:='C4'xc; { D D } +ordx['45'xc]:='00'x; { ... NUL } chrx['45'x]:='C5'xc; { E E } +ordx['46'xc]:='00'x; { ... NUL } chrx['46'x]:='C6'xc; { F F } +ordx['47'xc]:='00'x; { ... NUL } chrx['47'x]:='C7'xc; { G G } +ordx['48'xc]:='00'x; { ... NUL } chrx['48'x]:='C8'xc; { H H } +ordx['49'xc]:='00'x; { ... NUL } chrx['49'x]:='C9'xc; { I I } +ordx['4A'xc]:='5E'x; { ã ã } chrx['4A'x]:='D1'xc; { J J } +ordx['4B'xc]:='2E'x; { . . } chrx['4B'x]:='D2'xc; { K K } +ordx['4C'xc]:='3C'x; { < < } chrx['4C'x]:='D3'xc; { L L } +ordx['4D'xc]:='28'x; { ( ( } chrx['4D'x]:='D4'xc; { M M } +ordx['4E'xc]:='2B'x; { + + } chrx['4E'x]:='D5'xc; { N N } +ordx['4F'xc]:='7C'x; { | | } chrx['4F'x]:='D6'xc; { O O } +ordx['50'xc]:='26'x; { & & } chrx['50'x]:='D7'xc; { P P } +ordx['51'xc]:='00'x; { ... NUL } chrx['51'x]:='D8'xc; { Q Q } +ordx['52'xc]:='00'x; { ... NUL } chrx['52'x]:='D9'xc; { R R } +ordx['53'xc]:='00'x; { ... NUL } chrx['53'x]:='E2'xc; { S S } +ordx['54'xc]:='00'x; { ... NUL } chrx['54'x]:='E3'xc; { T T } +ordx['55'xc]:='00'x; { ... NUL } chrx['55'x]:='E4'xc; { U U } +ordx['56'xc]:='00'x; { ... NUL } chrx['56'x]:='E5'xc; { V V } +ordx['57'xc]:='00'x; { ... NUL } chrx['57'x]:='E6'xc; { W W } +ordx['58'xc]:='00'x; { ... NUL } chrx['58'x]:='E7'xc; { X X } +ordx['59'xc]:='00'x; { ... NUL } chrx['59'x]:='E8'xc; { Y Y } +ordx['5A'xc]:='21'x; { ! ! } chrx['5A'x]:='E9'xc; { Z Z } +ordx['5B'xc]:='24'x; { $ $ } chrx['5B'x]:='AD'xc; { [ [ } +ordx['5C'xc]:='2A'x; { * * } chrx['5C'x]:='E0'xc; { \ \ } +ordx['5D'xc]:='29'x; { ) ) } chrx['5D'x]:='BD'xc; { ] ] } +ordx['5E'xc]:='3B'x; { ; ; } chrx['5E'x]:='4A'xc; { ã ã } +ordx['5F'xc]:='7E'x; { ^ ^ } chrx['5F'x]:='6D'xc; { _ _ } +ordx['60'xc]:='2D'x; { - - } chrx['60'x]:='79'xc; { ` ` } +ordx['61'xc]:='2F'x; { / / } chrx['61'x]:='81'xc; { a a } +ordx['62'xc]:='00'x; { ... NUL } chrx['62'x]:='82'xc; { b b } +ordx['63'xc]:='00'x; { ... NUL } chrx['63'x]:='83'xc; { c c } +ordx['64'xc]:='00'x; { ... NUL } chrx['64'x]:='84'xc; { d d } +ordx['65'xc]:='00'x; { ... NUL } chrx['65'x]:='85'xc; { e e } +ordx['66'xc]:='00'x; { ... NUL } chrx['66'x]:='86'xc; { f f } +ordx['67'xc]:='00'x; { ... NUL } chrx['67'x]:='87'xc; { g g } +ordx['68'xc]:='00'x; { ... NUL } chrx['68'x]:='88'xc; { h h } +ordx['69'xc]:='00'x; { ... NUL } chrx['69'x]:='89'xc; { i i } +ordx['6A'xc]:='00'x; { ... NUL } chrx['6A'x]:='91'xc; { j j } +ordx['6B'xc]:='2C'x; { , , } chrx['6B'x]:='92'xc; { k k } +ordx['6C'xc]:='25'x; { % % } chrx['6C'x]:='93'xc; { l l } +ordx['6D'xc]:='5F'x; { _ _ } chrx['6D'x]:='94'xc; { m m } +ordx['6E'xc]:='3E'x; { > > } chrx['6E'x]:='95'xc; { n n } +ordx['6F'xc]:='3F'x; { ? ? } chrx['6F'x]:='96'xc; { o o } +ordx['70'xc]:='00'x; { ... NUL } chrx['70'x]:='97'xc; { p p } +ordx['71'xc]:='00'x; { ... NUL } chrx['71'x]:='98'xc; { q q } +ordx['72'xc]:='00'x; { ... NUL } chrx['72'x]:='99'xc; { r r } +ordx['73'xc]:='00'x; { ... NUL } chrx['73'x]:='A2'xc; { s s } +ordx['74'xc]:='00'x; { ... NUL } chrx['74'x]:='A3'xc; { t t } +ordx['75'xc]:='00'x; { ... NUL } chrx['75'x]:='A4'xc; { u u } +ordx['76'xc]:='00'x; { ... NUL } chrx['76'x]:='A5'xc; { v v } +ordx['77'xc]:='00'x; { ... NUL } chrx['77'x]:='A6'xc; { w w } +ordx['78'xc]:='00'x; { ... NUL } chrx['78'x]:='A7'xc; { x x } +ordx['79'xc]:='60'x; { ` ` } chrx['79'x]:='A8'xc; { y y } +ordx['7A'xc]:='3A'x; { : : } chrx['7A'x]:='A9'xc; { z z } +ordx['7B'xc]:='23'x; { # # } chrx['7B'x]:='C0'xc; { lcurly } +ordx['7C'xc]:='40'x; { @@ @@ } chrx['7C'x]:='4F'xc; { | | } +ordx['7D'xc]:='27'x; { ' ' } chrx['7D'x]:='D0'xc; { rcurly } +ordx['7E'xc]:='3D'x; { = = } chrx['7E'x]:='9C'xc; { tilde } +ordx['7F'xc]:='22'x; { " " } chrx['7F'x]:='07'xc; { DEL DEL } +ordx['80'xc]:='00'x; { ... NUL } +ordx['81'xc]:='61'x; { a a } +ordx['82'xc]:='62'x; { b b } +ordx['83'xc]:='63'x; { c c } +ordx['84'xc]:='64'x; { d d } +ordx['85'xc]:='65'x; { e e } +ordx['86'xc]:='66'x; { f f } +ordx['87'xc]:='67'x; { g g } +ordx['88'xc]:='68'x; { h h } +ordx['89'xc]:='69'x; { i i } +ordx['8A'xc]:='00'x; { ... NUL } +ordx['8B'xc]:='00'x; { ... NUL } +ordx['8C'xc]:='00'x; { ... NUL } +ordx['8D'xc]:='00'x; { ... NUL } +ordx['8E'xc]:='00'x; { ... NUL } +ordx['8F'xc]:='00'x; { ... NUL } +ordx['90'xc]:='00'x; { ... NUL } +ordx['91'xc]:='6A'x; { j j } +ordx['92'xc]:='6B'x; { k k } +ordx['93'xc]:='6C'x; { l l } +ordx['94'xc]:='6D'x; { m m } +ordx['95'xc]:='6E'x; { n n } +ordx['96'xc]:='6F'x; { o o } +ordx['97'xc]:='70'x; { p p } +ordx['98'xc]:='71'x; { q q } +ordx['99'xc]:='72'x; { r r } +ordx['9A'xc]:='00'x; { ... NUL } +ordx['9B'xc]:='00'x; { ... NUL } +ordx['9C'xc]:='7E'x; { tilde } +ordx['9D'xc]:='00'x; { ... NUL } +ordx['9E'xc]:='00'x; { ... NUL } +ordx['9F'xc]:='00'x; { ... NUL } +ordx['A0'xc]:='00'x; { ... NUL } +ordx['A1'xc]:='1A'x; { ... SUB } +ordx['A2'xc]:='73'x; { s s } +ordx['A3'xc]:='74'x; { t t } +ordx['A4'xc]:='75'x; { u u } +ordx['A5'xc]:='76'x; { v v } +ordx['A6'xc]:='77'x; { w w } +ordx['A7'xc]:='78'x; { x x } +ordx['A8'xc]:='79'x; { y y } +ordx['A9'xc]:='7A'x; { z z } +ordx['AA'xc]:='00'x; { ... NUL } +ordx['AB'xc]:='00'x; { ... NUL } +ordx['AC'xc]:='00'x; { ... NUL } +ordx['AD'xc]:='5B'x; { [ [ } +ordx['AE'xc]:='00'x; { ... NUL } +ordx['AF'xc]:='00'x; { ... NUL } +ordx['B0'xc]:='00'x; { ... NUL } +ordx['B1'xc]:='00'x; { ... NUL } +ordx['B2'xc]:='00'x; { ... NUL } +ordx['B3'xc]:='00'x; { ... NUL } +ordx['B4'xc]:='00'x; { ... NUL } +ordx['B5'xc]:='00'x; { ... NUL } +ordx['B6'xc]:='00'x; { ... NUL } +ordx['B7'xc]:='00'x; { ... NUL } +ordx['B8'xc]:='00'x; { ... NUL } +ordx['B9'xc]:='00'x; { ... NUL } +ordx['BA'xc]:='00'x; { ... NUL } +ordx['BB'xc]:='00'x; { ... NUL } +ordx['BC'xc]:='00'x; { ... NUL } +ordx['BD'xc]:='5D'x; { ] ] } +ordx['BE'xc]:='00'x; { ... NUL } +ordx['BF'xc]:='00'x; { ... NUL } +ordx['C0'xc]:='7B'x; { lcurly } +ordx['C1'xc]:='41'x; { A A } +ordx['C2'xc]:='42'x; { B B } +ordx['C3'xc]:='43'x; { C C } +ordx['C4'xc]:='44'x; { D D } +ordx['C5'xc]:='45'x; { E E } +ordx['C6'xc]:='46'x; { F F } +ordx['C7'xc]:='47'x; { G G } +ordx['C8'xc]:='48'x; { H H } +ordx['C9'xc]:='49'x; { I I } +ordx['CA'xc]:='00'x; { ... NUL } +ordx['CB'xc]:='00'x; { ... NUL } +ordx['CC'xc]:='00'x; { ... NUL } +ordx['CD'xc]:='00'x; { ... NUL } +ordx['CE'xc]:='00'x; { ... NUL } +ordx['CF'xc]:='00'x; { ... NUL } +ordx['D0'xc]:='7D'x; { rcurly } +ordx['D1'xc]:='4A'x; { J J } +ordx['D2'xc]:='4B'x; { K K } +ordx['D3'xc]:='4C'x; { L L } +ordx['D4'xc]:='4D'x; { M M } +ordx['D5'xc]:='4E'x; { N N } +ordx['D6'xc]:='4F'x; { O O } +ordx['D7'xc]:='50'x; { P P } +ordx['D8'xc]:='51'x; { Q Q } +ordx['D9'xc]:='52'x; { R R } +ordx['DA'xc]:='00'x; { ... NUL } +ordx['DB'xc]:='00'x; { ... NUL } +ordx['DC'xc]:='00'x; { ... NUL } +ordx['DD'xc]:='00'x; { ... NUL } +ordx['DE'xc]:='00'x; { ... NUL } +ordx['DF'xc]:='00'x; { ... NUL } +ordx['E0'xc]:='5C'x; { \ \ } +ordx['E1'xc]:='00'x; { ... NUL } +ordx['E2'xc]:='53'x; { S S } +ordx['E3'xc]:='54'x; { T T } +ordx['E4'xc]:='55'x; { U U } +ordx['E5'xc]:='56'x; { V V } +ordx['E6'xc]:='57'x; { W W } +ordx['E7'xc]:='58'x; { X X } +ordx['E8'xc]:='59'x; { Y Y } +ordx['E9'xc]:='5A'x; { Z Z } +ordx['EA'xc]:='00'x; { ... NUL } +ordx['EB'xc]:='00'x; { ... NUL } +ordx['EC'xc]:='00'x; { ... NUL } +ordx['ED'xc]:='00'x; { ... NUL } +ordx['EE'xc]:='00'x; { ... NUL } +ordx['EF'xc]:='00'x; { ... NUL } +ordx['F0'xc]:='30'x; { 0 0 } +ordx['F1'xc]:='31'x; { 1 1 } +ordx['F2'xc]:='32'x; { 2 2 } +ordx['F3'xc]:='33'x; { 3 3 } +ordx['F4'xc]:='34'x; { 4 4 } +ordx['F5'xc]:='35'x; { 5 5 } +ordx['F6'xc]:='36'x; { 6 6 } +ordx['F7'xc]:='37'x; { 7 7 } +ordx['F8'xc]:='38'x; { 8 8 } +ordx['F9'xc]:='39'x; { 9 9 } +ordx['FA'xc]:='00'x; { ... NUL } +ordx['FB'xc]:='00'x; { ... NUL } +ordx['FC'xc]:='00'x; { ... NUL } +ordx['FD'xc]:='00'x; { ... NUL } +ordx['FE'xc]:='00'x; { ... NUL } +ordx['FF'xc]:='00'x; { ... NUL } +@z + +@x +@! maxbuffer = 1029;@/ +@y +@! maxbuffer = 1024;@/ +@z + +@x +@p procedure writeheader; {only needed when using Datum 5095} +var + hdrec :string(5); +begin + if doingpages = true + then begin + hdrec := strconv(headernum); + write(setfile,hdrec); + bufferlen := 5; + end; {then..begin} + end; {writeheader} +@y +@p procedure writeheader; {only needed when using Datum 5095} +begin + if doingpages = true + then + bufferlen := 0; + end; {writeheader} +@z + +@x +@<write number of...@>= + writecommand(11,155*SPsPerPt); {155pt indent} + writecommand(25,320); {Bold} + write8600rec('50616765731e'xc); {'Pages '} + write8600rec('536574231e1e'xc); {'Set: '} + writecommand(25,330); {Bold Italic} + pages_conv := strconv(pages_set); + for inx := 1 to 5 + do write8600rec(str(chr(ordx + [pages_conv[inx]]))); + writecommand(11,265*SPsPerPt); {get ready for Tape \#} + +@ +@<write tape numb...@>= + writecommand(25,320); {Bold} + write8600rec('546170651e'xc); {'Tape '} + writecommand(20,2); {aux. char. set} + write8600rec('72'xc); {'\#'} + writecommand(20,1); {pri. char. set} + write8600rec('231e1e1e1e'xc); {': '} + postam_found := true; + writecommand(25,330); {bold italic} +@y +@<write number of...@>= + writecommand(11,155*SPsPerPt); {155pt indent} + writecommand(25,320); {Bold} + write8600rec('50616765731e'xc); {'Pages '} + write8600rec('536574231e1e'xc); {'Set: '} + writecommand(25,330); {Bold Italic} + pages_conv := strconv(pages_set); + for inx := 1 to 5 + do write8600rec(str(chr(ordx + [pages_conv[inx]]))); + +@ +@<write tape numb...@>= + postam_found := true; +@z + +@x +|setaccountbox| procedure. It also writes the information to another file +called the |infofile|. + +@<Global Constants@>= +@! notfatal = false;@/ + +@ +@<Global Variables@>= +@!addrline : text; +@!infofile : text; +@^system dependencies@> +@y +|setaccountbox| procedure. + +@<Global Constants@>= +@! notfatal = false;@/ + +@ +@<Global Variables@>= +@!addrline : text; +@^system dependencies@> +@z + +@x +@<parse info...@>= + rewrite(infofile,'NAME=' ccat filename ccat '.INFOFILE.*'); + while length(resource_info) > 0 do begin + inx := index(resource_info,':'); + if inx < 1 + then begin + errstr := resource_info; + error(28,notfatal,0); + end + else begin + str1 := substr(resource_info,1,inx-1); + resource_info := ltrim(substr(resource_info,inx+1)); + inx := index(resource_info,':'); + if inx = 0 + then begin + str2 := resource_info; + resource_info := ''; + end + else begin + int := inx - 1; {no sense starting at a colon:} + tempbool := false; + repeat + if substr(resource_info,int,1) = ' ' + then tempbool := true + else int := int - 1; + until tempbool; {which means we found a blank} + str2 := trim(substr(resource_info,1,int-1)); + resource_info := substr(resource_info,int+1); + end; + str1 := allcaps(ltrim(trim(str1))); + str2 := allcaps(ltrim(trim(str2))); + if str1 = 'NAME' then + infoname := str2 + else if str1 = 'PHONE' then + infophone := str2 + else if str1 = 'PROCEDURE_NUMBER' + then infoprocedure := str2 + else if str1 = 'BUDGET_PROJECT' + then infobudget := str2 + else if str1 = 'PICKUP' then + infodelivery := str2 + else if str1 = 'CAMPUS_ZIP' then + infozip := str2 + else if str1 = 'BIN' then + infobin := str2 + else if str1 = 'ID' then + infoid := str2 + else begin + errstr := resource_info; + error(28,notfatal,0); + end + end; + end; + +@ +@<send info...@>= + setaccountbox(infoname,infophone,infodelivery,infozip, + infobin,infoid); + writeln(infofile,infoname); + writeln(infofile,infophone); + writeln(infofile,infoprocedure); + writeln(infofile,infobudget); + writeln(infofile,infodelivery); + writeln(infofile,infozip); + writeln(infofile,infoid); + writeln(infofile,infobin); + writeln(infofile,job_length); + writeln(infofile,pages_set); + writeln(infofile,minimum_width); + writeln(infofile,real_filename); +@y +@<parse info...@>= + while length(resource_info) > 0 do begin + inx := index(resource_info,':'); + if inx < 1 + then begin + errstr := resource_info; + error(28,notfatal,0); + end + else begin + str1 := substr(resource_info,1,inx-1); + resource_info := ltrim(substr(resource_info,inx+1)); + inx := index(resource_info,':'); + if inx = 0 + then begin + str2 := resource_info; + resource_info := ''; + end + else begin + int := inx - 1; {no sense starting at a colon:} + tempbool := false; + repeat + if substr(resource_info,int,1) = ' ' + then tempbool := true + else int := int - 1; + until tempbool; {which means we found a blank} + str2 := trim(substr(resource_info,1,int-1)); + resource_info := substr(resource_info,int+1); + end; + str1 := allcaps(ltrim(trim(str1))); + str2 := allcaps(ltrim(trim(str2))); + if str1 = 'NAME' then + infoname := str2 + else if str1 = 'PHONE' then + infophone := str2 + else if str1 = 'PROCEDURE_NUMBER' + then infoprocedure := str2 + else if str1 = 'BUDGET_PROJECT' + then infobudget := str2 + else if str1 = 'PICKUP' then + infodelivery := str2 + else if str1 = 'CAMPUS_ZIP' then + infozip := str2 + else if str1 = 'BIN' then + infobin := str2 + else if str1 = 'ID' then + infoid := str2 + else begin + errstr := resource_info; + error(28,notfatal,0); + end + end; + end; + +@ +@<send info...@>= + setaccountbox(infoname,infophone,infodelivery,infozip, + infobin,infoid); +@z + +@x +@<set final...@>= + job_length := round(galley_length/72.0); + pages_set := num_of_pages; + job_type := 'TeX'; +@y +@<set final...@>= + job_length := round(galley_length/72.0); + pages_set := num_of_pages; + job_type := 'TeX'; + writecommand(11,0); {quad left} + writecommand(9,100*SPsPerPt); {VMF past box} + writecommand(1,0.0); {End of take} +@z + +@x + reset(input,'NAME=' ccat filename ccat '.' ccat filetype ccat '.*'); + writeln('******* tex8600 Version ',version:2,' Level ', + level:3,' *******'); + rewrite(setfile,'LRECL=1029,RECFM=F,NAME=' ccat filename ccat +'.TAPEFILE.*'); +@y + reset(input,'NAME=' ccat filename ccat '.' ccat filetype ccat '.*'); + writeln('******* tex8600 Version ',version:2,' Level ', + level:3,' *******'); + rewrite(setfile,'LRECL=1024,RECFM=F,NAME=' ccat filename ccat +'.TAPEFILE.*'); +@z diff --git a/macros/text1/compugraphics_8600/tex8600.web b/macros/text1/compugraphics_8600/tex8600.web new file mode 100644 index 0000000000..8b99589a5a --- /dev/null +++ b/macros/text1/compugraphics_8600/tex8600.web @@ -0,0 +1,3034 @@ +\font\twelvept=cmbx12 +\font\tentex=cmr10 +\def\topofcontents{\null\vfill\eject + \def\titlepage{T} + \centerline{{\twelvept The \TeX 8600 Driver}} + \vskip15pt + \centerline{Version 2.2, June 1988} + \hbox{\vbox{\hsize\the\hsize This work is + protected as an unpublished work under U.S. copyright laws. + Copyright $\copyright$ 1986 by WSUCSC. All rights Reserved.}} + \vskip18pt + \hbox{\vbox{\hsize\the\hsize This software is furnished under a + license for + use only on a single computer system and may be copied only + with the inclusion of the above copyright notice. + This software, or any other copies + thereof, may not be provided or otherwise made available to any + other person except for use on such system and to one who agrees to + these license terms. Title to and ownership of the software shall + at all times remain in WSUCSC.}} + \vfill} + +@* Introduction. +This program takes a \TeX\ DVI file and converts it into CG 8600 +Universal Slave Mode commands. Five bytes have been added to each +record. These five bytes are stripped off by the Datum 5095 tape +drive as it passes the file onto the 8600. + +The \TeX 8600 program is written in WEB. You will need the TANGLE +and WEAVE programs to make changes. The WEB code was written +originally for IBM Pascal/VS on VM/CMS. + +If you have a CG font that is not one of the ones on the \TeX 8600 +distribution tape, you need to modify the SAMPLE.FONTINFO file for +that font and process it through FONTTEX. + +@ Following are a few macros and definitions used throughout program: + +@d incr(#) == # := # + 1 +@d decr(#) == # := # - 1 +@d do_nothing == begin; end +@d ccat==@=||@> +@f static == var +@f value == var + +@ The beginning of the program. + +@p program tex8600(dumpout,sysprint,addrline,setfile,cgfonts,infofile); +const +@<Global Constants@>@/ +type +@<Global Types@>@/ +var +@<Global Variables@>@/ +static@/ +@!com_table :packed array[0..18] of string(7);@/ +value@/ + com_table[0] := 'HDR'; {Header Record}@/ + com_table[1] := 'CHWIDTH';{Character Width}@/ + com_table[2] := 'RT'; {Reverse Type}@/ + com_table[3] := 'PS'; {Point Size}@/ + com_table[4] := 'SS'; {Set Size}@/ + com_table[5] := 'VMF'; {Vertical Move Forward}@/ + com_table[6] := 'VMR'; {Vertical Move Reverse}@/ + com_table[7] := 'RW'; {Rule Width}@/ + com_table[8] := 'RD'; {Rule Depth}@/ + com_table[9] := 'IR'; {Insert Rule}@/ + com_table[10] := 'SL'; {Slant Mode}@/ + com_table[11] := 'RTWT'; {Reverse Type Window Top}@/ + com_table[12] := 'RTWB'; {Reverse Type Window Bottom}@/ + com_table[13] := 'AU'; {Auxiliary Character Set}@/ + com_table[14] := 'F'; {Change Fonts}@/ + com_table[15] := 'HMR'; {Horizontal Move Right}@/ + com_table[16] := 'HML'; {Horizontal Move Left}@/ + com_table[17] := 'TTS'; {8600 character, in decimal}@/ + com_table[18] := 'MAXCMD';@/ +@<CMS Includes@> + +@ This is a collection of arrays for converting ASCII to EBCDIC. + +@<CMS Includes@>= +@{This is a very long comment. It is designed to force a break@} +%include pasclib(asciicvt); + +@ This is a collection of arrays for converting ASCII to EBCDIC. + +@<CMS Includes@>= +@{This is a very long comment. It is designed to force a break@} +%include cms; +@{This is a very long comment. It is designed to force a break@} + +@* Beginning section. +This section includes some basic functions for reading the DVI file +as well as a couple of procedures, like error and allcaps. Nothing +tricky or noteworthy in these. + +@<Global Variables@>= +@!count : integer; +@!fileend :boolean; + +@ The function for reading a byte of information from the DVI file. + +@p function getbyte:integer; +var c :integer; + byte :char; +begin + read(byte); + getbyte := ord(byte); + c := count mod pv_dvi_lrecl; + if (c=(pv_dvi_lrecl-1)) and not (eof(input)) + then get(input) + else if (c=(pv_dvi_lrecl-1)) and eof(input) + then fileend:=true; + end; + +@ This is necessary because tangle doesn't let us get away with +using RETCODE by itself in more than one spot. + +@p procedure setretcode(rc:integer); +begin retcode(rc); end; + +@ This converts the byte to an integer, for further evaluation by +the program. + +@p function readinteger(length :integer):integer; +var + inx :integer; + int :integer; +begin + if (length<1) or (length>4) + then begin; + trace(output); + halt; + end; + int:=0; + for inx := 1 to length do begin + int := int * 256 + getbyte; + {check for cvt to negative...} + if (inx = 1) and (length > 1) and (int >= 128) + then int := int - 256; + incr(count); + end; + readinteger := int; + end; {readinteger} + +@ This function receives an integer value and converts it to its +hex value and returns that value as a string. + +@^system dependencies@> +@p function hex(int :integer) :string(2); +var + i :integer; + j :integer; + stri :string(2); +static + hexarray :array[0..15] of string(1); +value + hexarray[0] := '0'; + hexarray[1] := '1'; + hexarray[2] := '2';@/ + hexarray[3] := '3'; + hexarray[4] := '4'; + hexarray[5] := '5';@/ + hexarray[6] := '6'; + hexarray[7] := '7'; + hexarray[8] := '8';@/ + hexarray[9] := '9'; + hexarray[10] := 'A'; + hexarray[11] := 'B';@/ + hexarray[12] := 'C'; + hexarray[13] := 'D'; + hexarray[14] := 'E'; + hexarray[15] := 'F'; +begin + stri := ''; + i := int; + if i >= 16 + then begin + j := i div 16; + stri := hexarray[j]; + i := i - (j * 16); + end + else stri := '0'; + stri := stri ccat hexarray[i];@/ + hex := stri; + end; + +@ +@<Global Variables@>= +@! savecount :integer; +@^system dependencies@> +@! filename :string(8); +@^system dependencies@> +@! errstr :string(256); + +@ The error procedure. When a byte is read that does not jive with +what the program was expecting, it goes to this procedure with a +return code of some kind and an appropriate message is printed to user. + +@p procedure error(number :integer; + critical:boolean; + intval :integer); +begin + case number of + 1 :writeln('Error in file ',filename,', no header record'); + 2 :writeln('Error in file ',filename,', the highest 8600 ', + 'command has a value of ',ord(MAXCMD):3,' but ', + intval,' was read instead'); + 3 :writeln('Expected a font command and got "', + com_table[intval],'" instead'); + 4 :writeln('Expected a character width definition and got "', + com_table[intval],'" instead in file ',filename); + 5 :writeln('File ',filename,' is out of order for character ', + intval:3,' (',chrx[intval],')'); + 6 :writeln('Error in file ',filename,', the value of byte ', + intval,' is >= 218 and <= 255 at byte ',savecount); + 7 :writeln('Expected a Slantmode command and got ', + com_table[intval],' instead'); + 10 :writeln('No address information given'); + 28 :writeln('Unidentified input option "',errstr,'"'); + otherwise writeln('Unidentified error ',number); + end; {case} + if critical then begin + writeln('TeX8600 run aborted; See your consultant'); + trace(output); + halt; + end; + writeln('Tape will not be sent to operator'); + setretcode(32); + end; {error} + +@ Finally, a function that will convert whatever is passed to it into +all capital letters. It translates lower case letters into upper case +letters. All other characters outside of the range +a$<$=character$<$=z are returned as their original value. + +@^system dependencies@> +@p function allcaps(instring :string(40)) :string(40); +var + i :integer; + character :char; + buildit :string(40); +static@/ + chtable :packed array['81'xc..'e9'xc] of char;@/ +value@/ + chtable['81'xc] := 'A'; + chtable['82'xc] := 'B'; + chtable['83'xc] := 'C'; + chtable['84'xc] := 'D';@/ + chtable['85'xc] := 'E'; + chtable['86'xc] := 'F'; + chtable['87'xc] := 'G'; + chtable['88'xc] := 'H';@/ + chtable['89'xc] := 'I'; + chtable['91'xc] := 'J'; + chtable['92'xc] := 'K'; + chtable['93'xc] := 'L';@/ + chtable['94'xc] := 'M'; + chtable['95'xc] := 'N'; + chtable['96'xc] := 'O'; + chtable['97'xc] := 'P';@/ + chtable['98'xc] := 'Q'; + chtable['99'xc] := 'R'; + chtable['a2'xc] := 'S'; + chtable['a3'xc] := 'T';@/ + chtable['a4'xc] := 'U'; + chtable['a5'xc] := 'V'; + chtable['a6'xc] := 'W';@/ + chtable['a7'xc] := 'X'; + chtable['a8'xc] := 'Y'; + chtable['a9'xc] := 'Z'; +begin + buildit := ''; + for i := 1 to length(instring) do begin + readstr(substr(instring,i,1),character); + if character in ['a'..'z'] + then buildit := buildit ccat str(chtable[character]) + else buildit := buildit ccat str(character); + end; + allcaps := buildit; + end; + +@* Font Related Procedures. +This first font procedure reads the font matrix information for the +current font from an outside file called cginfo defined as cgfonts. + +@<Global Constants@>= +@! maxfunctions = 15;@/ +@! maxChar=127;@/ +@! fatal = true;@/ +@! fontsperrun = 76;@/ +@! maxFont=256;@/ + +@ +@<Global Types@>= +@! oneoftwo = packed 1..2; + command = (HDR,CHWIDTH,RT,PS,SS,VMF,VMR,RW,RD,IR,SL, + RTWT,RTWB,AU,F,HMR,HML,TTS,MAXCMD);@/ +@! storerec = packed record + comcode :packed -128..127; + case oneoftwo of + 1 :(argument :integer); + 2 :(real_argument :shortreal); + end; +@! charrec = packed record + num :-1..maxfunctions; + charwidth :shortreal; + comarray :packed array[0..maxfunctions] of storerec; + end; +@! driverrec = record + cmd :integer; + case oneoftwo of + 1 :(param :shortreal); + 2 :(code :integer); + end; +@! font_def = packed record + pointsize : 0..255; + designsize : 0..255; + fontindex : 0..255; + end; +@^system dependencies@> +@! fontrec = record + fontno8600 : 0..2550; + name : string(8); + a8600chars : packed array[0..maxChar] of charrec; + end; + +@ +@<Global Variables@>= +@!currfont : -1..maxFont; +@!a8600fontrec : packed array[1..fontsperrun] of fontrec; +@!fontcode : driverrec; +@^system dependencies@> +@!fontname : string(8); +@!dumpin : boolean; +@!fontenviron : packed array[-1..maxFont] of font_def; + +@ A new font is being used so it must have its font metrics read; this +procedure does just that. + +@p procedure readfontinfo(fontnum,a8600index:integer); +var + auxiliary :boolean; + cgfonts :file of driverrec; + changefont :boolean; + charmult :shortreal; + i,j,rc, + numcommands :integer; +begin + @<open cginfo file@> + @<read beginning info@> + @<read character info@> + @<close cginfo file@> +end; + +@ First open the cginfo file + + @<open cginfo file@>= + fontenviron[fontnum].fontindex := a8600index; + a8600fontrec[a8600index].name:= fontname; + cms('ESTATE 'ccat fontname ccat ' CGINFO *',rc); + if rc = 0 + then reset(cgfonts,'NAME=' ccat fontname ccat '.CGINFO.*') + else begin + reset(cgfonts,'NAME=ETR.CGINFO.*'); + writeln('Error!! Font ',fontname,' is not on the 8600'); + writeln('You will not be able to continue'); + setretcode(8); + end; + +@ Now read the first few records that give overall font info. + + @<read beginning info@>= + fontcode := cgfonts@@;{Read the first record of the file} + get(cgfonts);@/ + with fontcode do begin + if cmd <> ord(HDR) then error(1,fatal,0); + if code <> ord(MAXCMD) then error(2,fatal,code); + end; {with..begin} + fontcode := cgfonts@@; {read the second record of the file} + get(cgfonts);@/ + with fontcode do begin + if cmd <> ord(F) then error(3,fatal,cmd); {Must be font cmnd} + a8600fontrec[a8600index].fontno8600 := code; + end; {with..begin} + fontcode := cgfonts@@; + get(cgfonts); + with fontcode do begin + if cmd <> ord(CHWIDTH) then error(4,fatal,cmd); {charac mult} + charmult := param; + end; {with..begin} + {Each character (maxChar) has one header record (HDR) + and one character width record. The number of records + for each character that follows the width record is + contained as "code" in the header record. Each + character will have at least one record.} + fontcode := cgfonts@@; {slantmode option no longer used} + get(cgfonts); + with fontcode do begin + if cmd <> ord(SL) then error(7,fatal,cmd); + end; + if dumpin + then with a8600fontrec[fontenviron[fontnum].fontindex] + do begin + writeln(dumpout, + ' The character width multiplier for ', + filename,' is ',charmult:5:2); + writeln(dumpout, + ' The 8600 font number is ',fontno8600:3); + end; + +@ The individual character heights, depths, widths and positions +come next. + + @<read character info@>= + for i := 0 to maxChar do begin + with a8600fontrec[a8600index].a8600chars[i] +do begin + fontcode := cgfonts@@; + get(cgfonts); + with fontcode do begin + if cmd <> ord(HDR) then error(5,fatal,i); + numcommands := code; {number for this character} + end; {with..begin} + num := -1; + @<read character width@> + auxiliary := false; + changefont := false; + for j := 0 to numcommands do begin + @<read next command@> + end; + if auxiliary then begin + @<Auxiliary change@> + end; + if changefont then begin + @<Font change@> + end; + end; + end; + +@ Font is all read and safely tucked into appropriate places to +be used later, so close the door and shut off the lights on the +way out. + + @<close cginfo file@>= + close(cgfonts); + +@ + @<read character width@>= + fontcode := cgfonts@@; {read the character width} + get(cgfonts); + with fontcode do begin + if cmd <> ord(CHWIDTH) then error(5,fatal,i); + charwidth := param * charmult; + end; {with..begin} + +@ + @<read next command@>= + fontcode := cgfonts@@; + get(cgfonts); + num := num + 1; {increment number of commands} + with fontcode, comarray[num] do begin + if ((cmd >= 5) and (cmd <= 8)) or + (cmd = 11) or (cmd = 12) or (cmd = 16) + then real_argument := param + else argument := code; + case cmd of + 2 :comcode := 3; {reverse type} + 3 :comcode := 7; {Point Size Change} + 4 :comcode := 8; {Set Size Change} + 5 :comcode := 9; {Vertical Move Forward} + 6 :comcode := 10; {Vertical Move Reverse} + 7 :comcode := 12; {Rule Width} + 8 :comcode := 13; {Rule Depth} + 9 :comcode := 14; {Insert Rule} + 10 :comcode := 15; {Slant Mode} + 11 :comcode := 16; {Reverse Window Top} + 12 :comcode := 17; {Reverse Window Bot} + 13 :begin + @<Change to Auxiliary Characters@> + end; + 14 :begin + @<Change Font@> + end; + 15 :comcode := 27; {Horiz. Move Right} + 16 :comcode := 28; {Horiz. Move Left} + 17 :comcode := -1; {Decimal Char Code} + otherwise begin + @<Invalid Command Number@> + end; + end; + end; + +@ + @<Auxiliary change@>= + num := num + 1; + with comarray[num] do begin + comcode := 20; + argument := 1; + end; + +@ + @<Font change@>= + num := num + 1; + with comarray[num] do begin + comcode := 25; + argument := -1; {for quick ID in font changes} + end; + +@ + @<Change to Auxiliary Characters@>= + comcode := 20; + if auxiliary + then begin + argument := 1; + auxiliary := false; + end + else begin + argument := 2; + auxiliary := true; + end; + +@ + @<Change Font@>= + comcode := 25; + if code <> fontnum + then changefont := true; + argument := code * 10; + +@ + @<Invalid Command Number@>= + writeln('Invalid 8600 Command Number ', cmd); + error(5,fatal,cmd); + +@ This procedure checks to see if the current font has been + previously defined. If it has, it returns to the main program, + if it hasn't, |readfontinfo| is called. + +@p procedure checkfont; +var + i :integer; +static + in_count :integer; +value + in_count := 0; +begin +@<check fonts@> +readfontinfo(currfont,in_count); + end; + +@ Each time a font is encountered in the DVI file, one is added to +the |in_count|. The following section checks to see if the |curr_font| +has ever been used before in this file. If it has, nothing is done and +it returns to main program. If it is a new file, it continues on in +procedure to read the new font metrics. + +@<check fonts@>= + incr(in_count); + for i := 1 to in_count do begin + if a8600fontrec[i].name = fontname + then begin + fontenviron[currfont].fontindex := i; + return; + end; + end; + +@ This procedure reads the DVI file to get all pertinent information +for the |MAIN| program. + +@<Global Constants@>= +@! SPsPerPt = 65536;@/ +@! pc_dvi_lrecl=1024; + +@ +@<Global Variables@>= +@!checksumtest : integer; +@!pv_dvi_lrecl :integer; + +@ +@p procedure fontinfo; +var + fnlength : integer; + temp : integer; + temp2 : integer; + inx : integer; +begin + with fontenviron[currfont] do begin + checksumtest := readinteger(4);{check sum} + temp := readinteger(4);{scale} + temp2:= readinteger(4);{design size} + pointsize := temp2 * (temp div temp2) div SPsPerPt; + designsize := temp2 div SPsPerPt; + end; {WITH..begin} + temp := readinteger(1);{font name area} + fnlength := readinteger(1);{file length} + fnlength := fnlength + temp; + fontname := ''; + for inx := 1 to fnlength do begin + temp := readinteger(1); + fontname := fontname ccat allcaps(str(chrx[temp])); + end; + checkfont; +end; + +@* Tape-writing functions and procedures. +These next few functions and procedures prepare or write information +to a tape file + +@ This function converts an integer to a string or something like that + +@^system dependencies@> +@p function strconv(intnum : integer): string(5); +var + hdrec :string(5); + j :integer; + k10 :integer; + temphdr :integer; +begin + hdrec := ''; + k10 := 10000; + temphdr := intnum; + repeat + if temphdr >= k10 then begin + j := temphdr div k10; + hdrec := hdrec ccat str(chr(j + ord('0'))); + temphdr := temphdr - (j * k10); + end; + k10 := k10 div 10; + until k10 = 1; + hdrec := hdrec ccat str(chr(temphdr + ord('0'))); + if length(hdrec) < 5 + then hdrec := substr('00000',1,5-length(hdrec)) ccat hdrec; + strconv := hdrec; + end; + +@ This procedure is to add the 5 bytes at the beginning + of each record that will be read by the 5095 tape + drive. It should be noted that these 5 bytes are + discarded by the 5095 before it sends the rest of the record to the 8600. + +@<Global Constants@>= +@! maxbuffer = 1029;@/ + +@ +@<Global Variables@>= +@!doingpages : boolean; +@!setfile : text; +@!dumpout : text; +@!bufferlen : 0..maxbuffer; +@!headernum : integer; + +@ +@p procedure writeheader; {only needed when using Datum 5095} +var + hdrec :string(5); +begin + if doingpages = true + then begin + hdrec := strconv(headernum); + write(setfile,hdrec); + bufferlen := 5; + end; {then..begin} + end; {writeheader} + +@ +@<Global Constants@>= +@! allzeros = '00'xc;@/ + +@ +@<Global Variables@>= +@!postam_found : boolean; + +@ This procedure is used to write the tape file for the 5095 +drive on the 8600 + +@p @^system dependencies@> +procedure write8600rec(codes :string(17)); +var + i :integer; + codesize :integer; +begin + codesize := length(codes); + if doingpages=true + then begin + if bufferlen + codesize < maxbuffer + then begin + @<record length less than maximum@> + end {then..begin} + else if bufferlen + codesize = maxbuffer + then begin + @<record length equal to maximum@> + end {then..begin} + else begin + @<record length greater than maximum@> + end; {else..begin} + end; {then..begin} + end; {write8600rec} + +@ + @<record length less than maximum@>= + write(setfile,codes); + bufferlen := bufferlen + codesize; + if postam_found then begin + while bufferlen < maxbuffer do begin + write(setfile,allzeros); + codesize := length(allzeros); + bufferlen := bufferlen + codesize; + end; {while..begin} + end; {then..begin} + +@ + @<record length equal to maximum@>= + writeln(setfile,codes); + if not postam_found then writeheader; + +@ + @<record length greater than maximum@>= + i := maxbuffer - bufferlen; + writeln(setfile,substr(codes,1,i)); + writeheader; + write(setfile,substr(codes,i+1,codesize-i)); + bufferlen := bufferlen + codesize - i; + if postam_found then begin + while bufferlen < maxbuffer do begin + write(setfile,allzeros); + codesize := length(allzeros); + bufferlen := bufferlen + codesize; + end; {while..begin} + end; {then..begin} + +@ +@<Global Variables@>= +@!print_hmove : boolean; + +@ This function, +given amount in scale points, converts it to floating-point +points and print it. + +@p function getpts(amt :integer) :real; +var + temp :real; +begin + temp := float(amt) / SPsPerPt; + if dumpin and print_hmove then write(dumpout,temp:4:1,' pts.'); + getpts := temp; + end; + +@* Main tape-writing procedures. +These next few procedures are the main ones for writing information +to the tape file. + +@ +@<Global Constants@>= +@! high1 = '8000'@&x;@/ +@! SPsPer8th = 8192;@/ +@! SPsPer18th = 3640.8888;@/ + +@ +@<Global Type...@>= +@! valrec = packed record case oneoftwo of + 1 :(hexcode :char; + argument :packed -32768..32767); + 2 :(byte1 :packed 0..255; + byte2 :packed 0..255; + byte3 :packed 0..255) + end; +@! stackrec = packed record + H :integer; + V :integer; + W :integer; + X :integer; + Y :integer; + Z :integer; + end; + +@ +@<Global Variables@>= +@!stack : packed array[1..50] of stackrec; +@!stacktop : integer; +@!outrec : valrec; +@!in_reverse_type : boolean; +@!in_slant_mode : boolean; + +@ This procedure is called to format the output record + in a 1 or 3 byte word to be added to the 8600 output + record buffer. Each command used by the slave mode + is represented here by their appropriate code number + assigned by Compugraphics. The code "-1" was not + assigned by them. It was assigned to denote the use + of a character in the current font. + +@p @^system dependencies@> +procedure writecommand(codenum :integer; + inargument :real); +var + temp :string(3); + realtemp :real; +begin + with outrec do begin + case codenum of + -2 :@<long character form@>@/ + -1 :@<individual character code@>@/ + 0 :@<start of take@>@/ + 1 :@<end of take@>@/ + 2 :@<change reverse type@>@/ + 7 :@<change point size@>@/ + 8 :@<change set size@>@/ + 9 :@<forward vertical move@>@/ + 10 :@<reverse vertical move@>@/ + 11 :@<absolute horizontal positioning@>@/ + 12 :@<rule width@>@/ + 13 :@<rule depth@>@/ + 14 :@<insert rule@>@/ + 15 :@<slant mode@>@/ + 16 :@<reverse type window top@>@/ + 17 :@<reverse type window bottom@>@/ + 20 :@<change auxiliary character set@>@/ + 25 :@<change fonts@>@/ + 27 :@<right horizontal move@>@/ + 28 :@<left horizontal move@>@/ + otherwise @<all other cases@> + end; {case} + byte2 := byte2 + '10000000'B; + temp := str(chr(byte1)) ccat + str(chr(byte2)) ccat str(chr(byte3)); + write8600rec(temp); + end; {with..begin} + end; {writecommand} + +@ +@<long character...@>= + begin + hexcode := chr(trunc(inargument)+high1); + argument := round(getpts(stack[stacktop].H) * 18); + temp := str(chr(byte1)) ccat str(chr(byte2)); + temp := temp ccat str(chr(byte3)); + write8600rec(temp); + return; + end; + +@ +@<individual character code@>= + begin + {change inargument into a one character + string (hex) value} + argument := trunc(inargument); + write8600rec(str(chr(byte3))); + return; + end; +@ +@<start of take@>= + begin + hexcode := '80'xc; + argument := trunc(inargument); + end; + +@ +@<end of take@>= + begin + hexcode := '81'xc; + argument := trunc(inargument); + end; + +@ +@<change reverse type@>= + begin + if not in_reverse_type and (inargument = 0) + then return; {8600 warning if you try to + turn it off when its already off} + if inargument = 0 + then in_reverse_type := false + else in_reverse_type := true; + if in_reverse_type then begin + realtemp := {76\% of the current leading} + (fontenviron[currfont].pointsize + 2)*0.76; + writecommand(16,realtemp); {window top} + realtemp := {30\% of the current leading} + (fontenviron[currfont].pointsize + 2)*0.30; + writecommand(17,realtemp); {window bottom} + end; {then..begin} + hexcode := '83'xc; + argument := trunc(inargument); + end; + +@ +@<change point size@>= + begin + hexcode := '87'xc; + argument := round(inargument*2) * 4; {in eighths} + end; + +@ +@<change set size@>= + begin + hexcode := '88'xc; + argument := round((fontenviron[currfont].pointsize* + (inargument/100.0)) * 2) * 4; {in eighths} + end; + +@ +@<forward vertical move@>= + begin + if inargument = 0 then return; {0 invalid on 8600} + hexcode := '89'xc; + {in sixteenths} + argument := round(inargument / SPsPer8th) * 2; + end; + +@ +@<reverse vertical move@>= + begin + if inargument = 0 then return; {0 invalid on 8600} + hexcode := '8a'xc; + {in sixteenths} + argument := round(inargument / SPsPer8th) * 2; + end; + +@ +@<absolute horizontal positioning@>= + begin + hexcode := '8b'xc; + {eighteenths} + if inargument < -72.27 then begin + if dumpin then writeln(dumpout, + ' HP less than zero'); + inargument := 0; + end; + argument := round(inargument / SPsPer18th); + end; + +@ +@<rule width@>= + begin + if inargument = 0 then return; {0 invalid on 8600} + hexcode := '8c'xc; + argument := round(inargument * 18); + end; + +@ +@<rule depth@>= + begin + if inargument = 0 then return; {0 invalid on 8600} + hexcode := '8d'xc; + argument := round(inargument * 8) * 2; + end; + +@ +@<insert rule@>= + begin + hexcode := '8e'xc; + if inargument < 0 then begin + if dumpin then writeln(dumpout, + ' IR less than zero'); + inargument := 0; + end; + argument := round(inargument / SPsPer18th); + end; + +@ +@<slant mode@>= + begin + hexcode := '8f'xc; + argument := trunc(inargument); + if argument = 0 + then in_slant_mode := false + else in_slant_mode := true; + end; + +@ +@<reverse type window top@>= + begin + hexcode := '90'xc; + argument := round(inargument*8) * 2; {in sixteenths} + end; + +@ +@<reverse type window bottom@>= + begin + hexcode := '91'xc; + argument := round(inargument*8) * 2; {in sixteenths} + end; + +@ +@<change auxiliary character set@>= + begin + hexcode := '94'xc; + argument := trunc(inargument); + end; + +@ +@<change fonts@>= + begin + hexcode := '99'xc; + argument := trunc(inargument); + end; + +@ +@<right horizontal move@>= + begin + if inargument = 0 then return; {if no move} + hexcode := '9b'xc; + {eighteenths} + argument := round(inargument / SPsPer18th); + end; + +@ +@<left horizontal move@>= + begin + if inargument = 0 then return; {if no move} + hexcode := '9c'xc; + {eighteenths} + argument := round(inargument / SPsPer18th); + end; + +@ +@<all other cases@>= + begin + writeln('Invalid 8600 command code = ',codenum); + error(5,fatal,codenum); + end; {otherwise} + +@* Billing and identification information procedures. + +@ The first procedure is the one that writes out all the resource-type +information. It first checks to see if the character it is about to +write out is one of several special characters, if it is the hex code +is changed. + +@^system dependencies@> +@p procedure writeinfo(info:string(30)); + var + inx : integer; + begin + for inx := 1 to length(info) + do begin + if info[inx] = ' ' + then write8600rec('1F'xc) + else if info[inx] = '(' + then write8600rec('3A'xc) + else if info[inx] = ')' + then write8600rec('3B'xc) + else if info[inx] = '*' + then write8600rec('5C'xc) + else if info[inx] = '_' + then begin + writecommand(20,2); {aux. char. set} + write8600rec('50'xc); + writecommand(20,1); {back to primary} + end {then..begin} + else write8600rec(str(chr(ordx[info[inx]]))); + end; {do..begin} + end; {writeinfo} + +@ +@<Global Variables@>= +@^system dependencies@> +@!job_len_conv : string(5); +@!job_length : integer; +@^system dependencies@> +@!parmvalue : string(80); +@^system dependencies@> +@!pages_conv : string(5); +@!pages_set : integer; +@!galley_length : real; +@^system dependencies@> +@!real_filename : string(8); + +@ The following procedure writes the information within the accounting +box at the end of each job. + +@p @^system dependencies@> + procedure setaccountbox (infoname :string(30); + infophone :string(14); + infodelivery :string(8); + infozip :string(10); + infobin :string(8); + infoid :string(22)); + var + inx :integer; + begin + @<set constant values@>@/ + @<draw accounting box@>@/ + @<write name in box@>@/ + @<write phone number in box@>@/ + @<write delivery method in box@>@/ + @<write zipcode in box@>@/ + @<write center bin in box@>@/ + @<write user id in box@>@/ + @<write job length in box@>@/ + @<write file name in box@>@/ + @<write number of pages set, in box@>@/ + @<write tape number in box@>@/ + galley_length := galley_length + 140; + end; {setaccountbox} + +@ +@<set constant...@>= + different_setsize := false; + in_slant_mode := false; + in_reverse_type := false; + +@ +@<draw account...@>= + writecommand(12,410); {rule width in points} + writecommand(13,8); {rule depth in points} + writecommand(14,0); {set top rule} + writecommand(12,8); {rule width in points} + writecommand(13,84); {rule depth in points} + writecommand(14,402*SPsPerPt); {set left rule} + writecommand(14,0); {set right rule} + writecommand(9,83.8*SPsPerPt); {VMF to bottom in pts} + writecommand(12,410); {rule width in points} + writecommand(13,8); {rule depth in points} + writecommand(14,0); {set bottom rule} + writecommand(11,32*SPsPerPt); {32pt indent} + writecommand(10,56*SPsPerPt); {Move back up} + writecommand(25,320); {define bold font} + writecommand(7,11); {11pt size} + +@ +@<write name...@>= + write8600rec('4e616d65231e'xc); {'Name: '} + writecommand(25,330); {change to Bold Ital} + writeinfo(infoname); + writecommand(11,265*SPsPerPt); {265pt Indent} + writecommand(25,320); {Bold} + +@ +@<write phone...@>= + write8600rec('50686f6e65231e'xc); {'Phone: '} + writecommand(25,330); {Bold Italic} + writeinfo(infophone); + +@ +@<write delivery meth...@>= + writecommand(11,50*SPsPerPt); {50pt indent} + writecommand(9,16*SPsPerPt); {VMF 16pt} + writecommand(25,320); {Bold} + write8600rec('44656c6976657279231e'xc); {'Delivery: '} + writecommand(25,330); {Bold Italic} + writeinfo(infodelivery); + +@ +@<write zipcode...@>= + if infozip <> 'NA' + then begin + writecommand(11,190*SPsPerPt); {190pt indent} + writecommand(25,320); {Bold} + write8600rec('5a6970636f6465231e'xc); {'Zipcode: '} + writecommand(25,330); {Bold Italic} + writeinfo(infozip); + end; + +@ +@<write center...@>= + if infobin <> 'NA' + then begin + writecommand(11,284*SPsPerPt); {284pt indent} + writecommand(25,320); {Bold} + write8600rec('42696e231e'xc); {'Bin: '} + writecommand(25,330); {Bold Italic} + writeinfo(infobin); + end; {then..begin} + +@ +@<write user id...@>= + writecommand(9,14*SPsPerPt); {VMF 14pt} + if infoid <> 'NA' + then begin + writecommand(11,30*SPsPerPt); {30pt indent} + writecommand(25,320); {Bold} + write8600rec('4944231e'xc); {'ID: '} + writecommand(25,330); {Bold Italic} + writeinfo(infoid); + end; {then..begin} +@ +@<write job length...@>= + writecommand(11,250*SPsPerPt); {indent for job length} + writecommand(25,320); {BOLD} + write8600rec('4a6f621e'xc); {'Job '} + write8600rec('4c656e677468231e'xc); {'Length: '} + writecommand(25,330); {Bold Italic} + job_len_conv := strconv(job_length); + for inx := 1 to 5 + do write8600rec(str(chr + (ordx[job_len_conv[inx]]))); + write8600rec('1e696e63686573'xc); {' inches'} + writecommand(11,20*SPsPerPt); {get ready for DSN} + +@ +@<write file name...@>= + writecommand(9,16*SPsPerPt); {VMF 16pt} + writecommand(25,320); {Bold} + write8600rec('46696c656e616d65231f'xc); {'Filename: '} + writecommand(25,330); {Bold Italic} + parmvalue := real_filename; + writeinfo(parmvalue); + +@ +@<write number of...@>= + writecommand(11,155*SPsPerPt); {155pt indent} + writecommand(25,320); {Bold} + write8600rec('50616765731e'xc); {'Pages '} + write8600rec('536574231e1e'xc); {'Set: '} + writecommand(25,330); {Bold Italic} + pages_conv := strconv(pages_set); + for inx := 1 to 5 + do write8600rec(str(chr(ordx + [pages_conv[inx]]))); + writecommand(11,265*SPsPerPt); {get ready for Tape \#} + +@ +@<write tape numb...@>= + writecommand(25,320); {Bold} + write8600rec('546170651e'xc); {'Tape '} + writecommand(20,2); {aux. char. set} + write8600rec('72'xc); {'\#'} + writecommand(20,1); {pri. char. set} + write8600rec('231e1e1e1e'xc); {': '} + postam_found := true; + writecommand(25,330); {bold italic} + + +@ The information procedure reads the billing information from an outside +file called the |addrfile|, and sends that information to the +|setaccountbox| procedure. It also writes the information to another file +called the |infofile|. + +@<Global Constants@>= +@! notfatal = false;@/ + +@ +@<Global Variables@>= +@!addrline : text; +@!infofile : text; +@^system dependencies@> +@!resource_info : string(256); +@^system dependencies@> +@!str1 : string(256); +@^system dependencies@> +@!str2 : string(256); +@!minimum_width : integer;@/ + +@ +@p @^system dependencies@> +procedure information; + var + int :integer; + inx :integer; + infoname :string(30); + infophone :string(14); + infodelivery :string(10); + infozip :string(10); + infobin :string(8); + infoid :string(22); + infoprocedure :string(4); + infobudget :string(20); + tempbool :boolean; + begin + @<set initial values for strings@> + @<open address file and read and close@>@/ + @<parse info from address file@> + @<send info to accounting procedure and write infofile@> + end; {information} + +@ +@<set initial values...@>= + infozip := 'NA'; + infoid := 'NA'; + infobin := 'NA'; + infoprocedure := 'NA'; + infobudget := 'NA'; + +@ +@<open address...@>= + termin(addrline); + readln(addrline,resource_info); + close(addrline); + +@ +@<parse info...@>= + rewrite(infofile,'NAME=' ccat filename ccat '.INFOFILE.*'); + while length(resource_info) > 0 do begin + inx := index(resource_info,':'); + if inx < 1 + then begin + errstr := resource_info; + error(28,notfatal,0); + end + else begin + str1 := substr(resource_info,1,inx-1); + resource_info := ltrim(substr(resource_info,inx+1)); + inx := index(resource_info,':'); + if inx = 0 + then begin + str2 := resource_info; + resource_info := ''; + end + else begin + int := inx - 1; {no sense starting at a colon:} + tempbool := false; + repeat + if substr(resource_info,int,1) = ' ' + then tempbool := true + else int := int - 1; + until tempbool; {which means we found a blank} + str2 := trim(substr(resource_info,1,int-1)); + resource_info := substr(resource_info,int+1); + end; + str1 := allcaps(ltrim(trim(str1))); + str2 := allcaps(ltrim(trim(str2))); + if str1 = 'NAME' then + infoname := str2 + else if str1 = 'PHONE' then + infophone := str2 + else if str1 = 'PROCEDURE_NUMBER' + then infoprocedure := str2 + else if str1 = 'BUDGET_PROJECT' + then infobudget := str2 + else if str1 = 'PICKUP' then + infodelivery := str2 + else if str1 = 'CAMPUS_ZIP' then + infozip := str2 + else if str1 = 'BIN' then + infobin := str2 + else if str1 = 'ID' then + infoid := str2 + else begin + errstr := resource_info; + error(28,notfatal,0); + end + end; + end; + +@ +@<send info...@>= + setaccountbox(infoname,infophone,infodelivery,infozip, + infobin,infoid); + writeln(infofile,infoname); + writeln(infofile,infophone); + writeln(infofile,infoprocedure); + writeln(infofile,infobudget); + writeln(infofile,infodelivery); + writeln(infofile,infozip); + writeln(infofile,infoid); + writeln(infofile,infobin); + writeln(infofile,job_length); + writeln(infofile,pages_set); + writeln(infofile,minimum_width); + writeln(infofile,real_filename); + +@* End of File procedures. +At the end of the \TeX DVI file is a postamble command, when that +command is encountered |readpostamble| and |post_amble| are called. + +@ The second procedure called but first listed is the |post_amble| +procedure, it calls the |information| procedure and writes the job +length and number of pages to the terminal. + +@<Global Variables@>= +@!num_of_pages : integer; +@^system dependencies@> +@!job_type : string(6); + +@ +@p procedure post_amble; + begin + @<prepare and write information info@> + @<give job length to user on terminal@>@/ + @<set final values for galleylength, etc.@> + end; {Postamble} + +@ +@<prepare and write...@>= + if dumpin then writeln(dumpout, + 'PST -- post-amble: End of Run'); + doingpages := true; + writecommand(11,0); {Move to left col.} + writecommand(9,30.0*SPsPerPt); {VMF 30 pts} + information; + +@ +@<give job length...@>= + writeln; + writeln('Total length of run = ', + galley_length:9:1,' pts.'); + writeln(' = ', + galley_length/72.0:9:1,' inches.'); + writeln(' = ', + num_of_pages:9,' pages.'); + +@ +@<set final...@>= + job_length := round(galley_length/72.0); + pages_set := num_of_pages; + job_type := 'TeX'; + +@ This second procedure is called first and reads the final job +information for the file. Things like job length, widest page, +tallest page are set and the information sent to |post_amble|. + +@<Global Variables@>= +@!byte : integer;@/ +@!width : real;@/ +@!even_page_margin : real;@/ +@!odd_page_margin : real;@/ +@!totalpg : integer;@/ + +@ +@p procedure readpostamble; +var + int :integer;@/ + inx :integer;@/ +begin + job_length := round(galley_length / 72.0);@/ + pages_set := num_of_pages;@/ + for inx := 1 to 3 do byte := readinteger(4); + byte := readinteger(4); {Get magnification}@/ + if dumpin + then writeln(dumpout, + '** Font magnification = ',byte/1000.0:3:1); + writeln; + writeln('Tallest page is ',readinteger(4)/SPsPerPt/72.0:2:1, + ' inches.'); + width := readinteger(4) / SPsPerPt / 72.27; + width := max(width,put_width,even_page_margin/72.27, + odd_page_margin/72.27); + writeln('Widest page is ',width:2:1,' inches.');@/ + width := width + 0.31; {5/16" on the left that cannot be used.} + if width < 8.0 then int := 8 + else int := 12; + minimum_width := int; + writeln('The smallest paper you can use is ',int:2,'"'); + totalpg := 9999; + post_amble; + if galley_length = 0 then begin + writeln('Error!! No pages set. '); + setretcode(12); + end; + end; {readpostamble} + +@* Conversion Functions. +The following two functions will convert strings to integers +(|whole_value|) or to real numbers (|decimal_value|). + +@^system dependencies@> +@p function whole_value(str1 :string(10)) :integer; +var + inx, inz : integer;@/ + divisor : real;@/ + number : real;@/ +begin + number := 0; + inx := index(str1,'-'); + if inx > 0 + then begin + divisor := (-1 * 0.1); + str1 := substr(str1,2); + end {then..begin} + else divisor := 0.1; + for inz := 0 to (length(str1)-1) do begin + divisor := divisor * 10.0; + number := number + ((ordx[str1[length(str1) - inz]] - + ordx['0']) * divisor); + end; + whole_value := round(number); +end; {|whole_value|} + +@ +@^system dependencies@> +@p function decimal_value(str2 :string(40)): real; +var + inx, inz : integer; + divisor : real; + str3 : string(30); + number : real; +begin + number := 0.0; + inx := index(str2, '.');@/ + @<value with decimal, but nothing to right@> + @<value with decimal, and something to right@>@/ + @<value without decimal@> + decimal_value := number; + end; {|decimal_value|} + +@ +@<value with decimal, but...@>= + if inx = length(str2) then begin {read left side of decimal} + str2 := substr(str2,1,inx-1); + end +@ +@<value with decimal, and...@>= + else begin + if inx > 0 then begin + str3 := substr(str2,inx+1); + divisor := 1.0; + for inz := inx+1 to length(str3) do begin + divisor := divisor * 0.1; + number := number + + (ordx[str3[inz]] - ordx['0'] * divisor); + end; + if inx = 1 then return; + str2 := substr(str2,1,inx-1); + end; + end; + +@ +@<value without...@>= + divisor := 0.1; + for inz := 0 to (length(str2)-1) do begin + divisor := divisor * 10.0; + number := number + ((ordx[str2[length(str2) - inz]] - + ordx['0']) * divisor); + end; +@* Parm-reading procedure. +This procedure reads and parses the parameters entered with the +call to this program; it is expecting the following form of some +sort: + +\centerline{\tt tex8600 fn ft (1stpg \#ofpgs) realfn lrecl} + +@<Global Variables@>= +@^system dependencies@> +@!filetype : string(8); +@!firstpg : integer; + +@ +@p @^system dependencies@> +procedure readparms; +var + namepage : string(256); + temp : integer; + temp2 : integer; + temp3 : integer; + str1 : string(10); + lrecl : string(8); + +begin + namepage := ltrim(trim(parms)); + @<file name and real filename@> + @<file type not supplied@> + @<file type supplied@> + end; {readparms} + +@ + @<file name and real filename@>= + temp := index(namepage,' '); + temp2 := index(namepage,')'); + if temp2 > 0 + then @<parse real name and lrecl@> + else error(10,fatal,0); + filename := substr(namepage,1,temp-1); + +@ + @<parse real name and lrecl@>= + begin + temp3 := index(substr(namepage,temp2+2),' '); + if temp3 = 0 + then begin + real_filename := substr(namepage,temp2 + 2); + lrecl := ''; + end + else begin + real_filename := substr(namepage,temp2 + 2,temp3-1); + lrecl := substr(namepage,temp2+2+temp3); + end; + if lrecl = '' + then pv_dvi_lrecl := pc_dvi_lrecl + else readstr(lrecl,pv_dvi_lrecl); + end + +@ + @<file type not...@>= + namepage := substr(namepage,temp+1,(temp2-temp)); + temp := index(namepage,'('); + if temp = 1 + then begin + filetype := 'DVI'; + if length(namepage) > 1 + then begin + namepage := substr(namepage,temp+2); + temp := index(namepage,' '); + if temp > 0 + then begin + str1 := substr(namepage,1,temp-1); + firstpg := whole_value(str1); + str1 := substr(namepage,temp+1); + if length(str1) > 0 then + totalpg := whole_value(str1); + end {then..begin} + else begin + str1 := substr(namepage,1); + firstpg := whole_value(str1); + end {ELSE..begin} + end {then..begin} + end {then..begin} + +@ + @<file type supplied...@>= + else begin + filetype := substr(namepage,1,temp-2); + namepage := ltrim(substr(namepage,temp+1)); + temp := index(namepage,')'); + if temp > 1 + then begin + temp2 := index(namepage,' '); + str1 := substr(namepage,1,temp2-1); + if str1='*' + then firstpg := -99999 + else firstpg := whole_value(str1); + str1 := substr(namepage,temp2+1,(temp-temp2)-2); + if str1='*' + then totalpg := 99999 + else totalpg := whole_value(str1); + end; {then..begin} + end; {ELSE..begin} + +@* Print Position Procedures. +The next three procedures are called whenever there is to be a +vertical or horizontal move of any kind. + +@ +@<Global Type...@>= +@!movetype = (horiz,vert); + +@ This procedure will print the horizontal or vertical + distance that the 8600 is to move the paper. + +@p procedure figuredir(typ :movetype; + amt :integer); +var + temp :real; +begin + if dumpin and print_hmove then begin + writeln(dumpout); + write(dumpout,' *** move '); + end; + @<horizontal move@> + @<move right@> + @<move left@> + @<vertical move@> + @<move down@> + @<move up@> + if dumpin and print_hmove + then temp := getpts(abs(amt)); + end; {FigureDir} + +@ +@<horizontal move@>= + if typ = horiz + then if amt >= 0 + +@ +@<move right@>= + then begin + if dumpin and print_hmove then write(dumpout,'right '); + writecommand(11,stack[stacktop].H); + end + +@ +@<move left@>= + else begin + if dumpin and print_hmove then write(dumpout,'left '); + writecommand(11,stack[stacktop].H); + end + +@ + @<vertical move@>= + else if amt >= 0 + +@ + @<move down@>= + then begin + if dumpin then write(dumpout,'down '); + writecommand(9,amt); + end + +@ + @<move up@>= + else begin + if dumpin then write(dumpout,'up '); + writecommand(10,abs(amt)); + end; + +@ +@<Global Variables@>= +@!hmove_pending : boolean; +@!hmove_amt : integer; +@!vmove_pending : boolean; +@!vmove_amt : integer; +@!length_of_take : real; + +@ This procedure is invoked in the main program each + time something is actually to be set (such as a + character). If there is a vertical or horizontal + move pending, they will be set here, before continuing + on to the next set command (such as set character). + +@p procedure checkmoves; +var + tempbool :boolean; +begin + if hmove_pending then begin + figuredir(horiz,hmove_amt); + hmove_amt := 0; + hmove_pending := false; + print_hmove := true; + end; {then..begin} + if vmove_pending then begin + figuredir(vert,vmove_amt); + tempbool := dumpin; + dumpin := false; + if doingpages=true + then begin + galley_length := galley_length + getpts(vmove_amt); + length_of_take := length_of_take + getpts(vmove_amt); + end; + dumpin := tempbool; + vmove_amt := 0; + vmove_pending := false; + end; {then..begin} + end; {checkmoves} + +@ +@<Global Variables@>= +@!font8600 : 0..2550; +@!ptsize : 0..255; +@!different_setsize : boolean; +@!setsize : 0..255; + +@ This procedure sets the page environment to be that of ``font" + +@p procedure establish_font_parameters(font :integer); +begin + @<new font name@> + @<new font size@> + @<new set size@> +end; {|establish_font_parameters|} + +@ +@<new font name@>= + with a8600fontrec[fontenviron[font].fontindex] + do begin + if (fontno8600 <> font8600) and (fontno8600 <> 0) + then begin + writecommand(25,float(fontno8600)); + font8600 := fontno8600; + end; {then..begin} + end; {WITH..begin} + +@ +@<new font size@>= + if fontenviron[font].pointsize <> ptsize + then begin + ptsize := fontenviron[font].pointsize; + writecommand(7,float(ptsize)); + end; {then..begin} + +@ +@<new set size@>= + if different_setsize + then writecommand(8,float(setsize)); + + +@* ``Special'' Procedures. +The next few procedures enable the 8600 to do ``special'' things +like setting line footnotes, or slant type, or expanded type, etc. + +@ +@<Global Constants@>= +@! maxNote = 100;@/ + +@ This procedure establishes the line number reference in +|footnote_line_array| with the line number in which a line note was +called. + +@<Global Variables@>= +@!foot_area_ref : 0..255; +@!footnote_line_array : packed array[0..maxNote] of 0..255; +@!foot_line_ref : 0..255; +@!line_note_pending : boolean; +@!line_ref_pend_seq : 0..255; +@!counting_lines : boolean; +@!number_of_lines : integer; + +@ +@p procedure line_footnote_reference; +begin + if not counting_lines then begin + incr(foot_area_ref); + line_note_pending := true; + line_ref_pend_seq := 1; + end + else begin + incr(foot_line_ref); + footnote_line_array[foot_line_ref] := number_of_lines + 1; + end; + end; {|line_footnote_reference|} + +@ +@<Global Constants@>= +@! linefont = 256;@/ +@! linenumfont = 76;@/ + +@ +@<Global Variables@>= +@^system dependencies@> +@!special : string(40); +@!line_interval : 0..255; +@!margin_note : boolean; +@!numbering_lines : boolean; +@!printing_numbers : boolean; +@!pop_level : integer; + +@ This procedure reads and interprets all the \\special commands +entered in the \TeX\ file. Its primary purpose is for reading the +the instructions pertaining to linenotes. + +@p @^system dependencies@> +procedure readspecials; +var + int : integer; + inx : integer; + temp : string(40); + temp2 : string(40); + temp3 : string(40); + temp4 : string(40); + +begin + @<read special command@> + if temp = 'EVEN_PAGE_MARGIN' + then begin + temp := (substr(temp2, 1, length(temp2)-2)); + even_page_margin := decimal_value(temp); + end + else if temp = 'ODD_PAGE_MARGIN' + then begin + temp := (substr(temp2, 1, length(temp2)-2)); + odd_page_margin := decimal_value(temp); + end + else if temp = 'LINE_NUMBER_FONT' + @<linenumber font@> + else if temp = 'POP_LEVEL' + then pop_level := whole_value(temp2) + else if temp = 'LINE_INTERVAL' + then line_interval := whole_value(temp2) + else if temp = 'NUMBERING_LINES' + then begin + @<boolean value@> + then numbering_lines := true + else numbering_lines := false; + end {then..begin} + else if temp = 'COUNTING_LINES' + then begin + @<boolean value@> + then counting_lines := true + else counting_lines := false; + end {then..begin} + else if (temp = 'MARGINNOTE') + then margin_note := true + else if temp = 'PRINTING_NUMBERS' + then begin + @<boolean value@> + then printing_numbers := true + else printing_numbers := false; + end {then..begin} + else if temp = 'LINE_FOOTNOTE_REFERENCE' + then line_footnote_reference; + end; {then..begin} + end; {ReadSpecials} + +@ This gives default values for even and odd page margins that +will be reset if the user specified them in his file. It also reads +the special command. + +@<read special command@>= + int := index(special, '='); + if int > 0 + then begin + temp := trim(ltrim(substr(special, 1, int-1))); + temp2 := substr(special, int+1); + +@ If the special command is a Line Number Font, the command must +be further broken down to find the point size, as well as the name. + + @<linenumber font@>= + then begin + int := index(temp2, ' '); + if int > 0 + then begin + @<point size given@> + end + else begin + @<no point size given@> + end; + fontname := allcaps(temp3); + readfontinfo(linefont,linenumfont); + end + +@ A point size is given and that size must be sent along with the +name to the |readfontinfo| procedure. + +@<point size given...@>= + temp3 := trim(ltrim(substr(temp2, 1, int-1))); + temp4 := substr(temp2, int+1); + with fontenviron[linefont] do begin + inx := whole_value(temp4); + pointsize := inx; + designsize := inx; + end; + +@ No point size is given, so the default point size will be used +(ten-point). + +@<no point size...@>= + temp3 := trim(ltrim(substr(temp2, 1, int-1))); + inx := 10; + with fontenviron[linefont] do begin + pointsize := inx; + designsize := inx; + end; + +@ The boolean value module is used when the response to the +special command is true or false. + +@<boolean value@>= + temp2 := allcaps(ltrim(trim(temp2))); + if temp2 = 'TRUE' + +@ This procedure is used in conjunction with the 0 font and + handles the special functions codes like slant, + reverse type, set size, etc. + +@p procedure call_specials_routine(funcname :integer); +var + inx :integer; + num :integer; +begin + if dumpin then writeln(dumpout,'Function [',funcname:3,'] '); + if funcname = 10 + then counting_lines := true + else if funcname = 11 + then counting_lines := false + else if funcname = 12 + then printing_numbers := true + else if funcname = 13 + then printing_numbers := false + else if funcname = 14 + then line_footnote_reference; + if (funcname=14) or (funcname=13) or (funcname=12) or + (funcname=11) or (funcname=10) then return; + with stack[stacktop], + a8600fontrec[fontenviron[currfont].fontindex], + fontenviron[currfont] do begin + with a8600chars[funcname] do begin + for inx := 0 to num + do with comarray[inx] + do writecommand(comcode,float(argument)); + end; {DO..begin} + end; {DO..begin} + end; {|call_specials_routine|} + +@* Set the characters procedures. +The first procedure is called from the second one if a line +number is to be printed. +The second procedure actually sets an individual character. +First it checks +to make sure the character is a real one and not from the zero or +specials' font, then +it checks to see if a move needs to be made before the character is +printed. It makes the move and then +checks to see if a line number is to be printed; if it does, it prints +the line number, if it doesn't it sets the character. + +@<Global Variables@>= +@!points : real; +@!we_add_the_character_width : boolean; + +@ When \TeX\ formats the footnotes entered with a linenote reference +command, it simply inserts two zeros for the linenumber. This procedure +replaces those two zeros with the line number in which the linenote +reference was called. + +@p procedure setline_footnote_ref(font :integer); +var + temp :integer; + inx :integer; + tempreal :real; + return_ps :boolean; + return_ss :boolean; +begin +@<determine correct line number@> +@<print line number@> +@<reset line number values@> +end; {|setline_footnote_ref|} + +@ +@<determine correct line number@>= + if line_ref_pend_seq = 1 + then temp := footnote_line_array[foot_area_ref] div 10 + else temp := footnote_line_array[foot_area_ref] mod 10; + with fontenviron[font], stack[stacktop] do + H := H + round(pointsize * + a8600fontrec[fontindex].a8600chars[48].charwidth + * SPsPerPt); + if (line_ref_pend_seq = 1) and (temp = 0) then begin + hmove_pending := true; + line_ref_pend_seq := 2; + return; + end; + +@ +@<print line number@>= + with stack[stacktop], a8600fontrec[fontenviron[font].fontindex], + fontenviron[font] do begin + with a8600chars[48 + temp] do begin + @<set character commands@> + end; {WITH..begin} + end; {WITH..begin} + +@ +@<reset line number values@>= + if line_ref_pend_seq = 1 then begin + line_ref_pend_seq := 2; + return; end + else begin + line_ref_pend_seq := 0; + line_note_pending := false; + return; end; + if line_note_pending + then begin + line_note_pending := false; + return; + end; + +@ The |setcharacter| procedure is the main procedure for setting +any and all characters, except the |line_footnote| references. + +@p procedure setcharacter(character :integer; + font :integer); +var + inx :integer; + tempreal :real; + temppt :integer; + tempbool :boolean; + return_ps :boolean; + return_ss :boolean; +begin + @<specials font or dumpin@> + checkmoves; + @<linenote-footnote@> + @<debug info@> + @<begin character@> + end; {setcharacter} + +@ +@<specials font or dumpin@>= +if font8600 = 0 then begin + call_specials_routine(character); + return; + end; {then..begin} +if dumpin and (hmove_pending or vmove_pending) + then tempbool := true + else tempbool := false; + +@ +@<linenote-footnote@>= + if line_note_pending and (character = 48) + then begin + setline_footnote_ref(font); + return; + end; + +@ +@<debug info@>= + if dumpin and tempbool then writeln(dumpout); + if dumpin + then if (character >= 32) and (character < 127) + then write(dumpout,chrx[character]) + else write(dumpout,'?<',character:3,'>'); + +@ +@<begin character@>= + return_ps := false; + return_ss := false; + with stack[stacktop], a8600fontrec[fontenviron[font].fontindex], + fontenviron[font] do begin + with a8600chars[character] do begin + if different_setsize + then temppt := trunc(float(setsize) / + 100.0 * pointsize) + else temppt := pointsize; + if we_add_the_character_width + then H := H + round(temppt * charwidth * SPsPerPt); + @<set character commands@> + end; {WITH..begin} + end; {WITH..begin} + +@ +@<set character commands@>= +for inx := 0 to num do + with comarray[inx] do + if (comcode = 25) and (argument = -1) + then writecommand(25,fontno8600) + {Some commands need to be scaled by + the set size factor} + else if (comcode=9) or (comcode=10) or + (comcode = 27) or (comcode = 28) + then begin + points := float(pointsize) * + SPsPerPt * real_argument; + writecommand(comcode,points); + end {then..begin} + else if (comcode = 12) or (comcode = 13) + then begin + points :=float(pointsize) * real_argument; + writecommand(comcode,points); + end {then..begin} + else if comcode = 14 + then begin + tempreal := SPsPerPt * (getpts(H) + + (real_argument * pointsize)); + if we_add_the_character_width + then tempreal := tempreal - + round(pointsize*charwidth*SPsPerPt); + writecommand(14,tempreal); + end + else if comcode = 7 + then begin + writecommand(7,pointsize+float(argument)); + return_ps := true; + end + else if comcode = 8 + then begin + writecommand(8,designsize+float(argument)); + return_ss := true; + end + else writecommand(comcode,float(argument)); + if return_ss then writecommand(8,designsize); + if return_ps then writecommand(7,pointsize); + +@ +@<Global Variables@>= +@!size : integer; + +@ This next procedure sets the line number if that option is used. +It will print the line number according to +|odd_page_margin| or |even_page_margin|. The number will + be set in the |line_number_font|. The line numbers + will print every five lines by default or according to +|line_interval|, and begin at 1 on each page. + +@p procedure print_line_number; +var + j :integer; +begin + incr(number_of_lines); + if not printing_numbers then return; + if (number_of_lines <> ((number_of_lines div + line_interval) * line_interval)) + then return; {If this is not a line number divisible by + |line_interval|} + size := headernum div 2; + size := size * 2; + if even_page_margin = 0 then + even_page_margin := 50.8; + if odd_page_margin = 0 then + odd_page_margin := 407.7; + if size = headernum + then writecommand(11,even_page_margin*SPsPerPt) {H position} + else writecommand(11,odd_page_margin*SPsPerPt); {H position} + establish_font_parameters(linefont); + size := number_of_lines; + if dumpin then begin + writeln; + write(dumpout,'*** set line number '); + end; + we_add_the_character_width := false; + if size >= 10 + then begin + j := size div 10; + setcharacter(j+48,linefont); {set 1st digit} + size := size -(j * 10); + end + else with +a8600fontrec[fontenviron[linefont].fontindex].a8600chars[48] + do {set nothing, but move the width of a "0"} + writecommand(27, fontenviron[linefont].pointsize * + charwidth * SPsPerPt); + setcharacter(size+48,linefont); {+48 for ASCII code} + we_add_the_character_width := true; + if dumpin then writeln(dumpout); + establish_font_parameters(currfont); {return to active font} + end; {|print_line_number|} + +@* Initialization procedures. +These next few procedures, get the whole thing started by assigning +values to all necessary items. + +@<Global Constants@>= +@! version = 2;@/ +@! level = 7;@/ + +@ +@<Global Variables@>= +@!takenum : integer; +@!currpage : integer; +@!prevpage : integer; + +@ +@p @^system dependencies@> +procedure initialize8600; +begin + @<page-setting values@> + @<setting output/input values@> + @<line-numbering font values@>@/ + @<page and font values@> + @<line numbering values@> + @<miscellaneous values@> + end; {initialize8600} + +@ + @<page-setting values@>= + firstpg := -99999; + totalpg := 99999; + doingpages := false; + +@ + @<setting output/input values@>= + termout(output); + readparms; + reset(input,'NAME=' ccat filename ccat '.' ccat filetype ccat '.*'); + writeln('******* tex8600 Version ',version:2,' Level ', + level:3,' *******'); + rewrite(setfile,'LRECL=1029,RECFM=F,NAME=' ccat filename ccat +'.TAPEFILE.*'); + +@ + @<line-numbering font values@>= + with fontenviron[-1] do begin + pointsize := 10; + designsize := 1; + fontindex := 0; + end; {WITH..begin} + +@ +@<page and font values@>= + currfont := -1; + currpage := 0; + prevpage := -99999; + ptsize := 0; + setsize := 100; + +@ +@<line numbering values@>= + counting_lines := false; + margin_note := false; + numbering_lines := false; + printing_numbers := false; + line_note_pending := false; + line_ref_pend_seq := 0; + even_page_margin := 0.0; + odd_page_margin := 0.0; + line_interval := 5; + pop_level := 3; + bufferlen := 0; + +@ +@<miscellaneous values@>= + takenum := -1; + num_of_pages := 0; + length_of_take := 0; + dumpin := false; + +@ This procedure initializes values that pertain to the overall run. + +@<Global Variables@>= +@!last_command : 0..255; +@!outputpending : boolean; +@!page_counter : integer; +@!second_to_last_cmnd : 0..255; + +@ +@p procedure init_run; +begin + initialize8600; + @<debugging statements@> + count := 0; + fileend := false; + galley_length := 0; + hmove_amt := 0; + hmove_pending := false; + last_command := 0; + outputpending := false; + page_counter := 0; + postam_found := false; + put_width := 0.0; + print_hmove := true; + second_to_last_cmnd := 0; + stacktop := 1; {initialize stack} + vmove_amt := 0; + vmove_pending := false; + we_add_the_character_width := true; + @<initialize job's main record--stack@> + end; {|init_run|} + +@ + @<debugging statements@>= + if dumpin then begin + writeln(dumpout); + writeln(dumpout); + writeln(dumpout,'********************************************'); + writeln(dumpout,'byte:code meaning'); + writeln(dumpout); + end; + +@ +@<initialize job's main record--stack@>= + with stack[stacktop] do begin + H := 0; + V := 0; + W := 0; + X := 0; + Y := 0; + Z := 0; + end; {WITH loop} + +@* Rule-setting Procedures. +The |setrule| procedure is called when the horizontal position +is to be advanced. |putrule| is called when the horizontal position +is not to be advanced. + +@ This procedure sets a rule. + +@<Global Variables@>= +@!ruleht : integer; +@!rulewidth : integer; +@!height : real; +@!fudge : real; + +@ +@p procedure drawrule; +begin + checkmoves; + points := getpts(ruleht); + height := points * SPsPerPt; + if points <> 0 then begin + writecommand(13,points); + points := getpts(rulewidth); + writecommand(12,points); + if points <> 0 then begin + writecommand(10,height); {Move back the rule height} + writecommand(14,stack[stacktop].H); {set it} + writecommand(9,height); {move down after setting} + writecommand(11,stack[stacktop].H); {set it} + end; {then...begin} + end;{then..begin} +end; + +@ Rule and increase the value of H (horizontal position). + +@p procedure setrule; +begin + drawrule; + hmove_amt := rulewidth; + hmove_pending := true; + stack[stacktop].H := stack[stacktop].H + rulewidth; +end; {setrule} + +@ Rule and do not increase the value of H (horizontal position). + +@p procedure putrule; +begin + drawrule; +end; {putrule} + +@* Page procedures. +The |doendofpage| procedure is called at the end of each page and the +|dobeginningofpage| procedure at the beginning of each page. + +@ This procedure is entirely for the user's information. It prints +out to the terminal the number of pages set in the job. If there are +are more than 8 page numbers a carriage return is thrown. + +@p procedure doendofpage; +begin + incr(page_counter); + if page_counter >= 8 then begin + writeln; + page_counter := 0; + end; + if doingpages=true + then begin + decr(totalpg); + if totalpg = 0 + then begin + writeln('<',currpage:1,'> '); + return; + end {then..begin} + else write('<',currpage:1,'> '); + end; + end; + +@ This procedure does all of the 8600 initialization + for the start of each new page. + +@<Global Constants@>= +@! indent=' ';@/ +@! nullstring = '00000000000000000000'xc;@/ + +@ +@<Global Variables@>= +@!int : integer; +@!newtake : boolean; + +@ +@p procedure dobeginningofpage; +var +inx :integer; +begin + @<general initializations@> + @<read first page number@> + @<determine if current page is to be set@> + @<read counters@> + if doingpages=true + then begin + if (currpage = firstpg) or (int = -1) + or (length_of_take >= 5184) + then begin + @<first page or 6 feet in film canister@> + end {then..begin} + else begin + @<any other page@> + end; {ELSE..begin} + with fontenviron[currfont] do begin + if int = -1 then begin + @<first page font environment@> + end + else begin + @<all other pages font environment@> + @<print end of page rule@> + end; {ELSE..begin} + end;{WITH..begin} + incr(num_of_pages); + end; {then..begin} +end; {DoBeginningOfPage} + +@ +@<general initializations@>= + foot_line_ref := 0; + foot_area_ref := 0; + number_of_lines := 0; + newtake := false; + with stack[stacktop] do begin + H := 4718592; + V := 0; {start 1" over and 1" down} +vmove_amt := 4718592; +vmove_pending := true; +hmove_pending := true; + end; {WITH ... do begin} + +@ +@<read first page number@>= + int := readinteger(4); + if dumpin then writeln(dumpout,'BOP -- Beginning Of Page ',int); + headernum := int; + prevpage := currpage; + currpage := int; + +@ +@<determine if current...@>= +if (firstpg = -99999) + then + doingpages := true; +if not doingpages +then + if ((firstpg >= 0) and (firstpg <= currpage)) + or ((firstpg < 0) and (firstpg >= currpage)) + then + doingpages := true; +if (totalpg < 1) + then + doingpages := false; + +@ +@<read counters@>= + for inx := 1 to 9 do begin + int := readinteger(4); + if dumpin then writeln(dumpout,'Counter ',inx:1,' = ',int); + end; {FOR ... do begin} + int := readinteger(4); + if dumpin + then writeln(dumpout,indent,'previous page pointer = ',int); + +@ +@<first page or 6 feet in film canister@>= + incr(takenum); + length_of_take := 0; + if (int = -1) or (currpage = firstpg) {On first page} + then writeheader + else begin + inx := headernum; + headernum := 88888; + repeat {pad end of record with hex FF} + write8600rec(allzeros); + until bufferlen <= 5; + headernum := inx; + writecommand(1,0.0); {End of Take} + repeat {pad record with '00'xc} + write8600rec(allzeros); + until bufferlen <= 5; + end; + write8600rec(nullstring); {10 hex zeros} + writecommand(0,takenum); {Start of Take} + newtake := true; + +@ +@<any other page@>= + repeat {pad end of record with hex FF} + write8600rec(allzeros); + until bufferlen <= 5; + +@ +@<first page font environment@>= + different_setsize := false; + in_slant_mode := false; + in_reverse_type := false; + +@ +@<all other pages font environment@>= + writecommand(25,font8600); + writecommand(7,pointsize); + if different_setsize + then writecommand(8,float(setsize)); + if in_slant_mode + then writecommand(15,48); + if in_reverse_type + then writecommand(3,1); + +@ +@<print end of page rule@>= + writecommand(11,0); {Move to left col.} + writecommand(9,12.0*SPsPerPt); {VMF 12 pts} + writecommand(12,30.0); {set width of rule} + writecommand(13,1.5); {set depth of rule} + writecommand(14,0); {page separator} + writecommand(11,0); {quad left} + writecommand(9,12.0*SPsPerPt); {VMF 12 pts} + galley_length := galley_length + 24; + +@* MAIN PROGRAM. + +@<Global Variables@>= +@!tempstack : stackrec; +@!inx : integer; +@!temp : integer; +@!temp2 : integer; +@!put_width : real; +@!realtemp : real; + +@ +@p begin {MAIN} + {=== Initialize ===} + init_run; + while not postam_found do begin + savecount := count; {don't change it in readinteger} + byte := readinteger(1); {1-byte code} + if printing_numbers + then if ((byte > 128) and (byte < 218)) then begin + second_to_last_cmnd := last_command; + last_command := byte; + end; {then..begin} + if byte < 128 then begin {This is a character} + outputpending := true; + setcharacter(byte,currfont); + end {then..begin} + else if (byte>=250) and (byte<=255) + then error(6,fatal,byte) + else case byte of + 128: @<set horizontal character1@>@/ + 129: @<set horizontal character2@>@/ + 130: @<set horizontal character3@>@/ + 131: @<set horizontal character4@>@/ + 132: @<set a rule@>@/ + 133: @<put horizontal character1@>@/ + 134: @<put horizontal character2@>@/ + 135: @<put horizontal character3@>@/ + 136: @<put horizontal character4@>@/ + 137: @<put a rule@>@/ + 138: do_nothing; {NOP} + 139: dobeginningofpage;{BOP} + 140: doendofpage; {EOP} + 141: @<push@>@/ + 142: @<pop@>@/ + 143: @<right1 move@>@/ + 144: @<right2 move@>@/ + 145: @<right3 move@>@/ + 146: @<right4 move@>@/ + 147: @<``W'' horizontal move@>@/ + 148..151: @<``W''1-4 horizontal move@>@/ + 152: @<``X'' horizontal move@>@/ + 153..156: @<``X''1-4 horizontal move@>@/ + 157..160: @<down1@>@/ + 161: @<``Y'' vertical move@>@/ + 162..165:@<``Y''1-4 vertical move@>@/ + 166: @<``Z'' vertical move@>@/ + 167..170: @<``Z''1-4 vertical move@>@/ + 171..234: @<set font@>@/ + 235: @<font1 set@>@/ + 236: @<font2 set@>@/ + 237: @<font3 set@>@/ + 238: @<font4 set@>@/ + 239: @<nop1@>@/ + 240: @<nop2@>@/ + 241: @<nop3@>@/ + 242: @<nop4@>@/ + 243: @<font1 def $0<k<64$@>@/ + 244: @<font2 def $0<k<65536$@>@/ + 245: @<font3 def $0<k<2^{24}$@>@/ + 246: @<font4 def $-2^{31}<k<2{30}$@>@/ + 247: @<preamble@>@/ + 248: readpostamble; {Post-amble}@/ + 249: do_nothing; {Post-post-amble} + otherwise writeln('oops...forgot about ',byte:12); + end;{CASE} + end;{while} +end. + +@ +@<set horizontal character1@>= + begin + int := readinteger(1); + we_add_the_character_width := true; + hmove_pending := true; + setcharacter(int,currfont); + end; + +@ +@<set horizontal character2@>= +begin + int := readinteger(2); + we_add_the_character_width := true; + hmove_pending := true; + setcharacter(int,currfont); + end; + +@ + @<set horizontal character3@>= + begin + int := readinteger(3); + we_add_the_character_width := true; + hmove_pending := true; + setcharacter(int,currfont); + end; + +@ +@<set horizontal character4@>= +begin + int := readinteger(4); + we_add_the_character_width := true; + hmove_pending := true; + setcharacter(int,currfont); + end; + +@ +@<set a rule@>= +begin + ruleht := readinteger(4); + rulewidth := readinteger(4); + setrule; + end; + +@ +@<put horizontal character1@>= +begin + int := readinteger(1); + we_add_the_character_width := false; + hmove_pending := true; + setcharacter(int,currfont); + we_add_the_character_width := true; + end; + +@ +@<put horizontal character2@>= +begin + int := readinteger(2); + we_add_the_character_width := false; + hmove_pending := true; + setcharacter(int,currfont); + we_add_the_character_width := true; + end; + +@ +@<put horizontal character3@>= +begin + int := readinteger(3); + we_add_the_character_width := false; + hmove_pending := true; + setcharacter(int,currfont); + we_add_the_character_width := true; + end; + +@ +@<put horizontal character4@>= +begin {Put Horizontal Character} + int := readinteger(4); + we_add_the_character_width := false; + hmove_pending := true; + setcharacter(int,currfont); + we_add_the_character_width := true; + end; + +@ +@<put a rule@>= +begin + ruleht := readinteger(4); + rulewidth := readinteger(4); + realtemp := rulewidth / SPsPerPt / 72.27; + putrule; + end; + +@ +@<push@>= +begin + tempstack := stack[stacktop]; + stacktop := stacktop + 1; + stack[stacktop] := tempstack; + with stack[stacktop] do begin + end; {WITH..begin} + end; + +@ +@<pop@>= +begin + tempstack := stack[stacktop]; + inx := stacktop; + stacktop := stacktop - 1; + with stack[stacktop] do begin + hmove_pending := false; + hmove_amt := 0; + print_hmove := true; + vmove_amt := vmove_amt + V - tempstack.V; + vmove_pending := true; + if margin_note and counting_lines + then margin_note := false + else if numbering_lines and counting_lines + and (inx = pop_level) + then print_line_number; + writecommand(11,H); {HPOS to left margin} + end; {WITH .. do begin} +with tempstack do begin +if put_width = 12.0 then + else if H / SPsPerPt > 554 then + put_width := 12.0; + end; + end; {POP} + +@ +@<right1 move@>= +begin + int := readinteger(1); + with stack[stacktop] do begin + hmove_amt := hmove_amt + int; + hmove_pending := true; + h := h + int; + end; {DO..begin} + end; + +@ +@<right2 move@>= +begin + int := readinteger(2); + with stack[stacktop] do begin + hmove_amt := hmove_amt + int; + hmove_pending := true; + h := h + int; + end; {DO..begin} + end; + +@ +@<right3 move@>= +begin + int := readinteger(3); + with stack[stacktop] do begin + hmove_amt := hmove_amt + int; + hmove_pending := true; + h := h + int; + end; {DO..begin} + end; + +@ +@<right4 move@>= +begin + int := readinteger(4); + with stack[stacktop] do begin + hmove_amt := hmove_amt + int; + hmove_pending := true; + h := h + int; + end; {DO..begin} + end; + +@ +@<``W'' horizontal move@>= +begin + with stack[stacktop] do begin + hmove_amt := hmove_amt + W; + hmove_pending := true; + H := H + W; + end; {WITH..begin} + end; {"W" amount change} + +@ +@<``W''1-4 horizontal move@>= + begin + size := 4 + (byte - 151); + int := readinteger(size); + points := getpts(int); + hmove_amt := hmove_amt + int; + hmove_pending := true; + with stack[stacktop] do begin + W := int; {int is in scalepts} + H := H + W; + end; {WITH..begin} + end; {"W" change} + +@ +@<``X'' horizontal move@>= +begin + with stack[stacktop] do begin + hmove_amt := hmove_amt + X; + hmove_pending := true; + H := H + X; + end; {WITH..begin} + end; {"X" amount move} + +@ +@<``X''1-4 horizontal move@>= + begin + size := 4 + (byte - 156); + int := readinteger(size); + points := getpts(int); + hmove_amt := hmove_amt + int; + hmove_pending := true; + with stack[stacktop] do begin + X := int; ; {saveamt.} + H := H + X; {record the move} + end; {WITH..begin} + end; {"X" amount change} + +@ +@<down1@>= +begin + size := 4 + (byte - 160); + int := readinteger(size); + points := getpts(int); + with stack[stacktop] do begin + vmove_amt := vmove_amt + int; + vmove_pending := true; + V := V + int; + end; {WITH..begin} + end; {"Down" amount move} + +@ +@<``Y'' vertical move@>= +begin + with stack[stacktop] do begin + vmove_amt := vmove_amt + Y; + vmove_pending := true; + V := V + Y; + end; {WITH..begin} + end; {"Y" amount move} + +@ +@<``Y''1-4 vertical move@>= + begin + size := 4 + (byte - 165); + int := readinteger(size); + points := getpts(int); + vmove_amt := vmove_amt + int; + vmove_pending := true; + with stack[stacktop] do begin + Y := int; {save amt.} + V := V + Y; + end; {WITH..DO begin} + end; {"Y" amount move} + +@ +@<``Z'' vertical move@>= +begin + with stack[stacktop] do begin + vmove_amt := vmove_amt + Z; + vmove_pending := true; + V := V + Z; + end; {WITH..begin} + end; {"Z" amount move} + +@ +@<``Z''1-4 vertical move@>= + begin + size := 4 + (byte - 170); + int := readinteger(size); + points := getpts(int); + vmove_amt := vmove_amt + int; + vmove_pending := true; + with stack[stacktop] do begin + Z := int; {save amt.} + V := V + Z; + end; {WITH..begin} + end; {"Z" amount move} + +@ +@<set font@>= + begin + currfont := byte - 171; + establish_font_parameters(currfont); + end; + +@ +@<font1 set@>= +begin + currfont := readinteger(1); + establish_font_parameters(currfont); + end; + +@ +@<font2 set@>= +begin + currfont := readinteger(2); + establish_font_parameters(currfont); + end; + +@ +@<font3 set@>= +begin + currfont := readinteger(3); +{ |establish_font_parameters(currfont);|} + end; + +@ +@<font4 set@>= +begin + currfont := readinteger(4); + { |establish_font_parameters(currfont);|} + end; + +@ +@<nop1@>= +begin + int := readinteger(1); + special := ''; + for inx := 1 to int do begin + temp := readinteger(1); + special := special ccat allcaps(str(chrx[temp])); + end; {DO..begin} + readspecials; + end; + +@ +@<nop2@>= +begin + int := readinteger(2); + special := ''; + for inx := 1 to int do begin + temp := readinteger(1); + special := special ccat allcaps(str(chrx[temp])); + end; {DO..begin} + readspecials; + end; + +@ +@<nop3@>= +begin + int := readinteger(3); + special := ''; + for inx := 1 to int do begin + temp := readinteger(1); + special := special ccat allcaps(str(chrx[temp])); + end; {DO..begin} + readspecials; + end; + +@ +@<nop4@>= +begin + int := readinteger(4); + special := ''; + for inx := 1 to int do begin + temp := readinteger(1); + special := special ccat allcaps(str(chrx[temp])); + end; {DO..begin} + readspecials; + end; + +@ +@<font1 def...@>= +begin + currfont := readinteger(1); + fontinfo; + end; + +@ +@<font2 def...@>= +begin + currfont := readinteger(2); + fontinfo; + end; + +@ +@<font3 def...@>= +begin + currfont := readinteger(3); + fontinfo; +end; + +@ +@<font4 def...@>= +begin + currfont := readinteger(4); + fontinfo; + end; + +@ +@<preamble@>= +begin + int := readinteger(1); + int := readinteger(4); + temp := readinteger(4); + temp2 := readinteger(4); + temp := readinteger(1); + for int := 1 to temp do + inx := readinteger(1); + end; + +@* INDEX. |