-- HardcopyInstaller.mesa
-- Edited by Brotz, March 7, 1983 1:29 PM
-- Edited by Schroeder, October 27, 1980 10:38 AM
-- Edited by Levin, January 16, 1981 10:59 AM

DIRECTORY
Ascii USING [CR, SP, TAB],
csD: FROM "CoreStreamDefs" USING [Destroy, EndOfStream, OpenFromName, Read,
ReadBlock, SetPosition, StreamHandle],
exD: FROM "ExceptionDefs" USING [SysBug],
InlineDefs USING [LongDiv, LongMult],
intCommon USING [fontDirectorySegment, hardcopyFormTable,
hardcopyWidthTableSegment],
LaurelHardcopyDefs USING [boldFontFace, CharWidthArray, Column, ColumnNIL,
ColumnRec, FieldTable, FieldTableNIL, FontDirectory, FontDirectoryEntry,
FontDirectoryRec, FontCode, FontFace, FontName, FontNumber, HardcopyForm,
HardcopyFormRec, HardcopyFormTable, HardcopyFormTableElement,
HardcopyRelativeString, HardcopyRelativeStringNIL, Ix, Ixn, magicNonPrintingWidth,
maxNFonts, Mica, normalFontFace, Option, OptionNIL, OptionRec, Row, RowNIL,
RowRec, Stdix, WidthSegment, WidthTable, WidthTableArray],
lsD: FROM "LaurelStateDefs" USING [AllocateStateNode, AllocateStateString,
DefineStateSegment, ReleaseStateSegment, StateSegment, SwapInStateSegment,
WriteStateSegment],
MailParseDefs USING [GetFieldBody, ParseError, ParseHandle],
MiscDefs USING [Zero],
SegmentDefs USING [DataSegmentAddress, DataSegmentHandle, DefaultBase,
DeleteDataSegment, NewDataSegment],
Storage USING [Free, FreeString, Node, PagesForWords, Prune, String],
String USING [AppendString, EquivalentString, InvalidNumber, StringToDecimal,
UpperCase, WordsForString],
VMDefs USING [CantOpen];

HardcopyInstaller: PROGRAM
IMPORTS csD, exD, InlineDefs, intC: intCommon, lsD, MailParseDefs, MiscDefs,
SegmentDefs, Storage, String, VMDefs
EXPORTS LaurelHardcopyDefs =

BEGIN
OPEN LaurelHardcopyDefs;


fontTable: WidthTable;
fontDirectory: FontDirectory;


FontError: PUBLIC ERROR [code: FontCode] = CODE;



InitHardcopyFonts: PUBLIC PROCEDURE =
-- Initializes the font directory for hardcopy. This must be called first of all hardcopy
-- installation procedures.
BEGIN
intC.hardcopyWidthTableSegment
← lsD.DefineStateSegment[Storage.PagesForWords[SIZE[WidthTableArray]]];
fontTable ← lsD.SwapInStateSegment[intC.hardcopyWidthTableSegment];
MiscDefs.Zero[p: fontTable, l: SIZE[WidthTableArray]];
intC.fontDirectorySegment
← lsD.DefineStateSegment[Storage.PagesForWords[SIZE[FontDirectoryRec]]];
fontDirectory ← lsD.SwapInStateSegment[intC.fontDirectorySegment];
MiscDefs.Zero[p: fontDirectory, l: SIZE[FontDirectoryRec]];
END; -- of InitHardcopyFonts --


InstallHardcopy: PUBLIC PROCEDURE =
-- Must be called after Profile is read. Insures that appropriate fonts and forms are loaded,
-- supplying default fonts and forms if necessary. Writes out hardcopy font width tables,
-- font directory and forms to Laurel.state. This procedure must be called last of all
-- hardcopy installation procedures. May raise FontError.
BEGIN
i: FontNumber;
fontCode: FontCode ← ok;
FOR i IN [0 .. maxNFonts) DO
IF fontDirectory.entry[i].entryLength = 0 THEN
IncludeHardcopyFont
[fontNumber: i,
name: IF i = 3 THEN "Logo"L ELSE "TimesRoman"L,
points: SELECT i FROM 1 => 8, 2 => 12, 3 => 24, ENDCASE => 10,
face: IF i = 2 THEN boldFontFace ELSE normalFontFace
! FontError => {fontCode ← code; EXIT}];
ENDLOOP;
lsD.WriteStateSegment[intC.fontDirectorySegment];
lsD.ReleaseStateSegment[intC.fontDirectorySegment];
lsD.WriteStateSegment[intC.hardcopyWidthTableSegment];
lsD.ReleaseStateSegment[intC.hardcopyWidthTableSegment];
IncludeDefaultForms[];
MakeHardcopyFormTable[];
[] ← Storage.Prune[];
IF fontCode # ok THEN ERROR FontError[fontCode];
END; -- of InstallHardcopy --


IncludeHardcopyFont: PUBLIC PROCEDURE
[fontNumber: FontNumber, name: STRING, points: CARDINAL, face: FontFace] =
-- Reads name-points-face and makes it font number fontNumber. May be called an
-- arbitrary number of times between InitHardcopyFonts and InstallHardcopy.
BEGIN
wsh: csD.StreamHandle;
fontName: FontName;
IF fontNumber ~IN FontNumber THEN ERROR FontError[profileBadFont];
wsh ← csD.OpenFromName["Fonts.Widths"L, word, read
! VMDefs.CantOpen => GO TO BadFontsWidths];
MakeFontName[name, @fontName];
ReadFontWidths[@fontTable[fontNumber], @fontName, points, face, wsh
! csD.EndOfStream => {csD.Destroy[wsh]; GO TO BadFontsWidths};
FontError => csD.Destroy[wsh]];
IncludeInFontDirectory[fontNumber, name, points, face];
csD.Destroy[wsh];
EXITS
BadFontsWidths => ERROR FontError[badFontsWidths];
END; -- of IncludeHardcopyFont --


