DIRECTORY
InlineDefs: FROM "inlinedefs" USING
	[LongMult,LongDiv,LowHalf,HighHalf,BITAND,LDIVMOD,BITXOR,COPY],
MiscDefs: FROM "MiscDefs" USING [Zero],
OsStaticDefs: FROM "osstaticdefs",
PressDefs: FROM "PressDefs" USING [PressFileDescriptor,ELCommand,DocDir,PartDir,
	EntityCommandTrailer,MicaWidth,MicaHeight,Page,Font,ExternalFileDirectory,
	FontEntry,FontDir,PressPassword,PressDotsData,
	ELShowCharactersShort,ELSkipCharactersShort,
	ELShowCharactersAndSkip,ELSetSpaceXShort,ELSetSpaceYShort,ELFont,
	ELSkipControlBytesImmediate,ELAlternative,ELOnlyOnCopy,ELSetX,ELSetY,
	ELShowCharacters,ELSkipCharacters,ELSkipControlBytes,ELShowCharacterImmediate,
	ELSetSpaceX,ELSetSpaceY,ELResetSpace,ELSpace,ELSetBrightness,ELSetHue,
	ELSetSaturation,ELShowObject,ELShowDots,ELShowDotsOpaque,ELShowRectangle,
	ELNop,DLSetCoding,DLSetMode,DLSetSize,DLDotsFollow,DLGetDotsFromFile,
	DLSetSamplingProperties,DLSSPInputIntensity,DLSSPScreen,DLSetWindow,
	DLMoveTo,DLDrawTo,DLDrawCurve],
StreamDefs: FROM "StreamDefs" USING
	[CleanupDiskStream,WriteBlock,StreamHandle,StreamIndex,GetIndex,NewByteStream,
	Read,Write,Append,ReadBlock],
StringDefs: FROM "stringdefs",
SystemDefs: FROM "SystemDefs",
TimeDefs: FROM "timedefs";

PressOut: PROGRAM IMPORTS  MiscDefs, InlineDefs, SystemDefs, StreamDefs, StringDefs, t:TimeDefs EXPORTS PressDefs =
BEGIN OPEN PressDefs, StreamDefs, InlineDefs;
--these guys should be per PressFileDescriptor
entitySegment: TYPE = RECORD
 [	link: POINTER TO entitySegment,
	length: CARDINAL,
	beginByte,endByte: LONG CARDINAL
 ];
entitySegmentHead: POINTER TO entitySegment;
lastSetX,lastSetY,lastFont,lastSpaceX,lastSpaceY: CARDINAL _ 0;
maxEntitySegment: CARDINAL _ 16000;
externalFileStrings: ARRAY[0..100) OF STRING;
nExternalFileStrings: CARDINAL _ 0;

--Procedures

CopyBCPLString: PUBLIC PROCEDURE  [BCPLString: POINTER TO PACKED ARRAY [0..100) OF CHARACTER, mesaString: STRING] =
	BEGIN
	i: CARDINAL;
	BCPLString[0]_LOOPHOLE[mesaString.length];
	FOR i IN [0..mesaString.length)
		DO
		BCPLString[i+1]_mesaString[i];
		ENDLOOP;
	END;

MulDiv: PUBLIC PROCEDURE [a,b,c:CARDINAL] RETURNS [CARDINAL] =
BEGIN
	al: LONG CARDINAL _ LongMult[a,b];
	RETURN[LongDiv[al,c]];
END;

SignedMulDiv: PUBLIC PROCEDURE [a,b,c:INTEGER] RETURNS [INTEGER] =
BEGIN 
	rslt: INTEGER;
	sgn: INTEGER _ BITXOR[BITXOR[a,b],c];	--Sign bit;
	rslt _ MulDiv[ABS[a],ABS[b],ABS[c]];
	IF sgn < 0 THEN RETURN[-rslt];
	RETURN[rslt];
END;

SetBlock: PUBLIC PROCEDURE [buf: POINTER TO ARRAY [0..0) OF INTEGER,val,len: INTEGER] =
BEGIN
	buf[0]_val;
	COPY[to: @buf+1,from: @buf,nwords: len-1];
END;

