-- PressOut.mesa
-- Written by Joe Maleson
-- Last changed by Doug Wyatt, March 3, 1981 3:09 PM

DIRECTORY
InlineDefs USING
[LongMult,LongDiv,LowHalf,HighHalf,BITAND,LDIVMOD,BITXOR,COPY],
MiscDefs USING [Zero],
OsStaticDefs USING [OsStatics],
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 USING
[CleanupDiskStream,WriteBlock,StreamHandle,StreamIndex,GetIndex,NewByteStream,
Read,Write,Append,ReadBlock],
StringDefs USING [AppendString, BcplToMesaString, EquivalentStrings, EqualString],
SystemDefs USING [AllocateHeapNode, AllocateHeapString, AllocateSegment,
FreeHeapNode, FreeHeapString, FreeSegment],
TimeDefs USING [AppendDayTime, CurrentDayTime, PackedTime, UnpackDT];

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;

ResetSpace: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
IF p.CurSpaceX = 177777B AND p.CurSpaceY = 177777B THEN RETURN;
WriteCommand[p,ELResetSpace,NIL];
p.CurSpaceX ← p.CurSpaceY ← 177777B;
END;

PutSpace: PUBLIC PROCEDURE [p: POINTER TO PressFileDescriptor] =
BEGIN
WriteCommand[p,ELSpace,NIL];
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 = 16 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;

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

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;

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

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;
p.CurSpaceX ← p.CurSpaceY ← 177777B;
p.CurHue←p.CurSat←p.CurBright←0; -- fix by DKW, March 3, 1981 3:08 PM
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←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];

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.

--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;