MakeFontName: PROCEDURE [name: STRING, fontName: POINTER TO FontName] =
BEGIN
i, length: CARDINAL;
-- copy over the family name into Fonts.Widths format
length ← MIN[name.length, 19];
FOR i IN [0 .. length) DO
fontName[i + 1] ← String.UpperCase[name[i]];
ENDLOOP;
FOR i IN (length .. 20) DO
fontName[i] ← 0C;
ENDLOOP;
fontName[0] ← LOOPHOLE[length];
END; -- of MakeFontName --


IncludeInFontDirectory: PROCEDURE
[fontNumber: FontNumber, name: STRING, points: CARDINAL, face: FontFace] =
BEGIN
fontName: FontName;
MakeFontName[name, @fontName];
fontDirectory.entry[fontNumber] ← FontDirectoryEntry
[entryLength: SIZE[FontDirectoryEntry],
fontSet: 0,
fontNumber: fontNumber,
m: 0,
n: 127,
familyName: fontName,
face: face,
source: 0,
size: points,
rotation: 0];
END; -- of IncludeInFontDirectory --


ParseFont: PUBLIC PROCEDURE [line: STRING] =
-- Reads a font name from line and calls IncludeHardcopyFont with the parsed font.
BEGIN
-- Parses an entry in Laurel.Profile of the form
-- <number> <fontFamily> <blank> <number> [<blank> (B ! I)].
faceString: STRING ← [3];
name: STRING ← [19];
fontNumber: FontNumber;
face: FontFace ← 0;
i, index, points: CARDINAL;
[fontNumber, index] ← GetNextNumber[line, 0];
index ← GetNextString[line, index, name];
IF name.length = 0 THEN ERROR MailParseDefs.ParseError[badFieldBody];
[points, index] ← GetNextNumber[line, index];
[] ← GetNextToken[line, index, faceString];
FOR i IN [0 .. faceString.length) DO
face ← face + (SELECT faceString[i] FROM
’B, ’b => 2,
’I, ’i => 1,
’C, ’c => 6,
’E, ’e => 12,
ENDCASE => 0);
ENDLOOP;
IncludeHardcopyFont[fontNumber, name, points, face];
END; -- of ParseFont --


ReadFontWidths: PROCEDURE [table: POINTER TO CharWidthArray,
fontName: POINTER TO FontName, points: CARDINAL, face: FontFace,
fwStream: csD.StreamHandle] =
-- Reads Fonts.Widths and fills in table with the character widths for this font.
BEGIN
-- see [MAXC]<Press>FontFormats.bravo
-- if index.size=0, then numbers need to be scaled by points*2540/72000

ScaleThings: PROCEDURE [p: CARDINAL] RETURNS [Mica] =
BEGIN
IF p = magicNonPrintingWidth OR index.size # 0 THEN RETURN[p];
-- This will overflow at about 200 points.
IF p IN [0 .. 77777B] THEN
RETURN[InlineDefs.LongDiv[InlineDefs.LongMult[254 * points, p], 7200]];
RETURN[-InlineDefs.LongDiv[InlineDefs.LongMult[254 * points, -p], 7200]];
END; -- of ScaleThings --

EqualFontNames: PROCEDURE [a, b: POINTER TO FontName] RETURNS [BOOLEAN] =
BEGIN
IF a[0] # b[0] THEN RETURN[FALSE];
FOR i: CARDINAL IN [1 .. LOOPHOLE[a[0], CARDINAL]] DO
IF a[i] # b[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END; -- of EqualFontNames --

code, x: CARDINAL;
c: CHARACTER;
nameFound: BOOLEAN ← FALSE;
-- overflows at about 25 points
pointSizeInMicas: Mica ← InlineDefs.LongDiv[InlineDefs.LongMult[2540, points], 72];
ix: Ix;
header: Ixn;
index: Stdix;
widthSegment: WidthSegment;

DO
-- scan through index entries looking for
-- A) fontName to code correspondence (entry type 1)
-- B) file address of the font width information (entry type 4)
IF csD.ReadBlock[fwStream, @ix, 0, SIZE[Ix]] = 0 THEN
ERROR FontError[fontNotInFontsWidths];
SELECT ix.type FROM
0 => ERROR FontError[fontNotInFontsWidths];
1 => BEGIN
IF csD.ReadBlock[fwStream, @header + 1, 0, SIZE[Ixn] - 1] = 0 THEN
ERROR FontError[badFontsWidths];
IF EqualFontNames[fontName, @header.name] THEN
{code ← header.code; nameFound ← TRUE};
END;
4 => BEGIN
IF ix.length # SIZE[Stdix] THEN ERROR FontError[badFontsWidths];
IF csD.ReadBlock[fwStream, @index, 1, SIZE[Stdix] - 1] = 0
THEN ERROR FontError[badFontsWidths];
IF nameFound AND code = index.code AND face = index.face
AND index.rotation = 0
AND (index.size = 0
OR ABS[LOOPHOLE[index.size - pointSizeInMicas, INTEGER]] < 3)
THEN EXIT;
END;
ENDCASE => ERROR FontError[fontNotInFontsWidths];
ENDLOOP;

