-- HardcopyInstaller.mesa
-- Edited by Brotz, March 25, 1981 5:07 PM
-- Edited by Schroeder, October 27, 1980 10:38 AM
-- Edited by Levin, January 16, 1981 10:59 AM

DIRECTORY
Ascii,
csD: FROM "CoreStreamDefs",
exD: FROM "ExceptionDefs",
InlineDefs,
intCommon: FROM "IntCommon",
LaurelHardcopyDefs,
lsD: FROM "LaurelStateDefs",
MailParse,
MiscDefs,
ovD: FROM "OverviewDefs",
SegmentDefs,
Storage,
StringDefs,
SystemDefs;

HardcopyInstaller: PROGRAM
IMPORTS csD, exD, InlineDefs, intC: intCommon, lsD, MailParse, MiscDefs,
SegmentDefs, Storage, StringDefs, SystemDefs
EXPORTS LaurelHardcopyDefs
= PUBLIC

BEGIN OPEN LaurelHardcopyDefs;


fontTable: WidthTable;
fontDirectory: FontDirectory;



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


InstallHardcopy: PROCEDURE RETURNS [error: ovD.ErrorCode] =
-- 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.
BEGIN
i: FontNumber;
FOR i IN [0 .. maxNFonts) DO
IF fontDirectory.entry[i].entryLength = 0 THEN
IF (error ← 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]) # ovD.ok
THEN EXIT;
ENDLOOP;
lsD.WriteStateSegment[intC.fontDirectorySegment];
lsD.ReleaseStateSegment[intC.fontDirectorySegment];
lsD.WriteStateSegment[intC.hardcopyWidthTableSegment];
lsD.ReleaseStateSegment[intC.hardcopyWidthTableSegment];
IncludeDefaultForms[];
MakeHardcopyFormTable[];
[] ← SystemDefs.PruneHeap[];
END; -- of InstallHardcopy --


IncludeHardcopyFont: PROCEDURE [fontNumber: FontNumber, name: STRING,
points: CARDINAL, face: FontFace]
RETURNS [error: ovD.ErrorCode] =
-- 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;
nBufferPages: CARDINAL = 1;
fontName: FontName;
IF fontNumber ~IN FontNumber THEN RETURN[ovD.profileBadFont];
wsh ← csD.OpenFromName["Fonts.Widths"L, intC.user, word, read, nBufferPages
! csD.Error => GOTO cantOpen ];
MakeFontName[name, @fontName];
error ← ReadFontWidths[@fontTable[fontNumber], @fontName, points, face, wsh
! csD.Error => {error ← ovD.badFontsWidths; CONTINUE} ];
IF error = ovD.ok THEN IncludeInFontDirectory[fontNumber, name, points, face];
csD.Destroy[wsh];
EXITS cantOpen => RETURN[ovD.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] ← StringDefs.UpperCase[name[i]];
ENDLOOP;
FOR i IN (length .. 20) DO
fontName[i] ← 0C;
ENDLOOP;
fontName[0] ← LOOPHOLE[length];
END; -- of x --


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: PROCEDURE [line: STRING] RETURNS [error: ovD.ErrorCode] =
-- 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 MailParse.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;
RETURN[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] RETURNS [error: ovD.ErrorCode] =
-- 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
RETURN[ovD.fontNotInFontsWidths];
SELECT ix.type FROM
0 => RETURN[ovD.fontNotInFontsWidths];
1 => BEGIN
IF csD.ReadBlock[fwStream, @header+1, 0, SIZE[Ixn] - 1] = 0 THEN
RETURN[ovD.badFontsWidths];
IF EqualFontNames[fontName, @header.name] THEN
BEGIN
code ← header.code;
nameFound ← TRUE;
END;
END;
4 => BEGIN
IF ix.length # SIZE[Stdix] THEN RETURN[ovD.badFontsWidths];
IF csD.ReadBlock[fwStream, @index, 1, SIZE[Stdix] - 1] = 0
THEN RETURN[ovD.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 => RETURN[ovD.fontNotInFontsWidths];
ENDLOOP;

IF index.x1 # 0 OR index.x2 # 0 THEN RETURN[ovD.badFontsWidths];

-- position file to starting byte of our info
csD.SetPosition[fwStream, index.location];
IF csD.ReadBlock[fwStream, @widthSegment, 0, SIZE[WidthSegment]] = 0
THEN RETURN[ovD.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] ← 250;
table[Ascii.TAB] ← 250;
RETURN[ovD.ok];
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) )
(420 0 35 (Field 3175 19050 0 1 F T 3810 cc c F F T T) )
)"L;
IF ParseHardcopyFormString[form] # ovD.ok THEN exD.SysBug[];
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;
IF ParseHardcopyFormString[form] # ovD.ok THEN exD.SysBug[];
END; -- of IncludeDefaultMemoForm --


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;
IF ParseHardcopyFormString[form] # ovD.ok THEN exD.SysBug[];
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;
IF ParseHardcopyFormString[form] # ovD.ok THEN exD.SysBug[];
END; -- of IncludeDefaultArchiveForm --


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