WriteCommand: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,Command: CARDINAL,Param: POINTER TO ARRAY [0..6) OF CARDINAL] =
BEGIN
es: StreamHandle _ LOOPHOLE[p.EntityCommands];
i: CARDINAL;

	Stuff1: PROCEDURE [Argument: CARDINAL] =
	BEGIN
		p.EntityCommandLen _ p.EntityCommandLen+1;
		es.put[es,Argument]; --p.EntityCommands[p.EntityCommandLen]_Argument;
	END;

	Stuff2: PROCEDURE [Argument: CARDINAL] =
	BEGIN
		es.put[es,Argument/256];
			--p.EntityCommands[p.EntityCommandLen+1]_Argument/256;
		p.EntityCommandLen _ p.EntityCommandLen + 2;
		es.put[es,Argument]; --p.EntityCommands[p.EntityCommandLen]_Argument;
	END;

	SELECT Command FROM
		--standard "short" command
		ELFont	=>	
			BEGIN lastFont _ Param[0];Stuff1[Command+Param[0]];END;

		--standard "short-1" commands
		ELShowCharactersShort,
			ELSkipCharactersShort,
			ELShowCharactersAndSkip=>
			Stuff1[Command+Param[0]-1];

		--strange and puzzling set space short stuff
		ELSetSpaceXShort =>
			BEGIN lastSpaceX _ Param[0];Stuff2[Command*256+Param[0]];END;
		ELSetSpaceYShort =>
			BEGIN lastSpaceY _ Param[0];Stuff2[Command*256+Param[0]];END;

		--commands with no parameters
		ELResetSpace =>
			BEGIN lastSpaceX _ lastSpaceY _ 0;Stuff1[Command];END;
		ELSpace,ELNop	=>
			Stuff1[Command];

		--commands with a single byte parameter
		ELShowCharacters,
			ELShowCharacterImmediate,
			ELSkipCharacters,
			ELSkipControlBytesImmediate,
			ELSetBrightness,
			ELSetHue,ELSetSaturation,
			ELOnlyOnCopy	=>	
			BEGIN
			Stuff1[Command];
			Stuff1[Param[0]];
			END;

		--commands with two bytes of parameters
		ELSetSpaceX =>
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			lastSpaceX _ Param[0];
			END;
		ELSetSpaceY =>
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			lastSpaceY _ Param[0];
			END;
		ELSetX =>
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			lastSetX _ Param[0];
			END;
		ELSetY =>
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			lastSetY _ Param[0];
			END;
		ELShowObject =>
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			END;

		--commands with [2 bytes] [1 byte]
		ELSkipControlBytes =>
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			Stuff1[Param[1]];
			END;

		--commands with 4 bytes
		ELShowRectangle,ELShowDots,
			ELShowDotsOpaque	=>	
			BEGIN
			Stuff1[Command];
			Stuff2[Param[0]];
			Stuff2[Param[1]];
			END;

		--and the real long stuff
		ELAlternative	=>	
			BEGIN
			Stuff1[Command];
			FOR i IN [0..4] DO Stuff2[Param[i]]; ENDLOOP;
			END;
		ENDCASE;

IF p.EntityCommandLen > maxEntitySegment THEN
	BEGIN
	h: CARDINAL _ p.CurHue;
	s: CARDINAL _ p.CurSat;
	b: CARDINAL _ p.CurBright;
	NewEntitySegment[p];
	WriteCommand[p,ELSetX,LOOPHOLE[@lastSetX]];
	WriteCommand[p,ELSetY,LOOPHOLE[@lastSetY]];
	WriteCommand[p,ELSetHue,LOOPHOLE[@h]];
	WriteCommand[p,ELSetSaturation,LOOPHOLE[@s]];
	WriteCommand[p,ELSetBrightness,LOOPHOLE[@b]];
	WriteCommand[p,ELFont,LOOPHOLE[@lastFont]];
	IF lastSpaceX#0 THEN WriteCommand[p,ELSetSpaceX,LOOPHOLE[@lastSpaceX]];
	IF lastSpaceY#0 THEN WriteCommand[p,ELSetSpaceY,LOOPHOLE[@lastSpaceY]];
	END;

END;


WriteDirectory: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
	d: DocDir;
	dayTime: t.PackedTime _ t.CurrentDayTime[];
	MiscDefs.Zero[@d,SIZE[DocDir]];
	d.Password_PressPassword;
	d.nRecs_p.RecordStart+p.fontLen+p.partLen+1;
	d.nParts_p.numParts;
	d.partDirStart_p.RecordStart+p.fontLen;
	d.partLength_p.partLen;
	d.date _ LowHalf[dayTime]*200000B + HighHalf[dayTime];
	d.firstCopy_p.FirstCopy;
	d.lastCopy_p.LastCopy;
	d.firstPage_-1;
	d.lastPage_-1;
	d.solidCode_p.solidCode;
	CopyBCPLString[LOOPHOLE[@d.fileName],p.PressFileName];
	CopyBCPLString[LOOPHOLE[@d.userName],p.UserName];
	CopyBCPLString[LOOPHOLE[@d.dateString],p.DateString];
	[]_WriteBlock[p.outStream,@d,SIZE[DocDir]];
