-- PressOut.mesa
-- Written by Joe Maleson
-- Last changed by Doug Wyatt, November 6, 1980  9:33 AM
-- Last changed by Schmidt (Pilot Conversion),  1-Jul-81 18:40:17

	DIRECTORY
	DCSFileTypes USING [tLeaderPage],
	Directory USING[CreateFile, Error, ignore, Lookup, UpdateDates],
	Environment USING [bytesPerPage, wordsPerPage],
	File USING [Capability, delete, grow, Permissions, read, shrink, write],
	FileStream USING [Create, GetIndex, SetIndex],
	Heap USING [systemZone],
	Inline USING [BITAND, BITXOR, COPY, HighHalf, LDIVMOD, LongDiv, 
		LongMult, LowByte, LowHalf],
	LongString USING[AppendString, EqualString, EquivalentStrings],
	PressDefs USING [DLDotsFollow, DLDrawCurve, DLDrawTo, 
		DLGetDotsFromFile, DLMoveTo, DLSetCoding, DLSetMode, 
		DLSetSamplingProperties, DLSetSize, DLSetWindow, 
		DLSSPInputIntensity, DLSSPScreen, DocDir, ELAlternative, 
		ELCommand, ELFont, ELNop, ELOnlyOnCopy, ELResetSpace, 
		ELSetBrightness, ELSetHue, ELSetSaturation, ELSetSpaceX, 
		ELSetSpaceXShort, ELSetSpaceY, ELSetSpaceYShort, ELSetX, 
		ELSetY, ELShowCharacterImmediate, ELShowCharacters, 
		ELShowCharactersAndSkip, ELShowCharactersShort, ELShowDots, 
		ELShowDotsOpaque, ELShowObject, ELShowRectangle, 
		ELSkipCharacters, ELSkipCharactersShort, ELSkipControlBytes, 
		ELSkipControlBytesImmediate, ELSpace, EntityCommandTrailer, 
		ExternalFileDirectory, Font, FontDir, FontEntry, MicaHeight, 
		MicaWidth, Page, PartDir, PressDotsData, 
		PressFileDescriptor, PressPassword],
	Profile USING [userName],
	Stream USING [Delete, GetBlock, Handle, PutBlock, PutByte, 
		PutChar, PutWord, SendNow],
	Time USING [Append, Current, Unpack];

PressOut: PROGRAM 
IMPORTS  Directory, FileStream, Heap, Inline, LongString, Profile, Stream, Time 
EXPORTS PressDefs = {

OPEN PressDefs;

--these guys should be per PressFileDescriptor
entitySegment: TYPE = RECORD[
	link: LONG POINTER TO entitySegment,
	length: CARDINAL,
	beginByte,endByte: LONG CARDINAL
 	];
maxEntitySegment: CARDINAL = 16000;

-- MDS Usage
entitySegmentHead: LONG POINTER TO entitySegment;
lastSetX, lastSetY, lastFont, lastSpaceX,lastSpaceY: CARDINAL _ 0;
externalFileStrings: ARRAY[0..100) OF LONG STRING;
nExternalFileStrings: CARDINAL _ 0;
nw: CARDINAL;	-- used by ScanInitMem
sl: LONG POINTER;-- used by ScanInitMem
-- end of MDS Usage



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

MulDiv: PUBLIC PROC [a,b,c:CARDINAL] RETURNS [CARDINAL] =
{
	al: LONG CARDINAL _ Inline.LongMult[a,b];
	RETURN[Inline.LongDiv[al+c/2,c]];
};

SignedMulDiv: PUBLIC PROC [a,b,c:INTEGER] RETURNS [INTEGER] =
{ 
	rslt: INTEGER;
	sgn: INTEGER _ Inline.BITXOR[Inline.BITXOR[a,b],c];	--Sign bit;
	rslt _ MulDiv[ABS[a],ABS[b],ABS[c]];
	IF sgn < 0 THEN RETURN[-rslt];
	RETURN[rslt];
};

SetBlock: PUBLIC PROC [buf: LONG POINTER TO ARRAY [0..0) OF INTEGER,
	val,len: INTEGER] = {
	buf[0]_val;
	Inline.COPY[to: @buf+1,from: @buf,nwords: len-1];
};

WriteCommand: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	Command: CARDINAL,Param: POINTER TO ARRAY [0..6) OF CARDINAL] =
{
es: Stream.Handle _ LOOPHOLE[p.EntityCommands];
i: CARDINAL;

	Stuff1: PROC [Argument: CARDINAL] =
	{
		p.EntityCommandLen _ p.EntityCommandLen+1;
		PutLowerByte[es,Argument];
		--p.EntityCommands[p.EntityCommandLen]_Argument;
	};

	Stuff2: PROC [Argument: CARDINAL] =
	{
		PutLowerByte[es,Argument/256];
			--p.EntityCommands[p.EntityCommandLen+1]_Argument/256;
		p.EntityCommandLen _ p.EntityCommandLen + 2;
		PutLowerByte[es,Argument]; --p.EntityCommands[p.EntityCommandLen]_Argument;
	};

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

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

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

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

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

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

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

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

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

IF p.EntityCommandLen > maxEntitySegment THEN {
	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]];
	};

};


