-- TexOut.mesa
-- Mesa 6 version
-- Last changed by Doug Wyatt, September 23, 1980  4:54 PM

-- Press output routines for TEX

DIRECTORY
	TexDefs,
	TexDispDefs USING [InitDisp,CloseDisp,DisplayPage,unitScaling],
	TexErrorDefs,
	TexFontDefs USING [FontHdr,CharWd,CharHt,CharDp],
	TexGlueDefs,
	TexIODefs,
	TexMemDefs,
	TexNodeDefs,
	TexOutputDefs,
	TexStringDefs USING [AppendString],
	TexSynDefs USING [AppendOutputFileName],
	TfmDefs,
	AltoDefs USING [CharsPerPage],
	InlineDefs USING [LowHalf, LongCOPY],
	OsStaticDefs,
	SegmentDefs,
	StreamDefs,
	TimeDefs;

TexOut: PROGRAM 
IMPORTS TexDispDefs,TexErrorDefs,TexFontDefs,TexGlueDefs,TexIODefs,
	TexMemDefs,TexStringDefs,TexSynDefs,
	InlineDefs,SegmentDefs,StreamDefs,TimeDefs
EXPORTS TexOutputDefs =
BEGIN OPEN TexDefs, TexNodeDefs, TexGlueDefs;

display: BOOLEAN=TRUE;

Confusion: SIGNAL = TexErrorDefs.Confusion;

needToInit: BOOLEAN_TRUE;
displayPages: BOOLEAN_FALSE;

micasPerInch: Dimn=2540;
leftMargin: Dimn=micasPerInch; -- one inch
topMargin: Dimn=micasPerInch; -- also one inch
pageHeight: Dimn=11*micasPerInch; -- 11 inches
pageWidth: Dimn=17*(micasPerInch/2); -- 8.5 inches

-- Press Entity list commands
ELShowCharactersShort: BYTE = 0B;
ELFont: BYTE = 160B;
ELSetX: BYTE = 356B;
ELSetY: BYTE = 357B;
ELShowCharacters: BYTE = 360B;
ELShowRectangle: BYTE = 376B;
ELNop: BYTE = 377B;

pagePartType: CARDINAL = 0;
fontPartType: CARDINAL = 1;
PartEntry: TYPE = MACHINE DEPENDENT RECORD
	[
	partType: CARDINAL,
	recStart: CARDINAL, -- starting record number
	recLength: CARDINAL, -- length of part in records
	pad: CARDINAL  -- entity list padding in words, if partType=pagePartType
	];
FontEntry: TYPE = MACHINE DEPENDENT RECORD -- Press font directory entry
	[
	length: CARDINAL, -- length of entry in words
	fontset: BYTE, -- set for this entry
	fontnum: BYTE, -- number within set for this entry
	m: BYTE, -- first character defined by this entry
	n: BYTE, -- last character defined by this entry
	fam: ARRAY [0..10) OF WORD, -- bcpl string for name
	face: TfmDefs.FaceCode, -- Press face encoding
	source: BYTE, -- where to start reading characters
	size: CARDINAL, -- size of the font in points
	rotation: CARDINAL -- in minutes of arc
	];

ozone: TexMemDefs.ZonePtr_NIL;

ByteArray: TYPE = LONG DESCRIPTOR FOR PACKED ARRAY OF BYTE;
ListState: TYPE = RECORD
	[
	array: ByteArray, -- byte array
	count: CARDINAL, -- current number of bytes in list
	seg: SegmentDefs.DataSegmentHandle
	];
ListStatePtr: TYPE = POINTER TO ListState;

fontsPerSet: CARDINAL = 16; -- Press format restriction

EntityState: TYPE = RECORD
	[
	dlist: ListStatePtr, -- descriptor for DL
	elist: ListStatePtr, -- descriptor for EL
	pending: CARDINAL, -- number of pending characters in DL
	cx,cy: Dimn, -- current x,y position
	cf: [0..fontsPerSet)  -- current font
	];