END;

SetSpaceX: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, micaX: CARDINAL] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;
IF p.CurSpaceX = micaX THEN RETURN;
param[0] _ micaX;
WriteCommand[p,ELSetSpaceX,@param];
p.CurSpaceX _ micaX;
END;

SetSpaceY: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, micaY: CARDINAL] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;
IF p.CurSpaceY = micaY THEN RETURN;
param[0] _ micaY;
WriteCommand[p,ELSetSpaceY,@param];
p.CurSpaceY _ micaY;
END;

SetColor: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, hue,sat,bright: [0..256)] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;

IF hue#p.CurHue THEN
	BEGIN
	param[0]_hue;
	p.CurHue_hue;
	WriteCommand[p,ELSetHue,@param];
	END;
IF sat#p.CurSat THEN
	BEGIN
	param[0]_sat;
	WriteCommand[p,ELSetSaturation,@param];
	p.CurSat_sat;
	END;
IF bright#p.CurBright THEN
	BEGIN
	param[0]_bright;
	WriteCommand[p,ELSetBrightness,@param];
	p.CurBright_bright;
	END;
END;

SetHue: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, hue: [0..256)] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;

IF hue#p.CurHue THEN
	BEGIN
	param[0]_hue;
	p.CurHue_hue;
	WriteCommand[p,ELSetHue,@param];
	END;
END;

SetSaturation: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, sat: [0..256)] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;

IF sat#p.CurSat THEN
	BEGIN
	param[0]_sat;
	WriteCommand[p,ELSetSaturation,@param];
	p.CurSat_sat;
	END;
END;

SetBrightness: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, bright: [0..256)] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;

IF bright#p.CurBright THEN
	BEGIN
	param[0]_bright;
	WriteCommand[p,ELSetBrightness,@param];
	p.CurBright_bright;
	END;
END;

SetFont: PUBLIC PROCEDURE [p: POINTER TO PressDefs.PressFileDescriptor,Name: STRING,PointSize: CARDINAL,Face: CARDINAL _ 0,Rotation: CARDINAL _ 0] =
BEGIN
UC: ARRAY CHARACTER ['a..'z] OF CHARACTER =
		['A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M,'N,'O,'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z];
FBuf: POINTER TO PressDefs.FontEntry;
s: STRING;
i: CARDINAL;
param: ARRAY [0..6) OF CARDINAL;

FOR i IN [0..Name.length) 
	DO IF Name[i] IN ['a..'z] THEN Name[i] _ UC[Name[i]]; ENDLOOP;
FOR i IN [0..p.numFonts) DO
	FBuf _ p.fontDir[i];
	IF StringDefs.EqualString[Name,FBuf.Family] AND
		Face = FBuf.Face AND
		PointSize = FBuf.Size AND
		Rotation = FBuf.Rotation THEN 
			BEGIN
			param[0] _ i;
			WriteCommand[p,ELFont,@param];
			RETURN;
			END;
ENDLOOP;
IF p.numFonts = 15 THEN ERROR; --whoops, no space

--grab free storage, and go
FBuf _ SystemDefs.AllocateHeapNode[SIZE[PressDefs.FontEntry]];
s _ SystemDefs.AllocateHeapString[20];
FBuf.EntryLength_16;
FBuf.FontSet_0;
FBuf.Font_p.numFonts;
FBuf.M_0;FBuf.N_127;
StringDefs.AppendString[s,Name];
FBuf.Family_s;
FBuf.Face_Face;
FBuf.Source_0;
FBuf.Size_PointSize;
FBuf.Rotation_Rotation;
p.fontDir[p.numFonts]_FBuf;
p.numFonts_p.numFonts+1;

param[0] _ p.numFonts-1;
WriteCommand[p,ELFont,@param];
END;

PutText: PUBLIC PROCEDURE[p: POINTER TO PressFileDescriptor,str: STRING,xleft,ybase: CARDINAL] =
BEGIN
s: StreamHandle _ p.outStream;
param: ARRAY [0..6) OF CARDINAL;
i: CARDINAL;

param[0]_xleft;WriteCommand[p,ELSetX,@param];
param[0]_ybase;WriteCommand[p,ELSetY,@param];
IF p.numFonts = 0 THEN SetFont[p,"Gacha",8];
FOR i IN [0..str.length) DO s.put[s,str[i]]; ENDLOOP;
param[0] _ str.length;
WriteCommand[p,ELShowCharacters,@param];
END;

