summaryrefslogtreecommitdiff
path: root/macros/text1/compugraphics_8600
diff options
context:
space:
mode:
Diffstat (limited to 'macros/text1/compugraphics_8600')
-rw-r--r--macros/text1/compugraphics_8600/et10.textext37
-rw-r--r--macros/text1/compugraphics_8600/et11.textext37
-rw-r--r--macros/text1/compugraphics_8600/et12.textext37
-rw-r--r--macros/text1/compugraphics_8600/et14.textext37
-rw-r--r--macros/text1/compugraphics_8600/et18.textext37
-rw-r--r--macros/text1/compugraphics_8600/et8.textext37
-rw-r--r--macros/text1/compugraphics_8600/et9.textext37
-rw-r--r--macros/text1/compugraphics_8600/etb.fontinfo236
-rw-r--r--macros/text1/compugraphics_8600/etbi.fontinfo233
-rw-r--r--macros/text1/compugraphics_8600/eti.fontinfo233
-rw-r--r--macros/text1/compugraphics_8600/etr.fontinfo236
-rw-r--r--macros/text1/compugraphics_8600/etsc.fontinfo253
-rw-r--r--macros/text1/compugraphics_8600/fonttex.cmschan5
-rw-r--r--macros/text1/compugraphics_8600/fonttex.exec23
-rw-r--r--macros/text1/compugraphics_8600/fonttex.outchan324
-rw-r--r--macros/text1/compugraphics_8600/fonttex.web1936
-rw-r--r--macros/text1/compugraphics_8600/reblock.pascal34
-rw-r--r--macros/text1/compugraphics_8600/tex8600.cmschan1
-rw-r--r--macros/text1/compugraphics_8600/tex8600.outchan580
-rw-r--r--macros/text1/compugraphics_8600/tex8600.web3034
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.