dlPages: CARDINAL=30; -- dl buffer has this many pages
elPages: CARDINAL=20; -- el buffer has this many pages

numEntities: CARDINAL=(nFonts+fontsPerSet-1)/fontsPerSet;
EntityIndex: TYPE = [0..numEntities);
eState: ARRAY EntityIndex OF EntityState;
en: EntityIndex; -- current entity number

PressBufferFull: PUBLIC ERROR = CODE;

PutByte: PROCEDURE[list: ListStatePtr, b: BYTE] =
	BEGIN OPEN list;
	i: CARDINAL=count;
	IF i<LENGTH[array] THEN { array[i]_b; count_i+1 }
	ELSE ERROR PressBufferFull;
	END;

AllocList: PROCEDURE[pages: CARDINAL] RETURNS[ListStatePtr] =
	BEGIN OPEN SegmentDefs;
	list: ListStatePtr=TexMemDefs.Alloc[ozone,SIZE[ListState]];
	seg: DataSegmentHandle=NewDataSegment[base: DefaultXMBase, pages: pages];
	base: LONG POINTER=LongSegmentAddress[seg];
	list^_[array: DESCRIPTOR[base,512*pages], count: 0, seg: seg];
	RETURN[list];
	END;

FreeList: PROCEDURE[list: ListStatePtr] =
	BEGIN OPEN SegmentDefs;
	DeleteDataSegment[list.seg];
	-- closing ozone will free the ListState record
	END;

fontsUsed: ARRAY Font OF BOOLEAN;

nullStream: StreamDefs.StreamHandle = NIL;
outStream: StreamDefs.StreamHandle;

PartRec: TYPE = RECORD
	[
	link: PartRecPtr,
	entry: PartEntry
	];
PartRecPtr: TYPE = POINTER TO PartRec;

partlist: PartRecPtr_NIL;
lastpart: PartRecPtr_NIL;
nparts: CARDINAL_0; -- current number of parts in partlist

fileName: STRING _ [51];

InitOut: PUBLIC PROCEDURE =
	BEGIN
	f: Font;
	ozone_TexMemDefs.CreateZone[1,1];
	IF display THEN displayPages_TRUE;
	outStream_nullStream;
	needToInit_FALSE;
	-- initialize part directory
	nparts_0; partlist_lastpart_NIL;
	-- initialize font vector
	FOR f IN Font DO fontsUsed[f]_FALSE; ENDLOOP;
	IF display THEN TexDispDefs.InitDisp;
	END;

CloseOut: PUBLIC PROCEDURE [copies: CARDINAL] =
	BEGIN -- called just before TEX stops
	startrec, partrec: CARDINAL;
	IF needToInit THEN ERROR Confusion;

	IF outStream=nullStream THEN
		BEGIN OPEN TexIODefs; UseDisplay; Ps["No output file."]; END
	ELSE
		BEGIN
		-- write the directories
		[startrec,partrec]_WriteFontDirectory[];
		WritePartDirectory[];
		WriteDocDirectory[partrec, copies];

		-- finish the output
		outStream.destroy[outStream]; outStream_nullStream;
		END;

	-- deallocate
	IF display THEN TexDispDefs.CloseDisp;
	needToInit_TRUE; -- for next time
	END;

WriteList: PROCEDURE[list: ListStatePtr] =
	BEGIN OPEN SegmentDefs,list;
	bufseg: DataSegmentHandle_NewDataSegment[pages: 1];
	buf: POINTER_DataSegmentAddress[bufseg];
	lpage: LONG POINTER_BASE[array];
	rem: CARDINAL_count;
	WHILE rem>0 DO
		nwords: CARDINAL_MIN[256,rem/2];
		InlineDefs.LongCOPY[from: lpage, nwords: nwords, to: buf];
		[]_StreamDefs.WriteBlock[outStream,buf,nwords];
		rem_rem-2*nwords; lpage_lpage+256;
		IF rem=1 THEN SIGNAL Confusion;
		ENDLOOP;
	DeleteDataSegment[bufseg];
	END;