PutRectangle: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor, xstart,ystart,xlen,ylen: CARDINAL] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;

param[0]_xstart;WriteCommand[p,ELSetX,@param];
param[0]_ystart;WriteCommand[p,ELSetY,@param];
param[0]_xlen;
param[1]_ylen;
WriteCommand[p,ELShowRectangle,@param];
END;

nw: CARDINAL;
sl: POINTER;
ScanInitMem: PROCEDURE [mem: POINTER, nWordsPerLine: CARDINAL ]=
BEGIN
nw _ nWordsPerLine;
sl _ mem;
END;
nextScanLineMem: PROCEDURE RETURNS [POINTER] =
BEGIN
mem: POINTER _ sl;
sl _ sl+nw;
RETURN[mem];
END;

PutAltoDots: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,
	x,y,nDots,nScanLines: CARDINAL,dots: POINTER] =
BEGIN
PutDots[p,x,y,nDots,nScanLines,0,nDots*32,nScanLines*32,dots];
END;

PutDots: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,
	x,y,nPixels,nScanLines,bitsPerPixel,width,height: CARDINAL,dots: POINTER,
	screenFrequency: CARDINAL _ 0,screenAngle: CARDINAL _ 45] =
BEGIN
pdd: PressDefs.PressDotsData _
 [	nBitsPerPixel: bitsPerPixel,nPixels: nPixels,nLines: nScanLines,
	passPixels: 0,displayPixels: nPixels,passLines: 0,displayLines: nScanLines,
	micaWidth: width,micaHeight: height,
	min: 0,max: 0,
	angle: screenAngle,frequency: screenFrequency,
	opaque: FALSE,haveDot: FALSE,mode: 3,fileName: NIL,
	dotPosition: ,diskPosition:
 ];
ScanInitMem[dots,nPixels/(16/MIN[1,bitsPerPixel])];
PutPressDotsData[p,x,y,@pdd,nextScanLineMem];
END;

PutComputedDots: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,
	x,y,nPixels,nScanLines,bitsPerPixel,width,height: CARDINAL,
	nextScanLine: PROCEDURE RETURNS [POINTER],
	screenFrequency: CARDINAL _ 0,screenAngle: CARDINAL _ 45,
	min,max: CARDINAL _ 0]=
BEGIN
pdd: PressDefs.PressDotsData _
 [	nBitsPerPixel: bitsPerPixel,nPixels: nPixels,nLines: nScanLines,
	passPixels: 0,displayPixels: nPixels,passLines: 0,displayLines: nScanLines,
	micaWidth: width,micaHeight: height,
	min: min,max: max,
	angle: screenAngle,frequency: screenFrequency,
	opaque: FALSE,haveDot: FALSE,mode: 3,fileName: NIL,
	dotPosition: ,diskPosition:
 ];
PutPressDotsData[p,x,y,@pdd,nextScanLine];
END;

PutDotsFromFile: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,
	x,y,nPixels,nScanLines,bitsPerPixel,width,height: CARDINAL,dots: STRING,
	screenFrequency: CARDINAL _ 0,screenAngle: CARDINAL _ 45,
	min,max: CARDINAL _ 0] =
BEGIN
pdd: PressDefs.PressDotsData _
 [	nBitsPerPixel: bitsPerPixel,nPixels: nPixels,nLines: nScanLines,
	passPixels: 0,displayPixels: nPixels,passLines: 0,displayLines: nScanLines,
	micaWidth: width,micaHeight: height,
	min: min,max: max,
	angle: screenAngle,frequency: screenFrequency,
	opaque: FALSE,haveDot: FALSE,mode: 3,fileName: dots,
	dotPosition: ,diskPosition:
 ];
PutPressDotsData[p,x,y,@pdd,];
END;

PutPressDotsData: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,
	x,y: CARDINAL,dotsData: POINTER TO PressDefs.PressDotsData,
	nextScanLine: PROCEDURE RETURNS[POINTER]] =
BEGIN
s: StreamHandle _ p.outStream;
pixelsPerWord: CARDINAL _ 16/MAX[dotsData.nBitsPerPixel,1];
displayPixels: CARDINAL _ IF dotsData.fileName=NIL THEN dotsData.displayPixels
	ELSE dotsData.nPixels; 
displayLines: CARDINAL _ IF dotsData.fileName=NIL THEN dotsData.displayLines
	ELSE dotsData.nLines; 
passPixels: CARDINAL _ IF dotsData.fileName#NIL THEN dotsData.passPixels
	ELSE dotsData.passPixels MOD pixelsPerWord; 