ParseHardcopyForm: PROCEDURE [pH: MailParse.ParseHandle]
RETURNS [error: ovD.ErrorCode] =
-- 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: SystemDefs.PagesForWords[StringDefs.WordsForString[formStringSize]]];
formString: STRING ← DataSegmentAddress[formStringSegment];
formString↑ ← StringBody[length: 0, maxlength: formStringSize, text: ];
MailParse.GetFieldBody[pH, formString, TRUE];
error ← ParseHardcopyFormString[formString];
DeleteDataSegment[formStringSegment];
[] ← Storage.Prune[];
END; -- of ParseHardcopyForm --


ParseHardcopyFormString: PROCEDURE [formString: STRING]
RETURNS [error: ovD.ErrorCode] =
-- Internal workings of ParseHardcopyForm. This procedure expects that the entire form is
-- present in formString, with all internal white space compressed.
BEGIN
tempForm: TemporaryHardcopyForm ←
SystemDefs.AllocateHeapNode[SIZE[TemporaryHardcopyFormRec]];
form: HardcopyForm ← SystemDefs.AllocateHeapNode[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 MailParse.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 MailParse.ParseError[badFieldBody];
index ← GetNextString[formString, index, optionOrRow];
index ← SELECT TRUE FROM
StringDefs.EquivalentString["Options"L, optionOrRow]
=> ParseOptions[formString, index, tempForm],
StringDefs.EquivalentString["Rows"L, optionOrRow]
=> ParseRows[formString, index, tempForm],
ENDCASE => ERROR MailParse.ParseError[badFieldBody];
ENDLOOP;
permanentFormName ← lsD.AllocateStateString[formName.length];
StringDefs.AppendString[permanentFormName, formName];
MakeRelocatableForm[permanentFormName, tempForm];
[] ← Storage.Prune[];
RETURN[ovD.ok];
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 MailParse.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
StringDefs.EquivalentString["Heading"L, optionTypeString] =>
BEGIN
option ← SystemDefs.AllocateHeapNode[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;
StringDefs.EquivalentString["Caption"L, optionTypeString] =>
BEGIN
option ← SystemDefs.AllocateHeapNode[SIZE[caption OptionRec]];
option↑ ← OptionRec
[x: , y: , font: , onFirstPage: , nextOption: OptionNIL,
vp: caption[text: ]];
tempForm.nWords ← tempForm.nWords + SIZE[caption OptionRec]
END;
StringDefs.EquivalentString["PageNumber"L, optionTypeString] =>
BEGIN
option ← SystemDefs.AllocateHeapNode[SIZE[pageNumber OptionRec]];
option↑ ← OptionRec
[x: , y: , font: , onFirstPage: , nextOption: OptionNIL,
vp: pageNumber[]];
tempForm.nWords ← tempForm.nWords + SIZE[pageNumber OptionRec]
END;
ENDCASE => ERROR MailParse.ParseError[badFieldBody];
optionList ← SystemDefs.AllocateHeapNode[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 MailParse.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 MailParse.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 ← SystemDefs.AllocateHeapNode[SIZE[RowRec]];
row↑ ← RowRec
[rowLeading: , verticalTab: , lineLeading: , nextRow: RowNIL, columns: ColumnNIL];
tempForm.nWords ← tempForm.nWords + SIZE[RowRec];
rowList ← SystemDefs.AllocateHeapNode[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 MailParse.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
StringDefs.EquivalentString["Field"L, columnTypeString] =>
BEGIN
column ← SystemDefs.AllocateHeapNode[SIZE[specific field ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , 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;
StringDefs.EquivalentString["OtherFields"L, columnTypeString] =>
BEGIN
column ← SystemDefs.AllocateHeapNode[SIZE[other field ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , start: , end: , nextColumn: ColumnNIL,
cv: field[fieldFont: , fieldNameAbove: , colonAfterFieldName: , textLeft: ,
fv: other[fieldLeading: , newField: ]]];
tempForm.nWords ← tempForm.nWords + SIZE[other field ColumnRec]
END;
StringDefs.EquivalentString["Caption"L, columnTypeString] =>
BEGIN
column ← SystemDefs.AllocateHeapNode[SIZE[caption ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , start: , end: , nextColumn: ColumnNIL,
cv: caption[text: HardcopyRelativeStringNIL]];
tempForm.nWords ← tempForm.nWords + SIZE[caption ColumnRec]
END;
StringDefs.EquivalentString["Body"L, columnTypeString] =>
BEGIN
column ← SystemDefs.AllocateHeapNode[SIZE[body ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , start: , end: , nextColumn: ColumnNIL,
cv: body[]];
tempForm.nWords ← tempForm.nWords + SIZE[body ColumnRec]
END;
StringDefs.EquivalentString["Everything"L, columnTypeString] =>
BEGIN
column ← SystemDefs.AllocateHeapNode[SIZE[everything ColumnRec]];
column↑ ← ColumnRec
[left: , right: , font: , start: , end: , nextColumn: ColumnNIL,
cv: everything[]];
tempForm.nWords ← tempForm.nWords + SIZE[everything ColumnRec]
END;
ENDCASE => ERROR MailParse.ParseError[badFieldBody];
columnList ← SystemDefs.AllocateHeapNode[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 ← SystemDefs.AllocateHeapNode[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 MailParse.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 =>
BEGIN
[vField.fieldLeading, index] ← GetNextNumber[input, index];
END;
ENDCASE => exD.SysBug[];
END;
caption =>
BEGIN
[columnList.string, index] ← GetNextStringAndAllocate[input, index, tempForm];
END;
body => NULL;
everything => NULL;
ENDCASE => exD.SysBug[];
[paren, newIndex] ← GetNextParen[input, index];
IF paren # right THEN ERROR MailParse.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 MailParse.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 ← SystemDefs.AllocateHeapString[s.length];
tempForm.nWords ← tempForm.nWords + StringDefs.WordsForString[s.length];
StringDefs.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 MailParse.ParseError[badFieldBody];
number ← StringDefs.StringToDecimal[s ! StringDefs.InvalidNumber => ERROR MailParse.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
StringDefs.EquivalentString["True"L, s] => TRUE,
StringDefs.EquivalentString["T"L, s] => TRUE,
StringDefs.EquivalentString["False"L, s] => FALSE,
StringDefs.EquivalentString["F"L, s] => FALSE,
ENDCASE => ERROR MailParse.ParseError[badFieldBody];
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
StringDefs.EquivalentString["("L, s] => left,
StringDefs.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
BEGIN
output[output.length] ← char;
output.length ← output.length + 1;
END;
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;
’(, ’) => BEGIN AddToOutput[]; SkipToNonBlank[]; RETURN[index]; END;
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
BEGIN
index ← index + 1;
AddToOutput[];
END
ELSE BEGIN
SkipToNonBlank[];
RETURN[index];
END
END
ELSE AddToOutput[];
END
ELSE
SELECT char FROM
’), ’( => RETURN[index - 1];
Ascii.SP, Ascii.TAB, Ascii.CR => BEGIN
SkipToNonBlank[];
RETURN[index];
END;
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[SystemDefs.PagesForWords[tempForm.nWords]];
formList: FormList ← SystemDefs.AllocateHeapNode[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: ];
StringDefs.AppendString[hardcopyString, string];
formFF ← formFF + StringDefs.WordsForString[hardcopyString.maxlength];
SystemDefs.FreeHeapString[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↑;
SystemDefs.FreeHeapNode[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;
SystemDefs.FreeHeapNode[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;
SystemDefs.FreeHeapNode[optionList.option];
SystemDefs.FreeHeapNode[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;
SystemDefs.FreeHeapNode[columnList.column];
SystemDefs.FreeHeapNode[columnList];
column.nextColumn ← IF nextColumnList = NIL THEN ColumnNIL
ELSE LOOPHOLE[formFF];
ENDLOOP;

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

-- Clean up the finished form.
SystemDefs.FreeHeapNode[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;
SystemDefs.FreeHeapNode[form];
form ← nextForm;
ENDLOOP;
END; -- of MakeHardcopyFormTable --



END. -- of HardcopyInstaller --