<> <> <> <> DIRECTORY Basics USING [bitsPerWord, LongMult], CD, CDBasics, CDDrawQueue, CDProperties, CDSequencer USING [Command], CDViewerBase, CDVPrivate, CDVScale, CDVTicks, PrincOps USING [BBptr, BitAddress, BitBltFlags, SrcDesc, GrayParm], PrincOpsUtils USING [BITBLT], RuntimeError USING [UNCAUGHT], Terminal, ViewerClasses; CDVTicksImpl: CEDAR MONITOR IMPORTS Basics, CDDrawQueue, CDBasics, CDProperties, CDViewerBase, CDVPrivate, CDVScale, PrincOpsUtils, RuntimeError, Terminal EXPORTS CDVTicks = BEGIN <<>> <<-- implement ticks for ChipNDale viewers >> <<>> black: REF CARDINAL = NEW[CARDINAL_LAST[CARDINAL]]; virtual: Terminal.Virtual = Terminal.Current[]; PaintTicks: CDVPrivate.PainterProc = <<-- PROC [me: VRef, paintRef: REF PainterRec, interrestRect: CD.Rect];>> BEGIN ENABLE RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[me, FALSE, "PaintTicks"] THEN GOTO oops }; ModUp: PROC [x, md: CD.Number] RETURNS [CD.Number] = INLINE { RETURN [( IF x>0 THEN (x+md-1) ELSE (x) ) / md * md] }; -- division rounds towards 0 ModDown: PROC [x, md: CD.Number] RETURNS [CD.Number] = INLINE { RETURN [( IF x>=0 THEN (x) ELSE (x-md+1) ) / md * md] }; -- division rounds towards 0 dTicks: CD.Number = NARROW[paintRef.data, REF CD.Number]^; IF dTicks>0 THEN { <<--action in procedure to make sure catching errors works>> DrawTicks: PROC [] = BEGIN vTicks: CD.Number = CDVScale.DesignToViewerScalar[me.scale, dTicks]; IF vTicks>6 AND vTicks<=512 THEN TRUSTED { x, xStop, xMod, xInc: INT; yStart, yStop, yInc, yCur: LONG CARDINAL; dr: CD.Rect = CDBasics.Intersection[me.deviceDrawRef.interestClip, paintRef.rect]; -- design coords vr: CD.Rect _ CDVScale.DesignToViewerRect[me.scale, CD.Rect[ -- viewer coords x1: ModDown[dr.x1, dTicks], y1: ModDown[dr.y1, dTicks], x2: ModUp[dr.x2, dTicks], y2: ModUp[dr.y2, dTicks] ]]; vx1, vy1, vx2, vy2: CARDINAL; -- rect in V-coords; snapped to tick positions vx1 _ IF vr.x1>=0 THEN vr.x1 ELSE vr.x1 + ModUp[-vr.x1, vTicks]; vy1 _ IF vr.y1>=0 THEN vr.y1 ELSE vr.y1 + ModUp[-vr.y1, vTicks]; vx2 _ IF vr.x2<=me.viewer.cw THEN vr.x2 ELSE vr.x2-ModUp[vr.x2-me.viewer.cw, vTicks]; vy2 _ IF vr.y2<=me.viewer.ch THEN vr.y2 ELSE vr.y2-ModUp[vr.y2-me.viewer.ch, vTicks]; <<-- Now v.. denotes area for ticks; vTicks denote increment; in viewer coordinates>> me.xBBptr.width _ me.bpp; me.xBBptr.height _ 1; me.xBBptr.src _ [LOOPHOLE[black],,0]; me.xBBptr.srcDesc _ PrincOps.SrcDesc[gray[PrincOps.GrayParm[ yOffset: 0, widthMinusOne: 0, --words heightMinusOne: 0 --lines ]]]; me.xBBptr.flags _ PrincOps.BitBltFlags[ direction: forward, disjoint: TRUE, disjointItems: TRUE, gray: TRUE, srcFunc: null, dstFunc: or ]; xInc _ vTicks*me.bpp; x _ Basics.LongMult[vx1+me.vx, me.bpp]; --x start xStop _ Basics.LongMult[vx2+me.vx, me.bpp]; yInc _ vTicks*me.scWidthWords; yStart _ LOOPHOLE[me.screen + Basics.LongMult[(me.vy-vy2), me.scWidthWords] ]; yStop _ LOOPHOLE[me.screen + Basics.LongMult[(me.vy-vy1), me.scWidthWords] + xStop/Basics.bitsPerWord]; BEGIN DoIt: PROC [] = TRUSTED BEGIN WHILE x<=xStop DO yCur _ yStart+LOOPHOLE[(x/Basics.bitsPerWord), LONG CARDINAL]; xMod _ x MOD Basics.bitsPerWord; WHILE yCur<=yStop DO me.xBBptr.dst _ [LOOPHOLE[yCur],, xMod]; PrincOpsUtils.BITBLT[me.xBBptr]; yCur _ yCur+yInc ENDLOOP; x _ x+xInc; ENDLOOP; END; IF me.bpp=1 THEN DoIt[] ELSE Terminal.ModifyColorFrame[virtual, DoIt]; END; }; END;--DrawTicks DrawTicks[]; } EXITS oops => NULL END; ShowTicks: PUBLIC PROC [onto: REF, value: INT_0] = <<--called from client>> BEGIN me: CDVPrivate.VRef; WITH onto SELECT FROM x: CDVPrivate.VRef => me _ x; c: CDSequencer.Command => {ShowTicks[onto: c.ref, value: value]; RETURN}; v: ViewerClasses.Viewer => {ShowTicks[onto: v.data, value: value]; RETURN}; ENDCASE => RETURN; IF me#NIL THEN { pr: REF CDVPrivate.PainterRec = GetAPainterRec[me]; value _ MIN[4096, MAX[0, value]]; pr.data _ NEW[CD.Number_value]; IF value=0 THEN CDVPrivate.RemoveAPainterRec[me, pr] ELSE CDVPrivate.IncludeAPainterRec[me, pr]; CDDrawQueue.QueueInsertDrawCommand[me.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]] } END; GetAPainterRec: ENTRY PROC [me: CDVPrivate.VRef, create: BOOL _ TRUE] RETURNS [pr: REF CDVPrivate.PainterRec_NIL] = BEGIN ENABLE UNWIND => NULL; x: REF = CDProperties.GetListProp[me.properties^, $CDxTickProc]; IF x#NIL THEN pr _ NARROW[x] ELSE IF create THEN { pr _ NEW[CDVPrivate.PainterRec_[proc: PaintTicks, rect: CDBasics.universe]]; CDProperties.PutProp[me.properties, $CDxTickProc, pr]; } END; ToInt: PROC [ref: REF] RETURNS [i: INT_0] = INLINE { WITH ref SELECT FROM ri: REF INT => i _ ri^ ENDCASE => NULL }; GetTicks: ViewerClasses.GetProc = { ticks: REF INT _ NEW[INT_0]; me: CDVPrivate.VRef = NARROW[self.data]; pr: REF CDVPrivate.PainterRec = GetAPainterRec[me]; IF pr#NIL THEN ticks^ _ ToInt[pr.data]; data _ ticks }; SetTicks: ViewerClasses.SetProc = { ShowTicks[self, ToInt[data]] }; CDViewerBase.ImplementGetProc[$Ticks, GetTicks]; CDViewerBase.ImplementSetProc[$Ticks, SetTicks]; END.