WriteFontDirectory: PROCEDURE RETURNS[startrec,nextrec: CARDINAL] =
	BEGIN
	f: Font;
	[]_SkipToNextRecord[];
	startrec_CurrentRecord[];
	FOR f IN Font DO
		IF fontsUsed[f] THEN WriteFontEntry[f];
		ENDLOOP;
	Wout[0]; -- to mark end of font directory
	[]_SkipToNextRecord[];
	nextrec_CurrentRecord[];
	AddPart[[fontPartType,startrec,nextrec-startrec,0]];
	END;

WriteFontEntry: PROCEDURE[f: Font] =
	BEGIN -- only include fonts that were actually used
	fp: POINTER TO TfmDefs.FontHeader _ TexFontDefs.FontHdr[f];
	fe: FontEntry;
	size: LONG CARDINAL;
	fe.length_SIZE[FontEntry];
	[fe.fontset,fe.fontnum]_FontSet[f];
	fe.m_0; fe.n_127;
	fe.fam_LOOPHOLE[fp.name];
	fe.face_fp.face;
	fe.source_0;
	size_fp.micasize;
	fe.size_InlineDefs.LowHalf[(size*36+635)/1270];  -- 36pts=1270micas
	fe.rotation_0;
	[]_StreamDefs.WriteBlock[outStream,@fe,SIZE[FontEntry]];
	END;

WritePartDirectory: PROCEDURE =
	BEGIN
	p: PartRecPtr;
	UNTIL (p_partlist)=NIL
		DO
		partlist_p.link;
		[]_StreamDefs.WriteBlock[outStream,@p.entry,SIZE[PartEntry]];
		TexMemDefs.FreeMem[p,SIZE[PartRec]];
		ENDLOOP;
	[]_SkipToNextRecord[];
	lastpart_NIL;
	END;

WriteDocDirectory: PROCEDURE [partrec, copies: CARDINAL] =
	BEGIN
	pt: TimeDefs.PackedTime _ TimeDefs.CurrentDayTime[];
	createtime: STRING _ [39];
	WoutBcplString: PROCEDURE[s: STRING, words: CARDINAL] =
		BEGIN
		i: CARDINAL;
		bytes: CARDINAL _ words*2;
		len: CARDINAL _ IF s.length+1 > bytes THEN bytes-1 ELSE s.length;
		Bout[len];
		FOR i IN [0..len) DO Bout[s[i]]; ENDLOOP; -- does len Bout's
		THROUGH (len..bytes) DO Bout[0]; ENDLOOP; -- does bytes-len-1 Bout's
		END;
	currec: CARDINAL _ CurrentRecord[];
	username: POINTER;
	usernamewords: CARDINAL;
	Wout[27183]; -- Press password
	Wout[currec+1]; -- total number of records in file including this one
	Wout[nparts]; -- number of parts
	Wout[partrec]; -- start of part directory
	Wout[currec-partrec]; -- number of records in part directory
	Wout[177777B]; -- back-pointer to obsolete document directory
	Wout[LOOPHOLE[pt,WordPair].h];
	Wout[LOOPHOLE[pt,WordPair].l]; -- packed time
	Wout[1]; Wout[copies]; -- first and last copy to print
	THROUGH [10..177B] DO Wout[177777B]; ENDLOOP; --unused
	-- file name
	WoutBcplString[fileName,26];
	-- creator's name
	username _ OsStaticDefs.OsStatics.UserName;
	usernamewords _ MIN[16,(LOOPHOLE[LOOPHOLE[username^,BytePair].l,CARDINAL]+1)/2];
	[]_StreamDefs.WriteBlock[outStream,username,usernamewords];
	THROUGH [usernamewords..16) DO Wout[0]; ENDLOOP;
	-- creation date
	createtime.length_0;
	TimeDefs.AppendFullDayTime[createtime, TimeDefs.UnpackDT[pt]];
	WoutBcplString[createtime,20];
	-- skip to end of record
	[]_SkipToNextRecord[];
	END;

