SirPressImpl.mesa
Last edited by Michael Plass, February 14, 1983 1:55 pm
Press File Interface Implementation
Written by Michael Plass
Definitions: SirPress.mesa
DIRECTORY
Rope USING [ROPE, Equal, Size, Fetch],
Real USING [Float],
Inline USING [HighHalf, LowHalf, LowByte, HighByte, BITAND, BITOR, BITXOR, BITSHIFT],
IO USING [STREAM, UnsafeBlock, PutChar, PutBlock, PutRope, UnsafePutBlock, GetIndex, SetLength, SetIndex, Close],
Time USING [Current, Packed],
Convert USING [Value, ValueToRope, Base],
RealConvert USING [IeeeToBcpl],
UserTerminal USING [CursorArray],
SirPress;
SirPressImpl: CEDAR PROGRAM
IMPORTS Rope, Real, Inline, IO, Time, 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: UserTerminal.CursorArray = [
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 UserTerminal.CursorArray ←
NEW[UserTerminal.CursorArray ← 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 = Inline.LowHalf[n];
RETURN[Inline.BITAND[nc, m]];
END;
BitShift: PROC[bits: CARDINAL, amountToShiftLeft: CARDINAL] RETURNS [CARDINAL] =
BEGIN
RETURN[Inline.BITSHIFT[bits, amountToShiftLeft]];
END;
FromInt: PROC [n: INT, base: Convert.Base ← 10] RETURNS [ROPE] =
BEGIN -- Returns a printable repesentation of n in the given base.
RETURN[Convert.ValueToRope[Convert.Value[value:signed[signed:n, base:base]]]];
END;
RopeFromTime: PROC[time:Time.Packed] RETURNS [ROPE] =
BEGIN
RETURN[Convert.ValueToRope[Convert.Value[value:time[time:time]]]];
END;
CurrentTime: PROC RETURNS [time:Time.Packed] = TRUSTED
BEGIN
RETURN[Time.Current[]];
END;
UpperCase: PROC[c: CHARACTER] RETURNS [CHARACTER] =
INLINE {IF 'a <= c AND c <= 'z THEN c ← c - ('a - 'A); RETURN[c]};
Interface Implementation Routines
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];
END;
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, xCoordinateOfLeftEdge];
PutELByte[p, ELSetY];
PutELWord[p, yCoordinateOfBaseline];
p^.positionGood ← TRUE;
PutTextHere[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, xstart];
PutELByte[p, ELSetY];
PutELWord[p, ystart];
PutELByte[p, ELShowRectangle];
PutELWord[p, xlen];
PutELWord[p, 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, x];
PutELByte[p, ELSetY];
PutELWord[p, 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, stopIndexPlusOne: 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,Inline.HighHalf[n]];
PutELWord[p,Inline.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, (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: INT,
unit: INT ← mica
] =
BEGIN OPEN pipe^;
cp:NAT ← p^.dlSavedIndex;
oldx,oldy: INT ← -1;
State[p,piping];
IF scount>0 THEN
AddRectangleToCursor[p,slist[0].x,y,slist[scount-1].x-slist[0].x,1];
FOR i:NAT IN [0..scount) DO
cur:CharPtrAndPosition ← slist[i];
xx,yy: INT;
PutELShowCharacters[p,cur.charPtr-cp];
IF p^.landScape THEN {xx ← p^.micaWidth - y*unit/unitsPerMica;
yy ← cur.x*unit/unitsPerMica}
ELSE {xx ← cur.x*unit/unitsPerMica;
yy ← y*unit/unitsPerMica};
IF xx#oldx THEN
BEGIN
PutELByte[p,ELSetX];
PutELWord[p, xx];
oldx ← xx
END;
IF yy#oldy THEN
BEGIN
PutELByte[p,ELSetY];
PutELWord[p, yy];
oldy←yy
END;
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,current.xSpace];
END;
IF parameters.ySpace # current.ySpace THEN
BEGIN
PutELByte[p,ELSetSpaceY];
PutELWord[p,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];
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, stopIndexPlusOne: stopIndexPlusOne];
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: INTEGER] =
BEGIN
PutELByte[p,Inline.HighByte[word]];
PutELByte[p,Inline.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] ← Inline.HighByte[b];
t[l+1] ← Inline.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, Inline.LowHalf[ir]];
PutDLWord[p, Inline.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: Time.Packed ← 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,LOOPHOLE[now,INT]]; -- 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,Inline.LowByte[Inline.LowHalf[n]]];
END;
WriteWord: PROC[f: STREAM, n: INT] =
BEGIN
IO.PutChar[f,Inline.HighByte[Inline.LowHalf[n]]];
IO.PutChar[f,Inline.LowByte[Inline.LowHalf[n]]];
END;
WriteLong: PROC[f: STREAM, n: INT] =
BEGIN
IO.PutChar[f,Inline.HighByte[Inline.HighHalf[n]]];
IO.PutChar[f,Inline.LowByte[Inline.HighHalf[n]]];
IO.PutChar[f,Inline.HighByte[Inline.LowHalf[n]]];
IO.PutChar[f,Inline.LowByte[Inline.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,Inline.LowByte[Inline.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,Inline.LowByte[Inline.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 [NAT] =
BEGIN -- pads with garbage
index: INT ← IO.GetIndex[f];
padding: NAT ← 512-LogicalAnd[index, 511];
IF padding=512 THEN padding ← 0;
IO.SetLength[f,index+padding];
IO.SetIndex[f,index+padding];
RETURN[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] ← Inline.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] ← Inline.BITAND[pressCursor[i],Inline.BITOR[newPressCursor[i],3]]
ENDLOOP;
{i:NAT = 15-LogicalAnd[pageno,15];
pressCursor[i] ← Inline.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.