IF index.x1 # 0 OR index.x2 # 0 THEN ERROR FontError[badFontsWidths];

-- position file to starting byte of our info
csD.SetPosition[fwStream, index.location];
IF csD.ReadBlock[fwStream, @widthSegment, 0, SIZE[WidthSegment]] = 0
THEN ERROR FontError[badFontsWidths];
-- ignore font bounding box info.
FOR c IN [0C .. 177C] DO table[c] ← magicNonPrintingWidth; ENDLOOP;
IF widthSegment.xWidthFixed THEN
BEGIN
x ← ScaleThings[csD.Read[fwStream]];
FOR c IN [index.bc .. MIN[index.ec, 177C]] DO table[c] ← x; ENDLOOP;
END
ELSE
FOR c IN [index.bc .. MIN[index.ec, 177C]] DO
table[c] ← ScaleThings[csD.Read[fwStream]];
ENDLOOP;
table[0C] ← ScaleThings[widthSegment.fBBdy];
table[Ascii.SP] ← 200;
table[Ascii.TAB] ← 200;
END; -- of ReadFontWidths --


FormList: TYPE = POINTER TO FormListRec;
FormListRec: TYPE = RECORD
[element: HardcopyFormTableElement,
nextForm: FormList];
formListHead: FormList ← NIL;

FieldList: TYPE = POINTER TO FieldListRec;
FieldListRec: TYPE = RECORD
[string: STRING,
nextField: FieldList];
-- N.B. fields must be added to this list in order, i.e., each new field is added at the end of
-- the list.

RowList: TYPE = POINTER TO RowListRec;
RowListRec: TYPE = RECORD
[row: Row,
columnList: ColumnList,
nextRowList: RowList];

OptionList: TYPE = POINTER TO OptionListRec;
OptionListRec: TYPE = RECORD
[option: Option,
string: STRING,
nextOptionList: OptionList];

ColumnList: TYPE = POINTER TO ColumnListRec;
ColumnListRec: TYPE = RECORD
[column: Column,
string: STRING,
nextColumnList: ColumnList];

TemporaryHardcopyForm: TYPE = POINTER TO TemporaryHardcopyFormRec;
TemporaryHardcopyFormRec: TYPE = RECORD
[hardcopyForm: HardcopyForm,
nWords: CARDINAL, -- total number of words eventual form will require.
fieldList: FieldList,
rowList: RowList,
optionList: OptionList];


IncludeDefaultForms: PROCEDURE =
BEGIN
IF ~FormExists["Archive"L] THEN IncludeDefaultArchiveForm[];
IF ~FormExists["Headers"L] THEN IncludeDefaultHeadersForm[];
IF ~FormExists["Blank"L] THEN IncludeDefaultBlankForm[];
IF ~FormExists["InternalMemo"L] THEN IncludeDefaultMemoForm[];
END; -- of IncludeDefaultForms --