passLines: CARDINAL _ IF dotsData.fileName#NIL THEN dotsData.passLines
	ELSE 0; 
nWordsPerScanline: CARDINAL _ 
	((passPixels+displayPixels)*MAX[dotsData.nBitsPerPixel,1]+15)/16;
nWords: LONG CARDINAL _ LONG[nWordsPerScanline]*displayLines;
additionalWords: CARDINAL _ 0;
MaxTable: ARRAY [0..8] OF CARDINAL _ [1,1,3,7,15,31,63,127,255];
param: ARRAY [0..6) OF CARDINAL;

--set up scan lines to end on word boundaries
nPixels: CARDINAL _
	InlineDefs.BITAND[passPixels+displayPixels+pixelsPerWord-1,-pixelsPerWord];

param[0]_x;WriteCommand[p,ELSetX,@param];
param[0]_y;WriteCommand[p,ELSetY,@param];

IF dotsData.displayPixels = 0 OR dotsData.displayLines = 0 THEN RETURN;
IF BITAND[GetIndex[s].byte,1] = 1 THEN 
	BEGIN s.put[s,0];param[0]_1;WriteCommand[p,ELSkipCharactersShort,@param];END;

s.put[s,DLSetCoding];s.put[s,dotsData.nBitsPerPixel];
[] _ WriteBlock[s,@nPixels,1];[] _ WriteBlock[s,@displayLines,1];
s.put[s,DLSetMode];s.put[s,dotsData.mode];
s.put[s,0];s.put[s,DLSetSize];
[] _ WriteBlock[s,@dotsData.micaWidth,1];
[] _ WriteBlock[s,@dotsData.micaHeight,1];
IF dotsData.frequency # 0 THEN
	BEGIN
	s.put[s,0];s.put[s,DLSetSamplingProperties];
	s.put[s,0];s.put[s,7];	--7 words of property stuff
	s.put[s,0];s.put[s,DLSSPScreen];
	[] _ WriteBlock[s,@dotsData.angle,1];
	s.put[s,0];s.put[s,100];
	[] _ WriteBlock[s,@dotsData.frequency,1];
	s.put[s,0];s.put[s,DLSSPInputIntensity];
	[] _ WriteBlock[s,@dotsData.min,1];
	[] _ WriteBlock[s,IF dotsData.max=0 THEN @MaxTable[dotsData.nBitsPerPixel] 
		ELSE @dotsData.max,1];
	additionalWords _ additionalWords + 9;
	END;

s.put[s,0];s.put[s,DLSetWindow];
[] _ WriteBlock[s,@passPixels,1];
[] _ WriteBlock[s,@dotsData.displayPixels,1];
[] _ WriteBlock[s,@passLines,1];
[] _ WriteBlock[s,@dotsData.displayLines,1];
additionalWords _ additionalWords + 5;

s.put[s,0];
IF dotsData.fileName=NIL THEN
	BEGIN
	s.put[s,DLDotsFollow];
	THROUGH [0..dotsData.passLines) DO [] _ nextScanLine[];ENDLOOP;
	THROUGH[0..dotsData.displayLines) DO
		[] _ WriteBlock[s,nextScanLine[]+dotsData.passPixels/pixelsPerWord,
				nWordsPerScanline];
	ENDLOOP;
	param[0] _ HighHalf[nWords+8+additionalWords];
	param[1] _ LowHalf[nWords+8+additionalWords];
	END
ELSE
	BEGIN
	dots: STRING _ dotsData.fileName;
	nBytes: CARDINAL _ 
		dots.length + (1-BITAND[dots.length,1]);
	i: CARDINAL;
	found: BOOLEAN _ FALSE;
	
	FOR i IN [0..nExternalFileStrings) DO
		IF StringDefs.EquivalentStrings[externalFileStrings[i],dots] THEN
			BEGIN found _ TRUE;EXIT;END;
	ENDLOOP;
	
	IF NOT found THEN
		BEGIN
		externalFileStrings[nExternalFileStrings] _
					SystemDefs.AllocateHeapString[dots.length];
		StringDefs.AppendString[from: dots,to: externalFileStrings[nExternalFileStrings]];
		nExternalFileStrings _ nExternalFileStrings + 1;
		END;
	s.put[s,DLGetDotsFromFile];	
	s.put[s,0];s.put[s,4];		--record offset = 4 (1024 word header)
	s.put[s,dots.length];	
	FOR i IN [0..nBytes) DO s.put[s,dots[i]] ENDLOOP;
	param[0] _ 0;
	param[1] _ ((nBytes+1)/2)+9+additionalWords;
	END;

