CDViewerBackdoorImpl.mesa
Copyright © 1984, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, August 29, 1984 10:03:32 am PDT
last edited by Christian Jacobi, June 16, 1987 5:07:08 pm PDT
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
CDVScale
MakeScale:
PUBLIC
PROC [off:
CD.Position←[0, 0], nscale: CDVScale.ScaleRange𡤄, 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<noDivisionScale
THEN {
s.xx ← sE;
s.designToViewerFactor ← sE;
}
ELSE {
s.xx ← s.sA;
s.designToViewerFactor ← 1.0/s.sA;
};
};
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]
]
};
Set and Get procs
Speed is not so important
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;
};
More drawing behaviours
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𡤊MTypes.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
};
More TIP notifier behaviour
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
};
CDColors
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.