SirPressImpl.mesa
Last edited by Michael Plass, July 9, 1984 10:29:42 am PDT
Press File Interface Implementation
Written by Michael Plass
Definitions: SirPress.mesa
DIRECTORY
Rope USING [ROPE, Equal, Size, Fetch],
Real USING [Float],
Basics USING [HighHalf, LowHalf, LowByte, HighByte, BITAND, BITOR, BITXOR, BITSHIFT],
FS USING [StreamOpen],
IO USING [STREAM, PutChar, PutBlock, PutRope, UnsafePutBlock, GetIndex, Close],
BasicTime USING [Now, GMT, ToPupTime],
Convert USING [RopeFromInt, RopeFromTime],
RealConvert USING [IeeeToBcpl],
Terminal USING [BWCursorBitmap],
SirPress;
SirPressImpl: CEDAR PROGRAM
IMPORTS Rope, Real, Basics, FS, IO, BasicTime, Convert, RealConvert
EXPORTS SirPress = BEGIN
OPEN SirPress;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Constants
fontSetLimit: NAT = 256; -- max number of font sets (there are 16 fonts in each set)
micasPerInch: NAT = 2540;
bufferBlockLength: NAT = 512;
unitsPerMica: INT = 10000;
newPressCursor: Terminal.BWCursorBitmap = [
000000B,000000B,177740B,100040B,
100040B,100040B,100040B,100040B,
100040B,100040B,100040B,100040B,
100040B,100040B,100040B,177740B
];
Types
FontSetNumber: TYPE = [0..fontSetLimit];
dummyFontSet: FontSetNumber = fontSetLimit;
Byte: TYPE = [0..255];
FontNumber: TYPE = [0..fontSetLimit*16]; -- (font set) * 16 + (font selector)
dummyFont: FontNumber = fontSetLimit*16;
T: TYPE = INT; -- for declaring local temporary variables
Data Structure Definitions
PressHandle: PUBLIC TYPE = REF PressStateVector;
PressStateVector:
PUBLIC
TYPE =
RECORD [
-- represents the state of the partially completed press file
f: STREAM,
landScape: BOOLEAN,
prtMode: INTEGER,
micaHeight: NAT ← 0,
micaWidth: NAT ← 0,
current: PressParameters,
entities: LIST OF Entity,
elBuffer: ByteBuffer,
dlBuffer: REF TEXT,
currentPagePartOrigin: INT ← 0,
currentEntityOrigin: INT ← 0,
positionGood: BOOLEAN ← FALSE,
state: PressState ← normal,
The following fields are used only when there is a show-dots, show-object, or pipe active
dlSavedIndex: INT ← 0,
dlExtraBits: CARDINAL ← 0,
dlExtraRoom: [0..16] ← 16,
dotCoding: DotCoding ← bitMap,
numberOfDotsPerLine: INT ← 0,
numberOfLinesToGo: INT ← 0,
pipeXSpace: INT ← 0,
writtenPartCount: INT ← 0,
writtenPageParts: LIST OF WrittenPagePart ← NIL, -- in reverse order
fontTable: FontTable,
fileName: ROPE ← NIL,
creatorName: ROPE,
pressCursor:
REF Terminal.BWCursorBitmap ←
NEW[Terminal.BWCursorBitmap ← newPressCursor],
cursorObject: CursorObject
];
PressState: TYPE = {normal, closed, outline, dots, piping};
WrittenPagePart:
TYPE =
RECORD [
partType: NAT ← 0, -- part type (0 for page part, 1 for font directory)
partOrigin: INT, -- offset of beginning of part (in bytes)
partLength: INT, -- length of the part, in bytes
entityListPadding: NAT ← 0 -- number of padding words after the entity list (for a page part)
];
Entity:
TYPE =
RECORD [
-- Represents the current contents of an entity
fontSet: FontSetNumber ← dummyFontSet,
parameters: PressParameters,
length: INT ← 0,
dataListOrigin: INT ← 0, -- In bytes, wrt the beginning of the file
dataListLength: INT ← 0 -- In bytes
];
PressParameters:
TYPE =
RECORD [
font: FontNumber ← dummyFont,
spaceReset: BOOLEAN ← TRUE,
xSpace: INTEGER ← -32767,
ySpace: INTEGER ← -32767,
brightness: [0..255] ← 0,
hue: [0..240] ← 0,
saturation: [0..255] ← 0
];
FontTable:
TYPE =
RECORD [
nextAvailFontNumber: NAT ← 16,
fontList: LIST OF Font ← NIL
];
Font:
TYPE =
RECORD [
fontNumber: FontNumber,
fontFamily: ROPE,
fontFace: Byte,
fontMicaSize: INTEGER,
fontRotation: NAT
];
Entity List commands
ELCommand: TYPE = Byte;
ELShowCharactersShort: ELCommand = 0;
ELSkipCharactersShort: ELCommand = 40B;
ELShowCharactersAndSkip: ELCommand = 100B;
ELSetSpaceXShort: ELCommand = 140B;
ELSetSpaceYShort: ELCommand = 150B;
ELFont: ELCommand = 160B;
ELSkipControlBytesImmediate: ELCommand = 353B;
ELAlternative: ELCommand = 354B;
ELOnlyOnCopy: ELCommand = 355B;
ELSetX: ELCommand = 356B;
ELSetY: ELCommand = 357B;
ELShowCharacters: ELCommand = 360B;
ELSkipCharacters: ELCommand = 361B;
ELSkipControlBytes: ELCommand = 362B;
ELShowCharacterImmediate: ELCommand = 363B;
ELSetSpaceX: ELCommand = 364B;
ELSetSpaceY: ELCommand = 365B;
ELResetSpace: ELCommand = 366B;
ELSpace: ELCommand = 367B;
ELSetBrightness: ELCommand = 370B;
ELSetHue: ELCommand = 371B;
ELSetSaturation: ELCommand = 372B;
ELShowObject: ELCommand = 373B;
ELShowDots: ELCommand = 374B;
ELShowDotsOpaque: ELCommand = 375B;
ELShowRectangle: ELCommand = 376B;
ELNop: ELCommand = 377B;
Data List commands
DLMoveTo: CARDINAL = 0;
DLDrawTo: CARDINAL = 1;
DLDrawCurve: CARDINAL = 2;
DLSetCoding: Byte = 1; --byte
DLSetWindow: CARDINAL = 1; --word
DLSetMode: Byte = 2; --byte
DLSetSize: CARDINAL = 2; --word
DLDotsFollow: CARDINAL = 3; --word
DLGetDotsFromFile: CARDINAL = 4; --word
DLGetDotsFromPressFile: CARDINAL = 5; --word
DLSetSamplingProperties: CARDINAL = 6; --word
DLSSPInputIntensity: CARDINAL = 0; --word
DLSSPOutputIntensity: CARDINAL = 1; --word
DLSSPScreen: CARDINAL = 2; --word
DLSSPDot: CARDINAL = 3; --word
Signals and Errors
Code:
TYPE = {
noCurrentPosition,
directionsNotAtRightAngles,
wrongNumberOfScanLines,
improperScanLineCoding,
wrongScanLineLength,
invalidCommandSequence
};
SirPressError: SIGNAL [code: Code] = CODE;
Conversion routines
LogicalAnd:
PROC[n:
INT, m:
CARDINAL]
RETURNS [
CARDINAL] =
BEGIN
nc: CARDINAL = Basics.LowHalf[n];
RETURN[Basics.BITAND[nc, m]];
END;
BitShift:
PROC[bits:
CARDINAL, amountToShiftLeft:
CARDINAL]
RETURNS [
CARDINAL] =
BEGIN
RETURN[Basics.BITSHIFT[bits, amountToShiftLeft]];
END;
FromInt:
PROC [n:
INT, base:
NAT ← 10]
RETURNS [
ROPE] =
BEGIN -- Returns a printable repesentation of n in the given base.
RETURN[Convert.RopeFromInt[n, base]];
END;
RopeFromTime:
PROC[time:BasicTime.GMT]
RETURNS [
ROPE] =
BEGIN
RETURN[Convert.RopeFromTime[from: time, includeDayOfWeek: TRUE]];
END;
CurrentTime:
PROC
RETURNS [time:BasicTime.GMT] =
TRUSTED
BEGIN
RETURN[BasicTime.Now[]];
END;
UpperCase:
PROC[c:
CHARACTER]
RETURNS [
CHARACTER] =
INLINE {IF 'a <= c AND c <= 'z THEN c ← c - ('a - 'A); RETURN[c]};
Interface Implementation Routines
NewPressHandle:
PUBLIC
PROC [pressFileName:
ROPE]
RETURNS [PressHandle] =
{RETURN[Create[FS.StreamOpen[pressFileName, $create], pressFileName, NIL, normal, NIL]]};
Create:
PUBLIC
PROC [
outputStream: STREAM,
fileNameForHeaderPage: ROPE,
creatorName: ROPE,
printingMode: PrintingMode,
cursorObject: CursorObject
] RETURNS [p: PressHandle] =
BEGIN
printingModeCode: ARRAY PrintingMode OF INTEGER = [-1, LOOPHOLE['R], LOOPHOLE['S], LOOPHOLE['T]];
p ←
NEW[PressStateVector ← [
f: outputStream,
landScape: FALSE,
prtMode: printingModeCode[printingMode],
fileName: fileNameForHeaderPage,
creatorName: creatorName,
cursorObject: cursorObject
]];
ResetELBuffer[p];
p.dlBuffer ← NEW[TEXT[bufferBlockLength]];
p.dlBuffer.length ← 0;
SetPageSize[p];
SetPageSize:
PUBLIC
PROC [
-- applies for the current and following pages
p: PressHandle,
height: INT ← 110,
width: INT ← 85,
unit: INT ← in/10] =
BEGIN
p^.micaHeight ← height*unit/unitsPerMica;
p^.micaWidth ← width*unit/unitsPerMica;
IF p^.micaWidth > p^.micaHeight
THEN {
t: T ← p^.micaWidth; p^.micaWidth ← p^.micaHeight; p^.micaHeight ← t;
p^.landScape ← TRUE;
}
ELSE p^.landScape ← FALSE;
END;
SetSpace:
PUBLIC
PROC [p: PressHandle, xSpace:
INT, ySpace:
INT𡤀,
unit: INT ← mica] =
BEGIN
IF p^.landScape THEN {t:T← ySpace; ySpace←xSpace; xSpace←-t};
State[p,normal];
p^.current.spaceReset ← FALSE;
p^.current.xSpace ← xSpace*unit/unitsPerMica;
p^.current.ySpace ← ySpace*unit/unitsPerMica;
END;
ResetSpace:
PUBLIC
PROC [p: PressHandle] =
BEGIN
State[p,normal];
p^.current.spaceReset ← TRUE;
p^.current.xSpace ← -32767;
p^.current.ySpace ← -32767;
END;
SetColor:
PUBLIC
PROC [p: PressHandle, hue,saturation,brightness:
INT] =
BEGIN
SetHue[p,hue];
SetSaturation[p,saturation];
SetBrightness[p,brightness];
END;
SetHue:
PUBLIC
PROC [p: PressHandle, hue:
INT] =
BEGIN
State[p,normal];
p^.current.hue ← hue MOD 240;
END;
SetSaturation:
PUBLIC
PROC [p: PressHandle, saturation:
INT] =
BEGIN
ShowCursor[p];
State[p,normal];
p^.current.saturation ← saturation;
END;
SetBrightness:
PUBLIC
PROC [p: PressHandle, brightness:
INT] =
BEGIN
State[p,normal];
p^.current.brightness ← brightness;
END;
PutSpace:
PUBLIC
PROC [p: PressHandle] =
BEGIN
State[p,normal];
IF p^.current.font = dummyFont THEN SetFont[p,"HELVETICA",10];
SelectEntity[p];
PutELByte[p,ELSpace];
END;
SetFont:
PUBLIC
PROC [
p: PressHandle,
family: ROPE,
size: INT,
face: INT ← 0,
rotation: INT ← 0,
unit: INT ← pt -- unit for size, in nanometers--
] =
{SetFontFromCode[p,GetFontCode[p,family,size,face,rotation,unit]]};
PutText:
PUBLIC
PROC [
p: PressHandle,
textString: ROPE,
xCoordinateOfLeftEdge: INT,
yCoordinateOfBaseline: INT,
unit: INT ← mica
] =
BEGIN
IF p^.landScape
THEN {t:
T←yCoordinateOfBaseline*unit/unitsPerMica;
yCoordinateOfBaseline ← xCoordinateOfLeftEdge*unit/unitsPerMica;
xCoordinateOfLeftEdge ← p^.micaWidth - t}
ELSE {xCoordinateOfLeftEdge ← xCoordinateOfLeftEdge*unit/unitsPerMica;
yCoordinateOfBaseline ← yCoordinateOfBaseline*unit/unitsPerMica};
AddRectangleToCursor[
p, xCoordinateOfLeftEdge, yCoordinateOfBaseline,
Rope.Size[textString]*176, 1
];
State[p,normal];
IF p^.current.font = dummyFont THEN SetFont[p,"HELVETICA",10];
SelectEntity[p];
PutELByte[p,ELSetX];
PutELWord[p, Basics.LowHalf[xCoordinateOfLeftEdge]];
PutELByte[p, ELSetY];
PutELWord[p, Basics.LowHalf[yCoordinateOfBaseline]];
p^.positionGood ← TRUE;
PutELShowCharacters[p, Rope.Size[textString]];
PutDLRope[p,textString];
ShowCursor[p];
END;
PutTextHere:
PUBLIC
PROC [p: PressHandle, textString:
ROPE] =
BEGIN
State[p,normal];
IF p^.current.font = dummyFont THEN SetFont[p,"HELVETICA",10];
SelectEntity[p];
IF NOT p^.positionGood THEN SIGNAL SirPressError[noCurrentPosition];
PutELShowCharacters[p, Rope.Size[textString]];
PutDLRope[p,textString];
END;
PutELShowCharacters:
PROCEDURE [p:PressHandle, i:
NAT] =
BEGIN
WHILE i>255
DO
PutELByte[p,ELShowCharacters];
PutELByte[p,255];
i ← i-255;
ENDLOOP;
IF i>0
THEN
BEGIN
IF i<=32 THEN {PutELByte[p,ELShowCharactersShort+i-1]}
ELSE {PutELByte[p,ELShowCharacters]; PutELByte[p,i]};
END;
END;
PutRectangle:
PUBLIC
PROC [p: PressHandle, xstart, ystart, xlen, ylen:
INT, unit:
INT ← mica] =
BEGIN
IF p^.landScape
THEN {t:
T←ystart*unit/unitsPerMica;
ystart ← xstart*unit/unitsPerMica;
xstart ← p^.micaWidth - t;
t←ylen*unit/unitsPerMica;
ylen←xlen*unit/unitsPerMica;
xlen←t;
xstart←xstart-xlen}
ELSE {xstart←xstart*unit/unitsPerMica;
ystart←ystart*unit/unitsPerMica;
xlen←xlen*unit/unitsPerMica;
ylen←ylen*unit/unitsPerMica};
AddRectangleToCursor[p,xstart,ystart,xlen,ylen];
State[p,normal];
SelectEntity[p];
PutELByte[p, ELSetX];
PutELWord[p, Basics.LowHalf[xstart]];
PutELByte[p, ELSetY];
PutELWord[p, Basics.LowHalf[ystart]];
PutELByte[p, ELShowRectangle];
PutELWord[p, LOOPHOLE[INTEGER[xlen]]];
PutELWord[p, LOOPHOLE[INTEGER[ylen]]];
p^.positionGood ← FALSE;
ShowCursor[p];
END;
BeginScannedRectangle:
PUBLIC
PROC [
p: PressHandle,
x, y: INT,
dotsPerLine: INT,
numberOfLines: INT,
width: INT ← -1,
height: INT ← -1,
unit: INT ← mica,
nextLineDirection: Direction ← down,
nextDotDirection: Direction ← right,
coding: DotCoding ← bitMap,
samplingProperties: SamplingProperties
] =
BEGIN
encodeCoding: ARRAY DotCoding OF Byte = [0, 1, 2, 4, 8, 0];
rot: ARRAY Direction OF Direction = [up,down,left,right];
lineDir, dotDir: Byte;
onEar: BOOLEAN ← nextDotDirection = up OR nextDotDirection = down;
AlignDLToWord[p];
x ← x*unit/unitsPerMica;
y ← y*unit/unitsPerMica;
width ← width*unit/unitsPerMica;
height ← height*unit/unitsPerMica;
unit ← mica;
IF p^.landScape
THEN
BEGIN
t:T ← y; y←x; x←p^.micaWidth - t;
t←width; width ← height; height ← t;
nextLineDirection ← rot[nextLineDirection];
nextDotDirection ← rot[nextDotDirection];
onEar ← NOT onEar;
END;
IF height<=0
OR width<=0
THEN
BEGIN -- need to fill in an omitted height, width, or both
heightInDots:T ← IF onEar THEN dotsPerLine ELSE numberOfLines;
widthInDots:T ← IF onEar THEN numberOfLines ELSE dotsPerLine;
IF height>0 THEN {width ← height*widthInDots/heightInDots}
ELSE IF width>0 THEN {height ← width*heightInDots/widthInDots}
ELSE {height←heightInDots*32; width←widthInDots*32}
END;
IF p^.landScape THEN x ← x-width;
AddRectangleToCursor[p,x,y,width,height];
State[p,normal];
IF onEar
AND (nextLineDirection = up
OR nextLineDirection = down)
THEN
SIGNAL SirPressError[directionsNotAtRightAngles];
SelectEntity[p];
p^.state ← dots;
p^.dlSavedIndex ← DLIndex[p];
p^.dotCoding ← coding;
p^.numberOfDotsPerLine ← dotsPerLine;
p^.numberOfLinesToGo ← numberOfLines;
PutELByte[p,ELSetX];
PutELWord[p, CARDINAL[x]];
PutELByte[p, ELSetY];
PutELWord[p, CARDINAL[y]];
PutDLByte[p, DLSetCoding];
PutDLByte[p, encodeCoding[coding]];
PutDLWord[p, dotsPerLine];
PutDLWord[p, numberOfLines];
PutDLWord[p, DLSetSize];
PutDLWord[p, width];
PutDLWord[p, height];
PutDLByte[p, DLSetMode];
lineDir ← LOOPHOLE[nextLineDirection];
dotDir ← LOOPHOLE[nextDotDirection];
PutDLByte[p, dotDir*4 + lineDir];
IF
NOT samplingProperties.omitted
THEN {
PutDLWord[p, DLSetSamplingProperties];
PutDLWord[p, 7]; -- number of words of properties
PutDLWord[p, DLSSPInputIntensity];
PutDLWord[p, samplingProperties.minIntensity];
PutDLWord[p, samplingProperties.maxIntensity];
PutDLWord[p, DLSSPScreen];
PutDLWord[p, samplingProperties.screenAngle];
PutDLWord[p, samplingProperties.screenAmplitude];
PutDLWord[p, samplingProperties.screenFrequency];
};
PutDLWord[p, DLDotsFollow];
FlushDLBuffer[p];
ShowCursor[p];
END;
UnsafeShowLine:
PUBLIC
UNSAFE
PROC [
p: PressHandle,
dataPointer: LONG POINTER
] = UNCHECKED
BEGIN
sampleSize, scanlineSizeInWords: NAT;
State[p,dots];
sampleSize ←
SELECT p.dotCoding
FROM
bitMap => 1,
packedMap => 1,
bitSampled => 1,
bitBitSampled => 2,
nybbleSampled => 4,
byteSampled => 8,
ENDCASE => ERROR;
scanlineSizeInWords ← (p.numberOfDotsPerLine*sampleSize)/16;
IF scanlineSizeInWords*16 # p.numberOfDotsPerLine*sampleSize THEN ERROR;
IO.UnsafePutBlock[p.f, [base: dataPointer, startIndex: 0, count: scanlineSizeInWords*2]];
p^.numberOfLinesToGo ← p^.numberOfLinesToGo - 1;
END;
ShowLine:
PUBLIC
PROC [
p: PressHandle,
s: REF ScanLine
] =
BEGIN OPEN p^;
PutDLBits:
PROC [x:
CARDINAL, w: [0..16]] =
-- INLINE
BEGIN -- put bits to the DL. The data must not span a word boundary.
dlExtraRoom ← dlExtraRoom - w;
dlExtraBits ← dlExtraBits + BitShift[x, dlExtraRoom];
IF dlExtraRoom <= 0
THEN
BEGIN
PutDLWord[p,dlExtraBits];
dlExtraRoom ← 16;
dlExtraBits ← 0;
END;
END;
State[p,dots];
IF numberOfLinesToGo = 0 THEN SIGNAL SirPressError[wrongNumberOfScanLines];
WITH s
SELECT
FROM
bitMap =>
BEGIN
IF dotCoding # bitMap THEN SIGNAL SirPressError[improperScanLineCoding];
IF numberOfDotsPerLine # length THEN SIGNAL SirPressError[wrongScanLineLength];
FOR i:NAT IN [0..length) DO PutDLBits[bit[i],1]; ENDLOOP;
END;
packedMap =>
BEGIN
IF dotCoding # packedMap
AND dotCoding # bitMap
THEN
SIGNAL SirPressError[improperScanLineCoding];
IF numberOfDotsPerLine # length*16 THEN SIGNAL SirPressError[wrongScanLineLength];
FOR i:NAT IN [0..length) DO PutDLWord[p,bitWord[i]]; ENDLOOP;
END;
bitSampled =>
BEGIN
IF dotCoding # bitSampled THEN SIGNAL SirPressError[improperScanLineCoding];
IF numberOfDotsPerLine # length THEN SIGNAL SirPressError[wrongScanLineLength];
FOR i:NAT IN [0..length) DO PutDLBits[intensity[i],1]; ENDLOOP;
END;
bitBitSampled =>
BEGIN
IF p^.dotCoding # bitBitSampled THEN SIGNAL SirPressError[improperScanLineCoding];
IF p^.numberOfDotsPerLine # length THEN SIGNAL SirPressError[wrongScanLineLength];
FOR i:NAT IN [0..length) DO PutDLBits[intensity[i],2]; ENDLOOP;
END;
nybbleSampled =>
BEGIN
IF p^.dotCoding # nybbleSampled THEN SIGNAL SirPressError[improperScanLineCoding];
IF p^.numberOfDotsPerLine # length THEN SIGNAL SirPressError[wrongScanLineLength];
FOR i:NAT IN [0..length) DO PutDLBits[intensity[i],4]; ENDLOOP;
END;
byteSampled =>
BEGIN
IF p^.dotCoding # byteSampled THEN SIGNAL SirPressError[improperScanLineCoding];
IF p^.numberOfDotsPerLine # length THEN SIGNAL SirPressError[wrongScanLineLength];
FOR i:NAT IN [0..length) DO PutDLBits[intensity[i],8]; ENDLOOP;
END;
ENDCASE;
p^.numberOfLinesToGo ← p^.numberOfLinesToGo - 1;
ShowCursor[p];
END;
EndScannedRectangle:
PUBLIC
PROC [p: PressHandle] =
BEGIN
n: INT;
State[p,dots];
IF p^.numberOfLinesToGo # 0 THEN SIGNAL SirPressError[wrongNumberOfScanLines];
IF p^.dlExtraRoom < 16
THEN {PutDLWord[p,p^.dlExtraBits];
p^.dlExtraRoom ← 16;
p^.dlExtraBits ← 0};
n ← DLIndex[p] - p^.dlSavedIndex;
n ← n/2;
PutELByte[p,ELShowDots];
PutELWord[p, Basics.HighHalf[n]];
PutELWord[p, Basics.LowHalf[n]];
p^.state ← normal;
ShowCursor[p];
END;
StartOutline:
PUBLIC
PROC [p: PressHandle] =
BEGIN
State[p,normal];
SelectEntity[p];
p^.state←outline;
AlignDLToWord[p];
p^.dlSavedIndex ← DLIndex[p];
END;
PutMoveTo:
PUBLIC
PROC [p: PressHandle, x, y:
INT, unit:
INT ← mica] =
BEGIN
IF p^.landScape
THEN {t:
T←y*unit/unitsPerMica;
y ← x*unit/unitsPerMica;
x ← p^.micaWidth - t;
unit←mica};
State[p,outline];
PutDLWord[p,DLMoveTo];
PutDLWord[p, x*unit/unitsPerMica];
PutDLWord[p, y*unit/unitsPerMica];
END;
PutDrawTo:
PUBLIC
PROC [p: PressHandle, x, y:
INT, unit:
INT ← mica] =
BEGIN
IF p^.landScape
THEN {t:
T←y*unit/unitsPerMica;
y ← x*unit/unitsPerMica;
x ← p^.micaWidth - t;
unit←mica};
State[p,outline];
PutDLWord[p,DLDrawTo];
PutDLWord[p, x*unit/unitsPerMica];
PutDLWord[p, y*unit/unitsPerMica];
END;
PutCubic:
PUBLIC
PROC [p: PressHandle, x1, y1, x2, y2, x3, y3:
REAL, unit:
INT ← mica] =
BEGIN
u:REAL ← Real.Float[unit]/Real.Float[unitsPerMica];
State[p,outline];
PutDLWord[p,DLDrawCurve];
IF p^.landScape
THEN
BEGIN
PutDLReal[p,-y1*u];
PutDLReal[p,x1*u];
PutDLReal[p,-y2*u];
PutDLReal[p,x2*u];
PutDLReal[p,-y3*u];
PutDLReal[p,x3*u];
END
ELSE
BEGIN
PutDLReal[p,x1*u];
PutDLReal[p,y1*u];
PutDLReal[p,x2*u];
PutDLReal[p,y2*u];
PutDLReal[p,x3*u];
PutDLReal[p,y3*u];
END
END;
EndOutline:
PUBLIC
PROC [p: PressHandle] =
BEGIN
State[p,outline];
IF DLIndex[p] > p^.dlSavedIndex
THEN
BEGIN
PutELByte[p, ELShowObject];
PutELWord[p, CARDINAL[(DLIndex[p]-p^.dlSavedIndex)/2]];
END;
p^.state ← normal;
END;
WritePage:
PUBLIC
PROC [p: PressHandle] =
BEGIN OPEN p^;
State[p,normal];
WriteCurrentPart[p];
positionGood ← FALSE;
current ← PressParameters[];
entities ← NIL;
ShowCursor[p];
END;
ClosePress:
PUBLIC
PROC [p: PressHandle] =
BEGIN
partDirectoryOrigin: INT;
State[p,normal];
WriteCurrentPart[p];
WriteFontDirectory[p];
partDirectoryOrigin ← IO.GetIndex[p^.f];
WritePartDirectory[p];
WriteDocumentDirectory[p,partDirectoryOrigin];
IO.Close[p^.f];
p^.state ← closed;
OldCursor[p];
END;
DefaultCursorProc: PUBLIC CursorProc = {};
The remaining calls are for fast character-oriented output of text.
FontCode: TYPE = SirPress.FontCode;
GetFontCode:
PUBLIC
PROC[
p: PressHandle,
family: ROPE,
size: INT,
face: INT ← 0,
rotation: INT ← 0,
unit: INT ← pt -- unit for size, in nanometers--
] RETURNS [FontCode] =
BEGIN
micaSize:
INT =
IF unit=pt
THEN -size
--for compatability
ELSE size*unit/unitsPerMica;
a: LIST OF Font ← p^.fontTable.fontList;
IF p^.landScape THEN {rotation←(rotation+(90*60)) MOD (360*60)};
State[p,normal];
WHILE a #
NIL
DO
IF micaSize = a.first.fontMicaSize
AND
face = a.first.fontFace AND
Rope.Equal[family, a.first.fontFamily, FALSE] AND
rotation = a.first.fontRotation THEN EXIT;
a ← a.rest;
ENDLOOP;
IF a =
NIL
THEN
BEGIN
n: FontNumber ← p^.fontTable.nextAvailFontNumber;
p^.fontTable.nextAvailFontNumber ← n+1;
a ← CONS[[n, family, face, micaSize, rotation], p^.fontTable.fontList];
p^.fontTable.fontList ← a;
END;
ShowCursor[p];
RETURN [a.first.fontNumber];
END;
SetFontFromCode:
PUBLIC
PROC [p: PressHandle, f: FontCode] =
{p^.current.font ← f};
NewPipe:
PUBLIC
PROCEDURE [maximumNumberOfSpacesInPipe:
INT ← 200]
RETURNS [Pipe] =
{RETURN[NEW[PipeRec[maximumNumberOfSpacesInPipe]]]};
OpenPipe:
PUBLIC
PROCEDURE [p: PressHandle, pipe: Pipe] =
BEGIN
State[p, normal];
IF p^.current.font = dummyFont THEN SetFont[p,"HELVETICA",10];
SelectEntity[p];
FlushDLBuffer[p];
pipe.text ← p^.dlBuffer;
p^.dlSavedIndex ← pipe.text.length;
pipe.scount ← 0;
p^.state ← piping;
ShowCursor[p];
END;
ClosePipe:
PUBLIC
PROCEDURE [
p: PressHandle,
pipe: Pipe,
y: INTEGER
] =
BEGIN OPEN pipe^;
cp: NAT ← p^.dlSavedIndex;
State[p,piping];
IF scount>0
THEN
AddRectangleToCursor[p, slist[0].x, y, slist[scount-1].x-slist[0].x, 1];
IF p^.landScape
THEN {
xx: INT ← p^.micaWidth - y;
PutELByte[p, ELSetX];
PutELWord[p, Basics.LowHalf[xx]];
}
ELSE {
PutELByte[p, ELSetY];
PutELWord[p, Basics.LowHalf[y]];
};
FOR i:
NAT
IN [0..scount)
DO
cur: CharPtrAndPosition ← slist[i];
PutELShowCharacters[p, cur.charPtr-cp];
IF p^.landScape THEN {PutELByte[p, ELSetY]}
ELSE {PutELByte[p, ELSetX]};
PutELWord[p, Basics.LowHalf[cur.x]];
cp ← cur.charPtr;
ENDLOOP;
PutELShowCharacters[p, text.length-cp];
p^.positionGood ← FALSE;
p^.state ← normal;
text ← NIL;
scount ← 0;
ShowCursor[p];
END;
State:
PROC [p: PressHandle, s: PressState] = --
INLINE
BEGIN -- make sure the press file in in a legal state
IF p^.state # s THEN SIGNAL SirPressError[invalidCommandSequence];
END;
SelectEntity:
PROC [p: PressHandle] =
BEGIN
IF p^.entities = NIL THEN StartEntity[p];
IF p^.elBuffer.currentLength - p^.currentEntityOrigin >= 10000 THEN {FinishEntity[p]; StartEntity[p]};
IF p^.current.font/16 # p^.entities.first.fontSet
THEN {
IF p^.entities.first.fontSet # dummyFontSet AND p^.current.font # dummyFont THEN {FinishEntity[p]; StartEntity[p]};
p^.entities.first.fontSet ← p^.current.font/16
};
IF p^.current # p^.entities.first.parameters
THEN
BEGIN
OPEN p^, p^.entities.first;
IF parameters.font # current.font
THEN
PutELByte[p, ELFont+LogicalAnd[p^.current.font,17B]];
IF current.spaceReset
THEN
{IF NOT parameters.spaceReset THEN PutELByte[p, ELResetSpace]}
ELSE
BEGIN
IF parameters.xSpace # current.xSpace
THEN
BEGIN
PutELByte[p,ELSetSpaceX];
PutELWord[p, CARDINAL[current.xSpace]];
END;
IF parameters.ySpace # current.ySpace
THEN
BEGIN
PutELByte[p,ELSetSpaceY];
PutELWord[p, CARDINAL[current.ySpace]];
END;
END;
IF parameters.brightness # current.brightness
THEN
{PutELByte[p,ELSetBrightness]; PutELByte[p,current.brightness]};
IF parameters.hue # current.hue
THEN
{PutELByte[p,ELSetHue]; PutELByte[p,current.hue]};
IF parameters.saturation # current.saturation
THEN
{PutELByte[p,ELSetSaturation]; PutELByte[p,current.saturation]};
parameters ← current;
END;
END;
StartEntity:
PROC [p: PressHandle] =
BEGIN
p^.entities ← CONS[[dataListOrigin: IO.GetIndex[p^.f]], p^.entities];
p^.currentEntityOrigin ← p^.elBuffer.currentLength;
END;
FinishEntity:
PROC [p: PressHandle] =
BEGIN
FlushDLBuffer[p];
p^.entities.first.length ← p^.elBuffer.currentLength - p^.currentEntityOrigin;
p^.entities.first.dataListLength ← DLIndex[p] - p^.entities.first.dataListOrigin;
PadToWord[p^.f];
p^.positionGood ← FALSE;
END;
Data Structure Building Routines
ByteBuffer:
TYPE =
RECORD [
currentLength: INT,
blockList: LIST OF REF TEXT,
blockListEnd: LIST OF REF TEXT,
outputBlockList: LIST OF REF TEXT,
outputBlockOffset: NAT
];
ExtendELBuffer:
PROC [p: PressHandle]
RETURNS [t:
REF
TEXT] =
BEGIN
IF p^.elBuffer.blockListEnd.rest =
NIL
THEN
p^.elBuffer.blockListEnd.rest ← LIST[NEW[TEXT[bufferBlockLength]]];
p^.elBuffer.blockListEnd ← p^.elBuffer.blockListEnd.rest;
t ← p^.elBuffer.blockListEnd.first;
t.length ← 0;
END;
ResetELBuffer:
PROC [p: PressHandle]
=
BEGIN
IF p^.elBuffer.blockList = NIL THEN p^.elBuffer.blockList ← LIST[NEW[TEXT[bufferBlockLength]]];
p^.elBuffer.blockListEnd ← p^.elBuffer.blockList;
p^.elBuffer.blockList.first.length ← 0;
p^.elBuffer.currentLength ← 0;
p^.elBuffer.outputBlockList ← p^.elBuffer.blockList;
p^.elBuffer.outputBlockOffset ← 0;
END;
WriteFromELBuffer:
PROC [p: PressHandle, byteCount:
INT] =
BEGIN
obOffset: NAT ← p^.elBuffer.outputBlockOffset;
obList: LIST OF REF TEXT ← p^.elBuffer.outputBlockList;
WHILE byteCount>0
DO
block: REF TEXT ← obList.first;
stopIndexPlusOne: NAT ← MIN[byteCount + obOffset, block.length];
IO.PutBlock[self: p^.f, block: block, startIndex: obOffset, count: stopIndexPlusOne-obOffset];
byteCount ← byteCount - (stopIndexPlusOne - obOffset);
obOffset ← stopIndexPlusOne;
IF stopIndexPlusOne = block.length THEN {obOffset ← 0; obList ← obList.rest};
ENDLOOP;
p^.elBuffer.outputBlockOffset ← obOffset;
p^.elBuffer.outputBlockList ← obList;
END;
PutELByte:
PROC [p: PressHandle, byte: Byte] =
-- INLINE
BEGIN
t: REF TEXT ← p^.elBuffer.blockListEnd.first;
IF t.length = t.maxLength THEN t ← ExtendELBuffer[p];
t[t.length] ← LOOPHOLE[byte, CHARACTER];
t.length ← t.length + 1;
p^.elBuffer.currentLength ← p^.elBuffer.currentLength + 1;
END;
PutELWord:
PROC [p: PressHandle, word:
CARDINAL] =
BEGIN
PutELByte[p, Basics.HighByte[word]];
PutELByte[p, Basics.LowByte[word]];
END;
DLIndex:
PROC[p: PressHandle] RETURNS [INT] = --
INLINE
BEGIN
RETURN[IO.GetIndex[p^.f]+p^.dlBuffer.length];
END;
FlushDLBuffer:
PROC[p: PressHandle] = --
INLINE
BEGIN
IO.PutBlock[p^.f, p^.dlBuffer];
p^.dlBuffer.length ← 0;
END;
AlignDLToWord:
PROC [p: PressHandle] =
BEGIN
IF LogicalAnd[DLIndex[p], 1] = 1
THEN {
PutELByte[p,ELSkipCharactersShort+0];
PutDLByte[p,0];
};
END;
PutDLByte:
PROC[p: PressHandle, b: Byte] =
BEGIN
t: REF TEXT ← p^.dlBuffer;
l: CARDINAL ← t.length;
t.length ← l+1;
t[l] ← LOOPHOLE[b];
IF l+3>t.maxLength THEN FlushDLBuffer[p];
END;
PutDLWord:
PROC[p: PressHandle, b:
CARDINAL] =
BEGIN
t: REF TEXT ← p^.dlBuffer;
l: CARDINAL ← t.length;
t.length ← l+2;
t[l] ← '\000+Basics.HighByte[b];
t[l+1] ← '\000+Basics.LowByte[b];
IF l+4>t.maxLength THEN FlushDLBuffer[p];
END;
PutDLReal:
PROC[p: PressHandle, r:
REAL] =
BEGIN
ir:LONG CARDINAL = LOOPHOLE[RealConvert.IeeeToBcpl[r]];
PutDLWord[p, Basics.LowHalf[ir]];
PutDLWord[p, Basics.HighHalf[ir]];
END;
PutDLRope:
PROC[p: PressHandle, s:
ROPE] =
BEGIN
FlushDLBuffer[p];
IO.PutRope[p^.f, s];
END;
Data Structure Writing Routines
WriteCurrentPart:
PROC[p: PressHandle] =
BEGIN
WriteEntity:
PROC[entity: Entity] =
BEGIN
eLStart: INT ← IO.GetIndex[p^.f];
WriteFromELBuffer[p, entity.length];
PadToWord[p^.f, ELNop];
WriteByte[p^.f, 0]; -- Entity type
WriteByte[p^.f, entity.fontSet]; -- Font set
WriteLong[p^.f, entity.dataListOrigin - p^.currentPagePartOrigin]; -- Start of relevant DL portion
WriteLong[p^.f, entity.dataListLength]; -- Length of the data list
WriteWord[p^.f,0]; -- Xe
WriteWord[p^.f,0]; -- Ye
WriteWord[p^.f,0]; -- left edge of bounding box
WriteWord[p^.f,0]; -- bottom edge of bounding box
WriteWord[p^.f,p^.micaWidth]; -- page width
WriteWord[p^.f,p^.micaHeight]; -- page height
WriteWord[p^.f,(IO.GetIndex[p^.f]+2-eLStart)/2];
END;
WriteEntityList:
PROC[entities:
LIST
OF Entity] =
BEGIN
IF entities = NIL THEN RETURN;
WriteEntityList[entities.rest];
WriteEntity[entities.first];
END;
padding: NAT;
IF p^.entities = NIL THEN RETURN;
FinishEntity[p];
WriteWord[p^.f,0];
WriteEntityList[p^.entities];
ResetELBuffer[p];
p^.entities ← NIL;
padding ← PadBlock[p^.f];
p^.writtenPageParts ←
CONS[
[partOrigin: p^.currentPagePartOrigin, partLength: IO.GetIndex[p^.f] - p^.currentPagePartOrigin, entityListPadding: padding/2],
p^.writtenPageParts
];
NewPageCursor[p, p^.writtenPartCount];
p^.writtenPartCount ← p^.writtenPartCount + 1;
p^.currentPagePartOrigin ← IO.GetIndex[p^.f];
END;
WriteFontDirectory:
PROC[p: PressHandle] =
BEGIN
blackHole: INT; -- write-only variable
a: LIST OF Font ← p^.fontTable.fontList;
start: INT ← IO.GetIndex[p^.f];
WHILE a#
NIL
DO
WriteWord[p^.f,16]; -- length of font entry, in words
WriteByte[p^.f,a.first.fontNumber/16]; -- font set
WriteByte[p^.f,LogicalAnd[a.first.fontNumber,15]]; -- font number within set
WriteByte[p^.f,0]; -- first char to define
WriteByte[p^.f,255]; -- last char to define
WriteUpperBCPLString[p^.f,a.first.fontFamily,19]; -- the font family name
WriteByte[p^.f,a.first.fontFace]; -- face
WriteByte[p^.f,0]; -- source
WriteWord[p^.f, - a.first.fontMicaSize]; -- size of font, in micas
WriteWord[p^.f,a.first.fontRotation]; -- rotation of font
a ← a.rest;
ENDLOOP;
WriteWord[p^.f,0];
blackHole ← PadBlock[p^.f];
p^.writtenPageParts ←
CONS[[partType: 1, partOrigin: start,
partLength: IO.GetIndex[p^.f] - start],p^.writtenPageParts];
p^.writtenPartCount ← p^.writtenPartCount + 1;
END;
WritePartDirectory:
PROC[p: PressHandle] =
BEGIN
blackHole: INT; -- write-only variable
WritePartDirectoryEntries[p^.f,p^.writtenPageParts];
blackHole ← PadBlock[p^.f];
END;
WritePartDirectoryEntries:
PROC[f:
STREAM, a:
LIST
OF WrittenPagePart] =
BEGIN
IF a=NIL THEN RETURN;
WritePartDirectoryEntries[f, a.rest];
WriteWord[f, a.first.partType];
WriteWord[f, a.first.partOrigin/512];
WriteWord[f, a.first.partLength/512];
WriteWord[f, a.first.entityListPadding];
END;
WriteDocumentDirectory:
PROC[p: PressHandle, partDirOrigin:
INT] =
BEGIN
blackHole: INT;
docDirOrigin: INT ← IO.GetIndex[p^.f];
now: BasicTime.GMT ← CurrentTime[];
WriteWord[p^.f,27183]; -- General password
WriteWord[p^.f,docDirOrigin / 512 + 1]; -- Number of records in the file
WriteWord[p^.f,p^.writtenPartCount]; -- Number of parts
WriteWord[p^.f,partDirOrigin/512]; -- Record number of part directory
WriteWord[p^.f,(docDirOrigin - partDirOrigin) / 512]; -- Number of records in PD
WriteWord[p^.f,0]; -- obsolete DD pointer
WriteLong[p^.f,BasicTime.ToPupTime[now]]; -- date
WriteWord[p^.f,1]; -- first copy to print
WriteWord[p^.f,1]; -- last copy to print
WriteWord[p^.f,-1]; -- first page to print
WriteWord[p^.f,-1]; -- last page to print
WriteWord[p^.f,p^.prtMode]; -- printing mode
FOR i:NAT IN [13..177B] DO WriteWord[p^.f,-1]; ENDLOOP; -- unused
WriteBCPLString[p^.f,p^.fileName,51];
WriteBCPLString[p^.f,p^.creatorName,31];
WriteBCPLString[p^.f,RopeFromTime[now],39];
blackHole ← PadBlock[p^.f];
END;
Low-level Output Routines
WriteByte:
PROC[f:
STREAM, n:
INT] =
BEGIN
IO.PutChar[f,'\000+Basics.LowByte[Basics.LowHalf[n]]];
END;
WriteWord:
PROC[f:
STREAM, n:
INT] =
BEGIN
IO.PutChar[f,'\000+Basics.HighByte[Basics.LowHalf[n]]];
IO.PutChar[f,'\000+Basics.LowByte[Basics.LowHalf[n]]];
END;
WriteLong:
PROC[f:
STREAM, n:
LONG
CARDINAL] =
BEGIN
IO.PutChar[f,'\000+Basics.HighByte[Basics.HighHalf[n]]];
IO.PutChar[f,'\000+Basics.LowByte[Basics.HighHalf[n]]];
IO.PutChar[f,'\000+Basics.HighByte[Basics.LowHalf[n]]];
IO.PutChar[f,'\000+Basics.LowByte[Basics.LowHalf[n]]];
END;
WriteBCPLString:
PROC[f:
STREAM, s:
ROPE, len:
INT←-1] =
BEGIN -- Writes a rope out in BCPL string format, converted to upper case
i: NAT;
IF len<0 THEN len ← Rope.Size[s];
IF len>255 THEN len ← 255;
IO.PutChar[f,'\000+Basics.LowByte[Basics.LowHalf[
IF Rope.Size[s]<len
THEN Rope.Size[s]
ELSE len]]];
i ← 0;
WHILE i<Rope.Size[s]
AND i<len
DO
IO.PutChar[f,Rope.Fetch[s,i]];
i ← i+1;
ENDLOOP;
WHILE i<len
DO
IO.PutChar[f,0C];
i ← i+1;
ENDLOOP;
END;
WriteUpperBCPLString:
PROC[f:
STREAM, s:
ROPE, len:
INT←-1] =
BEGIN -- Writes a rope out in BCPL string format, converted to upper case
i: NAT;
IF len<0 THEN len←Rope.Size[s];
IF len>255 THEN len�
IO.PutChar[f,'\000+Basics.LowByte[Basics.LowHalf[
IF Rope.Size[s]<len THEN Rope.Size[s]
ELSE len]]];
i ← 0;
WHILE i<Rope.Size[s]
AND i<len
DO
IO.PutChar[f,UpperCase[Rope.Fetch[s,i]]];
i ← i+1;
ENDLOOP;
WHILE i<len
DO
IO.PutChar[f,0C];
i ← i+1;
ENDLOOP;
END;
PadToWord:
PROC[f:
STREAM, d: Byte ← 0] =
BEGIN
IF LogicalAnd[IO.GetIndex[f],1] = 1 THEN WriteByte[f,d];
END;
PadBlock:
PROC[f:
STREAM]
RETURNS [padBytes:
NAT] =
BEGIN -- pads with zeros
Zero: TYPE = CHAR ← '\000;
nZeroBytes: NAT = 32;
zeros: PACKED ARRAY [0..nZeroBytes) OF Zero;
index: INT ← IO.GetIndex[f];
padding: NAT ← 512-LogicalAnd[index, 511];
IF padding=512 THEN padding ← 0;
padBytes ← padding;
WHILE padding >= nZeroBytes
DO
TRUSTED {IO.UnsafePutBlock[f, [base: @zeros, startIndex: 0, count: nZeroBytes]]};
padding ← padding - nZeroBytes;
ENDLOOP;
TRUSTED {IO.UnsafePutBlock[f, [base: @zeros, startIndex: 0, count: padding]]};
END;
AddRectangleToCursor:
PROC[p: PressHandle, x,y,w,h:
INT] =
BEGIN OPEN p^;
ifirst: NAT = CheckCursorBounds[14 - (y+h)/2540];
ilast: NAT = CheckCursorBounds[14 - y/2540];
jfirst: NAT = CheckCursorBounds[x/2540+1];
jlast: NAT = CheckCursorBounds[(x+w)/2540+1];
mask: CARDINAL = BitShift[1,16-jfirst]-BitShift[1,15-jlast];
FOR i:NAT IN [ifirst..ilast] DO pressCursor[i] ← Basics.BITOR[pressCursor[i],mask] ENDLOOP;
END;
ShowCursor:
PROC[p: PressHandle] =
BEGIN
IF p.cursorObject # NIL THEN p.cursorObject.cursorProc[p.cursorObject.clientData, p.pressCursor];
END;
OldCursor:
PROC[p: PressHandle] =
BEGIN
IF p.cursorObject # NIL THEN p.cursorObject.cursorProc[p.cursorObject.clientData, NIL];
END;
CheckCursorBounds:
PROC[n:
INT]
RETURNS [
NAT] =
BEGIN
IF n>13 THEN RETURN[13];
IF n<1 THEN RETURN[1];
RETURN[n]
END;
NewPageCursor:
PROC [p:PressHandle, pageno:
INT] =
BEGIN OPEN p^;
FOR i:
NAT
IN [0..16)
DO
pressCursor[i] ← Basics.BITAND[pressCursor[i],Basics.BITOR[newPressCursor[i],3]]
ENDLOOP;
{i:
NAT = 15-LogicalAnd[pageno,15];
pressCursor[i] ← Basics.BITXOR[pressCursor[i],3]};
END;
END.
Michael Plass, July 21, 1982 9:07 am. Fixed data list length calculation.
Michael Plass, October 22, 1982. Revised entity and data list buffering strategy.
Michael Plass, October 25, 1982 11:28 am. Added sampling properties.
Michael Plass, October 25, 1982 12:05 pm. Made into a CEDAR program.
Michael Plass, November 3, 1982 10:27 am: Replaced cursor proc with cursor object.
Michael Plass, November 10, 1982 4:42 pm: Fixed 4 minor bugs introduced with the last changes.
Michael Plass, November 12, 1982 1:08 pm: Fixed bug that was making entity lists too often.
Michael Plass, November 15, 1982 11:29 am: Added UnsafeShowLine.
Michael Plass, November 16, 1982 10:49 am: Put portrait/landscape logic into SetPageSize.
Michael Plass, December 8, 1982 2:38 pm: Fixed sampling properties bug.
Michael Plass, December 9, 1982 1:24 pm: Aligned data list for objects and sampled images.
Michael Plass, February 14, 1983 1:55 pm: Limited entity list size to about 10000 bytes.
Michael Plass, April 16, 1984 3:54:26 pm PST: Eliminated possibility of entity list switchover between setposition and puttext.