WriteCommand[p,
	IF dotsData.opaque THEN ELShowDotsOpaque ELSE ELShowDots,@param];
END;

BytePos: PROCEDURE [s: StreamHandle] RETURNS [l: LONG CARDINAL] =
BEGIN
strmIndex: StreamIndex;
strmIndex_GetIndex[s];
l _ strmIndex.page;
l _ (strmIndex.byte + l*512);
END;

NewEntitySegment: PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
esh,segmentQ: POINTER TO entitySegment;
offset: LONG CARDINAL _ LONG[p.RecordStart]*512;
es: StreamHandle _ LOOPHOLE[p.EntityCommands];
IF (p.EntityCommandLen MOD 2)=1 THEN 
	BEGIN es.put[es,ELNop];p.EntityCommandLen_p.EntityCommandLen+1;END;
esh _ SystemDefs.AllocateHeapNode[SIZE[entitySegment]];
esh^ _ [link: NIL,length: p.EntityCommandLen,beginByte:,
	endByte: BytePos[p.outStream]-offset];
IF entitySegmentHead = NIL THEN 
	BEGIN
	esh.beginByte _ 0;
	entitySegmentHead _ esh;
	END
ELSE
	BEGIN
	segmentQ _ entitySegmentHead;
	UNTIL segmentQ.link = NIL DO segmentQ _ segmentQ.link;ENDLOOP;
	segmentQ.link _ esh;
	esh.beginByte _ segmentQ.endByte;
	END;
p.EntityCommandLen _ 0;
END;

WritePage: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
s: StreamHandle _ p.outStream;
es: StreamHandle _ LOOPHOLE[p.EntityCommands];
ECommand: EntityCommandTrailer;
startPos,byteLen,entityLen: LONG INTEGER;
padding,recordLen: INTEGER;
segmentQWordLen: CARDINAL;
segmentQ: POINTER TO entitySegment;
buffer: ARRAY [0..256) OF UNSPECIFIED;

IF (GetIndex[s].byte MOD 2)=1 THEN s.put[s,0];
startPos_p.RecordStart;
startPos_startPos*512;
byteLen _ BytePos[s] - startPos;
--first, insert a zero word
s.put[s,0];s.put[s,0];
entityLen_(byteLen/2)+1;

NewEntitySegment[p];
CleanupDiskStream[es];
es.reset[es];

FOR segmentQ _ entitySegmentHead,segmentQ.link UNTIL segmentQ = NIL DO
	segmentQWordLen _ segmentQ.length/2;
	UNTIL segmentQWordLen = 0 DO
		[] _ ReadBlock[es,@buffer,MIN[256,segmentQWordLen]];
		[] _ WriteBlock[s,@buffer,MIN[256,segmentQWordLen]];
		segmentQWordLen _ segmentQWordLen-MIN[256,segmentQWordLen];
	ENDLOOP;
--	THROUGH [1..segmentQ.length] DO s.put[s,es.get[es]];ENDLOOP;
	
	startPos _ segmentQ.beginByte;
	byteLen _ segmentQ.endByte - startPos;
	ECommand _
		[Type: 0, FontSet: 0,
			BeginByte: [HighHalf[startPos],LowHalf[startPos]],
			ByteLen: [HighHalf[byteLen],LowHalf[byteLen]],Xe: 0,Ye: 0,
			Left: 0,Bottom: 0,Width: MicaWidth,Height: MicaHeight,
			EntityLen: SIZE[EntityCommandTrailer] +
															segmentQ.length/2
		];	
	[]_WriteBlock[s,@ECommand,SIZE[EntityCommandTrailer]];
	entityLen_entityLen+ECommand.EntityLen;
ENDLOOP;
DO
	segmentQ _ entitySegmentHead;
	entitySegmentHead _ segmentQ.link;
	SystemDefs.FreeHeapNode[segmentQ];
	IF entitySegmentHead = NIL THEN EXIT;
ENDLOOP;
es.reset[es];

--now, compute (and write) padding, update part directory
padding_BITAND
	[256-BITAND[LowHalf[entityLen],377B],377B];
[recordLen,]_LDIVMOD[numlow: LowHalf[entityLen],
											numhigh: HighHalf[entityLen],den: 256];