WriteDirectory: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor] = {
	d: DocDir;
	dayTime: LONG CARDINAL _ Time.Current[];
	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 _ Inline.LowHalf[dayTime]*200000B + Inline.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]];
};

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

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

ResetSpace: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor] =
{
IF p.CurSpaceX = 177777B AND p.CurSpaceY = 177777B THEN RETURN;
WriteCommand[p,ELResetSpace,NIL];
p.CurSpaceX _ p.CurSpaceY _ 177777B;
};

PutSpace: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor] =
{
WriteCommand[p,ELSpace,NIL];
};

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

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

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

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

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

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

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

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

SetFont: PUBLIC PROC [p: LONG POINTER TO PressDefs.PressFileDescriptor,
	Name: LONG STRING,PointSize: CARDINAL,Face: CARDINAL _ 0,
	Rotation: CARDINAL _ 0] =
{
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: LONG POINTER TO PressDefs.FontEntry;
s: LONG STRING;
param: ARRAY [0..6) OF CARDINAL;

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

--grab free storage, and go
FBuf _ AllocateSegment[SIZE[PressDefs.FontEntry]];
s _ AllocateString[20];
FBuf.EntryLength_16;
FBuf.FontSet_0;
FBuf.Font_p.numFonts;
FBuf.M_0;FBuf.N_127;
LongString.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];
};

PutText: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor,
	str: LONG STRING,xleft,ybase: CARDINAL] =
{
s: Stream.Handle _ p.outStream;
param: ARRAY [0..6) OF CARDINAL;

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

PutRectangle: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor, 
	xstart,ystart,xlen,ylen: CARDINAL] =
{
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];
};

PutTextHere: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor,
	str: LONG STRING] = {
s: Stream.Handle _ p.outStream;
param: ARRAY [0..6) OF CARDINAL;

IF p.numFonts = 0 THEN SetFont[p,"Gacha"L,8];
FOR i: CARDINAL IN [0..str.length) DO 
	Stream.PutChar[s,str[i]]; 
	ENDLOOP;
param[0] _ str.length;
WriteCommand[p,ELShowCharacters,@param];
};

PutRectangleHere: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor, 
	xlen,ylen: CARDINAL] =
{
param: ARRAY [0..6) OF CARDINAL;

param[0]_xlen;
param[1]_ylen;
WriteCommand[p,ELShowRectangle,@param];
};

ScanInitMem: PROC [mem: LONG POINTER, nWordsPerLine: CARDINAL ]={
nw _ nWordsPerLine;
sl _ mem;
};

nextScanLineMem: PROC RETURNS [LONG POINTER] = {
mem: LONG POINTER _ sl;
sl _ sl+nw;
RETURN[mem];
};

PutAltoDots: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	x,y,nDots,nScanLines: CARDINAL,dots: LONG POINTER] = {
PutDots[p,x,y,nDots,nScanLines,0,nDots*32,nScanLines*32,dots];
};

PutDots: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	x,y,nPixels,nScanLines,bitsPerPixel,width,height: CARDINAL,dots: LONG POINTER,
	screenFrequency: CARDINAL _ 0,screenAngle: CARDINAL _ 45] =
{
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];
};

PutComputedDots: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	x,y,nPixels,nScanLines,bitsPerPixel,width,height: CARDINAL,
	nextScanLine: PROC RETURNS [LONG POINTER],
	screenFrequency: CARDINAL _ 0,screenAngle: CARDINAL _ 45,
	min,max: CARDINAL _ 0]=
{
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];
};

