-- 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 --
(635)\f1