IF padding # 0 THEN recordLen_recordLen+1;
[]_WriteBlock[s,p,padding]; --write garbage padding
p.partDir[p.numParts].Type_Page;	--printed page
p.partDir[p.numParts].RecordStart_p.RecordStart;
p.partDir[p.numParts].RecordLength_recordLen;
p.partDir[p.numParts].PaddingLength_padding;
lastSetX_lastSetY_lastFont_lastSpaceX_lastSpaceY_p.CurHue_p.CurSat_p.CurBright_0;
p.numParts_p.numParts+1;

p.RecordStart_p.RecordStart+recordLen;
END;

WritePartDirectory: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
i: CARDINAL;
padding,temp: INTEGER;

FOR i IN [0..p.numParts) DO
		[]_WriteBlock[p.outStream,@p.partDir[i],4];
		ENDLOOP;
padding_(256-LOOPHOLE[(p.numParts MOD 64)*4,INTEGER]) MOD 256;
[]_WriteBlock[p.outStream,p,padding];
temp_p.numParts;
UNTIL temp <= 0 DO
	p.partLen_p.partLen+1;
	temp_temp-64;
	ENDLOOP;
END;

InitPressFileDescriptor: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor,filename: STRING] =
BEGIN
entityCommandArray: 
	StreamHandle _ NewByteStream["EntityCommandList.$",Read+Write+Append];
dateString: STRING _ SystemDefs.AllocateHeapString[40];
userString: STRING _ SystemDefs.AllocateHeapString[20];
pd: POINTER TO PartDir _
	SystemDefs.AllocateSegment[SIZE[PartDir]];
fd: POINTER TO FontDir _
	SystemDefs.AllocateSegment[SIZE[FontDir]];

nExternalFileStrings _ 0;	--should be in PressFileDescriptor
entitySegmentHead _ NIL;
p.outStream_NewByteStream[filename,Write+Append];
p.EntityCommandLen_0;
p.EntityCommands_LOOPHOLE[entityCommandArray];
p.RecordStart_0;
p.fontLen_0;
p.partLen_0;
p.numParts_0;
p.numFonts_0;
p.fontDir_fd;
p.partDir_pd;
p.FirstCopy_1;
p.LastCopy_1;
p.solidCode_'t;	--undefined: only 's or 't are meaningful
p.PressFileName_filename;
StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserName,userString];
p.UserName_userString;
t.AppendDayTime[dateString,t.UnpackDT[t.CurrentDayTime[]]];
p.DateString_dateString;
END;

ClosePressFile: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
i,j: CARDINAL;
zero: CARDINAL _ 0;
s: StreamHandle _ p.outStream;
es: StreamHandle _ LOOPHOLE[p.EntityCommands];
FBuf: POINTER TO PressDefs.FontEntry;

IF p.EntityCommandLen # 0 THEN WritePage[p];

IF nExternalFileStrings > 0 THEN
	BEGIN
	nBytesOut: CARDINAL _ 0;
	str: STRING;
	FOR i IN [0..nExternalFileStrings) DO
		str _ externalFileStrings[i];
		s.put[s,str.length];
		FOR j IN [0..str.length+1-BITAND[str.length,1]) DO s.put[s,str[j]] ENDLOOP;
		nBytesOut _ nBytesOut + 1 + str.length+1-BITAND[str.length,1];
	ENDLOOP;
	[] _ WriteBlock[s,@zero,(512-nBytesOut)/2];
	p.partDir[p.numParts].Type_ExternalFileDirectory;
	p.partDir[p.numParts].RecordStart_p.RecordStart;
	p.partDir[p.numParts].RecordLength_1;
	p.partDir[p.numParts].PaddingLength_255;
	p.numParts_p.numParts+1;
	p.RecordStart _ p.RecordStart + 1;
	END;

--WriteFontDirectory;
FOR i IN [0..p.numFonts) DO
	FBuf _ p.fontDir[i];
	[] _ WriteBlock[s,FBuf,3]; --len,(set,font),(m,n)
	s.put[s,FBuf.Family.length];
	FOR j IN [0..19) DO s.put[s,FBuf.Family[j]]; ENDLOOP;
	[] _ WriteBlock[s,FBuf+4,3]; --(face,source),size,rotation
ENDLOOP;
[] _ WriteBlock[s,@zero,256-(p.numFonts*16)];	--padding
p.partDir[p.numParts].Type_Font;
p.partDir[p.numParts].RecordStart_p.RecordStart;
p.partDir[p.numParts].RecordLength_1;
p.partDir[p.numParts].PaddingLength_255;
p.numParts_p.numParts+1;
p.fontLen_1;

WritePartDirectory[p];
WriteDirectory[p];