StartPage: PROCEDURE =
	BEGIN
	i: EntityIndex;
	TexMemDefs.OpenZone[ozone];
	FOR i IN EntityIndex
		DO OPEN eState[i];
		elist_AllocList[elPages];
		dlist_AllocList[dlPages];
		pending_0; cx_cy_0; cf_0;
		ENDLOOP;
	en_0;
	END;

EndPage: PROCEDURE =
	BEGIN
	i: EntityIndex;
	FOR i IN EntityIndex
		DO OPEN eState[i];
		FreeList[elist];
		FreeList[dlist];
		ENDLOOP;
	[]_TexMemDefs.CloseZone[ozone];
	END;


-- A note on machine and implementation dependencies:
-- This module makes a number of assumptions about how Alto/Mesa
-- arranges bits.
-- 	a CARDINAL(=WORD) is 16 bits
--		a LONG INTEGER is two words, low-order word first
-- 	bytes are packed left to right in a PACKED ARRAY OF BYTE
-- 		e.g., data and entity lists
-- 	

BYTE: TYPE = [0..377B]; -- 8 bits
WORD: TYPE = CARDINAL; -- 16 bits
BytePair: TYPE = MACHINE DEPENDENT RECORD[l,r: BYTE]; -- left,right
WordPair: TYPE = MACHINE DEPENDENT RECORD[l,h: WORD]; -- low,high

ELByte: PROCEDURE[b: UNSPECIFIED] = --INLINE--
	BEGIN
	list: ListStatePtr _ eState[en].elist;
	PutByte[list,b];
	END;

ELWord: PROCEDURE[w: UNSPECIFIED] =
	BEGIN
	ELByte[LOOPHOLE[w,BytePair].l];
	ELByte[LOOPHOLE[w,BytePair].r];
	END;

ELDWord: PROCEDURE[d: LONG UNSPECIFIED] =
	BEGIN
	ELWord[LOOPHOLE[d,WordPair].h];
	ELWord[LOOPHOLE[d,WordPair].l];
	END;

DLByte: PROCEDURE[b: UNSPECIFIED, bump: BOOLEAN _ FALSE] =
	BEGIN OPEN eState[en];
	list: ListStatePtr _ dlist;
	PutByte[list,b];
	IF bump THEN pending_pending+1;
	END;

DLWord: PROCEDURE[w: UNSPECIFIED] =
	BEGIN
	DLByte[LOOPHOLE[w,BytePair].l];
	DLByte[LOOPHOLE[w,BytePair].r];
	END;

AddPart: PROCEDURE[part: PartEntry] =
	BEGIN
	p: PartRecPtr_TexMemDefs.AllocMem[SIZE[PartRec]];
	p^_[link: NIL, entry: part];
	IF lastpart=NIL THEN partlist_p ELSE lastpart.link_p;
	lastpart_p;
	nparts_nparts+1;
	END;

PutChar: PROCEDURE[c: Char] = INLINE
	BEGIN
	DLByte[c, TRUE];
	END;

Flush: PROCEDURE =
	BEGIN OPEN eState[en];
	n: CARDINAL_pending;
	IF n=0 THEN RETURN;
	WHILE n > 255
		DO ELByte[ELShowCharacters]; ELByte[255]; n _ n-255 ENDLOOP;
	IF n<=32 THEN ELByte[ELShowCharactersShort+n-1]
	ELSE BEGIN ELByte[ELShowCharacters]; ELByte[n] END;
	pending_0;
	END;

SetX: PROCEDURE[x: Dimn] =
	BEGIN OPEN eState[en];
	Flush; ELByte[ELSetX]; ELWord[cx_x];
	END;

SetY: PROCEDURE[y: Dimn] =
	BEGIN OPEN eState[en];
	yy: Dimn_pageHeight-y; -- invert y direction
	-- note the assumption that ShowCharacters does not change y
	IF yy#cy THEN
		BEGIN Flush; ELByte[ELSetY]; ELWord[cy_yy] END;
	END;