PutDotsFromFile: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	x,y,nPixels,nScanLines,bitsPerPixel,width,height: CARDINAL,dots: LONG STRING,
	screenFrequency: CARDINAL _ 0,screenAngle: CARDINAL _ 45,
	min,max: CARDINAL _ 0] =
{
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,];
};

PutPressDotsData: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	x,y: CARDINAL,dotsData: LONG POINTER TO PressDefs.PressDotsData,
	nextScanLine: PROC RETURNS[LONG POINTER]] = {
s: Stream.Handle _ 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 _
	Inline.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 Inline.BITAND[Inline.LowHalf[FileStream.GetIndex[s]],1] = 1 THEN 
	{ PutLowerByte[s,0];param[0]_1;WriteCommand[p,ELSkipCharactersShort,@param];};

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

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

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

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

NewEntitySegment: PROC [p: LONG POINTER TO PressFileDescriptor] = {
esh,segmentQ: LONG POINTER TO entitySegment;
offset: LONG CARDINAL _ LONG[p.RecordStart]*Environment.bytesPerPage;
es: Stream.Handle _ LOOPHOLE[p.EntityCommands];
IF (p.EntityCommandLen MOD 2)=1 THEN 
	{ PutLowerByte[es,ELNop];p.EntityCommandLen_p.EntityCommandLen+1;};
esh _ AllocateSegment[SIZE[entitySegment]];
esh^ _ [link: NIL,length: p.EntityCommandLen,beginByte:,
	endByte: FileStream.GetIndex[p.outStream]-offset];
IF entitySegmentHead = NIL THEN 
	{
	esh.beginByte _ 0;
	entitySegmentHead _ esh;
	}
ELSE
	{
	segmentQ _ entitySegmentHead;
	UNTIL segmentQ.link = NIL DO segmentQ _ segmentQ.link;ENDLOOP;
	segmentQ.link _ esh;
	esh.beginByte _ segmentQ.endByte;
	};
p.EntityCommandLen _ 0;
};

WritePage: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor] = {
s: Stream.Handle _ p.outStream;
es: Stream.Handle _ LOOPHOLE[p.EntityCommands];
ECommand: EntityCommandTrailer;
startPos,byteLen,entityLen: LONG INTEGER;
padding,recordLen: INTEGER;
segmentQWordLen: CARDINAL;
segmentQ: LONG POINTER TO entitySegment;
buffer: ARRAY [0..Environment.wordsPerPage) OF UNSPECIFIED;

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

NewEntitySegment[p];
Stream.SendNow[es];
FileStream.SetIndex[es, 0];

FOR segmentQ _ entitySegmentHead,segmentQ.link UNTIL segmentQ = NIL DO
	segmentQWordLen _ segmentQ.length/2;
	UNTIL segmentQWordLen = 0 DO
		[] _ ReadBlock[es,@buffer,MIN[Environment.wordsPerPage,segmentQWordLen]];
		[] _ WriteBlock[s,@buffer,MIN[Environment.wordsPerPage,segmentQWordLen]];
		segmentQWordLen _ segmentQWordLen-MIN[Environment.wordsPerPage,segmentQWordLen];
	ENDLOOP;
	--THROUGH [1..segmentQ.length] DO PutLowerByte[s,Stream.GetWord[es]];ENDLOOP;
	
	startPos _ segmentQ.beginByte;
	byteLen _ segmentQ.endByte - startPos;
	ECommand _
		[Type: 0, FontSet: 0,
			BeginByte: [Inline.HighHalf[startPos],Inline.LowHalf[startPos]],
			ByteLen: [Inline.HighHalf[byteLen],Inline.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;
	FreeSegment[segmentQ];
	IF entitySegmentHead = NIL THEN EXIT;
	ENDLOOP;
FileStream.SetIndex[es, 0];

--now, compute (and write) padding, update part directory
padding_Inline.BITAND[Environment.wordsPerPage-
	Inline.BITAND[Inline.LowHalf[entityLen],377B],377B];
[recordLen,]_Inline.LDIVMOD[numlow: Inline.LowHalf[entityLen],
	numhigh: Inline.HighHalf[entityLen],den: Environment.wordsPerPage];
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;
};

WritePartDirectory: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor] = {
padding,temp: INTEGER;

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

InitPressFileDescriptor: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor,
	filename: LONG STRING] =
{
entityCommandArray: Stream.Handle _ NewStream["EntityCommandList.$"L,
	File.read + File.write + File.grow + File.shrink + File.delete];
temp: STRING _ [40];
dateString: LONG STRING _ AllocateString[40];
userString: LONG STRING _ AllocateString[20];
pd: LONG POINTER TO PartDir _ AllocateSegment[SIZE[PartDir]];
fd: LONG POINTER TO FontDir _ AllocateSegment[SIZE[FontDir]];

nExternalFileStrings _ 0;	--should be in PressFileDescriptor
entitySegmentHead _ NIL;
p.outStream_NewStream[filename,File.write + File.grow + File.shrink + File.delete];
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;
p.UserName_AllocateString[Profile.userName.length];
LongString.AppendString[p.UserName, Profile.userName];
Time.Append[temp,Time.Unpack[Time.Current[]]];
LongString.AppendString[dateString, temp];
p.DateString_dateString;
p.CurSpaceX _ p.CurSpaceY _ 177777B;
};

ClosePressFile: PUBLIC PROC [p: LONG POINTER TO PressFileDescriptor] = {
i,j: CARDINAL;
zero: CARDINAL _ 0;
s: Stream.Handle _ p.outStream;
es: Stream.Handle _ LOOPHOLE[p.EntityCommands];
FBuf: LONG POINTER TO PressDefs.FontEntry;

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

IF nExternalFileStrings > 0 THEN
	{
	nBytesOut: CARDINAL _ 0;
	str: LONG STRING;
	FOR i IN [0..nExternalFileStrings) DO
		str _ externalFileStrings[i];
		PutLowerByte[s,str.length];
		FOR j IN [0..str.length+1-Inline.BITAND[str.length,1]) DO 
			Stream.PutChar[s,str[j]] 
			ENDLOOP;
		nBytesOut _ nBytesOut + 1 + str.length+1-Inline.BITAND[str.length,1];
	ENDLOOP;
	[] _ WriteBlock[s,@zero,(Environment.bytesPerPage-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;
	};

--WriteFontDirectory;
FOR i IN [0..p.numFonts) DO
	FBuf _ p.fontDir[i];
	Stream.PutWord[s,FBuf.EntryLength];
	Stream.PutByte[s,FBuf.FontSet];
	Stream.PutByte[s,FBuf.Font];
	Stream.PutByte[s,FBuf.M];
	Stream.PutByte[s,FBuf.N];
	PutLowerByte[s,FBuf.Family.length];
	FOR j IN [0..19) DO 
		Stream.PutChar[s,
			IF j<FBuf.Family.length THEN FBuf.Family[j] ELSE 0C]; 
		ENDLOOP;
	Stream.PutByte[s,FBuf.Face];
	Stream.PutByte[s,FBuf.Source];
	Stream.PutWord[s,FBuf.Size];
	Stream.PutWord[s,FBuf.Rotation];
ENDLOOP;
[] _ WriteBlock[s,@zero,Environment.wordsPerPage-(p.numFonts*16)];	--padding
p.partDir[p.numParts].Type_Font;
p.partDir[p.numParts].RecordStart_p.RecordStart;
p.partDir[p.numParts].RecordLength_IF p.numFonts < 16 THEN 1 ELSE 2;
p.partDir[p.numParts].PaddingLength_255;
p.numParts_p.numParts+1;
p.fontLen_1;

WritePartDirectory[p];
WriteDirectory[p];

Stream.Delete[s];
Stream.Delete[es]; --SystemDefs.FreeSegment[p.EntityCommands];
FreeString[p.DateString];
FreeString[p.UserName];
FreeSegment[p.partDir];
};

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

StartOutline: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor,
	x0,y0: CARDINAL] = {
s: Stream.Handle _ p.outStream;
param: ARRAY [0..6) OF CARDINAL;
IF Count#0 THEN	{
	EndOutline[p];
	Count _ 0;
	};
IF Inline.BITAND[Inline.LowHalf[FileStream.GetIndex[s]],1] = 1 THEN 
	{ 
	PutLowerByte[s,0];
	param[0]_1;
	WriteCommand[p,ELSkipCharactersShort,@param];
	};
PutMoveTo[p,x0,y0];
};

PutMoveTo: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor,
	xend,yend: CARDINAL] = {
s: Stream.Handle _ p.outStream;
cmd: CARDINAL _ DLMoveTo;
[] _ WriteBlock[s,@cmd,1];
[] _ WriteBlock[s,@xend,1];
[] _ WriteBlock[s,@yend,1];
Count _ Count + 3;
};