s.destroy[s];
es.destroy[es]; --SystemDefs.FreeSegment[p.EntityCommands];
SystemDefs.FreeHeapString[p.DateString];
SystemDefs.FreeHeapString[p.UserName];
SystemDefs.FreeSegment[p.partDir];
END;

--object commands, Written by Martin Newell, January 1980
Count: CARDINAL _ 0; --ought to be in the individual PressFileDescriptors

StartOutline: PUBLIC PROCEDURE[p: POINTER TO PressFileDescriptor,x0,y0: CARDINAL] =
BEGIN
s: StreamHandle _ p.outStream;
param: ARRAY [0..6) OF CARDINAL;
IF Count#0 THEN
		BEGIN
		EndOutline[p];
		Count _ 0;
		END;
IF BITAND[GetIndex[s].byte,1] = 1 THEN 
	BEGIN s.put[s,0];param[0]_1;WriteCommand[p,ELSkipCharactersShort,@param];
	END;
PutMoveTo[p,x0,y0];
END;

PutMoveTo: PUBLIC PROCEDURE[p: POINTER TO PressFileDescriptor,xend,yend: CARDINAL] =
BEGIN
s: StreamHandle _ p.outStream;
cmd: CARDINAL _ DLMoveTo;
[] _ WriteBlock[s,@cmd,1];
[] _ WriteBlock[s,@xend,1];
[] _ WriteBlock[s,@yend,1];
Count _ Count + 3;
END;

PutDrawTo: PUBLIC PROCEDURE[p: POINTER TO PressFileDescriptor,xend,yend: CARDINAL] =
BEGIN
s: StreamHandle _ p.outStream;
cmd: CARDINAL _ DLDrawTo;
[] _ WriteBlock[s,@cmd,1];
[] _ WriteBlock[s,@xend,1];
[] _ WriteBlock[s,@yend,1];
Count _ Count + 3;
END;

PutCubic: PUBLIC PROCEDURE[p: POINTER TO PressFileDescriptor,x1,y1,x2,y2,x3,y3: REAL] =
BEGIN
s: StreamHandle _ p.outStream;
cmd: CARDINAL _ DLDrawCurve;
[] _ WriteBlock[s,@cmd,1];
[] _ WriteBlock[s,@x1,2];
[] _ WriteBlock[s,@y1,2];
[] _ WriteBlock[s,@x2,2];
[] _ WriteBlock[s,@y2,2];
[] _ WriteBlock[s,@x3,2];
[] _ WriteBlock[s,@y3,2];
Count _ Count + 13;
END;

EndOutline: PUBLIC PROCEDURE[p: POINTER TO PressFileDescriptor] =
BEGIN
param: ARRAY [0..6) OF CARDINAL;
param[0] _ Count;
WriteCommand[p,ELShowObject,@param];
Count _ 0;
END;

END.
(635)\f1 1213b8B154b395B3b10B2b14B256b6B129b12B220b8B149b12B3065b14B692b9B230b9B230b8B451b7B215b14B222b14B240b8B1234b7B435b12B302b2B12b2B11b11B95b15B88b11B179b7B665b15B667b15B626b16B258b111f0 5f1 59f0 5f1 17f0 5f1 3f0 4f1 58f0 4f1 22f0 4f1 27f0 9f1 52f0 9f1 11B33b26B87b7f0 5f1B217b24B162b7B246b12B670b132f0 9f1 40f0 5f1 5B250b34B1030b7B168b16B743b9B2289b18B377b23B424b86B518b14B1713b5B70b12B350b9B247b9B247b8B355b10B
--Main Code
p: PressFileDescriptor;
xstart,ystart,xlen,ylen: CARDINAL;
MicaMarg: INTEGER = 2540/2;


InitPressFileDescriptor[@p,"Play.PRESS"];
PutText[@p,"Default font",2540,2540*9];
SetFont[@p,"Helvetica",10];
PutText[@p,"Helvetica 10 here",2540,2540*8];
SetFont[@p,"Gacha",8];
PutText[@p,"Gacha 8 here",2540,2540*7];
SetFont[@p,"HelVetiCa",10];
PutText[@p,"Helvetica 10 here",2540,2540*6];
ClosePressFile[@p];
FOR i IN [0..6) DO
	SetColor[@p,i*40,255,255];
	xlen_(MicaWidth-3*MicaMarg)/2;
	ylen_(MicaHeight-4*MicaMarg)/3;
	xstart_MicaMarg+(i MOD 2)*(xlen+MicaMarg);
	ystart_MicaMarg+(i/2)*(ylen+MicaMarg);
	PutRectangle[@p,xstart,ystart,xlen,ylen];
	ENDLOOP;
\f1 2b9B