PutRectangle: PROCEDURE[x,y,h,w: Dimn] =
	-- x,y specify the upper left corner
	-- h,w specify height and width
	BEGIN OPEN eState[en];
	en_1; -- all rectangles go into entity 1
	Flush;
	SetX[x]; SetY[y+h]; -- lower left corner
	ELByte[ELShowRectangle]; ELWord[w]; ELWord[h];
	END;

FontSet: PROCEDURE[f: Font] RETURNS[set,font: CARDINAL] =
-- this procedure maps from a TEX Font number to
-- the corresponding Press font set / font number
	BEGIN
	set_f/16; font_f MOD 16;
	END;

SetFont: PROCEDURE[f: Font] =
	BEGIN OPEN eState[en]; -- note: this changes if en changes
	s,t: CARDINAL;
	[set: s, font: t]_FontSet[f];
	en_s; -- switch entities if necessary
	-- now change fonts if necessary
	IF cf#t THEN BEGIN Flush; ELByte[ELFont+(cf_t)] END;
	fontsUsed[f]_TRUE;
	END;


etypeTEX: CARDINAL=125; -- arbitrary entity type code for TEX

ETrailer: PROCEDURE[n: EntityIndex, beginbyte,bytelength: LONG INTEGER] =
	BEGIN OPEN eState[en];
	en_n; -- set current entity number
	Flush; -- don't forget to flush out pending characters!
	IF elist.count=0 THEN RETURN; -- empty entity
	IF (elist.count MOD 2)#0 THEN ELByte[ELNop]; -- pad to word boundary
	ELByte[etypeTEX]; -- entity type
	ELByte[en]; -- font set
	ELDWord[beginbyte]; -- beginning of DL region
	ELDWord[bytelength]; -- length of DL region
	ELWord[0]; ELWord[0]; -- origin (Xe,Ye)
	ELWord[0]; ELWord[0]; -- bottom left corner of bounding box
	ELWord[pageWidth]; ELWord[pageHeight]; -- dimensions of bounding box
	ELWord[elist.count/2+1]; -- entity length in WORDS [including this number]
	-- Assertion: the entity now contains an even number of bytes
	END;

VlistOut: PROCEDURE[p: BoxNodePtr, x,y: Dimn] =
	-- x,y give top,left corner for placing box
	BEGIN
	qq, qptr: NodePtr;

	qq_p.head;
	WHILE qq#NIL
		-- qptr is used so that q is not invalidated if qq changes
		DO
		qptr_qq;
		WITH q:qptr SELECT FROM
		char =>
			BEGIN OPEN q;
			y_y+TexFontDefs.CharHt[c];
			SetFont[c.font]; -- DO THIS FIRST! (may switch entity lists)
			SetX[x]; SetY[y]; PutChar[c.char];
			y_y+TexFontDefs.CharDp[c];
			END;
		glue => y_y+TexGlueDefs.FixGlue[q.g, p.glueset];
		space, kern => y_y+q.s; -- for kerning
		rule =>
			BEGIN
			h: Dimn_q.height+q.depth;
			w: Dimn_IF q.width<0 THEN p.width ELSE q.width;
			PutRectangle[x,y,h,w];
			y_y+h;
			END;
		box => SELECT q.dir FROM
			vlist =>
				BEGIN
				VlistOut[@q,x+q.shiftamt,y];
				y_y+q.height+q.depth;
				END;
			hlist =>
				BEGIN
				y_y+q.height; -- baseline
				HlistOut[@q,x+q.shiftamt,y];
				y_y+q.depth;
				END;
			ENDCASE => ERROR;
		leader =>
			BEGIN
			s: Dimn; -- space to be filled with leaders
			yend: Dimn; -- final y value
			gptr: NodePtr_q.link; -- pointer to node following leader Node
			IF gptr=NIL THEN
				BEGIN SIGNAL Confusion; GOTO Exit END;
			WITH g:gptr SELECT FROM -- should be glue node
				glue =>
					BEGIN
					s_TexGlueDefs.FixGlue[g.g, p.glueset];
					qq_gptr;
					END;
				ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
			yend_y+s;
			WITH b:q.p SELECT FROM -- should be rule or box
				box =>
					BEGIN
					hh: Dimn_b.height+b.depth; -- box height
					t: INTEGER; -- quotient
					IF hh<=0 THEN GOTO Exit;
					t_y/hh;
					y_hh*(t+1); -- the smallest suitable multiple of hh
					SELECT b.dir FROM
						hlist => WHILE y+hh<=yend
							DO HlistOut[@b,x,y+b.height]; y_y+hh ENDLOOP;
						vlist => WHILE y+hh<=yend
							DO VlistOut[@b,x,y]; y_y+hh ENDLOOP;
						ENDCASE => ERROR;
					END;
				rule => PutRectangle[x,y,s,b.width]; -- variable vertical rule
					-- note: ignores height and depth of rule
				ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
			y_yend;
			EXITS Exit => NULL END;
		ENDCASE => NULL; -- ignore all other types of nodes
		qq_qq.link; -- NOT q.link; qq may have been changed!
		ENDLOOP;
	END;