PutDrawTo: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor,
	xend,yend: CARDINAL] = {
s: Stream.Handle _ p.outStream;
cmd: CARDINAL _ DLDrawTo;
[] _ WriteBlock[s,@cmd,1];
[] _ WriteBlock[s,@xend,1];
[] _ WriteBlock[s,@yend,1];
Count _ Count + 3;
};

PutCubic: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor,
	x1,y1,x2,y2,x3,y3: REAL] = {
s: Stream.Handle _ 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;
};

EndOutline: PUBLIC PROC[p: LONG POINTER TO PressFileDescriptor] =
{
param: ARRAY [0..6) OF CARDINAL;
param[0] _ Count;
WriteCommand[p,ELShowObject,@param];
Count _ 0;
};

-- compatibility routines for Pilot
AllocateString: PUBLIC PROC[nchars: CARDINAL] RETURNS[s: LONG STRING] = {
s _ Heap.systemZone.NEW[StringBody[nchars]
	_ StringBody[length: 0, maxlength: nchars, text:]];
};

FreeString: PUBLIC PROC[str: LONG STRING] = {
IF str = NIL THEN RETURN;
Heap.systemZone.FREE[@str];
};

AllocateSegment: PROC[nwords: CARDINAL] RETURNS[ptr: LONG POINTER] = {
seq: TYPE = RECORD[
	body: SEQUENCE maxsize: CARDINAL OF WORD
	];
IF nwords > 32000 THEN ERROR;
ptr _ Heap.systemZone.NEW[seq[nwords]];
};

