-- Presser.mesa; edit by Johnsson; 16-Apr-81 14:25:18
-- edit by Schmidt, July 8, 1982 2:28 pm
DIRECTORY
Heap USING [systemMDSZone],
Inline USING [HighByte, LongCOPY, LongDiv, LongMult, LowByte, LowHalf],
LongString USING [AppendDecimal, AppendString],
LongStorage USING [Node, String, Words, Free, FreeWords],
Press USING [
defaultBottom, defaultCharWidth, defaultHeight, defaultLeft,
defaultLineHeight, defaultLineLeading, defaultRight, defaultTabSpacing,
defaultTop, defaultWidth, FontIndex, FontSlope, FontWeight,
magicNonPrintingWidth, Mica, Mode, numberOfFonts, pageHeight, pageWidth,
Points, pointsPerInch],
PressFormat USING [
BYTE, DDV, EFont, ENop, EResetSpace, ESetX, ESetY, EShow, EShowRectangle,
EShowShort, ESpaceX, ESpaceXShort, ESpaceY, ESpaceYShort, FE, LCToDouble,
Mica, micasPerInch, PartType, PE, PETypeFont, PETypePage, PressPasswd],
PressUtilities USING [FontNotInFontsDotWidths, ErrorReadingFontWidths, FindFontWidths],
Segments USING [FileNameProblem],
Streams USING [GetIndex, Handle, PutBlock, PutByte, PutChar, SetIndex],
Time USING [Append, Unpack, defaultTime, Packed, Current];
Presser: PROGRAM
IMPORTS
Heap, Inline, LongString, LongStorage, PressFormat, PressUtilities, Segments,
Streams, Time
EXPORTS Press =
BEGIN OPEN Press, PressFormat;
MoreThan16Fonts: PUBLIC ERROR = CODE;
ELBufferOverflow: PUBLIC ERROR = CODE;
PartBufferOverflow: PUBLIC ERROR = CODE;
BadParameters: PUBLIC ERROR = CODE;
InternalError: PUBLIC ERROR = CODE;
wppr: CARDINAL = 256; -- words per press record
bppr: CARDINAL = 2*wppr;
recordsPerEntityList: CARDINAL = 10;
wordsPerEntityList: CARDINAL = recordsPerEntityList*wppr;
bytesPerEntityList: CARDINAL = recordsPerEntityList*bppr;
recordsPerItemList: CARDINAL = 2;
wordsPerItemList: CARDINAL = recordsPerItemList*wppr;
BYTE: TYPE = [0..377B];
CR: CHARACTER = 15C;
FF: CHARACTER = 14C;
SP: CHARACTER = 40C;
TAB: CHARACTER = 11C;
onePoint: Mica = micasPerInch/pointsPerInch;
widthGacha6: Mica = 129; -- default character width in landscape mode
widthGacha8: Mica = 173; -- default character width in portrait mode
-- big buffers
entityIndex: [0..bytesPerEntityList);
partsPerRecord: CARDINAL = wppr/SIZE[PressFormat.PE]; -- is 127 pages/doc enough?
partsPerDocument: CARDINAL = recordsPerItemList*partsPerRecord;
partIndex: [0..partsPerDocument); -- edit by Schmidt, used to be .. partsPerRecord
-- global data
Data: TYPE = RECORD [
currentX, currentY: Mica ← NULL,
pressFile: Streams.Handle,
height: Mica ← defaultHeight,
width: Mica ← defaultWidth,
entityList: LONG POINTER TO PACKED ARRAY [0..bytesPerEntityList) OF BYTE ← NIL,
partList: LONG POINTER TO ARRAY [0..partsPerDocument) OF PressFormat.PE ← NIL,
lineLeading: Mica ← defaultLineLeading,
tabWidth: Mica ← defaultTabSpacing,
spaceWidth: Mica ← NULL,
documentFileName: LONG STRING ← NIL, -- max length 51
documentUserName: LONG STRING ← NIL, -- max length 31
documentCreationDate: LONG STRING ← NIL, -- max length 39
pageHeader, pageTrailer: LONG STRING ← NIL,
numberOfColumns: CARDINAL ← 1,
spaceBetweenColumns: Mica ← 0,
leftMargin: Mica ← defaultLeft,
rightMargin: Mica ← defaultRight,
topMargin: Mica ← defaultTop,
bottomMargin: Mica ← defaultBottom,
-- lineActive means that we don't have to do a Set-x and Set-y
-- lineCharacters#0 means that we need to do a Show-characters
-- We don't know how high the line is until we have seen it go past.
-- This kludge remembers the entityIndex for the Y data word so we can fix it later.
-- When we switch fonts, we save the height of the tallest one.
lineHeight: Mica ← defaultLineHeight,
fixupXIndex, fixupYIndex: CARDINAL ← NULL,
lineCharacters: CARDINAL ← 0,
firstEntityIndexOfPage: CARDINAL ← 0,
firstPageCharacter, pageCharacters: CARDINAL ← 0,
currentPageNumber: CARDINAL ← 1,
currentColumn: CARDINAL ← 0,
currentRecordNumber: CARDINAL ← 0,
firstDataRecordOfPaper: CARDINAL ← 0,
paperCharacters: CARDINAL ← 0,
userFonts: LONG POINTER TO ARRAY FontIndex OF UserFontInfo ← NIL,
pressFonts: LONG POINTER TO ARRAY FontIndex OF PressFontInfo ← NIL,
currentFontPointer: LONG POINTER TO PressFontInfo ← NIL,
heightOfHeaderLine: Mica ← 0,
widthOfHeaderDigit: Mica ← 0,
numberOfCopies: CARDINAL ← 1,
fontZeroPointer: LONG POINTER TO PressFontInfo,
active: BOOLEAN ← FALSE,
landscape: BOOLEAN ← FALSE,
lineActive: BOOLEAN ← FALSE,
pageActive: BOOLEAN ← FALSE,
paperActive: BOOLEAN ← FALSE,
headerPageNumbers, trailerPageNumbers: BOOLEAN ← FALSE,
vSpaceWidth: BOOLEAN ← FALSE]; -- TRUE after SetWidthOfSpace
data: POINTER TO Data ← NIL;
UserFontInfo: TYPE = RECORD [
family: LONG STRING, -- mostly for debugging
name: FamilyName, -- BCPL string body in caps
size: Points,
-- pointers below are NIL if not used yet
portrait, landscape: ARRAY FontFace OF LONG POINTER TO PressFontInfo];
WidthArray: TYPE = ARRAY CHARACTER OF Mica;
PressFontInfo: TYPE = RECORD [
index: FontIndex, -- the one we feed to press
face: FontFace,
fBBox, fBBoy, width, height: Mica ← NULL,
widths: LONG POINTER TO WidthArray, -- NIL if not used yet
rotation: CARDINAL,
user: LONG POINTER TO UserFontInfo]; -- to build Font Directory
FamilyName: TYPE = PACKED ARRAY [0..20) OF BYTE;
FontFace: TYPE = [0..2*2); -- should really be 2*3*3, See FontFormats memo
Initialize: PUBLIC PROCEDURE =
BEGIN OPEN data;
Reset[];
data ← Heap.systemMDSZone.NEW[Data];
userFonts ← LongStorage.Node[numberOfFonts*SIZE[UserFontInfo]];
userFonts↑ ← ALL[[NIL, , 0, [NIL, NIL, NIL, NIL], [NIL, NIL, NIL, NIL]]];
pressFonts ← LongStorage.Node[numberOfFonts*SIZE[PressFontInfo]];
pressFonts↑ ← ALL[[0, 0, 0, 0, 0, 0, NIL, 0, NIL]];
entityList ← LongStorage.Words[wordsPerEntityList];
Zero[entityList, wordsPerEntityList];
partList ← LongStorage.Words[wordsPerItemList];
Zero[partList, wordsPerItemList];
END;
Reset: PUBLIC PROCEDURE =
BEGIN OPEN LongStorage, data;
i: FontIndex;
IF data = NIL THEN RETURN;
LongStorage.Free[pageHeader];
LongStorage.Free[pageTrailer];
LongStorage.Free[documentFileName];
LongStorage.Free[documentUserName];
LongStorage.Free[documentCreationDate];
IF userFonts # NIL THEN
BEGIN
FOR i IN FontIndex DO LongStorage.Free[userFonts[i].family]; ENDLOOP;
Free[userFonts];
END;
IF pressFonts # NIL THEN {FlushFontBuffers[]; Free[pressFonts]};
IF entityList # NIL THEN {FreeWords[entityList]; entityList ← NIL};
IF partList # NIL THEN {FreeWords[partList]; partList ← NIL};
Heap.systemMDSZone.FREE[@data]
END;
SetDocumentCreationDate: PUBLIC PROCEDURE [date: LONG STRING] =
{MakeMeACopy[@data.documentCreationDate, date]};
SetDocumentUserName: PUBLIC PROCEDURE [user: LONG STRING] =
{MakeMeACopy[@data.documentUserName, user]};
SetHeaderText: PUBLIC PROCEDURE [header: LONG STRING, pageNumbers: BOOLEAN] =
{MakeMeACopy[@data.pageHeader, header]; data.headerPageNumbers ← pageNumbers};
SetTrailerText: PUBLIC PROCEDURE [trailer: LONG STRING, pageNumbers: BOOLEAN] =
{MakeMeACopy[@data.pageTrailer, trailer]; data.trailerPageNumbers ← pageNumbers};
SetNumberOfCopies: PUBLIC PROCEDURE [copies: CARDINAL] =
{data.numberOfCopies ← copies};
PutFontInTable: PUBLIC PROCEDURE [
index: FontIndex, family: LONG STRING, size: Points] =
BEGIN OPEN data;
IF userFonts = NIL THEN ERROR BadParameters;
IF index NOT IN FontIndex THEN ERROR BadParameters;
IF family.length NOT IN [1..19] THEN ERROR BadParameters; -- only 20 bytes words
MakeMeACopy[@userFonts[index].family, family];
userFonts[index].size ← size;
FOR i: CARDINAL IN [0..20) DO userFonts[index].name[i] ← 0; ENDLOOP;
userFonts[index].name[0] ← family.length;
FOR i: CARDINAL IN [0..family.length) DO
SELECT family[i] FROM
IN ['A..'Z], IN ['0..'9] =>
userFonts[index].name[i + 1] ← LOOPHOLE[family[i]];
IN ['a..'z] =>
userFonts[index].name[i + 1] ← LOOPHOLE[family[i], BYTE] - 40B;
ENDCASE => ERROR BadParameters;
ENDLOOP;
END;
SetMargins: PUBLIC PROCEDURE [l, r, t, b: Mica] =
BEGIN OPEN data;
IF pageActive THEN ERROR BadParameters;
leftMargin ← l;
rightMargin ← r;
topMargin ← t;
bottomMargin ← b;
IF landscape THEN
BEGIN
height ← pageWidth - rightMargin - leftMargin;
width ← pageHeight - topMargin - bottomMargin;
END
ELSE
BEGIN
height ← pageHeight - topMargin - bottomMargin;
width ← pageWidth - rightMargin - leftMargin;
END;
width ← width - (numberOfColumns - 1)*(spaceBetweenColumns);
width ← LOOPHOLE[width, CARDINAL]/numberOfColumns;
END;
SetCurrentTabWidth: PUBLIC PROCEDURE [tab: Mica] = {data.tabWidth ← tab};
SetCurrentLineLeading: PUBLIC PROCEDURE [lead: Mica] = {data.lineLeading ← lead};
Start: PUBLIC PROCEDURE [docName: LONG STRING, file: Streams.Handle] =
BEGIN OPEN data;
IF data = NIL THEN Initialize[];
IF active THEN RETURN;
pressFile ← file;
MakeMeACopy[@documentFileName, docName];
IF documentCreationDate = NIL THEN
BEGIN OPEN Time;
time: STRING = [18];
Append[time, Unpack[defaultTime]];
MakeMeACopy[@documentCreationDate, time];
END;
IF documentUserName = NIL THEN MakeMeACopy[@documentUserName, "NoName"L];
IF documentFileName = NIL THEN MakeMeACopy[@documentFileName, "NoName"L];
IF documentFileName.length > 51 THEN documentFileName.length ← 51;
currentRecordNumber ← 0;
Streams.SetIndex[pressFile, 0];
entityIndex ← partIndex ← 0;
FOR i: FontIndex IN FontIndex DO
userFonts[i].portrait ← [NIL, NIL, NIL, NIL];
userFonts[i].landscape ← [NIL, NIL, NIL, NIL];
ENDLOOP;
currentPageNumber ← 1;
lineActive ← pageActive ← paperActive ← FALSE;
currentX ← 0;
currentY ← height;
BeSureFontZeroExists[];
active ← TRUE;
END;
Finish: PUBLIC PROCEDURE =
BEGIN OPEN data;
fd: LONG POINTER = entityList; -- build Font Directory in random buffer
fp: LONG POINTER TO PressFormat.FE ← fd;
dd: LONG POINTER TO PressFormat.DDV = fd;
-- build Document Directory in random buffer
now: Time.Packed ← Time.Current[];
numberOfPartRecords, firstPartRecord: CARDINAL;
IF lineActive THEN EndCurrentLine[];
IF pageActive THEN EndCurrentPage[];
IF paperActive THEN EndCurrentPaper[];
-- send Font Directory
Zero[fd, wppr];
firstDataRecordOfPaper ← currentRecordNumber; -- for AppendPartItem
FOR i: CARDINAL IN FontIndex DO
IF pressFonts[i].user # NIL THEN
BEGIN
fp↑ ← PressFormat.FE[
length: SIZE[PressFormat.FE], set: 0, -- we only use one font set
fno: pressFonts[i].index, destm: 0, destn: 177B,
fam: pressFonts[i].user.name, face: pressFonts[i].face, source: 0,
siz: pressFonts[i].user.size, rotn: pressFonts[i].rotation];
fp ← fp + SIZE[PressFormat.FE];
IF fp = fd + wppr THEN -- opps, record exactly full
BEGIN
[] ← Streams.PutBlock[pressFile, fd, wppr];
Zero[fd, wppr];
fp ← fd;
END;
END;
ENDLOOP;
[] ← Streams.PutBlock[pressFile, fd, wppr];
AppendPartItem[PressFormat.PETypeFont, 0];
-- send off Part Directory
firstPartRecord ← currentRecordNumber;
numberOfPartRecords ← (partIndex*SIZE[PressFormat.PE] + wppr - 1)/wppr;
[] ← Streams.PutBlock[pressFile, partList, numberOfPartRecords*wppr];
-- send off Document Directory - use entity buffer
Zero[dd, wppr];
dd.Passwd ← PressFormat.PressPasswd; -- General Password
dd.nRecs ← firstPartRecord + numberOfPartRecords + 1;
-- total number of records
dd.nParts ← partIndex;
dd.pdStart ← firstPartRecord;
dd.pdRecs ← numberOfPartRecords;
dd.Backp ← 0; -- ?? funny backpointer
dd.date ← PressFormat.LCToDouble[now];
dd.fCopy ← 1;
dd.lCopy ← numberOfCopies; -- first, last copy
dd.fPage ← 1;
dd.lPage ← 0; -- first, last page
PackString[documentFileName, @dd.FileStr];
PackString[documentUserName, @dd.CreatStr];
PackString[documentCreationDate, @dd.DateStr];
currentRecordNumber ← currentRecordNumber + 1;
[] ← Streams.PutBlock[pressFile, dd, wppr];
active ← FALSE;
END;
Abort: PUBLIC PROCEDURE = {data.active ← FALSE};
String: PUBLIC PROCEDURE [s: LONG STRING] =
{FOR i: CARDINAL IN [0..s.length) DO Character[s[i]] ENDLOOP};
PieceOfLine: PUBLIC PROCEDURE [s: LONG STRING, width: Mica] =
BEGIN -- can't OPEN data; because of width:
IF ~data.lineActive THEN
BEGIN OPEN data;
-- If we switch to a taller font, this test might miss.
IF pageActive AND currentY < (currentFontPointer.height + lineLeading) THEN
DoPageOverflow[];
BeginLine[];
END;
FOR i: CARDINAL IN [0..s.length) DO Streams.PutChar[data.pressFile, s[i]]; ENDLOOP;
data.lineCharacters ← data.lineCharacters + s.length;
data.currentX ← data.currentX + width;
END;
GetWidthOfString: PUBLIC PROCEDURE [s: LONG STRING] RETURNS [w: Mica] =
BEGIN
w ← 0;
FOR i: CARDINAL IN [0..s.length) DO
w ← w + GetWidthOfCharacter[s[i]]; ENDLOOP;
END;
GetWidthOfCharacter: PUBLIC PROCEDURE [c: CHARACTER] RETURNS [w: Mica] =
BEGIN OPEN data;
IF vSpaceWidth AND c = SP THEN RETURN[spaceWidth];
w ← currentFontPointer.widths[c];
IF w = magicNonPrintingWidth THEN w ← 0;
END;
GetHeightOfFont: PUBLIC PROCEDURE [font: FontIndex] RETURNS [Mica] =
BEGIN OPEN data;
IF font NOT IN FontIndex OR userFonts[font].family = NIL THEN
ERROR BadParameters;
RETURN[PointsToMicas[userFonts[font].size]]
END;
Character: PUBLIC PROCEDURE [c: CHARACTER] =
BEGIN OPEN data;
charWidth: Mica;
SELECT c FROM
CR => DoCR[];
FF => DoFF[];
TAB => DoTAB[];
ENDCASE =>
BEGIN
IF vSpaceWidth AND c = SP THEN charWidth ← spaceWidth
ELSE charWidth ← currentFontPointer.widths[c];
IF charWidth = magicNonPrintingWidth THEN charWidth ← 0;
IF ~lineActive THEN
BEGIN
-- If we switch to a taller font, this test might miss.
IF pageActive AND currentY < (currentFontPointer.height + lineLeading)
THEN DoPageOverflow[];
BeginLine[];
END;
IF (currentX + charWidth) > width AND c # SP THEN DoLineOverflow[];
Streams.PutChar[pressFile, c];
lineCharacters ← lineCharacters + 1;
currentX ← currentX + charWidth;
END;
END;
DoTAB: PROCEDURE =
BEGIN OPEN data;
IF ~lineActive AND currentY < (currentFontPointer.height + lineLeading) THEN
DoPageOverflow[]; -- else this TAB gets lost
SkipSomeSpace[(((currentX + 20)/tabWidth) + 1)*tabWidth - currentX];
END;
SkipSomeSpace: PUBLIC PROCEDURE [mica: Mica] =
BEGIN OPEN data;
IF mica = 0 THEN RETURN;
IF ~pageActive THEN BeginPage[];
IF lineActive THEN FlushBuffer[]
ELSE
IF currentY < (currentFontPointer.height + lineLeading) THEN
DoPageOverflow[];
currentX ← currentX + mica;
IF currentX > width THEN BEGIN DoLineOverflow[]; RETURN; END;
IF ~lineActive THEN RETURN; -- BeginLine will set position
-- TAB - TAB will generate an extra Set-?
IF landscape THEN AppendEntityByte[ESetY] ELSE AppendEntityByte[ESetX];
AppendEntityWord[currentX];
END;
DoCR: PROCEDURE =
BEGIN OPEN data;
IF ~pageActive THEN BeginPage[];
IF lineActive THEN EndCurrentLine[];
currentX ← 0;
currentY ← currentY - lineHeight - lineLeading;
END;
DoLineOverflow: PROCEDURE =
BEGIN
Character[CR];
-- Leave line active, but overflow test is done by PrintCharacter
String["**"L];
END;
DoFF: PROCEDURE =
-- FF, FF will get you an empty page
{IF ~data.pageActive THEN BeginPage[]; EndCurrentPage[]};
DoPageOverflow: PROCEDURE = {EndCurrentPage[]; BeginPage[]}; -- leave page active
SetMode: PUBLIC PROCEDURE [columns: CARDINAL, between: Mica, mode: Mode] =
BEGIN OPEN data;
numberOfColumns ← columns;
spaceBetweenColumns ← between;
SELECT mode FROM
portrait =>
BEGIN
landscape ← FALSE;
height ← pageHeight - topMargin - bottomMargin;
width ← pageWidth - rightMargin - leftMargin;
END;
landscape =>
BEGIN
landscape ← TRUE;
height ← pageWidth - rightMargin - leftMargin;
width ← pageHeight - topMargin - bottomMargin;
END;
ENDCASE => ERROR;
width ← width - (numberOfColumns - 1)*(spaceBetweenColumns);
width ← LOOPHOLE[width, CARDINAL]/numberOfColumns;
END;
SetCurrentPosition: PUBLIC PROCEDURE [x, y: Mica] =
BEGIN OPEN data;
IF ~pageActive THEN BeginPage[];
IF lineActive THEN EndCurrentLine[];
currentX ← x;
currentY ← y;
END;
GetCurrentPageNumber: PUBLIC PROCEDURE RETURNS [CARDINAL] =
{RETURN[data.currentPageNumber]};
SetCurrentPageNumber: PUBLIC PROCEDURE [pn: CARDINAL] =
{data.currentPageNumber ← pn};
GetCurrentPosition: PUBLIC PROCEDURE RETURNS [x, y: Mica] =
{IF ~data.pageActive THEN BeginPage[]; RETURN[data.currentX, data.currentY]};
SetWidthOfSpace: PUBLIC PROCEDURE [w: Mica] =
BEGIN OPEN data;
IF ~pageActive THEN BeginPage[];
IF lineActive THEN EndCurrentLine[];
IF w < 2048 THEN
AppendEntityWord[
(IF landscape THEN ESpaceYShort ELSE ESpaceXShort)*400B + w]
ELSE
BEGIN
AppendEntityByte[IF landscape THEN ESpaceY ELSE ESpaceX];
AppendEntityWord[w];
END;
vSpaceWidth ← TRUE;
spaceWidth ← w;
END;
ResetWidthOfSpace: PUBLIC PROCEDURE =
BEGIN OPEN data;
IF ~pageActive THEN BeginPage[];
IF lineActive THEN EndCurrentLine[];
AppendEntityByte[EResetSpace];
vSpaceWidth ← FALSE;
END;
DrawRectangle: PUBLIC PROCEDURE [w, h: Mica] =
BEGIN OPEN data;
IF ~pageActive THEN BeginPage[];
IF lineActive THEN EndCurrentLine[];
AppendEntityByte[ESetX];
AppendEntityWord[IF landscape THEN height - currentY ELSE currentX];
AppendEntityByte[ESetY];
AppendEntityWord[IF landscape THEN currentX ELSE currentY];
AppendEntityByte[EShowRectangle];
AppendEntityWord[IF landscape THEN h ELSE w];
AppendEntityWord[IF landscape THEN w ELSE h];
END;
BeginLine: PROCEDURE =
BEGIN OPEN data;
IF ~pageActive THEN BeginPage[];
lineCharacters ← 0;
lineHeight ← currentFontPointer.height;
AppendEntityByte[ESetX];
fixupXIndex ← entityIndex;
AppendEntityWord[IF landscape THEN height - currentY ELSE currentX];
AppendEntityByte[ESetY];
fixupYIndex ← entityIndex;
AppendEntityWord[IF landscape THEN currentX ELSE currentY];
lineActive ← TRUE;
END;
-- called by SkipSomeSpace, EndCurrentLine, BeginPage (headers), and SetCurrentFont
FlushBuffer: PROCEDURE =
BEGIN OPEN data;
SELECT lineCharacters FROM
0 => RETURN;
IN [1..40B] => BEGIN AppendEntityByte[EShowShort + lineCharacters - 1]; END;
IN [40B..400B] =>
BEGIN AppendEntityByte[EShow]; AppendEntityByte[lineCharacters]; END;
ENDCASE => ERROR InternalError;
paperCharacters ← paperCharacters + lineCharacters;
pageCharacters ← pageCharacters + lineCharacters;
lineCharacters ← 0;
END;
EndCurrentLine: PROCEDURE =
BEGIN OPEN data;
temp: Mica;
IF ~lineActive THEN ERROR InternalError;
FlushBuffer[];
IF landscape THEN
BEGIN
temp ← height - currentY;
entityList[fixupXIndex] ← Inline.HighByte[temp];
entityList[fixupXIndex + 1] ← Inline.LowByte[temp];
END
ELSE
BEGIN
temp ← currentY - lineHeight - lineLeading;
entityList[fixupYIndex] ← Inline.HighByte[temp];
entityList[fixupYIndex + 1] ← Inline.LowByte[temp];
END;
lineActive ← FALSE;
END;
BeginPage: PROCEDURE =
BEGIN OPEN data;
IF pageActive THEN ERROR InternalError;
IF ~paperActive THEN BeginPaper[];
firstEntityIndexOfPage ← entityIndex;
firstPageCharacter ← paperCharacters;
pageCharacters ← 0;
pageActive ← TRUE;
Headers[];
currentX ← 0;
currentY ← height;
IF currentFontPointer.index NOT IN FontIndex THEN ERROR InternalError;
IF currentFontPointer.index # 0 THEN
AppendEntityByte[EFont + currentFontPointer.index];
END;
EndCurrentPage: PROCEDURE =
BEGIN OPEN data;
cardinal: CARDINAL;
header, trailer: Mica ← 0; -- fudge for headers/trailers
IF ~pageActive THEN ERROR InternalError;
IF lineActive THEN EndCurrentLine[];
Trailers[];
pageActive ← FALSE;
-- header must start on a word boundry
IF (entityIndex MOD 2) = 1 THEN AppendEntityByte[ENop];
-- build entity header
AppendEntityWord[0]; -- type and font-set
AppendEntityWord[0];
AppendEntityWord[firstPageCharacter]; -- begin byte
AppendEntityWord[0];
AppendEntityWord[pageCharacters]; -- length
IF landscape THEN
BEGIN -- Xe, Ye
AppendEntityWord[leftMargin];
AppendEntityWord[
bottomMargin + currentColumn*(width + spaceBetweenColumns)];
IF pageHeader # NIL THEN header ← 3*heightOfHeaderLine;
IF pageTrailer # NIL THEN trailer ← 3*heightOfHeaderLine;
AppendEntityWord[-header];
AppendEntityWord[0]; -- left, bottom
AppendEntityWord[height + header + trailer]; -- width
AppendEntityWord[width]; -- height
END
ELSE
BEGIN -- Xe, Ye
AppendEntityWord[leftMargin + currentColumn*(width + spaceBetweenColumns)];
AppendEntityWord[bottomMargin];
IF pageHeader # NIL THEN header ← 3*heightOfHeaderLine;
IF pageTrailer # NIL THEN trailer ← 3*heightOfHeaderLine;
AppendEntityWord[0];
AppendEntityWord[-trailer]; -- left, bottom
AppendEntityWord[width]; -- width
AppendEntityWord[height + header + trailer]; -- height
END;
cardinal ← entityIndex - firstEntityIndexOfPage;
AppendEntityWord[1 + cardinal/2]; -- entity-length
currentPageNumber ← currentPageNumber + 1;
IF (currentColumn ← currentColumn + 1) = numberOfColumns THEN
EndCurrentPaper[];
END;
Headers: PROCEDURE =
BEGIN OPEN data;
buffer: STRING = [4];
fontPointer: LONG POINTER TO PressFontInfo ← currentFontPointer;
-- Each new page starts out in font 0, but we have to switch the pointer so that the width calculations work out ok. If not, and headers are in a bigger font than the current font, the page number will overflow its line.
IF pageHeader = NIL THEN RETURN;
currentFontPointer ← fontZeroPointer;
currentX ← 0;
currentY ← height + 3*heightOfHeaderLine;
BeginLine[];
String[pageHeader];
FlushBuffer[];
LongString.AppendDecimal[buffer, currentPageNumber];
SkipSomeSpace[width - buffer.length*widthOfHeaderDigit - currentX];
String[buffer];
EndCurrentLine[];
currentFontPointer ← fontPointer;
END;
Trailers: PROCEDURE =
BEGIN OPEN data;
buffer: STRING = [4];
fontPointer: LONG POINTER TO PressFontInfo ← currentFontPointer;
IF pageTrailer = NIL THEN RETURN;
IF currentFontPointer.index # 0 THEN AppendEntityByte[EFont + 0]; -- font 0
currentFontPointer ← fontZeroPointer;
currentX ← 0;
currentY ← 0 - 2*heightOfHeaderLine;
BeginLine[];
String[pageTrailer];
FlushBuffer[];
LongString.AppendDecimal[buffer, currentPageNumber];
SkipSomeSpace[width - buffer.length*widthOfHeaderDigit - currentX];
String[buffer];
EndCurrentLine[];
currentFontPointer ← fontPointer;
END;
BeginPaper: PROCEDURE =
BEGIN OPEN data;
IF paperActive THEN ERROR InternalError;
Zero[entityList, wordsPerEntityList];
entityIndex ← 0;
AppendEntityWord[0]; -- marker
firstDataRecordOfPaper ← currentRecordNumber;
paperActive ← TRUE;
paperCharacters ← 0;
currentColumn ← 0;
END;
EndCurrentPaper: PROCEDURE =
BEGIN OPEN data;
pad: CARDINAL;
IF pageActive THEN EndCurrentPage[];
THROUGH [0..2 + (Inline.LowHalf[Streams.GetIndex[pressFile]] MOD 2)) DO
-- word boundary + 2 zeros
Streams.PutByte[pressFile, 0]
ENDLOOP;
[] ← Streams.PutBlock[pressFile, entityList, entityIndex/2];
pad ← wppr - (CARDINAL[Inline.LowHalf[Streams.GetIndex[pressFile]]] MOD bppr)/2;
THROUGH [0..pad) DO
Streams.PutByte[pressFile, 0]; Streams.PutByte[pressFile, 0]; ENDLOOP;
AppendPartItem[PressFormat.PETypePage, pad];
paperActive ← FALSE;
END;
SetCurrentFont: PUBLIC PROCEDURE [font: FontIndex, w: FontWeight, s: FontSlope] =
BEGIN OPEN data;
ff: FontFace ← 0;
new: LONG POINTER TO PressFontInfo;
IF data = NIL THEN ERROR BadParameters;
IF font NOT IN FontIndex OR userFonts[font].family = NIL THEN
ERROR BadParameters;
SELECT w FROM
medium => ff ← ff + 0;
bold => ff ← ff + 2;
--light => ff ← ff+4;
ENDCASE => ERROR BadParameters;
SELECT s FROM
regular => ff ← ff + 0;
italic => ff ← ff + 1;
ENDCASE => ERROR BadParameters;
--SELECT expansion FROM
-- regular => ff ← ff+0;
-- condensed => ff ← ff+6;
-- expanded => ff ← ff+12;
-- ENDCASE => ERROR BadParameters;
IF ~landscape THEN
BEGIN
IF userFonts[font].portrait[ff] = NIL THEN FindPressSlot[font, ff, w, s];
new ← userFonts[font].portrait[ff];
END
ELSE
BEGIN
IF userFonts[font].landscape[ff] = NIL THEN FindPressSlot[font, ff, w, s];
new ← userFonts[font].landscape[ff];
END;
IF new = currentFontPointer THEN RETURN;
currentFontPointer ← new;
IF lineActive THEN FlushBuffer[];
IF currentFontPointer.index NOT IN FontIndex THEN ERROR InternalError;
IF ~pageActive THEN RETURN;
AppendEntityByte[EFont + currentFontPointer.index]; -- Font
lineHeight ← MAX[lineHeight, currentFontPointer.height];
END;
FindPressSlot: PROCEDURE [font: FontIndex, ff: FontFace, w: FontWeight, s: FontSlope] =
BEGIN OPEN data;
i: FontIndex;
pf: LONG POINTER TO PressFontInfo;
rot: CARDINAL ← IF landscape THEN 60*90 ELSE 0;
family: LONG STRING = userFonts[font].family;
points: Points = userFonts[font].size;
FOR i IN FontIndex DO
pf ← @pressFonts[i];
IF pf.user = NIL THEN EXIT; -- empty slot - use it
IF pf.user = @userFonts[font] AND pf.face = ff AND pf.rotation = rot THEN
EXIT;
REPEAT FINISHED => ERROR MoreThan16Fonts;
ENDLOOP;
IF pf.user = NIL THEN
BEGIN OPEN pf;
pf↑ ←
[index: i, face: ff, widths: LongStorage.Words[SIZE[WidthArray]],
rotation: rot, user: @userFonts[font]];
-- initialize to something legal
height ← PointsToMicas[points];
width ← IF landscape THEN widthGacha6 ELSE widthGacha8;
pf.widths↑ ← ALL[width];
[fBBox, fBBoy, width, ] ← PressUtilities.FindFontWidths[
family, points, w, s, pf.widths !
Segments.FileNameProblem[],
PressUtilities.ErrorReadingFontWidths,
PressUtilities.FontNotInFontsDotWidths => CONTINUE];
END;
IF landscape THEN userFonts[font].landscape[ff] ← pf
ELSE userFonts[font].portrait[ff] ← pf;
END;
PointsToMicas: PROCEDURE [p: Points] RETURNS [Mica] =
BEGIN OPEN Inline;
RETURN[LongDiv[LongMult[micasPerInch, p], pointsPerInch]];
END;
BeSureFontZeroExists: PROCEDURE =
BEGIN OPEN data;
fontZero: FontIndex = FIRST[FontIndex];
i: FontIndex = FIRST[FontIndex];
c: CHARACTER;
ff: FontFace ← 0; -- medium, regular
IF userFonts[fontZero].family # NIL THEN -- try for normal font 0
BEGIN
-- The client has already specified a font 0.
-- Activate it now so it will be the press font 0 that we can use for page headers.
SetCurrentFont[fontZero, medium, regular];
fontZeroPointer ← currentFontPointer;
heightOfHeaderLine ← currentFontPointer.height;
widthOfHeaderDigit ← currentFontPointer.widths['0];
RETURN;
END;
-- ARGH! The idiot user didn't give us any font 0. The default is Gacha 8.
-- We brew up the constants so it will work without Fonts.widhts.
PutFontInTable[fontZero, "Gacha"L, 8];
pressFonts[i] ←
[i, ff, , , , , LongStorage.Words[200B], , @userFonts[fontZero]];
pressFonts[i].height ← defaultLineHeight;
pressFonts[i].width ← defaultCharWidth;
FOR c IN [40C..176C] DO pressFonts[i].widths[c] ← defaultCharWidth; ENDLOOP;
IF landscape THEN
BEGIN
userFonts[fontZero].landscape[ff] ← @pressFonts[i];
pressFonts[i].rotation ← 90*60;
END
ELSE
BEGIN
userFonts[fontZero].portrait[ff] ← @pressFonts[i];
pressFonts[i].rotation ← 0;
END;
currentFontPointer ← @pressFonts[i];
fontZeroPointer ← currentFontPointer;
heightOfHeaderLine ← currentFontPointer.height;
widthOfHeaderDigit ← currentFontPointer.widths['0];
AppendEntityByte[EFont + i]; -- Font
END;
FlushFontBuffers: PUBLIC PROCEDURE =
BEGIN OPEN data;
FOR i: FontIndex IN FontIndex DO
IF pressFonts[i].widths # NIL THEN
LongStorage.FreeWords[pressFonts[i].widths];
pressFonts[i] ← [0, 0, 0, 0, 0, 0, NIL, 0, NIL];
ENDLOOP;
END;
AppendEntityByte: PROCEDURE [b: BYTE] =
BEGIN OPEN data;
IF entityIndex = bytesPerEntityList THEN ERROR ELBufferOverflow;
entityList[entityIndex] ← b;
entityIndex ← entityIndex + 1;
END;
AppendEntityWord: PROCEDURE [w: UNSPECIFIED] =
{AppendEntityByte[Inline.HighByte[w]]; AppendEntityByte[Inline.LowByte[w]]};
AppendPartItem: PROCEDURE [type: PressFormat.PartType, last: CARDINAL] =
BEGIN OPEN data;
page: CARDINAL;
IF partIndex = partsPerDocument THEN ERROR PartBufferOverflow;
page ← Inline.LowHalf[Streams.GetIndex[pressFile] / bppr];
partList[partIndex] ←
[Type: type, pStart: firstDataRecordOfPaper,
pRecs: page - firstDataRecordOfPaper, Padding: last];
partIndex ← partIndex + 1;
currentRecordNumber ← page;
END;
KillString: PROCEDURE [where: LONG POINTER TO LONG STRING] =
{LongStorage.Free[where↑]; where↑ ← NIL};
MakeMeACopy: PROCEDURE [where: LONG POINTER TO LONG STRING, newString: LONG STRING] =
BEGIN OPEN LongStorage;
KillString[where];
IF newString # NIL THEN
BEGIN
where↑ ← String[newString.length];
LongString.AppendString[where↑, newString];
END;
END;
Zero: PROCEDURE [p: LONG POINTER, nwords: CARDINAL] =
BEGIN
IF nwords = 0 THEN RETURN;
p↑ ← 0;
Inline.LongCOPY[from: p, to: p+1, nwords: nwords-1];
END;
PackString: PROCEDURE [s: LONG STRING, p: LONG POINTER] =
BEGIN
ps: LONG POINTER TO PACKED ARRAY OF UNSPECIFIED[0..255] = p;
FOR i: CARDINAL IN [0..s.length) DO ps[i+1] ← s[i] ENDLOOP;
ps[0] ← s.length;
END;
-- initialization
END.