HlistOut: PROCEDURE[p: BoxNodePtr, x,y: Dimn] =
	-- x,y are left,baseline for box
	BEGIN
	qq, qptr: NodePtr;

	qq_p.head;
	WHILE qq#NIL
		-- qptr is used so that q is not invalidated if qq changes
		DO
		qptr_qq;
		WITH q:qptr SELECT FROM
		char =>
			BEGIN
			SetFont[q.c.font]; -- do this first. might switch entites
			SetX[x]; SetY[y]; PutChar[q.c.char];
			x_x+TexFontDefs.CharWd[q.c];
			END;
		string =>
			BEGIN
			f: Font;
			c: Char;
			i: CARDINAL;
			SetFont[f_q.font]; -- do this first. might switch entites
			SetX[x]; SetY[y];
			FOR i IN[0..q.length)
				DO
				PutChar[c_q.text[i]];
				x_x+TexFontDefs.CharWd[[f,c]];
				ENDLOOP;
			END;
		glue => x_x+TexGlueDefs.FixGlue[q.g, p.glueset];
		space, kern => x_x+q.s;
		rule =>
			BEGIN
			h: Dimn_IF q.height<0 THEN p.height ELSE q.height;
			d: Dimn_IF q.depth<0 THEN p.depth ELSE q.depth;
			w: Dimn_q.width;
			PutRectangle[x,y-h,h+d,w];
			x_x+w;
			END;
		box => SELECT q.dir FROM
			vlist =>
				BEGIN
				VlistOut[@q,x,y-q.height+q.shiftamt];
				x_x+q.width;
				END;
			hlist =>
				BEGIN
				HlistOut[@q,x,y+q.shiftamt];
				x_x+q.width;
				END;
			ENDCASE => ERROR;
		leader =>
			BEGIN
			s: Dimn; -- space to be filled with leaders
			xend: Dimn; -- final x value
			gptr: NodePtr_q.link; -- pointer to node following leader Node
			IF gptr=NIL THEN
				BEGIN SIGNAL Confusion; GOTO Exit END;
			WITH g:q.link SELECT FROM -- should be glue node
				glue =>
					BEGIN
					s_TexGlueDefs.FixGlue[g.g, p.glueset];
					qq_gptr;
					END;
				ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
			xend_x+s;
			WITH b:q.p SELECT FROM -- should be rule or box
				box =>
					BEGIN
					ww: Dimn_b.width; -- box width
					t: INTEGER; -- quotient
					IF ww<=0 THEN GOTO Exit;
					t_x/ww;
					x_ww*(t+1); -- the smallest suitable multiple of ww
					SELECT b.dir FROM
						hlist => WHILE x+ww<=xend
							DO HlistOut[@b,x,y]; x_x+ww ENDLOOP;
						vlist => WHILE x+ww<=xend
							DO VlistOut[@b,x,y-b.height]; x_x+ww ENDLOOP;
						ENDCASE => ERROR;
					END;
				rule => PutRectangle[x,y-b.height,b.height+b.depth,s]; -- variable horizontal rule
					-- note: ignores width of rule
				ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
			x_xend;
			EXITS Exit => NULL END;
		ENDCASE => NULL; -- ignore all other types of nodes
		qq_qq.link; -- NOT q.link; qq may have been changed!
		ENDLOOP;
	END;