FreeSegment: PUBLIC PROC[ptr: LONG POINTER] = {
IF ptr = NIL THEN RETURN;
Heap.systemZone.FREE[@ptr];
};

NewStream: PROC [name: LONG STRING, access: File.Permissions]
	RETURNS [Stream.Handle] = {
cap: File.Capability;
old: BOOLEAN _ FALSE;
IF access ~= File.read THEN 
	cap _ Directory.CreateFile[name, DCSFileTypes.tLeaderPage, 0
		! Directory.Error => {
			IF type = fileAlreadyExists THEN old _ TRUE 
			ELSE ERROR;
			CONTINUE
		}]
ELSE old _ TRUE;
IF old THEN cap _ Directory.Lookup[fileName: name, permissions: Directory.ignore
	! Directory.Error => ERROR];
cap _ Directory.UpdateDates[cap, access];
RETURN[FileStream.Create[cap]];
};

WriteBlock: PROC[sh: Stream.Handle, p: LONG POINTER, nwords: CARDINAL] = {
Stream.PutBlock[sh, [p, 0, nwords * 2]];
};

ReadBlock: PROC[sh: Stream.Handle, p: LONG POINTER, nwords: CARDINAL] 
	RETURNS[nbytesread: CARDINAL] = {
[bytesTransferred: nbytesread] _ Stream.GetBlock[sh, [p, 0, nwords*2]];
};

Zero: PROC[p: LONG POINTER, nwords: CARDINAL] = {
FOR i: CARDINAL IN [0 .. nwords) DO
	(p+i)^ _ 0;
	ENDLOOP;
};

PutLowerByte: PROC[sh: Stream.Handle, w: CARDINAL] = {
Stream.PutByte[sh, Inline.LowByte[w]];
};

-- this testprogram may be called to test out changes to this Module
TestProgram: PROC = {
p: PressFileDescriptor;
InitPressFileDescriptor[@p,"Play.PRESS"L];
PutText[@p,"Default font"L,2540,2540*9];
SetFont[@p,"Helvetica"L,10];
PutText[@p,"Helvetica 10 here"L,2540,2540*8];
SetFont[@p,"Gacha"L,8];
PutText[@p,"Gacha 8 here"L,2540,2540*7];
SetFont[@p,"HelVetiCa"L,10];
PutText[@p,"Helvetica 10 here"L,2540,2540*6];
IF TRUE THEN {
	xstart,ystart,xlen,ylen: CARDINAL;
	MicaMarg: INTEGER = 2540/2;
	FOR i: CARDINAL 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;
	};
ClosePressFile[@p];
};

}.