<> <> <> <> <> 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; <> 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 ]; <> 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 <> 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, <> 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 ]; <> 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; <> 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 <> Code: TYPE = { noCurrentPosition, directionsNotAtRightAngles, wrongNumberOfScanLines, improperScanLineCoding, wrongScanLineLength, invalidCommandSequence }; SirPressError: SIGNAL [code: Code] = CODE; <> 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]}; <> 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_0, 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 = {}; <> 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; <> 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; <> 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; <> 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]255 THEN len_255; IO.PutChar[f,Inline.LowByte[Inline.LowHalf[ IF Rope.Size[s]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. <<>> <> <> <> <> <> <> <> <> <> <> <> <>