IncludeDefaultMemoForm: PROCEDURE =
-- Built in Bravo-style internal memo form.
BEGIN
form: STRING ←
"InternalMemo 25400 2540 3175 19050 0 T
(Options
(Caption 4445 26670 2 T ""Laurel Message"")
(Heading 3175 26670 0 F Subject 15875)
(PageNumber 18415 26670 0 F)
)
(Rows
(0 0 35 (Field 3175 10795 0 1 F T 4445 From """" T F T F)
(Field 12065 19050 0 1 F T 13018 Date """" T F T F) )
(0 0 0 (Field 3175 19050 0 1 F T 4445 PrintForm """" F T T F) )
(420 0 35 (OtherFields 3175 19050 0 1 F T 4445 500) )
(1000 0 35 (Caption 635 19050 3 XEROX) )
(1000 0 35 (Field 3175 19050 0 1 F T 4445 In-Reply-To """" F F T F) )
(1000 0 35 (Body 3175 19050 0 T) )
(420 0 35 (Field 3175 19050 0 1 F T 3810 cc c F F T T) )
)"L;
ParseHardcopyFormString[form];
END; -- of IncludeDefaultMemoForm --


IncludeDefaultBlankForm: PROCEDURE =
-- Built in blank form.
BEGIN
form: STRING ←
"Blank 25400 2540 3175 19050 0 T
(Options
(Heading 3175 26670 0 F Subject 15875)
(PageNumber 18415 26670 0 F)
)
(Rows
(0 0 35 (OtherFields 3175 19050 0 1 F T 4445 500) )
(1000 0 35 (Body 3175 19050 0) )
)"L;
ParseHardcopyFormString[form];
END; -- of IncludeDefaultBlankForm --


IncludeDefaultHeadersForm: PROCEDURE =
-- Built in headers form.
BEGIN
form: STRING ←
"Headers 25400 2540 1800 20500 0 F
(Options
(Caption 8000 26670 0 T ""Laurel Table of Contents"" )
(Caption 1800 26300 1 T From: )
(Caption 6245 26300 1 T Subject: )
(Caption 15000 26300 1 T Date: )
(PageNumber 20000 26670 0 T)
(Caption 8000 26670 0 F ""Laurel Table of Contents"" )
(Caption 1800 26300 1 F From: )
(Caption 6245 26300 1 F Subject: )
(Caption 15000 26300 1 F Date: )
(PageNumber 20000 26670 0 F)
)
(Rows
(300 0 35 (Field 1800 5610 0 1 F F 2000 From """" T F F F)
(Field 6245 14365 0 1 F F 6550 Subject """" T F F F)
(Field 15000 20500 0 1 F F 15300 Date """" T F F F) )
)"L;
ParseHardcopyFormString[form];
END; -- of IncludeDefaultHeadersForm --


IncludeDefaultArchiveForm: PROCEDURE =
-- Built in headers form.
BEGIN
form: STRING ←
"Archive 25400 2540 3175 19050 0 F
(Options
(PageNumber 18415 26670 0 T)
(PageNumber 18415 26670 0 F)
)
(Rows
(200 0 35 (Caption 2000 19050 0 ""−−−−−−−−−−−−−−−−−−−− Start of message −−−−−−−−−−−−−−−−−−−−"") )
(200 0 35 (Everything 3175 19050 0) )
)"L;
ParseHardcopyFormString[form];
END; -- of IncludeDefaultArchiveForm --


FormExists: PROCEDURE [name: STRING] RETURNS [BOOLEAN] =
BEGIN
formList: FormList;
FOR formList ← formListHead, formList.nextForm UNTIL formList = NIL DO
IF String.EquivalentString[formList.element.name, name] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END; -- of FormExists --


ParseHardcopyForm: PUBLIC PROCEDURE [pH: MailParseDefs.ParseHandle] =
-- Parses the next field body read from Laurel.profile and creates a relocatable segment for it.
BEGIN OPEN SegmentDefs;
formStringSize: CARDINAL = 2000;
formStringSegment: DataSegmentHandle ← NewDataSegment
[base: DefaultBase, pages: Storage.PagesForWords[String.WordsForString[formStringSize]]];
formString: STRING ← DataSegmentAddress[formStringSegment];
formString↑ ← StringBody[length: 0, maxlength: formStringSize, text: ];
MailParseDefs.GetFieldBody[pH, formString, TRUE];
ParseHardcopyFormString[formString];
DeleteDataSegment[formStringSegment];
[] ← Storage.Prune[];
END; -- of ParseHardcopyForm --


ParseHardcopyFormString: PROCEDURE [formString: STRING] =
-- Internal workings of ParseHardcopyForm. This procedure expects that the entire form is
-- present in formString, with all internal white space compressed.
BEGIN
tempForm: TemporaryHardcopyForm ← Storage.Node[SIZE[TemporaryHardcopyFormRec]];
form: HardcopyForm ← Storage.Node[SIZE[HardcopyFormRec]];
formName: STRING ← [25];
permanentFormName: STRING;
optionOrRow: STRING ← [7];
index: CARDINAL ← 0;
paren: ParenType;
form↑ ← HardcopyFormRec
[top: ,
bottom: ,
left: ,
right: ,
nFields: 0,
lineLeading: ,
startOnNewPage: ,
fieldTable: FieldTableNIL,
options: OptionNIL,
rows: RowNIL];
tempForm↑ ← TemporaryHardcopyFormRec
[hardcopyForm: form,
nWords: SIZE[HardcopyFormRec],
fieldList: NIL,
rowList: NIL,
optionList: NIL];

index ← GetNextString[formString, index, formName];
IF formName.length = 0 THEN ERROR MailParseDefs.ParseError[badFieldBody];
[form.top, index] ← GetNextNumber[formString, index];
[form.bottom, index] ← GetNextNumber[formString, index];
[form.left, index] ← GetNextNumber[formString, index];
[form.right, index] ← GetNextNumber[formString, index];
[form.lineLeading, index] ← GetNextNumber[formString, index];
[form.startOnNewPage, index] ← GetNextBoolean[formString, index];

UNTIL index = formString.length DO
[paren, index] ← GetNextParen[formString, index];
IF paren # left THEN ERROR MailParseDefs.ParseError[badFieldBody];
index ← GetNextString[formString, index, optionOrRow];
index ← SELECT TRUE FROM
String.EquivalentString["Options"L, optionOrRow] =>
ParseOptions[formString, index, tempForm],
String.EquivalentString["Rows"L, optionOrRow] =>
ParseRows[formString, index, tempForm],
ENDCASE => ERROR MailParseDefs.ParseError[badFieldBody];
ENDLOOP;
permanentFormName ← lsD.AllocateStateString[formName.length];
String.AppendString[permanentFormName, formName];
MakeRelocatableForm[permanentFormName, tempForm];
[] ← Storage.Prune[];
END; -- of ParseHardcopyFormString --


ParseOptions: PROCEDURE [input: STRING, index: CARDINAL,
tempForm: TemporaryHardcopyForm] RETURNS [newIndex: CARDINAL] =
BEGIN
optionList, optionTail: OptionList;
paren: ParenType;
DO
[paren, index] ← GetNextParen[input, index];
SELECT paren FROM
left => [optionList, index] ← ParseOneOption[input, index, tempForm];
right => RETURN[index];
none => ERROR MailParseDefs.ParseError[badFieldBody];
ENDCASE => exD.SysBug[];
IF tempForm.optionList = NIL THEN tempForm.optionList ← optionList
ELSE BEGIN
FOR optionTail ← tempForm.optionList, optionTail.nextOptionList
UNTIL optionTail.nextOptionList = NIL DO ENDLOOP;
optionTail.nextOptionList ← optionList;
END;
ENDLOOP;
END; -- of ParseOptions --


ParseOneOption: PROCEDURE
[input: STRING, index: CARDINAL, tempForm: TemporaryHardcopyForm]
RETURNS [optionList: OptionList, newIndex: CARDINAL] =
BEGIN
optionTypeString: STRING ← [16];
option: Option;
paren: ParenType;
index ← GetNextString[input, index, optionTypeString];
SELECT TRUE FROM
String.EquivalentString["Heading"L, optionTypeString] =>
BEGIN
option ← Storage.Node[SIZE[heading OptionRec]];
option↑ ← OptionRec[x: , y: , font: , onFirstPage: , nextOption: OptionNIL,
vp: heading[fieldName: HardcopyRelativeStringNIL, right: , start: 0, end: 0]];
tempForm.nWords ← tempForm.nWords + SIZE[heading OptionRec]
END;
String.EquivalentString["Caption"L, optionTypeString] =>
BEGIN
option ← Storage.Node[SIZE[caption OptionRec]];
option↑
← OptionRec[x: , y: , font: , onFirstPage: , nextOption: OptionNIL, vp: caption[text: ]];
tempForm.nWords ← tempForm.nWords + SIZE[caption OptionRec]
END;
String.EquivalentString["PageNumber"L, optionTypeString] =>
BEGIN
option ← Storage.Node[SIZE[pageNumber OptionRec]];
option↑
← OptionRec[x: , y: , font: , onFirstPage: , nextOption: OptionNIL, vp: pageNumber[]];
tempForm.nWords ← tempForm.nWords + SIZE[pageNumber OptionRec]
END;
ENDCASE => ERROR MailParseDefs.ParseError[badFieldBody];
optionList ← Storage.Node[SIZE[OptionListRec]];
optionList↑ ← OptionListRec[option: option, string: NIL, nextOptionList: NIL];
[option.x, index] ← GetNextNumber[input, index];
[option.y, index] ← GetNextNumber[input, index];
[option.font, index] ← GetNextNumber[input, index];
[option.onFirstPage, index] ← GetNextBoolean[input, index];
WITH vOption: option SELECT FROM
heading =>
BEGIN
[optionList.string, index] ← GetNextStringAndAllocate[input, index, tempForm];
[vOption.right, index] ← GetNextNumber[input, index];
END;
caption => [optionList.string, index] ← GetNextStringAndAllocate[input, index, tempForm];
pageNumber => NULL;
ENDCASE => exD.SysBug[];
[paren, newIndex] ← GetNextParen[input, index];
IF paren # right THEN ERROR MailParseDefs.ParseError[badFieldBody];
END; -- of ParseOneOption --


ParseRows: PROCEDURE
[input: STRING, index: CARDINAL, tempForm: TemporaryHardcopyForm]
RETURNS [newIndex: CARDINAL] =
BEGIN
rowList, rowTail: RowList;
paren: ParenType;
DO
[paren, index] ← GetNextParen[input, index];
SELECT paren FROM
left => [rowList, index] ← ParseOneRow[input, index, tempForm];
right => RETURN[index];
none => ERROR MailParseDefs.ParseError[badFieldBody];
ENDCASE => exD.SysBug[];
IF tempForm.rowList = NIL THEN tempForm.rowList ← rowList
ELSE BEGIN
FOR rowTail ← tempForm.rowList, rowTail.nextRowList
UNTIL rowTail.nextRowList = NIL DO ENDLOOP;
rowTail.nextRowList ← rowList;
END;
ENDLOOP;
END; -- of ParseRows --


ParseOneRow: PROCEDURE
[input: STRING, index: CARDINAL, tempForm: TemporaryHardcopyForm]
RETURNS [rowList: RowList, newIndex: CARDINAL] =
BEGIN
columnList, columnTail: ColumnList;
paren: ParenType;
row: Row ← Storage.Node[SIZE[RowRec]];
row↑ ← RowRec
[rowLeading: , verticalTab: , lineLeading: , nextRow: RowNIL, columns: ColumnNIL];
tempForm.nWords ← tempForm.nWords + SIZE[RowRec];
rowList ← Storage.Node[SIZE[RowListRec]];
rowList↑ ← RowListRec[row: row, columnList: NIL, nextRowList: NIL];
[row.rowLeading, newIndex] ← GetNextNumber[input, index];
[row.verticalTab, newIndex] ← GetNextNumber[input, newIndex];
[row.lineLeading, newIndex] ← GetNextNumber[input, newIndex];
DO
[paren, newIndex] ← GetNextParen[input, newIndex];
SELECT paren FROM
left => [columnList, newIndex] ← ParseOneColumn[input, newIndex, tempForm];
right => RETURN;
none => ERROR MailParseDefs.ParseError[badFieldBody];
ENDCASE => exD.SysBug[];
IF rowList.columnList = NIL THEN rowList.columnList ← columnList
ELSE BEGIN
FOR columnTail ← rowList.columnList, columnTail.nextColumnList
UNTIL columnTail.nextColumnList = NIL DO ENDLOOP;
columnTail.nextColumnList ← columnList;
END;
ENDLOOP;
END; -- of ParseOneRow --


ParseOneColumn: PROCEDURE
[input: STRING, index: CARDINAL, tempForm: TemporaryHardcopyForm]
RETURNS [columnList: ColumnList, newIndex: CARDINAL] =
BEGIN
columnTypeString: STRING ← [11];
column: Column;
fieldList, fieldTail: FieldList;
paren: ParenType;
index ← GetNextString[input, index, columnTypeString];
SELECT TRUE FROM
String.EquivalentString["Field"L, columnTypeString] =>
BEGIN
column ← Storage.Node[SIZE[specific field ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , justify: , start: , end: , nextColumn: ColumnNIL,
cv: field[fieldFont: , fieldNameAbove: , colonAfterFieldName: , textLeft: ,
fv: specific[fieldIndex: , aliasFieldIndex: , required: , suppress: , printFieldName: ,
breakOnComma: ]]];
tempForm.nWords ← tempForm.nWords + SIZE[specific field ColumnRec]
END;
String.EquivalentString["OtherFields"L, columnTypeString] =>
BEGIN
column ← Storage.Node[SIZE[other field ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , justify: , start: , end: , nextColumn: ColumnNIL,
cv: field[fieldFont: , fieldNameAbove: , colonAfterFieldName: , textLeft: ,
fv: other[fieldLeading: , newField: ]]];
tempForm.nWords ← tempForm.nWords + SIZE[other field ColumnRec]
END;
String.EquivalentString["Caption"L, columnTypeString] =>
BEGIN
column ← Storage.Node[SIZE[caption ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , justify: , start: , end: , nextColumn: ColumnNIL,
cv: caption[text: HardcopyRelativeStringNIL]];
tempForm.nWords ← tempForm.nWords + SIZE[caption ColumnRec]
END;
String.EquivalentString["Body"L, columnTypeString] =>
BEGIN
column ← Storage.Node[SIZE[body ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , justify: , start: , end: , nextColumn: ColumnNIL, cv: body[]];
tempForm.nWords ← tempForm.nWords + SIZE[body ColumnRec]
END;
String.EquivalentString["Everything"L, columnTypeString] =>
BEGIN
column ← Storage.Node[SIZE[everything ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , justify: , start: , end: , nextColumn: ColumnNIL, cv: everything[]];
tempForm.nWords ← tempForm.nWords + SIZE[everything ColumnRec]
END;
ENDCASE => ERROR MailParseDefs.ParseError[badFieldBody];
columnList ← Storage.Node[SIZE[ColumnListRec]];
columnList↑ ← ColumnListRec[column: column, string: NIL, nextColumnList: NIL];
[column.left, index] ← GetNextNumber[input, index];
[column.right, index] ← GetNextNumber[input, index];
[column.font, index] ← GetNextNumber[input, index];
WITH vColumn: column SELECT FROM
field =>
BEGIN
[vColumn.fieldFont, index] ← GetNextNumber[input, index];
[vColumn.fieldNameAbove, index] ← GetNextBoolean[input, index];
[vColumn.colonAfterFieldName, index] ← GetNextBoolean[input, index];
[vColumn.textLeft, index] ← GetNextNumber[input, index];
WITH vField: vColumn SELECT FROM
specific =>
BEGIN

IncludeFieldString: PROCEDURE [fieldIndex: POINTER TO CARDINAL] =
BEGIN
s: STRING;
[s, index] ← GetNextStringAndAllocate[input, index, tempForm];
IF s = NIL THEN {fieldIndex↑ ← LAST[CARDINAL]; RETURN};
fieldIndex↑ ← tempForm.hardcopyForm.nFields;
tempForm.hardcopyForm.nFields ← tempForm.hardcopyForm.nFields + 1;
fieldList ← Storage.Node[SIZE[FieldListRec]];
fieldList↑ ← FieldListRec[string: s, nextField: NIL];
IF tempForm.fieldList = NIL THEN tempForm.fieldList ← fieldList
ELSE BEGIN
FOR fieldTail ← tempForm.fieldList, fieldTail.nextField
UNTIL fieldTail.nextField = NIL DO ENDLOOP;
fieldTail.nextField ← fieldList;
END;
END; -- of IncludeFieldString --

IncludeFieldString[@vField.fieldIndex];
IF vField.fieldIndex = LAST[CARDINAL] THEN
ERROR MailParseDefs.ParseError[badFieldBody];
IncludeFieldString[@vField.aliasFieldIndex];
[vField.required, index] ← GetNextBoolean[input, index];
[vField.suppress, index] ← GetNextBoolean[input, index];
[vField.printFieldName, index] ← GetNextBoolean[input, index];
[vField.breakOnComma, index] ← GetNextBoolean[input, index];
END;
other => [vField.fieldLeading, index] ← GetNextNumber[input, index];
ENDCASE => exD.SysBug[];
END;
caption => [columnList.string, index] ← GetNextStringAndAllocate[input, index, tempForm];
body => NULL;
everything => NULL;
ENDCASE => exD.SysBug[];
[column.justify, index] ← GetNextBoolean[input, index];
[paren, newIndex] ← GetNextParen[input, index];
IF paren # right THEN ERROR MailParseDefs.ParseError[badFieldBody];
END; -- of ParseOneColumn --


GetNextString: PROCEDURE [input: STRING, index: CARDINAL, output: STRING]
RETURNS [newIndex: CARDINAL] =
BEGIN
newIndex ← GetNextToken[input, index, output];
IF output[0] = ’( OR output[0] = ’) THEN ERROR MailParseDefs.ParseError[badFieldBody];
END; -- of GetNextString --


GetNextStringAndAllocate: PROCEDURE
[input: STRING, index: CARDINAL, tempForm: TemporaryHardcopyForm]
RETURNS [newString: STRING, newIndex: CARDINAL] =
BEGIN
s: STRING ← [100];
newIndex ← GetNextString[input, index, s];
IF s.length = 0 THEN newString ← NIL
ELSE BEGIN
newString ← Storage.String[s.length];
tempForm.nWords ← tempForm.nWords + String.WordsForString[s.length];
String.AppendString[newString, s];
END;
END; -- of GetNextStringAndAllocate --


GetNextNumber: PROCEDURE [input: STRING, index: CARDINAL]
RETURNS [number: CARDINAL, newIndex: CARDINAL] =
BEGIN
s: STRING ← [10];
newIndex ← GetNextToken[input, index, s];
IF s.length = 0 THEN ERROR MailParseDefs.ParseError[badFieldBody];
number ← String.StringToDecimal[s ! String.InvalidNumber => ERROR MailParseDefs.ParseError[badFieldBody]];
END; -- of GetNextNumber --


GetNextBoolean: PROCEDURE [input: STRING, index: CARDINAL]
RETURNS [boolean: BOOLEAN, newIndex: CARDINAL] =
BEGIN
s: STRING ← [5];
newIndex ← GetNextToken[input, index, s];
boolean ← SELECT TRUE FROM
String.EquivalentString["True"L, s] => TRUE,
String.EquivalentString["T"L, s] => TRUE,
String.EquivalentString["False"L, s] => FALSE,
String.EquivalentString["F"L, s] => FALSE,
String.EquivalentString[")"L, s] => FALSE,
ENDCASE => ERROR MailParseDefs.ParseError[badFieldBody];
IF String.EquivalentString[")"L, s] THEN newIndex ← index;
END; -- of GetNextBoolean --


ParenType: TYPE = {left, right, none};


GetNextParen: PROCEDURE [input: STRING, index: CARDINAL]
RETURNS [paren: ParenType, newIndex: CARDINAL] =
BEGIN
s: STRING ← [1];
newIndex ← GetNextToken[input, index, s];
paren ← SELECT TRUE FROM
String.EquivalentString["("L, s] => left,
String.EquivalentString[")"L, s] => right,
ENDCASE => none;
END; -- of GetNextParen --


GetNextToken: PROCEDURE [input: STRING, index: CARDINAL, output: STRING]
RETURNS [newIndex: CARDINAL] =
-- Starting at input[index], the next white space is flushed, and the following token is
-- returned in output. input[newIndex] is the first character not included in output.
-- Tokens consist of identifiers and the delimiters ’( and ’).
BEGIN
char: CHARACTER;
inQuotes: BOOLEAN ← FALSE;

AddToOutput: PROCEDURE =
BEGIN
IF output.length < output.maxlength THEN
{output[output.length] ← char; output.length ← output.length + 1};
END; -- of AddToOutput --

SkipToNonBlank: PROCEDURE =
BEGIN
UNTIL index >= input.length DO
char ← input[index];
SELECT char FROM
Ascii.SP, Ascii.TAB, Ascii.CR => index ← index + 1;
ENDCASE => RETURN;
ENDLOOP;
END; -- of SkipToNonBlank --

output.length ← 0;
SkipToNonBlank[];
IF index >= input.length THEN RETURN[index];
index ← index + 1;
SELECT char FROM
’" => inQuotes ← TRUE;
’(, ’) => {AddToOutput[]; SkipToNonBlank[]; RETURN[index]};
ENDCASE => AddToOutput[];
UNTIL index >= input.length DO
char ← input[index];
index ← index + 1;
IF inQuotes THEN
BEGIN
IF char = ’" THEN
BEGIN
IF index >= input.length THEN RETURN[index];
char ← input[index];
IF char = ’" THEN {index ← index + 1; AddToOutput[]}
ELSE {SkipToNonBlank[]; RETURN[index]}
END
ELSE AddToOutput[];
END
ELSE
SELECT char FROM
’), ’( => RETURN[index - 1];
Ascii.SP, Ascii.TAB, Ascii.CR => {SkipToNonBlank[]; RETURN[index]};
ENDCASE => AddToOutput[];
REPEAT
FINISHED => RETURN[index];
ENDLOOP;
END; -- of GetNextToken --


MakeRelocatableForm: PROCEDURE[formName: STRING, tempForm: TemporaryHardcopyForm]=
-- Transforms the temporary data structure representing a hardcopy form into a compact
-- relocatable state segment hardcopy form. Links in the formName and state segment into
-- the temporary hardcopy table. Frees storage associated with the temporary hardcopy
-- form representation. formName must be allocated from the state heap.
BEGIN
segment: lsD.StateSegment
← lsD.DefineStateSegment[Storage.PagesForWords[tempForm.nWords]];
formList: FormList ← Storage.Node[SIZE[FormListRec]];
base: POINTER;
formFF: CARDINAL;
hardcopyForm: HardcopyForm;
fieldTable: FieldTable;
fieldList, nextFieldList: FieldList;
fieldIndex: CARDINAL;
optionList, nextOptionList: OptionList;
option: Option;
rowList, nextRowList: RowList;
row: Row;
columnList, nextColumnList: ColumnList;
column: Column;

AddHardcopyString: PROCEDURE
[relPtr: POINTER TO HardcopyRelativeString, string: STRING] =
BEGIN
hardcopyString: STRING;
IF string = NIL THEN exD.SysBug[];
relPtr↑ ← LOOPHOLE[formFF, HardcopyRelativeString];
hardcopyString ← @hardcopyForm[relPtr↑];
hardcopyString↑ ← StringBody[length: 0, maxlength: string.length, text: ];
String.AppendString[hardcopyString, string];
formFF ← formFF + String.WordsForString[hardcopyString.maxlength];
Storage.FreeString[string];
END; -- of AddHardcopyString --

-- Add this form to the temporary form table.
formList↑ ← FormListRec
[element: HardcopyFormTableElement[name: formName, segment: segment],
nextForm: formListHead];
formListHead ← formList;

-- Add the HardcopyForm header to the segment.
hardcopyForm ← base ← lsD.SwapInStateSegment[segment];
hardcopyForm↑ ← tempForm.hardcopyForm↑;
Storage.Free[tempForm.hardcopyForm];
formFF ← SIZE[HardcopyFormRec];
fieldTable ← LOOPHOLE[base + formFF];

-- construct the field table.
hardcopyForm.fieldTable ← LOOPHOLE[formFF];
formFF ← formFF + hardcopyForm.nFields;
fieldIndex ← 0;
FOR fieldList ← tempForm.fieldList, nextFieldList UNTIL fieldList = NIL DO
AddHardcopyString[@fieldTable[fieldIndex], fieldList.string];
nextFieldList ← fieldList.nextField;
fieldIndex ← fieldIndex + 1;
Storage.Free[fieldList];
ENDLOOP;

-- Add the options to the segment.
hardcopyForm.options
← IF tempForm.optionList = NIL THEN OptionNIL ELSE LOOPHOLE[formFF];
FOR optionList ← tempForm.optionList, nextOptionList UNTIL optionList = NIL DO
option ← LOOPHOLE[base + formFF];
WITH vOption: optionList.option SELECT FROM
heading => BEGIN
headingOption: POINTER TO heading OptionRec ← LOOPHOLE[option];
formFF ← formFF + SIZE[heading OptionRec];
headingOption↑ ← vOption;
AddHardcopyString[@headingOption.fieldName, optionList.string];
END;
caption => BEGIN
captionOption: POINTER TO caption OptionRec ← LOOPHOLE[option];
formFF ← formFF + SIZE[caption OptionRec];
captionOption↑ ← vOption;
AddHardcopyString[@captionOption.text, optionList.string];
END;
pageNumber => BEGIN
pageOption: POINTER TO pageNumber OptionRec ← LOOPHOLE[option];
formFF ← formFF + SIZE[pageNumber OptionRec];
pageOption↑ ← vOption;
END;
ENDCASE => exD.SysBug[];
nextOptionList ← optionList.nextOptionList;
Storage.Free[optionList.option];
Storage.Free[optionList];
option.nextOption ← IF nextOptionList = NIL THEN OptionNIL ELSE LOOPHOLE[formFF];
ENDLOOP;

-- Add the rows to the segment.
hardcopyForm.rows ← IF tempForm.rowList = NIL THEN RowNIL ELSE LOOPHOLE[formFF];
FOR rowList ← tempForm.rowList, nextRowList UNTIL rowList = NIL DO
row ← LOOPHOLE[base + formFF];
formFF ← formFF + SIZE[RowRec];
row↑ ← rowList.row↑;
row.columns ← LOOPHOLE[formFF];
-- Add the columns of this row to the segment.
FOR columnList ← rowList.columnList, nextColumnList UNTIL columnList = NIL DO
column ← LOOPHOLE[base + formFF];
WITH vColumn: columnList.column SELECT FROM
field => BEGIN
WITH vfColumn: vColumn SELECT FROM
specific => BEGIN
sfc: POINTER TO specific field ColumnRec ← LOOPHOLE[column];
formFF ← formFF + SIZE[specific field ColumnRec];
sfc↑ ← vfColumn;
END;
other => BEGIN
ofc: POINTER TO other field ColumnRec ← LOOPHOLE[column];
formFF ← formFF + SIZE[other field ColumnRec];
ofc↑ ← vfColumn;
END;
ENDCASE => exD.SysBug[];
END;
caption => BEGIN
captionColumn: POINTER TO caption ColumnRec ← LOOPHOLE[column];
formFF ← formFF + SIZE[caption ColumnRec];
captionColumn↑ ← vColumn;
AddHardcopyString[@captionColumn.text, columnList.string];
END;
body => BEGIN
bodyColumn: POINTER TO body ColumnRec ← LOOPHOLE[column];
formFF ← formFF + SIZE[body ColumnRec];
bodyColumn↑ ← vColumn;
END;
everything => BEGIN
everythingColumn: POINTER TO everything ColumnRec ← LOOPHOLE[column];
formFF ← formFF + SIZE[everything ColumnRec];
everythingColumn↑ ← vColumn;
END;
ENDCASE => exD.SysBug[];
nextColumnList ← columnList.nextColumnList;
Storage.Free[columnList.column];
Storage.Free[columnList];
column.nextColumn ← IF nextColumnList = NIL
THEN ColumnNIL ELSE LOOPHOLE[formFF];
ENDLOOP;

nextRowList ← rowList.nextRowList;
Storage.Free[rowList.row];
Storage.Free[rowList];
row.nextRow ← IF nextRowList = NIL THEN RowNIL ELSE LOOPHOLE[formFF];
ENDLOOP;

-- Clean up the finished form.
Storage.Free[tempForm];
lsD.WriteStateSegment[segment];
lsD.ReleaseStateSegment[segment];
END; -- of MakeRelocatableForm --


MakeHardcopyFormTable: PROCEDURE =
-- Allocates just enough space in the state heap for the hardcopy form table. Copies
-- temporary list style form table into the permanent state heap form table. Frees
-- temporary form table.
BEGIN
nForms: CARDINAL ← 0;
form, nextForm: FormList;
table: HardcopyFormTable;
i: CARDINAL;
FOR form ← formListHead, form.nextForm UNTIL form = NIL DO
nForms ← nForms + 1;
ENDLOOP;
intC.hardcopyFormTable ← table
← lsD.AllocateStateNode[SIZE[HardcopyFormTableElement] * nForms + 1];
table.nForms ← nForms;
form ← formListHead;
FOR i IN [0 .. nForms) DO
table.formTable[i] ← form.element;
nextForm ← form.nextForm;
Storage.Free[form];
form ← nextForm;
ENDLOOP;
END; -- of MakeHardcopyFormTable --


END. -- of HardcopyInstaller --