<> <> <> <> DIRECTORY Basics USING [BITSHIFT, BITAND, LongMult, logBitsPerWord], CD, CDBasics, CDBasicsInline, CDColors, CDInstances, CDLayers, CDOps, CDPrivate, CDTexts, CDVPrivate, CDVScale, CedarProcess, Imager, ImagerPrivate, ImagerFont USING [RopeEscapement], ImagerColor USING [ColorFromRGB], InterminalBackdoor USING [terminal], PrincOps, PrincOpsUtils USING [BITBLT], Rope, RuntimeError USING [UNCAUGHT], Terminal, VFonts USING [DefaultFont]; CDVDraw: CEDAR MONITOR IMPORTS Basics, CD, CDBasics, CDBasicsInline, CDColors, CDInstances, CDLayers, CDOps, CDVPrivate, CDVScale, CedarProcess, Imager, ImagerColor, ImagerFont, InterminalBackdoor, PrincOpsUtils, RuntimeError, Terminal, VFonts EXPORTS CDVPrivate, CD, --DrawRef's private fields-- Imager --access ClassRep-- SHARES CDLayers = BEGIN ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep; -- export to Imager.ClassRep VRef: TYPE = CDVPrivate.VRef; PainterRec: TYPE = CDVPrivate.PainterRec; ViewerPrivateRep: PUBLIC TYPE = CDVPrivate.VRec; virtual: Terminal.Virtual = InterminalBackdoor.terminal; blackBrick: REF CDColors.Brick = NEW[CDColors.Brick_ALL[LAST[CARDINAL]]]; whiteBrick: REF CDColors.Brick = NEW[CDColors.Brick_ALL[0]]; defaultFont: Imager.Font = VFonts.DefaultFont[]; maskModBitsPerWord: CARDINAL = 15; paintUsingAnd: BOOL = FALSE; <<--I don't trust List using loopholes's >> DRemove: PROC [ref: REF PainterRec, list: CDVPrivate.PainterList] RETURNS [CDVPrivate.PainterList] = { l, l1: CDVPrivate.PainterList _ NIL; l _ list; UNTIL l = NIL DO IF l.first = ref THEN { IF l1 = NIL THEN RETURN[l.rest]; -- ref was first object on list l1.rest _ l.rest; RETURN[list]; }; l1 _ l; l _ l.rest; ENDLOOP; RETURN [list]; }; Memb: PROC [ref: REF PainterRec, list: CDVPrivate.PainterList] RETURNS [BOOL] = { FOR l: CDVPrivate.PainterList _ list, l.rest WHILE l#NIL DO IF l.first=ref THEN RETURN [TRUE] ENDLOOP; RETURN [FALSE] }; IncludeAPainterRec: PUBLIC ENTRY PROC [me: VRef, pr: REF PainterRec] = { ENABLE UNWIND => NULL; inner: PROC [] = TRUSTED { IF ~Memb[ref: pr, list: me.painterList] THEN me.painterList _ CONS[pr, me.painterList]; }; inner[];--indirection to make sure catching UNWIND works }; RemoveAPainterRec: PUBLIC ENTRY PROC [me: VRef, pr: REF PainterRec] = { ENABLE UNWIND => NULL; inner: PROC [] = TRUSTED { me.painterList _ DRemove[ref: pr, list: me.painterList]; }; inner[];--indirection to make sure catching UNWIND works }; CheckPriority: PUBLIC CD.CheckPriorityProc = { <<--the priority business is a hint only>> IF pr.checkPriority THEN { WITH pr.devicePrivate SELECT FROM vRef: VRef => { pr.checkPriority _ FALSE; IF vRef.slowDown THEN { vRef.slowDown _ FALSE; CedarProcess.SetPriority[CedarProcess.Priority[background]]; }; IF vRef.hurryUp THEN { --this will be executed only after the other slowed down ... vRef.hurryUp _ FALSE; CedarProcess.SetPriority[CedarProcess.Priority[normal]]; }; }; ENDCASE => NULL; }; }; BitBlitDraw: PROC [vRef: VRef, r: CD.Rect, layer: CD.Layer] = { ENABLE RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.BitBlitDraw"] THEN GOTO oops; }; <<--Not monitored because called from protected places only>> InlineBitBlitDraw[vRef, r, layer]; EXITS oops => NULL; }; InlineBitBlitDraw: PROC[vRef: VRef, r: CD.Rect, layer: CD.Layer] = TRUSTED INLINE { <<-- Not monitored because called from protected places only>> <<-- DONE OUTSIDE r _ CDBasics.Intersection[r, vRef.deviceDrawRef.interestClip];>> <<-- this guarantees no arithmetic overflows if non empty; but there are nasty guys>> <<-- calling this procedure with empty rects.>> <<-- This is not a complete clip yet>> xBit, x1, x2, yt, y2: CARDINAL; vr: CD.Rect; IF r.x1>r.x2 OR r.y1>r.y2 THEN RETURN; --silly bad guys could cause overflow vr _ CDVScale.DesignToViewerRect[vRef.scale, r]; x1 _ MAX[vr.x1, 0]; yt _ MAX[vr.y1, 0]; x2 _ MIN[vr.x2, vRef.vw]; y2 _ MIN[vr.y2, vRef.vh]; <<>> <<--Arbitrary: >> <<--In case of rectangles smaller than 1 pixel: >> <<--try to draw at least one pixel depending on layer >> IF x1>=x2 THEN { IF x1=x2 AND x2=y2 THEN { IF yt=y2 AND y2 rr _ rrr; ENDCASE => vRef.remember _ rr _ NEW[RemRec]; IF rr.used>=remLeng THEN { next: REF RemRec _ NEW[RemRec]; next.next _ rr.next; rr.next _ next; rr _ next; }; rr.rem[rr.used] _ r; rr.used _ rr.used+1; }; DrawRemembered: PROC [vRef: VRef] = { InlineBBO2: --NOT ENTRY-- INTERNAL PROC [vRef: VRef, r: CD.Rect, col: REF CDColors.Brick] = TRUSTED INLINE { <<--This is a copy of InlineBitBlitOutLine; modified knowing 1 bit per pixel>> <<--r in design coordinates>> <<--Theoretically an entry proc >> <<-- but for reason of catching the UNWIND, the ENTRY is made outside >> vr, clipVr: CD.Rect; --in viewer coordinates DrawGrey2: PROC [vRef: VRef, x1, y1, x2, y2: INTEGER] = TRUSTED INLINE { <<--no empty test; is guaranteed by caller>> xBits: CARDINAL = LOOPHOLE[x1+INTEGER[vRef.vx]]; vRef.xBBptr.width _ x2-x1; vRef.xBBptr.height _ y2-y1; y1 _ vRef.vy-y2; vRef.xBBptr.dst _ [ vRef.screen + Basics.LongMult[y1, vRef.scWidthWords] + LONG[Basics.BITSHIFT[xBits, -Basics.logBitsPerWord]],, Basics.BITAND[xBits, maskModBitsPerWord] ]; vRef.xBBptr.src _ [ LOOPHOLE[ LOOPHOLE[col, LONG CARDINAL] + Basics.BITAND[y1, 3], LONG POINTER],, Basics.BITAND[xBits, maskModBitsPerWord] ]; vRef.xBBptr.srcDesc.gray.yOffset _ Basics.BITAND[y1, 3]; PrincOpsUtils.BITBLT[vRef.xBBptr]; }; DoIt: PROC [] = TRUSTED { IF vr.x1>=clipVr.x1 THEN DrawGrey2[vRef, clipVr.x1, clipVr.y1, clipVr.x1+1, clipVr.y2]; --left IF vr.y2<=clipVr.y2 THEN DrawGrey2[vRef, clipVr.x1, clipVr.y2-1, clipVr.x2, clipVr.y2]; --top IF vr.x2<=clipVr.x2 THEN DrawGrey2[vRef, clipVr.x2-1, clipVr.y1, clipVr.x2, clipVr.y2]; --right IF vr.y1>=clipVr.y1 THEN DrawGrey2[vRef, clipVr.x1, clipVr.y1, clipVr.x2, clipVr.y1+1]; --bot }; <<>> <<--clip to area where>> <<--1) small enough: it does not crash on scaling later>> <<--2) big enough: if drawn, it does not draw artificial lines >> IF r.x2>vRef.dClip.x2 THEN r.x2 _ vRef.dClip.x2+1; IF r.y2>vRef.dClip.y2 THEN r.y2 _ vRef.dClip.y2+1; IF r.x1> <<--empty test weak: we want to see the selection even if rounding>> <<--tells us not to...>> IF clipVr.x1>=clipVr.x2 THEN { IF clipVr.x1=clipVr.x2 AND clipVr.x2=clipVr.y2 THEN { IF clipVr.y1=clipVr.y2 AND clipVr.y2 NULL; RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.EntryHandleABunch"] THEN GOTO oops; }; }; <<--this procedure made to be able to put the ENTRY and the UNWIND >> <<--outside of the INLINE procedure InlineBBO2>> FOR i: INT IN [0..rr.used) DO InlineBBO2[vRef, rr.rem[i], color]; ENDLOOP; EXITS oops => NULL; }; rr: REF RemRec _ NIL; color: REF CDColors.Brick _ vRef.colorTable.bricks[selBrickLayer]; WITH vRef.remember SELECT FROM rrr: REF RemRec => rr _ rrr; ENDCASE => RETURN; WHILE rr#NIL DO next: REF RemRec _ rr.next; rr.next _ NIL; EntryHandleABunch[rr, vRef, color]; rr.used _ 0; rr _ next; IF vRef.stoprequest^ THEN RETURN; <<--it feels faster if the selection is always drawn and interrupted only if excessively>> ENDLOOP; }; KillRemembered: PROC [vRef: VRef] = INLINE { WITH vRef.remember SELECT FROM rr: REF RemRec => {rr.used _ 0; rr.next_NIL}; ENDCASE => RETURN; }; InlineBitBlitOutLine: --NOT ENTRY-- INTERNAL PROC[vRef: VRef, r: CD.Rect, layer: CD.Layer] = TRUSTED INLINE { <<--Theoretically an entry proc >> <<-- but for reason of catching the UNWIND, the ENTRY is made outside >> <<--r in design coordinates>> vr: CD.Rect; --in viewer coordinates clipVr: CD.Rect; --in viewer coordinates color: REF CDColors.Brick; DrawGrey: PROC[vRef: VRef, x1, y1, x2, y2: INTEGER] = TRUSTED INLINE { <<--no empty test; is guaranteed by caller>> xBits: CARDINAL = Basics.BITSHIFT[x1+INTEGER[vRef.vx], vRef.logbpp]; vRef.pBBptr.width _ Basics.BITSHIFT[x2-x1, vRef.logbpp]; vRef.pBBptr.height _ y2-y1; y1 _ vRef.vy-y2; vRef.pBBptr.dst _ [ vRef.screen + Basics.LongMult[y1, vRef.scWidthWords] + LONG[Basics.BITSHIFT[xBits, -Basics.logBitsPerWord]],, Basics.BITAND[xBits, maskModBitsPerWord] ]; vRef.pBBptr.src _ [ LOOPHOLE[ LOOPHOLE[color, LONG CARDINAL] + Basics.BITAND[y1, 3], LONG POINTER],, Basics.BITAND[xBits, maskModBitsPerWord] ]; vRef.pBBptr.srcDesc.gray.yOffset _ Basics.BITAND[y1, 3]; PrincOpsUtils.BITBLT[vRef.pBBptr]; }; DoIt: PROC [] = TRUSTED { IF vr.x1>=clipVr.x1 THEN DrawGrey[vRef, clipVr.x1, clipVr.y1, clipVr.x1+1, clipVr.y2]; --left IF vr.y2<=clipVr.y2 THEN DrawGrey[vRef, clipVr.x1, clipVr.y2-1, clipVr.x2, clipVr.y2]; --top IF vr.x2<=clipVr.x2 THEN DrawGrey[vRef, clipVr.x2-1, clipVr.y1, clipVr.x2, clipVr.y2]; --right IF vr.y1>=clipVr.y1 THEN DrawGrey[vRef, clipVr.x1, clipVr.y1, clipVr.x2, clipVr.y1+1]; --bot }; <<>> IF vRef.logbpp=0 AND layer=CD.selectionLayer THEN { Remember[vRef, r]; RETURN }; <<>> <<--clip to area where>> <<--1) small enough: it does not crash on scaling later>> <<--2) big enough: if drawn, it does not draw artificial lines >> IF r.x2>vRef.dClip.x2 THEN r.x2 _ vRef.dClip.x2+1; IF r.y2>vRef.dClip.y2 THEN r.y2 _ vRef.dClip.y2+1; IF r.x1> <<--empty test weak: we want to see the selection even if rounding>> <<--tells us not to...>> IF clipVr.x1>=clipVr.x2 THEN { IF clipVr.x1=clipVr.x2 AND clipVr.x2=clipVr.y2 THEN { IF clipVr.y1=clipVr.y2 AND clipVr.y2 NULL; RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[me, TRUE, "CDVDraw.IA"] THEN GOTO oops; }; <<--proc to make the unwind really catching the errors>> SafetyProc: PROC [] = TRUSTED { xBit: CARDINAL; xc1: CARDINAL _ MIN[MAX[x1, 0], LONG[me.vw-2]]; yc1: CARDINAL _ MIN[MAX[y1, 1], LONG[me.vh-1]]; xc2: CARDINAL _ MIN[MAX[x2, 0], LONG[me.vw-2]]; yc2: CARDINAL _ MIN[MAX[y2, 1], LONG[me.vh-1]]; IF xc1>xc2 THEN {t: CARDINAL=xc1; xc1_xc2; xc2_t}; IF yc1>yc2 THEN {t: CARDINAL=yc1; yc1_yc2; yc2_t}; me.xBBptr.width _ Basics.BITSHIFT[(xc2+1-xc1), me.logbpp]; me.xBBptr.height _ (yc2+1-yc1); xBit _ Basics.BITSHIFT[(xc1+me.vx), me.logbpp]; yc1 _ me.vy-yc2; --yc2>me.vy impossible ?? me.xBBptr.dst _ [ me.screen + Basics.LongMult[yc1, me.scWidthWords] + LONG[Basics.BITSHIFT[xBit, -Basics.logBitsPerWord]],, Basics.BITAND[xBit, maskModBitsPerWord] ]; me.xBBptr.flags.dstFunc _ xor; me.xBBptr.src _ [LOOPHOLE[blackBrick, LONG POINTER],,0]; me.xBBptr.srcDesc _ PrincOps.SrcDesc[gray[PrincOps.GrayParm[ yOffset: 0, widthMinusOne: 0, --words heightMinusOne: 0 --lines ]]]; IF me.display=bw THEN PrincOpsUtils.BITBLT[me.xBBptr] ELSE { Blit: PROC [] = TRUSTED { PrincOpsUtils.BITBLT[me.xBBptr]; }; Terminal.ModifyColorFrame[vt: virtual, action: Blit, xmin: xc1+me.vx, ymin: yc1 , xmax: xc2+me.vx+1, ymax: yc1+me.xBBptr.height ]; }; }; SafetyProc[]; EXITS oops => NULL; }; OutLine: ENTRY PROC [pr: CD.DrawRef, r: CD.Rect, l: CD.Layer] = { <<--Theoretically not entry; the entry should be on InlineBitBlitOutLine >> <<-- but for reason of catching the UNWIND, the ENTRY is made here >> ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[pr.viewerPrivate, TRUE, "CDVDraw.OutLine"] THEN GOTO oops; }; }; IF pr=NIL THEN RETURN; WITH pr.viewerPrivate SELECT FROM vRef: VRef => { InlineBitBlitOutLine[vRef: vRef, r: r, layer: l]; } ENDCASE => NULL; EXITS oops => NULL; }; BitBlitDrawRectForViewers: ENTRY PROC [pr: CD.DrawRef, r: CD.Rect, l: CD.Layer] = { ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[pr.viewerPrivate, TRUE, "CDVDraw.BitBlitDrawRectForViewers"] THEN GOTO oops; }; WITH pr.viewerPrivate SELECT FROM vRef: VRef => InlineBitBlitDraw[vRef, CDBasics.Intersection[r, pr.interestClip], l]; ENDCASE => NULL; EXITS oops => NULL; }; SetGround: --CD.SetGroundProc-- PROC [pr: CD.DrawRef, pushedOut: BOOL] = { WITH pr.devicePrivate SELECT FROM vRef: VRef => vRef.colorTable _ vRef.personalColors[vRef.display][IF pushedOut THEN pushedOut ELSE normal] ENDCASE => NULL; }; DrawCommentForViewers: PUBLIC PROC[pr: CD.DrawRef, r: CD.Rect, comment: Rope.ROPE] = { topToFontLine: NAT = 9+2; fontHeight: NAT = 10; leftMargin: NAT = 2; bothMargin: NAT = 2*leftMargin; vRef: VRef _ NARROW[pr.devicePrivate]; vr: CD.Rect _ CDVScale.DesignToViewerRect[vRef.scale, r]; IF vr.y2-vr.y1>fontHeight THEN { xw: REAL = ImagerFont.RopeEscapement[font: defaultFont, rope: comment].x; IF vr.x2-vr.x1>xw+bothMargin THEN { class: ImagerPrivate.Class ~ pr.deviceContext.class; <> class.SetColor[vRef.viewContext, Imager.black]; <> class.SetFont[vRef.viewContext, defaultFont]; <> class.SetXY[vRef.viewContext, [vr.x1+leftMargin, vr.y2-topToFontLine]]; Imager.ShowRope[vRef.viewContext, comment]; } }; }; RepaintRectAreaInViewer: PUBLIC PROC [vRef: VRef, rect: CD.Rect, eraseFirst: BOOL] = { ENABLE RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.rep1"] THEN GOTO oops; interestRect: CD.Rect; pixel: CD.Number; ReUseDrawInformation[vRef]; pixel _ CDVScale.UngriddedViewerToDesignScalar[vRef.scale, 1]; rect.x2 _ rect.x2+pixel; --a pixel to grow because selection is painted a pixel off rect.y2 _ rect.y2+pixel; --in case of small scale vRef.deviceDrawRef.interestClip _ interestRect _ CDBasics.Intersection[rect, vRef.dClip]; IF CDBasics.NonEmpty[interestRect] THEN { RepaintBackground[vRef, interestRect, eraseFirst]; IF vRef.logbpp=0 THEN KillRemembered[vRef]; CDOps.QuickDrawDesign[vRef.actualDesign, vRef.deviceDrawRef ! RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.rep2"] THEN CONTINUE ]; FOR pl: CDVPrivate.PainterList _ vRef.painterList, pl.rest WHILE pl#NIL DO IF CDBasics.Intersect[interestRect, pl.first.rect] THEN pl.first.proc[vRef, pl.first, interestRect ! RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.rep3"] THEN CONTINUE ] ENDLOOP; IF vRef.logbpp=0 THEN DrawRemembered[vRef]; } EXITS oops=> NULL }; RepaintBackground: PUBLIC ENTRY PROC[vRef: VRef, rect: CD.Rect, eraseFirst: BOOL] = { ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.back"] THEN GOTO oops; }; DrawOutside: PROC [r: CD.Rect] = { BitBlitDraw[vRef, CDBasics.Intersection[r, vRef.dClip], CD.backgroundLayer]; }; <<--RepaintBackground>> IF eraseFirst THEN TRUSTED { vRef.pBBptr.flags.dstFunc _ <<--I really don't understand why null for the dstFunc doesn't always work>> <<--Now I do: micro code bug !!!>> IF ~paintUsingAnd OR vRef.display=bw THEN null ELSE or; BitBlitDraw[vRef, CDBasics.Intersection[rect, vRef.dClip], initialColor]; vRef.pBBptr.flags.dstFunc _ IF ~paintUsingAnd OR vRef.display=bw THEN or ELSE and; }; IF vRef.actualDesign.actual.first.mightReplace#NIL AND vRef.environment THEN { mr: CD.Instance = vRef.actualDesign.actual.first.mightReplace; <<--copy to protect from NIL-ing out by other process>> IF mr#NIL AND mr.ob#NIL THEN CDBasics.DecomposeRect[r: rect, test: CDInstances.InstRectO[mr], outside: DrawOutside]; } EXITS oops => NULL; }; InitForBBLT: INTERNAL PROC [vRef: VRef] = INLINE --called only from one place..-- { IF vRef.viewer.column=color THEN TRUSTED { colorMode: Terminal.ColorMode = Terminal.GetColorMode[virtual]; IF colorMode.full THEN ERROR CDVPrivate.notSupportedColorMode; SELECT colorMode.bitsPerPixelChannelA FROM 8 => {vRef.display _ bit8; vRef.logbpp _ 3}; 1 => {vRef.display _ bit1; vRef.logbpp _ 0}; 4 => {vRef.display _ bit4; vRef.logbpp _ 2}; 2 => {vRef.display _ bit2; vRef.logbpp _ 1}; ENDCASE => ERROR CDVPrivate.notSupportedColorMode; vRef.frame _ Terminal.GetColorFrameBufferA[virtual]; } ELSE { -- b+w vRef.display _ bw; vRef.logbpp _ 0; vRef.frame _ Terminal.GetBWFrameBuffer[virtual]; }; vRef.bpp _ vRef.frame.bitsPerPixel; vRef.screen _ vRef.frame.base; vRef.colorTable _ vRef.personalColors[vRef.display][normal]; vRef.scWidthWords _ vRef.frame.wordsPerLine; <<-- vRef.vx _ distance from left of screen to left most pixel>> <<-- vRef.vy _ distance from top of screen to bottom most pixel>> <<-- in pixels>> <<-- vRef.vw, vRef.vh copied to avoid race conditions>> vRef.vw _ vRef.viewer.cw; vRef.vh _ vRef.viewer.ch; vRef.vx _ vRef.viewer.cx+vRef.viewer.wx; vRef.vy _ vRef.frame.height-(vRef.viewer.cy+vRef.viewer.wy); <<--fixed fooBBptr initializations>> <<--done in "viewer" process: vRef.fooBBptr _ PrincOpsUtils.AlignedBBTable[@fooBTableSpace];>> TRUSTED { vRef.xBBptr^ _ vRef.pBBptr^ _ PrincOps.BBTable[ dst: TRASH, dstBpl: vRef.frame.width*vRef.frame.bitsPerPixel, src: [LOOPHOLE[blackBrick, LONG POINTER],,0], srcDesc: PrincOps.SrcDesc[gray[PrincOps.GrayParm[ yOffset: 0, --is actually trash widthMinusOne: 0, --words heightMinusOne: 3 --lines ]]], width: TRASH, height: TRASH, flags: IF ~paintUsingAnd OR vRef.display=bw THEN PrincOps.BitBltFlags[ direction: forward, disjoint: TRUE, disjointItems: TRUE, gray: TRUE, srcFunc: null, dstFunc: or ] ELSE PrincOps.BitBltFlags[ direction: forward, disjoint: TRUE, disjointItems: TRUE, gray: TRUE, srcFunc: complement, dstFunc: and ] ]; }; }; ViewerDrawContext: PROC [pr: CD.DrawRef, proc: CD.DrawContextLayerProc, ob: CD.Object, trans: CD.Transformation, layer: CD.Layer] = { <<--calls proc which may use context; mode and color are set to layer's need>> <<--call is suppressed if layer does not need drawing; this is default.>> <<--on recursive calls, the context may or may not include previous transformations>> IF pr.contextColors#NIL AND pr.contextColors#NIL THEN { Action: PROC [] = { vRef: VRef ~ NARROW[pr.viewerPrivate]; class: ImagerPrivate.Class ~ pr.deviceContext.class; s: REAL _ CDVScale.DesignToViewerFactor[vRef.scale]; class.Scale2T[context: pr.deviceContext, s: [s, s]]; class.TranslateT[pr.deviceContext, [-vRef.scale.off.x, -vRef.scale.off.y]]; IF trans.orient=original THEN class.TranslateT[context: pr.deviceContext, t: [trans.off.x, trans.off.y]] ELSE class.ConcatT[pr.deviceContext, CDBasicsInline.ImagerTransform[trans]]; class.SetColor[pr.deviceContext, pr.contextColors[layer]]; proc[pr.deviceContext, ob, layer]; }; Imager.DoSave[pr.deviceContext, Action]; } }; ICreateDrawRef: INTERNAL PROC [vRef: VRef] = { ENABLE RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.cr"] THEN GOTO oops; pr: CD.DrawRef = CD.CreateDrawRef[[ drawRect: BitBlitDrawRectForViewers, drawOutLine: OutLine, drawComment: DrawCommentForViewers, drawContext: ViewerDrawContext, setGround: SetGround, priorityChecker: CheckPriority, devicePrivate: vRef, stopFlag: vRef.stoprequest, symbolics: vRef.symbolics, borders: vRef.borders, environment: vRef.environment, fontSubstitution: vRef.fontSubstitution, checkPriority: vRef.checkPriority, b4: vRef.b4, b5: vRef.b5, design: vRef.actualDesign ]]; InitForBBLT[vRef]; vRef.deviceDrawRef _ pr; pr.interestClip _ vRef.dClip _ CDVScale.GetClipRecord[vRef.intendedScale, vRef.vw, vRef.vh]; pr.scaleHint _ CDVScale.DesignToViewerFactor[vRef.intendedScale]*vRef.suppressFactorForCells; pr.contextColors _ vRef.colorTable.cols; pr.viewerPrivate _ vRef; -- this line last! it tells DummyNotify that the rest is initialized EXITS oops => NULL }; ReUseContext: PROC [pr: CD.DrawRef, vRef: VRef] = INLINE { pr.deviceContext _ vRef.viewContext; Imager.SetColor[vRef.viewContext, Imager.black]; Imager.SetFont[vRef.viewContext, defaultFont]; }; ReUseDrawInformation: ENTRY PROC [vRef: VRef] = { <<--theoretically INLINE, but not in practice for reason of catching UNWIND>> ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.reuse"] THEN GOTO oops; }; }; IF vRef.deviceDrawRef=NIL THEN --usually not-- ICreateDrawRef[vRef]; ReUseContext[vRef.deviceDrawRef, vRef]; EXITS oops => NULL; }; CreateDrawInformation: PUBLIC ENTRY PROC [vRef: VRef] = { ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.reuse"] THEN GOTO oops; }; }; ICreateDrawRef[vRef]; ReUseContext[vRef.deviceDrawRef, vRef]; EXITS oops => NULL; }; DoInsideMonitor: PUBLIC ENTRY PROC [proc: PROC [VRef], vRef: VRef] = { ENABLE UNWIND => NULL; proc[vRef ! RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[vRef, TRUE, "CDVDraw.XXX"] THEN CONTINUE; ] }; initialColor: CD.Layer = CD.NewLayer[NIL, $InitialColor]; selBrickLayer: CD.Layer = CD.NewLayer[NIL, $CDVDrawPrivate2]; CDLayers.MakeAbstract[selBrickLayer]; CDColors.DefineColor[selBrickLayer, NEW[CDColors.Brick_[03333H, 03333H, 0CCCCH, 0CCCCH]], bw]; CDColors.DefineColor[initialColor, whiteBrick, bw]; CDColors.DefineColor[initialColor, whiteBrick, bit4]; CDColors.DefineColor[initialColor, whiteBrick, bit8]; CDColors.DefineColor[CD.undefLayer, NIL, bw]; CDColors.DefineColor[CD.undefLayer, NIL, bit4]; CDColors.DefineColor[CD.undefLayer, NIL, bit8]; CDColors.DefineColor[CD.backgroundLayer, NEW[CDColors.Brick_[257,0,0,0]], bw]; CDColors.DefineColor[CD.backgroundLayer, NEW[CDColors.Brick_[0,10,0,11*256]], bit4]; CDColors.DefineColor[CD.backgroundLayer, NEW[CDColors.Brick_[8, 0, 800h, 0]], bit8]; CDColors.DefineColor[CD.shadeLayer, NEW[CDColors.Brick_[101H, 0, 0, 0]], bw]; CDColors.DefineColor[CD.shadeLayer, NEW[CDColors.Brick_[0, 0F0FH, 0, 0]], bit4]; CDColors.DefineColor[CD.shadeLayer, NEW[CDColors.Brick_[255, 0, 255, 0]], bit8]; CDColors.DefineColor[CD.errorLayer, NEW[CDColors.Brick_[101H, 0, 101H, 0]], bw]; CDColors.DefineColor[CD.errorLayer, NEW[CDColors.Brick_[0, 0F0FH, 0, 0F0FH]], bit4]; CDColors.DefineColor[CD.errorLayer, NEW[CDColors.Brick_[0, 255, 0, 0]], bit8]; CDColors.DefineColor[CD.outlineLayer, NEW[CDColors.Brick_[08888h, 04444h, 02222h, 01111h]], bw]; CDColors.DefineColor[CD.outlineLayer, NEW[CDColors.Brick_[07C7CH, 07C7CH, 07C7CH, 07C7CH]], bit4]; CDColors.DefineColor[CD.outlineLayer, NEW[CDColors.Brick_[07C7CH, 07C7CH, 07C7CH, 07C7CH]], bit8]; CDColors.DefineColor[CD.selectionLayer, NEW[CDColors.Brick_[0ffffH, 0ffffH, 0ffffH, 0ffffH]], bw]; CDColors.DefineColor[CD.selectionLayer, NEW[CDColors.Brick_[0ffffH, 0ffffH, 0ffffH, 0ffffH]], bit4]; CDColors.DefineColor[CD.selectionLayer, NEW[CDColors.Brick_[0ffffH, 0ffffH, 0ffffH, 0ffffH]], bit8]; CDColors.DefineColor[CD.commentLayer, NEW[CDColors.Brick_[0ffffH, 0ffffH, 0ffffH, 0ffffH]], bw]; CDColors.DefineColor[CD.commentLayer, NEW[CDColors.Brick_[0bbbbH, 0bbbbH, 0bbbbH, 0bbbbH]], bit4]; CDColors.DefineColor[CD.commentLayer, NEW[CDColors.Brick_[07f7fh, 07f7fh, 07f7fh, 07f7fh]], bit8]; CDColors.DefineColor[CD.commentLayer, NEW[CDColors.Brick_[07f00h, 0007fh, 07f00h, 0007fh]], bit8, pushedOut]; CDColors.DefineColor[CD.FetchLayer[NIL, $blue], NEW[CDColors.Brick_[1028, 1028, 1028, 1028]], bw]; CDColors.DefineColor[CD.FetchLayer[NIL, $red], NEW[CDColors.Brick_[4112, 4112, 4112, 4112]], bw]; CDColors.DefineColor[CD.FetchLayer[NIL, $green], NEW[CDColors.Brick_[257, 257, 257, 257]], bw]; CDColors.DefineColor[CD.FetchLayer[NIL, $yellow], NEW[CDColors.Brick_[8224, 8224, 8224, 8224]], bw]; CDColors.DefineColor[CD.FetchLayer[NIL, $blue], NEW[CDColors.Brick_[1028, 1028, 1028, 1028]], bit8]; CDColors.DefineColor[CD.FetchLayer[NIL, $red], NEW[CDColors.Brick_[4112, 4112, 4112, 4112]], bit8]; CDColors.DefineColor[CD.FetchLayer[NIL, $green], NEW[CDColors.Brick_[257, 257, 257, 257]], bit8]; CDColors.DefineColor[CD.FetchLayer[NIL, $yellow], NEW[CDColors.Brick_[8224, 8224, 8224, 8224]], bit8]; CDColors.DefineIColor[CD.commentLayer, ImagerColor.ColorFromRGB[[0, 0, 0]], bit8]; CDColors.DefineIColor[CD.commentLayer, ImagerColor.ColorFromRGB[[0, 0, 0]], bw]; CDColors.DefineIColor[CD.FetchLayer[NIL, $green], ImagerColor.ColorFromRGB[[0, 1, 0]], bit8]; CDColors.DefineIColor[CD.FetchLayer[NIL, $green], ImagerColor.ColorFromRGB[[0, 1, 0]], bw]; CDColors.DefineIColor[CD.FetchLayer[NIL, $blue], ImagerColor.ColorFromRGB[[0, 0, 1]], bit8]; CDColors.DefineIColor[CD.FetchLayer[NIL, $blue], ImagerColor.ColorFromRGB[[0, 0, 1]], bw]; CDColors.DefineIColor[CD.FetchLayer[NIL, $red], ImagerColor.ColorFromRGB[[1, 0, 0]], bit8]; CDColors.DefineIColor[CD.FetchLayer[NIL, $red], ImagerColor.ColorFromRGB[[1, 0, 0]], bw]; CDColors.DefineIColor[CD.FetchLayer[NIL, $yellow], ImagerColor.ColorFromRGB[[1, 1, 0]], bit8]; CDColors.DefineIColor[CD.FetchLayer[NIL, $yellow], ImagerColor.ColorFromRGB[[1, 1, 0]], bw]; END.