SkipToNextRecord: PROCEDURE RETURNS[i: CARDINAL] =
	BEGIN -- result is number of bytes skipped
	index: StreamDefs.StreamIndex;
	-- make sure output file is open
	index_StreamDefs.GetIndex[outStream];
	i_AltoDefs.CharsPerPage-StreamDefs.NormalizeIndex[index].byte;
	IF i=AltoDefs.CharsPerPage THEN i_0 -- no skip needed
	ELSE StreamDefs.SetIndex[outStream,StreamDefs.ModifyIndex[index,i]];
	IF (StreamDefs.GetIndex[outStream].byte MOD AltoDefs.CharsPerPage)#0 THEN ERROR;
	END;

CurrentRecord: PROCEDURE RETURNS[CARDINAL] =
	BEGIN -- first record of file is numbered 0
	RETURN [StreamDefs.NormalizeIndex[StreamDefs.GetIndex[outStream]].page]
	END;

-- the main output procedure, produces one page
ShipOut: PUBLIC PROCEDURE[p: BoxNodePtr] =
	BEGIN
	e: EntityIndex;
	padding: CARDINAL;
	startrec: CARDINAL;
	n: CARDINAL;
	lastcount: LONG CARDINAL;

	IF needToInit THEN BEGIN SIGNAL Confusion; RETURN END;

	IF outStream=nullStream THEN
		BEGIN
		-- get the output file name and open the output stream
		TexSynDefs.AppendOutputFileName[fileName,"TexOut"];
		TexStringDefs.AppendString[fileName,".Press"];
		outStream_StreamDefs.NewByteStream[name: fileName,
					access: StreamDefs.Write+StreamDefs.Append];
		END;

	IF display AND displayPages THEN -- display it
		BEGIN OPEN TexDispDefs;
		DisplayPage[p, leftMargin/2, topMargin/2, unitScaling];
		END;

	-- position stream at start of record
	[]_SkipToNextRecord[];
	startrec_CurrentRecord[];
	
	StartPage;
	VlistOut[p, leftMargin, topMargin]; -- make data and entity lists

	-- write data lists
	FOR e IN EntityIndex
		DO OPEN eState[en];
		en_e;
		IF (dlist.count MOD 2)#0 THEN DLByte[0]; -- pad to word boundary
		WriteList[dlist]; -- flush the buffer
		ENDLOOP;
	-- construct entity trailers
	lastcount_0;
	FOR e IN EntityIndex
		DO
		n_eState[e].dlist.count;
		ETrailer[e, lastcount, n];
		lastcount_lastcount+n;
		ENDLOOP;
	Wout[0]; -- zero word to mark beginning of entity lists
	-- write entity lists
	FOR e IN EntityIndex
		DO OPEN eState[en];
		en_e; WriteList[elist]; -- ETrailer padded to word
		ENDLOOP;
	-- pad record
	padding_SkipToNextRecord[]/2; -- in words

	-- create part entry and fill it in
	AddPart[[pagePartType,startrec,CurrentRecord[]-startrec,padding]];

	EndPage;
	END;

Bout: PROCEDURE[b: UNSPECIFIED] =
	BEGIN
	outStream.put[outStream, b];
	END;

Wout: PROCEDURE[w: UNSPECIFIED] =
	BEGIN -- stream should be positioned at a word boundary
	[]_StreamDefs.WriteBlock[outStream,@w,1];
	END;

END.(670)