<> <> <> <> DIRECTORY AMBridge, AMTypes, Atom, CD, CDColors, CDColorsExtras, CDDrawQueue, CDProperties, CDViewerBackdoor, CDVPrivate, CDVScale, Imager, ImagerColor, ImagerDitherContext, RefTab, Rope, RuntimeError, ViewerClasses; CDViewerBackdoorImpl: CEDAR MONITOR IMPORTS AMBridge, AMTypes, Atom, CD, CDProperties, CDVPrivate, CDVScale, Imager, ImagerColor, ImagerDitherContext, RefTab, Rope, RuntimeError EXPORTS CDViewerBackdoor, CDVScale, CDColors, CDColorsExtras = BEGIN <> <<>> MakeScale: PUBLIC PROC [off: CD.Position_[0, 0], nscale: CDVScale.ScaleRange_4, grid: INTEGER_-1] RETURNS [s: CDVScale.ScaleRec] = { <<--given the grid, offset and nscale; makes a correctly gridded and initialized CDVScale.ScaleRec>> <<--explanation of crazy scaling procedure for ScaleViewerToDesign>> <<--v * scale + offset :: ideal>> <<--v* s1/s2 + offset :: integer arithmetic>> <<--(v*s1 + s2/2) / s2 + offset :: correct round of screen point>> <<--( (v*s1 + s2/2) / s2) + grid/2) / grid * grid + offset :: introduce grid>> <<--(v*s1 + s2/2 + grid/2*s2 ) / s2 / grid * grid + offset >> <<--(v*s1 + s2/2 + grid/2*s2 ) / (s2*grid) * grid + offset>> sE: INTEGER; noDivisionScale: CDVScale.ScaleRange = 8; scaleE: ARRAY CDVScale.ScaleRange OF INTEGER = --scale for factors [24, 16, 12, 8, 6, 4, 3, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]; scaleF: ARRAY CDVScale.ScaleRange OF INTEGER = --scale for divisors [1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192]; scaleS: ARRAY CDVScale.ScaleRange OF NAT = --scale for shifts [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13]; s.nscale _ nscale; --MIN[MAX[nscale, 0], CDVScale.scaleNum-1]; s.grid _ MAX[1, grid]; sE _ scaleE[s.nscale]; s.sA _ scaleF[s.nscale]; s.sB _ (s.grid/2)*sE+sE/2; s.sC _ sE*s.grid; s.sD _ s.grid; s.sS _ scaleS[s.nscale]; s.off.x _ off.x/s.grid*s.grid; s.off.y _ off.y/s.grid*s.grid; IF s.useMultiply _ s.nscale> GetClipRecord: PUBLIC PROC[scale: CDVScale.ScaleRec, highX, highY: CARDINAL] RETURNS [CD.Rect] = { <<--given the index of the (high-most) pixel in the viewer, compute an outside clipping >> <<--rectangle in design coordinates; (such that all outside the clipping area is invisible).>> UnGridedScaleViewerToDesignUp: PROC [scale: CDVScale.ScaleRec, v: LONG CARDINAL] RETURNS [CD.Number] = INLINE { sE: INTEGER = IF scale.useMultiply THEN scale.xx ELSE 1; RETURN [LOOPHOLE[(v*scale.sA+sE+sE)/sE, CD.Number]] }; RETURN [CD.Rect[ x1: CDVScale.ViewerToDesignScalar[scale, 0]+scale.off.x, y1: CDVScale.ViewerToDesignScalar[scale, 0]+scale.off.y, x2: UnGridedScaleViewerToDesignUp[scale, highX+1]+scale.off.x, y2: UnGridedScaleViewerToDesignUp[scale, highY+1]+scale.off.y] ] }; <<>> <<>> <> <> <<>> getList: CDProperties.PropRef _ CDProperties.InitPropRef[]; setList: CDProperties.PropRef _ CDProperties.InitPropRef[]; InstallGetProc: PUBLIC PROC [op: ATOM, proc: ViewerClasses.GetProc] = { ENABLE UNWIND => NULL; val: REF = IF proc=NIL THEN NIL ELSE NEW[ViewerClasses.GetProc_proc]; IF proc=CallGetProc THEN ERROR; --don't do that, it causes infinite recursion CDProperties.PutProp[getList, op, val] }; InstallSetProc: PUBLIC PROC [op: ATOM, proc: ViewerClasses.SetProc] = { ENABLE UNWIND => NULL; val: REF = IF proc=NIL THEN NIL ELSE NEW[ViewerClasses.SetProc_proc]; IF proc=CallSetProc THEN ERROR; --don't do that, it causes infinite recursion CDProperties.PutProp[setList, op, val] }; CallGetProc: PUBLIC ViewerClasses.GetProc = { WITH CDProperties.GetListProp[getList^, op] SELECT FROM gp: REF ViewerClasses.GetProc => RETURN [gp[self, op]]; ENDCASE => RETURN [NIL]; }; CallSetProc: PUBLIC ViewerClasses.SetProc = { WITH CDProperties.GetListProp[setList^, op] SELECT FROM sp: REF ViewerClasses.SetProc => sp[self, data, finalise, op]; ENDCASE => NULL; }; <> <> PaintRegRec: TYPE = RECORD [type: AMTypes.Type, proc: CDViewerBackdoor.FurtherPaintProc]; paintList: LIST OF REF PaintRegRec _ NIL; paintKeyTable: RefTab.Ref _ RefTab.Create[]; InstallFurtherPaint: PUBLIC PROC[keyReferentType: AMTypes.Type_AMTypes.nullType, keyValue: REF_NIL, proc: CDViewerBackdoor.FurtherPaintProc] = { IF proc=NIL THEN ERROR; IF keyValue#NIL THEN [] _ RefTab.Store[paintKeyTable, keyValue, NEW[CDViewerBackdoor.FurtherPaintProc_proc]] ELSE IF keyReferentType=CODE[CDDrawQueue.Request] OR keyReferentType=AMTypes.nullType THEN ERROR ELSE paintList _ CONS[NEW[PaintRegRec_[type: keyReferentType, proc: proc]], paintList] }; CallFurtherPaint: PUBLIC PROC[me: CDVPrivate.VRef, key: REF] = { <<--Catches all errors and signals!>> <<--Called by the viewer paintproc of ChipNDale-design viewers only.>> ENABLE RuntimeError.UNCAUGHT => IF CDVPrivate.ShallContinue[me, TRUE, "CDVDraw.back"] THEN GOTO oops; transmitt: REF _ key; WITH key SELECT FROM req: REF CDDrawQueue.Request => key _ req.key ENDCASE => NULL; WITH RefTab.Fetch[paintKeyTable, key].val SELECT FROM p: REF CDViewerBackdoor.FurtherPaintProc => p^[me, transmitt] ENDCASE => TRUSTED { <<--then check if we know the type of key>> type: AMTypes.Type _ AMTypes.TVType[AMBridge.TVForReferent[key]]; FOR list: LIST OF REF PaintRegRec _ paintList, list.rest WHILE list#NIL DO IF list.first.type=type THEN { list.first.proc[me, transmitt]; EXIT } ENDLOOP; } EXITS oops => NULL }; <> <> <<>> NotifyRegRec: TYPE = RECORD [mode: REF, doit: CDViewerBackdoor.FurtherNotifyProc]; NotifyList: TYPE = LIST OF NotifyRegRec; notifyList: NotifyList _ NIL; InstallFurtherNotify: PUBLIC ENTRY PROC[mode: REF, proc: CDViewerBackdoor.FurtherNotifyProc] = { ENABLE UNWIND => NULL; IF proc=NIL THEN RETURN WITH ERROR CD.Error[]; IF notifyList=NIL THEN notifyList _ LIST[NotifyRegRec[mode: mode, doit: proc]] ELSE <<--invert the order: efficiency hack: the first installed cursor is found the fastest>> FOR list: NotifyList _ notifyList, list.rest DO IF list.first.mode=mode THEN {list.first.doit _ proc; EXIT} ELSE IF list.rest=NIL THEN {list.rest _ LIST[NotifyRegRec[mode: mode, doit: proc]]; EXIT} ENDLOOP }; CallFurtherNotify: PUBLIC PROC[me: CDVPrivate.VRef, mode: REF] = { ENABLE RuntimeError.UNCAUGHT => { IF CDVPrivate.ShallContinue[me, TRUE, "CDViewerBackdoorImpl.CFN"] THEN GOTO oops; }; FOR list: NotifyList _ notifyList, list.rest WHILE list#NIL DO IF list.first.mode=mode THEN {list.first.doit[me, mode]; RETURN} ENDLOOP; <<--error catch>> UseDefaultOutLine[me, NIL]; EXITS oops => NULL; }; <<>> DefaultOutLine: PROC [me: CDVPrivate.VRef] = {}; UseDefaultOutLine: CDViewerBackdoor.FurtherNotifyProc = { me.designRec.outlineProcLC _ DefaultOutLine }; <<>> <<>> <> DisplayType: TYPE = CDColors.DisplayType; <<-- {bw, bit1, bit2, bit4, bit8, bit9}; >> DisplayMode: TYPE = CDColors.DisplayMode; <<-- {normal, pushedOut}; >> Brick: TYPE = CDColors.Brick; -- ARRAY [0..4) OF CARDINAL; ColorTable: TYPE = CDColors.ColorTable; <<-- RECORD; >> <<-- bricks: ARRAY CD.Layer OF REF Brick; >> <<-- cols: ARRAY CD.Layer OF Imager.Color; >> ColorTableSet: TYPE = CDColors.ColorTableSet; <<-- ARRAY DisplayMode OF REF ColorTable;>> ColorDefinition: TYPE = CDColors.ColorDefinition; <<-- ARRAY DisplayType OF REF ColorTableSet;>> globalColors: PUBLIC REF ColorDefinition _ NEW[ColorDefinition_ALL[NIL]]; emptyBrick: REF Brick = NEW[Brick_ALL[0]]; fullBrick: REF Brick = NEW[Brick_ALL[LAST[CARDINAL]]]; registeredColors: REF CD.ContextColors _ NEW[CD.ContextColors]; madeUpColors: REF CD.ContextColors _ NEW[CD.ContextColors]; eraseColor: Imager.Color _ NIL; ColorNotRegistered: PUBLIC SIGNAL = CODE; InitialColor: PUBLIC PROC [] RETURNS [col: Imager.Color] = { IF eraseColor#NIL THEN RETURN [eraseColor]; col _ eraseColor _ ImagerColor.Find["Xerox/Research/ChipNDale/cd/InitialColor"]; IF col=NIL THEN {SIGNAL ColorNotRegistered; col _ Imager.white}; }; RegisteredColor: PUBLIC PROC [layer: CD.Layer] RETURNS [col: Imager.Color] = { IF CD.LayerKey[layer]=NIL THEN ERROR CD.Error[calling]; col _ FindColor[layer]; IF col=NIL THEN {SIGNAL ColorNotRegistered; col _ MakUpColor[layer]}; }; FindColor: PROC [layer: CD.Layer] RETURNS [col: Imager.Color] = { IF registeredColors[layer]#NIL THEN RETURN [registeredColors[layer]]; col _ registeredColors[layer] _ ImagerColor.Find[ColorName[layer]]; <<--hack to propagate registered colors into the default for the color display>> IF col#NIL THEN IF globalColors[bit8][normal].cols[layer]=NIL OR globalColors[bit8][normal].cols[layer]=madeUpColors[layer] THEN globalColors[bit8][normal].cols[layer] _ globalColors[bit8][pushedOut].cols[layer] _ col }; MakUpColor: PROC [layer: CD.Layer] RETURNS [col: Imager.Color] = { IF madeUpColors[layer]#NIL THEN RETURN [madeUpColors[layer]]; madeUpColors[layer] _ col _ ImagerDitherContext.MakeSpecialColor[ordinaryColor: Imager.black, specialPixel: [0, or], name: ColorName[layer]]; }; ColorName: PROC [l: CD.Layer] RETURNS [Rope.ROPE] = { tech: CD.Technology _ CD.LayerTechnology[l]; RETURN [Rope.Cat["Xerox/Research/ChipNDale/", (IF tech=NIL THEN "cd" ELSE tech.name), "/", Atom.GetPName[CD.LayerKey[l]]]] }; NewColorTab: PROC [] RETURNS [ct: REF ColorTable] = { ct _ NEW[ColorTable _ [ bricks: NEW[ARRAY CD.Layer OF REF Brick _ ALL[fullBrick]], filter: NEW[CD.ContextFilter _ ALL[TRUE]], cols: NEW[ARRAY CD.Layer OF Imager.Color _ ALL[Imager.black]] ]]; ct.filter[CD.backgroundLayer] _ FALSE; }; GetCTS: PROC [table: REF ColorDefinition, display: DisplayType] RETURNS [cts: REF ColorTableSet] = { IF table=NIL THEN table _ globalColors; IF table[display]=NIL THEN { IF table=globalColors THEN { IF display=bit1 THEN display _ bw --color 1 bit/pixel gets same stipples as bw ELSE IF display=bit9 THEN display _ bit8; --9 bit/pixel uses same stipples as 8 bit/pixel }; IF table[display]=NIL THEN { table[display] _ NEW[ColorTableSet _ ALL[NIL]]; table[display][normal] _ NewColorTab[]; table[display][pushedOut] _ NewColorTab[]; }; }; cts _ table[display]; }; DefineColor: PUBLIC PROC[ layer: CD.Layer, brick: REF Brick _ NIL, -- do no more change the values display: DisplayType _ bw, mode: DisplayMode _ normal, table: REF ColorDefinition _ NIL --NIL uses the global table ] = { cts: REF ColorTableSet _ GetCTS[table, display]; IF brick=NIL THEN brick _ fullBrick ELSE IF brick^=fullBrick^ THEN brick _ fullBrick -- reuse fullbrick; reduce swapping ELSE IF brick^=emptyBrick^ THEN brick _ emptyBrick; cts[mode].bricks[layer] _ brick; cts[mode].cols[layer] _ FindColor[layer]; IF cts[mode].cols[layer]=NIL THEN cts[mode].cols[layer] _ MakUpColor[layer]; cts[mode].filter[layer] _ cts[mode].cols[layer]#NIL; IF mode=normal THEN { cts[pushedOut].bricks[layer] _ brick; cts[pushedOut].cols[layer] _ cts[mode].cols[layer]; cts[pushedOut].filter[layer] _ cts[mode].filter[layer]; }; }; DefineIColor: PUBLIC PROC[ layer: CD.Layer, col: Imager.Color _ NIL, display: DisplayType _ bw, mode: DisplayMode _ normal, table: REF ColorDefinition _ NIL --NIL uses the global table ] = { cts: REF ColorTableSet _ GetCTS[table, display]; abstract: Imager.Color _ registeredColors[layer]; <<--make the abstract color win if it exists...>> IF abstract#NIL THEN col _ abstract; <<--check special case>> IF abstract=NIL AND col#NIL AND display=bit8 AND ISTYPE[col, ImagerColor.OpConstantColor] THEN { b: REF Brick _ cts[mode].bricks[layer]; IF b#NIL AND b[0]=b[1] AND b[0]=b[1] AND b[0]=b[3] THEN { n: CARDINAL _ b[0] MOD 256; IF n=(b[0] / 256) THEN { madeUpColors[layer] _ col _ ImagerDitherContext.MakeSpecialColor[ ordinaryColor: NARROW[col], specialPixel: [n, or], name: ColorName[layer] ]; } } }; <<--always>> cts[mode].cols[layer] _ col; cts[mode].filter[layer] _ col#NIL; IF mode=normal THEN { cts[pushedOut].cols[layer] _ col; cts[pushedOut].filter[layer] _ col#NIL; } }; globalColors[bw] _ globalColors[bit1] _ NEW[ColorTableSet]; globalColors[bw][normal] _ NewColorTab[]; globalColors[bw][pushedOut] _ NewColorTab[]; globalColors[bit8] _ globalColors[bit4] _ globalColors[bit2] _ globalColors[bit9] _ NEW[ColorTableSet]; globalColors[bit8][normal] _ NewColorTab[]; globalColors[bit8][pushedOut] _ NewColorTab[]; <<>> <<>> InstallFurtherNotify[NIL, UseDefaultOutLine]; END.