CoreViewImpl.mesa
Copyright Ó 1987, 1988 by Xerox Corporation. All rights reserved.
Written by Giordano Bruno Beretta, January 22, 1987 10:44:14 am PST
gbb January 19, 1988 10:58:37 am PST
Bertrand Serlet April 2, 1987 3:56:13 pm PST
Visualizes the Manhattan geometry in a Core data structure.
DIRECTORY
CD USING [LayerKey, Object, Position, undefLayer],
CDBasics USING [BaseOfRect, ComposeTransform, MapRect, NonEmpty, SizeOfRect],
Checksum USING [ComputeChecksum],
Core USING [CellType, Wire],
CoreClasses USING [CellInstance, recordCellClass, RecordCellType, transistorCellClass],
CoreGeometry USING [BBox, CellInstance, CellType, Decoration, EachInstanceProc, EnumerateGeometry, FlattenInstance, GetObject, GetTrans, Instance, Layer, Transformation, Wire],
CoreOps USING [GetCellTypeName],
CoreView USING [CoreCell, Layout, Rect, Viewer],
CStitching USING [all, Area, ChangeEnumerateArea, ChangeRect, DumpCache, EnumerateArea, EnumerateNeighborhood, NewTesselation, RectProc, Region, ResetTesselation, Tesselation, Tile, TileProc],
Icons USING [NewIconFromFile],
Imager USING [black, ClipRectangle, Color, Context, ConstantColor, Font, MakeGray, MaskRectangle, MaskVector, MaskVectorI, Rectangle, ScaleT, SetColor, SetFont, SetPriorityImportant, SetStrokeEnd, SetStrokeJoint, SetStrokeWidth, SetXY, ShowRope, StrokeEnd, TranslateT, VEC, white],
ImagerBackdoor USING [GetBounds],
ImagerColor USING [ColorFromRGB, ConstantColor, RGB],
ImagerColorPrivate USING [RGBFromColor],
ImagerTransformation USING [Transformation],
IO USING [card, int, PutR1],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, CreateMenu, Menu, MenuEntry],
MessageWindow USING [Append, Blink, Clear],
NectarineColors USING [LayerColour, SetLayerColourTable],
Process USING [CheckForAbort],
Real USING [Fix, Float],
RefTab USING [Create, EachPairAction, Fetch, Insert, Key, Pairs, Ref],
Rope USING [Cat, ROPE],
VFonts USING [defaultFont],
ViewerClasses USING [DestroyProc, HScrollProc, PaintProc, ScrollProc, ViewerClass, ViewerClassRec, ViewerFlavor, ViewerRec],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass],
WindowManager USING [colorDisplayOn];
CoreViewImpl: CEDAR PROGRAM
IMPORTS CD, CDBasics, Checksum, CoreGeometry, CoreOps, CoreClasses, CStitching, Icons, Imager, ImagerBackdoor, ImagerColor, ImagerColorPrivate, IO, Menus, MessageWindow, NectarineColors, Process, Real, RefTab, Rope, VFonts, ViewerOps, WindowManager
EXPORTS CoreView ~ BEGIN
OPEN CoreView, Real;
break: SIGNAL ~ CODE; -- for debugging
Font: TYPE ~ Imager.Font;
Color: TYPE ~ Imager.Color;
Context: TYPE ~ Imager.Context;
Rectangle: TYPE ~ Imager.Rectangle;
Transformation: TYPE ~ ImagerTransformation.Transformation;
ROPE: TYPE ~ Rope.ROPE;
Region: TYPE ~ LIST OF REF CStitching.Region;
Tess: TYPE ~ CStitching.Tesselation;
Tile: TYPE ~ CStitching.Tile;
TileAndContext: TYPE ~ REF TcRec;
TcRec: TYPE ~ RECORD [tile: Tile, context: Context];
Transf: TYPE ~ CoreGeometry.Transformation;
CoreInst: TYPE ~ CoreGeometry.CellInstance;
FakeInst: TYPE ~ CoreGeometry.Instance;
Wire: TYPE ~ CoreGeometry.Wire;
Layer: TYPE ~ CoreGeometry.Layer;
debugViewer: PUBLIC Viewer;
monitorHandle: PUBLIC Tess; -- needed fom Cedar 7.0 on because a break-point in a paint procedure will lock the column
identity: Transf; -- READONLY it is the default
rectClass: ATOM ~ $Rect;
markClass: ATOM ~ $AlignmentMarkOb;
segmentClass: ATOM ~ $SymbolicSegment;
pinClass: ATOM ~ $PinOb0;
empty: REF ~ NIL;
nothing: REF INT ~ NEW [INT];
outline: REAL ← -1.0;
minInteger: INT ~ INTEGER.FIRST;
maxInteger: INT ~ INTEGER.LAST;
State: TYPE = REF StateRec;
StateRec: TYPE = RECORD [
previousColour: Color ← NIL,
previousStrokeWidth: REAL ← -1024.0,
tess: Tess,
boundingBox, window: Rectangle,
translation: Imager.VEC ← [0.0, 0.0], -- initialization imporant for caches
scale: REAL,
bottomSB, rightSB: INTEGER ← 100, -- caches: initialization imporant
topSB, leftSB: INTEGER ← 0, -- caches: initialization imporant
resetPainting: BOOL ← TRUE, -- initialization imporant for caches
attributes: Layout,
abort: REF BOOL];
Interfaces
GeometryView:
PUBLIC
PROC [cell: CoreCell, geom: Layout, abortFlag:
REF
BOOL]
RETURNS [viewer: Viewer] ~
BEGIN
Draws the geometry in a Core data structure in a viewer using the Imager.
state: State ~ NEW [StateRec];
BEGIN
OPEN state;
abort ← IF (abortFlag # NIL) THEN abortFlag ELSE NEW [BOOL ← FALSE];
boundingBox ← window ←
ImagerRect [CoreGeometry.BBox [[CoreGeometry.GetObject [geom, cell], identity]]];
tess ← CStitching.NewTesselation [stopFlag: abort];
previousColour ← NIL;
attributes ← geom
END;
IF (EnumerateCore [cell, identity, EveryCell, state]) THEN RETURN;
[] ← NectarineColors.SetLayerColourTable []; BlendAllColours;
viewer ← InitializeViewer [cell, normal, state]
END; -- GeometryView
StartIncrementalView:
PUBLIC
PROC [cell: CoreCell, geom: Layout, abortFlag:
REF
BOOL]
RETURNS [viewer: Viewer] ~
BEGIN
Initializes a viewer into which rectangles can be drawn one at a time in the context of a given cell.
state: State ~ NEW [StateRec];
BEGIN
OPEN state;
abort ← IF (abortFlag # NIL) THEN abortFlag ELSE NEW [BOOL ← FALSE];
boundingBox ← window ←
ImagerRect [CoreGeometry.BBox [[CoreGeometry.GetObject [geom, cell], identity]]];
tess ← CStitching.NewTesselation [stopFlag: abort];
previousColour ← NIL;
attributes ← geom
END;
viewer ← InitializeViewer [cell, labelled, state];
END; -- StartIncrementalView
AddRectangle:
PUBLIC
PROC [viewer: Viewer, rect: Rect, label:
REF
ANY] ~
BEGIN
Adds a rectangle to a viewer started with StartIncrementalView. The label field is loopholed to label the rectangle.
state: State;
InsertRect: CStitching.RectProc ~
BEGIN
[plane: REF Tesselation, rect: Rect, oldValue: REF, data: REF]
plane.ChangeRect [rect: rect, new: label]
END; -- InsertRect
IF (viewer = NIL) THEN RETURN ELSE state ← NARROW [viewer.data, State];
IF state.abort^ THEN RETURN;
state.tess.ChangeEnumerateArea [rect: rect, eachRect: InsertRect, skip: nothing];
ViewerOps.PaintViewer [viewer: viewer, hint: client]
END; -- AddRectangle
Core
ComposedTransf:
PROC [parent: Transf, child: CoreInst, state: State]
RETURNS [Transf] ~
BEGIN
Returns the child's absolute coordinates.
RETURN [CDBasics.ComposeTransform [CoreGeometry.GetTrans [state.attributes, child], parent]]
END; -- ComposedTransf
EachCell: TYPE ~ PROC [cell: CoreCell, transf: Transf, state: State];
EnumerateCore:
PROC [cell: CoreCell, transf: Transf, action: EachCell, state: State]
RETURNS [quit:
BOOL ←
FALSE] ~
BEGIN
Enumerates the cell and does action on each subcell.
IF state.abort^ THEN RETURN [TRUE];
SELECT cell.class
FROM
CoreClasses.recordCellClass =>
BEGIN
cellData: CoreClasses.RecordCellType ~ NARROW [cell.data];
FOR sub:
NAT
IN [0 .. cellData.size)
DO
subTransf: Transf ~ ComposedTransf [transf, cellData.instances[sub], state];
IF (EnumerateCore [cellData.instances[sub].type, subTransf, action, state]) THEN RETURN [TRUE]
ENDLOOP
END;
ENDCASE => NULL;
action [cell, transf, state];
quit ← state.abort^
END; -- EnumerateCore
EveryCell: EachCell ~
BEGIN
[cell: CoreCell, transf: Transf, state: State]
SELECT cell.class
FROM
CoreClasses.recordCellClass =>
BEGIN
cellData: CoreClasses.RecordCellType ~ NARROW [cell.data];
FOR i:
NAT
IN [0 .. cellData.internal.size)
DO
IF state.abort^
THEN
RETURN;
EveryWire [state: state, cell: cell, w: cellData.internal[i], transf: transf]
ENDLOOP
END;
CoreClasses.transistorCellClass =>
FOR i:
NAT
IN [0 .. cell.public.size)
DO
IF state.abort^
THEN
RETURN;
EveryWire [state: state, cell: cell, w: cell.public[i], transf: transf]
ENDLOOP
ENDCASE => NULL -- Print warning
END; -- EveryCell
EveryWire:
PROC [cell: CoreCell, w: Wire, transf: Transf, state: State] ~
BEGIN
EveryRect: CoreGeometry.EachInstanceProc ~
BEGIN
[instance: CdInsts] RETURNS [quit: BOOL ← FALSE]
rect: Rect ~ CDBasics.MapRect [CoreGeometry.BBox [instance], transf];
dec: Tess ~ state.tess;
l: Layer ~ instance.obj.layer;
InsertRect: CStitching.RectProc ~
BEGIN
[plane: REF Tesselation, rect: Rect, oldValue: REF, data: REF]
Note that merging works correctly because of the use of the colour table.
WITH oldValue
SELECT
FROM
b: Blend => IF NOT b.flavours[l] THEN dec.ChangeRect [rect: rect, new: ColourTile [b, l]];
ENDCASE =>
BEGIN
b: Blend ← NEW [BlendRec];
dec.ChangeRect [rect: rect, new: ColourTile [b, l]]
END
END; -- InsertRect
IF state.abort^ THEN RETURN [state.abort^];
IF (instance.obj.class.objectType # rectClass) THEN break;
SELECT instance.obj.class.objectType
FROM
rectClass =>
IF (CDBasics.NonEmpty [rect])
THEN
dec.ChangeEnumerateArea [rect: rect, eachRect: InsertRect, skip: nothing];
markClass, segmentClass, pinClass => NULL;
ENDCASE => quit ← CoreGeometry.FlattenInstance [instance, EveryRect];
END; -- EveryRect
[] ← state.attributes.EnumerateGeometry [w, EveryRect];
FOR i:
INT
IN [0 .. w.size)
DO
[] ← state.attributes.EnumerateGeometry [w.elements[i], EveryRect]
ENDLOOP
END; -- EveryWire
Viewers & Context Set-up
ViewerFlavor: TYPE ~ ViewerClasses.ViewerFlavor;
normal: ViewerFlavor ~ $CoreView;
labelled: ViewerFlavor ~ $LabelledCoreView;
InitializeViewerClasses:
PROC ~
BEGIN
Initializes and registers the viewer classes.
classN: ViewerClasses.ViewerClass ← NEW [ViewerClasses.ViewerClassRec];
classL: ViewerClasses.ViewerClass ← NEW [ViewerClasses.ViewerClassRec];
classMenu: Menus.Menu ~ Menus.CreateMenu [];
abortButton: Menus.MenuEntry ~ Menus.CreateEntry [name: "Abort", proc: Abort, guarded: TRUE];
zoomInButton: Menus.MenuEntry ~ Menus.CreateEntry [name: "Zoom-In", proc: ZoomIn];
zoomOutButton: Menus.MenuEntry ~ Menus.CreateEntry [name: "Zoom-Out", proc: ZoomOut];
everythingButton: Menus.MenuEntry ~ Menus.CreateEntry [name: "Reset", proc: Everything];
Menus.AppendMenuEntry [classMenu, abortButton];
Menus.AppendMenuEntry [classMenu, zoomInButton];
Menus.AppendMenuEntry [classMenu, zoomOutButton];
Menus.AppendMenuEntry [classMenu, everythingButton];
BEGIN
OPEN classN;
flavor ← normal;
paint ← Paint;
destroy ← Destroy;
scroll ← VerticalTranslation;
hscroll ← HorizontalTranslation;
menu ← classMenu;
icon ← Icons.NewIconFromFile ["[DATools]<DATools7.0>CoreView>CoreView.Icons", 0];
cursor ← crossHairsCircle
END;
classL^ ← classN^;
classL.flavor ← labelled;
classL.icon ← Icons.NewIconFromFile ["[DATools]<DATools7.0>CoreView>CoreView.Icons", 1];
ViewerOps.RegisterViewerClass [normal, classN];
ViewerOps.RegisterViewerClass [labelled, classL]
END; -- InitializeViewerClasses
InitializeViewer:
PROC [cell: CoreCell, flavor: ViewerFlavor, state: State]
RETURNS [viewer: Viewer] ~
BEGIN
Draws the geometry in a Core data structure in a viewer using the Imager.
info: ViewerClasses.ViewerRec;
BEGIN
OPEN info;
label ← CoreOps.GetCellTypeName [cell];
name ← IF (flavor = normal) THEN label ELSE label.Cat [" debugging"];
column ← IF WindowManager.colorDisplayOn THEN color ELSE left;
scrollable ← TRUE;
hscrollable ← TRUE;
iconic ← (flavor = labelled);
guardDestroy ← TRUE;
data ← state
END;
viewer ← ViewerOps.CreateViewer [flavor, info]
END; -- InitializeViewer
Paint: ViewerClasses.PaintProc ~
BEGIN
[self: Viewer, context: Context, whatChanged: REF, clear: BOOL] RETURNS [quit: BOOL ← FALSE]
Called by the window manager when the client should repaint the data on the screen. The context is clipped to the client screen area. whatChanged is just passed from the call to ViewerOps.PaintViewer, but will be NIL when the window manager requires a full repaint after moving a viewer on the screen. clear is a hint that the client background is white, so that the client can paint on the black bits if it so chooses. See comments for paintRectangles bit in the viewer class. Return quit~TRUE to stop without painting children.
state: State ~ NARROW [self.data];
ChangeStrokeWidth:
PROC [state: State, w:
REAL] ~
INLINE
BEGIN
w < 0 means that it has not yet been set in this body. Must be fast as a bullet.
IF (w < 0)
OR (w # state.previousStrokeWidth)
THEN
BEGIN
context.SetStrokeWidth [w]; state.previousStrokeWidth ← w
END
END; -- ChangeStrokeWidth
ChangeColour:
PROC [colour: Color] ~
INLINE
BEGIN
At this point we know that only one colour representation is used. Must be fast as a bullet.
a: ImagerColor.RGB ~ RGBFromColour [colour];
b: ImagerColor.RGB ~ RGBFromColour [state.previousColour];
IF (a.R # b.R)
OR (a.G # b.G)
OR (a.B # b.B)
OR (state.previousColour =
NIL)
THEN
BEGIN
Draw black using the grey colour model, so that it is placed in the black colour separation.
IF (a.R = 0.0) AND (a.G = 0.0) AND (a.B = 0.0) THEN context.SetColor [blackBlack]
ELSE context.SetColor [colour];
state.previousColour ← colour
END
END; -- ChangeColour
FastMaskVector:
PROC [context: Context, x1, y1, x2, y2:
INT] ~
BEGIN
Probably for speed reasons the Imager uses 16 bit integers.
IF ((x1 >= minInteger) AND (y1 >= minInteger) AND (x2 <= maxInteger) AND (y2 <= maxInteger)) THEN context.MaskVectorI [x1, y1, x2, y2]
ELSE context.MaskVector [[Float[x1], Float[y1]], [Float[x2], Float[y2]]]
END; -- FastMaskVector
SouthRim: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
tc: TileAndContext ~ NARROW [data];
IF (tile.value # tc.tile.value)
THEN
BEGIN
tr: Rect ~ tc.tile.Area; nr: Rect ~ tile.Area;
x1: INT ~ MAX [tr.x1, nr.x1]; x2: INT ~ MIN [tr.x2, nr.x2];
IF (x1 < x2) THEN FastMaskVector [tc.context, x1, tr.y1, x2, tr.y1]
END
END; -- SouthRim
EastRim: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
tc: TileAndContext ~ NARROW [data];
IF (tile.value # tc.tile.value)
THEN
BEGIN
tr: Rect ~ tc.tile.Area; nr: Rect ~ tile.Area;
y1: INT ~ MAX [tr.y1, nr.y1]; y2: INT ~ MIN [tr.y2, nr.y2];
IF (y1 < y2) THEN FastMaskVector [tc.context, tr.x2, y1, tr.x2, y2]
END
END; -- EastRim
NorthRim: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
tc: TileAndContext ~ NARROW [data];
IF (tile.value # tc.tile.value)
THEN
BEGIN
tr: Rect ~ tc.tile.Area; nr: Rect ~ tile.Area;
x1: INT ~ MAX [tr.x1, nr.x1]; x2: INT ~ MIN [tr.x2, nr.x2];
IF (x1 < x2) THEN FastMaskVector [tc.context, x1, tr.y2, x2, tr.y2]
END
END; -- NorthRim
WestRim: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
tc: TileAndContext ~ NARROW [data];
IF (tile.value # tc.tile.value)
THEN
BEGIN
tr: Rect ~ tc.tile.Area; nr: Rect ~ tile.Area;
y1: INT ~ MAX [tr.y1, nr.y1]; y2: INT ~ MIN [tr.y2, nr.y2];
IF (y1 < y2) THEN FastMaskVector [tc.context, tr.x1, y1, tr.x1, y2]
END
END; -- WestRim
NewPrintTile: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
This is an experiment for Cedar 7.0. Michael Plass has changed the implementation of MaskVector so that it gives the result of PrintAlignedTile at the cost of PrintTile.
state: State ~ NARROW [data];
b: Blend ~ NARROW [tile.value];
r: Rect ~ CStitching.Area [tile]; -- not the area but the rectangle !
ir: Rectangle ~ ImagerRect [r];
median: INT;
ChangeColour [b.blend]; context.SetStrokeEnd [butt];
IF (ir.w > ir.h)
THEN
BEGIN
ChangeStrokeWidth [state, ir.h]; median ← (r.y1 + r.y2) / 2;
FastMaskVector [context, r.x1, median, r.x2, median]
END
ELSE
BEGIN
ChangeStrokeWidth [state, ir.w]; median ← (r.x1 + r.x2) / 2;
FastMaskVector [context, median, r.y1, median, r.y2]
END;
IF state.abort^ THEN ERROR ABORTED;
Process.CheckForAbort;
IF (outline >= 0.0)
AND (b.blend # blackBlack)
THEN
BEGIN
tc: TileAndContext ~ NEW [TcRec ← [tile, context]];
ChangeColour [blackBlack]; ChangeStrokeWidth [state, outline];
context.SetStrokeEnd [square];
state.tess.EnumerateNeighborhood [tile, SouthRim, WestRim, NorthRim, EastRim, tc, nothing]
END
END; -- NewPrintTile
PrintTile: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
b: Blend ~ NARROW [tile.value];
r: Rect ~ CStitching.Area [tile]; -- not the area but the rectangle !
IF state.abort^ THEN RETURN;
ChangeColour [b.blend];
context.MaskRectangle [ImagerRect [r]]
END; -- PrintTile
PrintLabeledTile: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
r: Rect ~ CStitching.Area [tile]; -- not the area but the rectangle !
l: CARD;
IF state.abort^ THEN RETURN;
ChangeColour [lightGrey];
context.MaskRectangle [ImagerRect [r]];
ChangeColour [blackBlack];
context.SetStrokeWidth [0.0];
context.MaskVectorI [r.x1, r.y1, r.x2, r.y1]; -- South
context.MaskVectorI [r.x2, r.y1, r.x2, r.y2]; -- East
context.MaskVectorI [r.x2, r.y2, r.x1, r.y2]; -- North
context.MaskVectorI [r.x1, r.y2, r.x1, r.y1]; -- West
TRUSTED {l ← LOOPHOLE [tile.value, CARD]};
context.SetXY [[r.x1, r.y1]];
context.ShowRope [IO.PutR1 [IO.card [l]]]
END; -- PrintLabeledTile
state.abort^ ← FALSE; monitorHandle ← state.tess;
state.previousColour ← NIL; context.SetStrokeEnd [butt];
state.window ← ImagerBackdoor.GetBounds [context]; -- needed for scroll bars
IF (self.class.flavor = normal)
AND ((self.column = color)
OR (
NOT clear))
THEN
BEGIN
context.SetColor [IF (self.column = color) THEN grey ELSE whiteWhite];
context.SetColor [whiteWhite];
context.MaskRectangle [state.window]
END;
IF state.abort^ THEN {state.abort^ ← FALSE; RETURN [TRUE]};
context.SetPriorityImportant [FALSE];
IF state.resetPainting
THEN
BEGIN
-- important for initialization of caches
state.translation ← [state.boundingBox.x, state.boundingBox.y];
state.scale ← MIN [(state.window.w / state.boundingBox.w), (state.window.h / state.boundingBox.h)];
state.resetPainting ← FALSE
END;
context.TranslateT [state.translation]; context.ScaleT [state.scale];
state.window ← ImagerBackdoor.GetBounds [context]; -- needed for scroll bars
context.ClipRectangle [state.window];
context.SetStrokeJoint [miter]; context.SetStrokeWidth [0]; context.SetStrokeEnd [square];
context.SetFont [VFonts.defaultFont];
SELECT self.class.flavor
FROM
normal =>
state.tess.EnumerateArea [rect: CStitching.all, eachTile: NewPrintTile, data: state, skip: empty];
labelled =>
state.tess.EnumerateArea [rect: CStitching.all, eachTile: PrintLabeledTile, data: state, skip: empty];
ENDCASE => ERROR
END; -- Paint
VerticalTranslation: ViewerClasses.ScrollProc ~
BEGIN
[self: Viewer, op: ScrollOp, amount: INTEGER, shift, control: BOOL ← FALSE] RETURNS [top, bottom: INTEGER ← LAST[INTEGER]]
ScrollOp = {query, up, down, thumb}
Client scrolling and scrolling feedback. If op is 'query' the client should return the percentage of the scrollable document at the top and bottom of the screen, or default if unknown. If op is 'up' or 'down' then amount is number of pixels to glitch. If op is 'thumb' then amount is percentage into document to scroll. The shift and control information reflects the state of the shift and control keys during the up, down, and thumb ops and may be interpreted by the client as desired.
state: State ~ NARROW [self.data];
viewport: [self.cx, cy, cw, ch]
BEGIN
OPEN state;
SELECT op
FROM
query =>
BEGIN
A query is performed each time the mouse is on a scroll bar, hence this must be faster than a bullet.
top ← MAX [topSB, 0]; bottom ← MIN [bottomSB, 100]; RETURN
END;
up =>
IF (window.y < boundingBox.y+boundingBox.h)
THEN
BEGIN
translation.y ← translation.y + (Float [amount] / Float [self.ch]) * window.h;
Note that the cached values may exceed the diplayed values to avoid referring to the window when it is moved back into the viewer.
Note also that topSB and bottomSB cannot be computed trivially from amount, because amount is in pixels, while I have to return a percentage.
topSB ← Fix [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + Fix [(window.h / boundingBox.h) * 100.0]
END;
down =>
IF (window.y+window.h > boundingBox.y)
THEN
BEGIN
translation.y ← translation.y - (Float [amount] / Float [self.ch]) * window.h;
topSB ← Fix [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + Fix [(window.h / boundingBox.h) * 100.0]
END;
thumb =>
SELECT
TRUE
FROM
shift AND control => ImportantMessage ["Invalid command"];
shift =>
BEGIN
-- scale up (window becomes relatively smaller)
The scroll bar is viewed as a scale from 1 to 10.
factor: REAL ~ 10.0 / Float [amount + 10];
scale ← scale * factor;
topSB ← Fix [((window.y + window.h) * factor) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + Fix [(window.h / boundingBox.h) * 100.0]
END;
control =>
BEGIN
-- reset painting
resetPainting ← TRUE;
bottomSB ← rightSB ← 100; topSB ← leftSB ← 0
END;
ENDCASE =>
BEGIN
-- thumb
sign: INTEGER ← IF (boundingBox.h > window.h) THEN -1 ELSE 1;
translation.y ← sign * (boundingBox.y + (boundingBox.h * Float [amount] / 100.0));
topSB ← amount;
bottomSB ← amount + Fix [(window.h / boundingBox.h) * 100.0]
END;
ENDCASE => ERROR;
Trace [amount];
ViewerOps.PaintViewer [viewer: self, hint: client]; -- op <> query
Note that the cached values may exceed the diplayed values to avoid referring to the window when it is moved back into the viewer.
top ← MAX [topSB, 0]; bottom ← MIN [bottomSB, 100]
END -- OPEN state
END; -- VerticalTranslation
HorizontalTranslation: ViewerClasses.HScrollProc ~
BEGIN
[self: Viewer, op: HScrollOp, amount: INTEGER, shift, control: BOOL ← FALSE] RETURNS [left, right: INTEGER ← LAST[INTEGER]]
HScrollOp = {query, left, right, thumb}
Client scrolling and scrolling feedback. If op is 'query' the client should return the percentage of the scrollable document at the top and bottom of the screen, or default if unknown. If op is 'up' or 'down' then amount is number of pixels to glitch. If op is 'thumb' then amount is percentage into document to scroll. The shift and control information reflects the state of the shift and control keys during the up, down, and thumb ops and may be interpreted by the client as desired.
state: State ~ NARROW [self.data];
BEGIN
OPEN state;
SELECT op
FROM
query =>
BEGIN
A query is performed each time the mouse is on a scroll bar, hence this must be faster than a bullet.
right ← MIN [rightSB, 100]; left ← MAX [leftSB, 0]; RETURN
END;
right =>
IF (window.x < boundingBox.x+boundingBox.w)
THEN
BEGIN
translation.x ← translation.x + (Float [amount] / Float [self.cw]) * window.w;
leftSB ← Fix [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + Fix [(window.w / boundingBox.w) * 100.0]
END;
left =>
IF (window.x+window.w > boundingBox.x)
THEN
BEGIN
translation.x ← translation.x - (Float [amount] / Float [self.cw]) * window.w;
leftSB ← Fix [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + Fix [(window.w / boundingBox.w) * 100.0]
END;
thumb =>
SELECT
TRUE
FROM
shift AND control => ImportantMessage ["Invalid command"];
shift =>
BEGIN
-- scale down (window becomes relatively larger)
factor: REAL ~ Float [amount + 10] / 10.0;
scale ← scale * factor;
leftSB ← Fix [((window.x + window.w) * factor) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + Fix [(window.w / boundingBox.w) * 100.0]
END;
control =>
BEGIN
-- reset painting
resetPainting ← TRUE;
bottomSB ← rightSB ← 100; topSB ← leftSB ← 0
END;
ENDCASE =>
BEGIN
-- thumb
sign: INTEGER ← IF (boundingBox.w > window.w) THEN -1 ELSE 1;
translation.x ← sign * (boundingBox.x + (boundingBox.w * Float [amount] / 100.0));
leftSB ← amount;
rightSB ← amount + Fix [(window.w / boundingBox.w) * 100.0]
END;
ENDCASE => ERROR;
Trace [amount];
ViewerOps.PaintViewer [viewer: self, hint: client]; -- op <> query
Note that the cached values may exceed the diplayed values to avoid referring to the window when it is moved back into the viewer.
right ← MIN [rightSB, 100]; left ← MAX [leftSB, 0]
END -- OPEN state
END; -- HorizontalTranslation
Destroy: ViewerClasses.DestroyProc ~
BEGIN
Called when the viewer has been destroyed for some reason.
state: State ~ NARROW [self.data];
state.tess.ResetTesselation []; CStitching.DumpCache
END; -- Destroy
Abort: Menus.ClickProc ~
BEGIN
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
IF NOT ISTYPE [parent, Viewer] THEN ImportantMessage ["Implementation error"]
ELSE
BEGIN
state: State ~ NARROW [NARROW [parent, Viewer].data];
state.abort^ ← TRUE
END
END; -- Abort
ZoomIn: Menus.ClickProc ~
BEGIN
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
IF NOT ISTYPE [parent, Viewer] THEN ImportantMessage ["Implementation error"]
ELSE
BEGIN
v: Viewer ~ NARROW [parent];
state: State ~ NARROW [v.data];
BEGIN
OPEN state;
scale ← scale * 1.5;
ViewerOps.PaintViewer [viewer: v, hint: client];
topSB ← Fix [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + Fix [(window.h / boundingBox.h) * 100.0];
leftSB ← Fix [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + Fix [(window.w / boundingBox.w) * 100.0]
END
END
END; -- ZoomIn
ZoomOut: Menus.ClickProc ~
BEGIN
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
IF NOT ISTYPE [parent, Viewer] THEN ImportantMessage ["Implementation error"]
ELSE
BEGIN
v: Viewer ~ NARROW [parent];
state: State ~ NARROW [v.data];
BEGIN
OPEN state;
scale ← scale / 1.5;
ViewerOps.PaintViewer [viewer: v, hint: client];
topSB ← Fix [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + Fix [(window.h / boundingBox.h) * 100.0];
leftSB ← Fix [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + Fix [(window.w / boundingBox.w) * 100.0]
END
END
END; -- ZoomOut
Everything: Menus.ClickProc ~
BEGIN
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
IF NOT ISTYPE [parent, Viewer] THEN ImportantMessage ["Implementation error"]
ELSE
BEGIN
v: Viewer ~ NARROW [parent];
state: State ~ NARROW [v.data];
state.resetPainting ← TRUE;
[] ← NectarineColors.SetLayerColourTable []; BlendAllColours;
state.bottomSB ← state.rightSB ← 100; state.topSB ← state.leftSB ← 0;
ViewerOps.PaintViewer [viewer: v, hint: client]
END
END; -- Everything
Color Blending
Data is global
Bitset: TYPE ~ PACKED ARRAY Layer OF BOOLEAN ← ALL [FALSE];
BlendKey: TYPE ~ REF Bitset;
Blend: TYPE ~ REF BlendRec;
BlendRec: TYPE ~ RECORD [count: Layer ← 0,
flavours: Bitset,
blend: Color ← NIL,
area: CARD ← 0];
colourTable: RefTab.Ref ~ RefTab.Create [557, Match, Hash]; -- or 997
ColourTile:
PROC [old: Blend, l: Layer]
RETURNS [new: Blend] ~
BEGIN
Sets up a blending record for a tile. Must be fast as a bullet.
key: BlendKey ~ NEW [Bitset ← old.flavours];
key[l] ← TRUE;
new ← NARROW [colourTable.Fetch[key].val, Blend];
IF (new =
NIL)
THEN
BEGIN
copy: Blend ← NEW [BlendRec ← [flavours: old.flavours]];
copy.count ← SUCC [old.count];
copy.flavours[l] ← TRUE;
new ← copy;
IF NOT colourTable.Insert [key, copy] THEN ERROR
END
END; -- ColourTile
blackBlack: Color ~ Imager.black;
whiteWhite: Color ~ Imager.white;
grey: Color ~ Imager.MakeGray [0.36];
lightGrey: Color ~ Imager.MakeGray [0.18];
black: Color ~ ImagerColor.ColorFromRGB [[0.0, 0.0, 0.0]];
blue: Color ~ ImagerColor.ColorFromRGB [[0.0, 0.0, 1.0]];
unColour: ImagerColor.RGB ~ [0.0, 0.0, 0.0];
doubleYellowRGB: ImagerColor.RGB ~ [2.0, 2.0, 0.0];
doubleYellow: Color ~ ImagerColor.ColorFromRGB [doubleYellowRGB];
magentaRGB: ImagerColor.RGB ~ [1.0, 0.0, 1.0];
cyan: Color ~ ImagerColor.ColorFromRGB [[0.0, 1.0, 1.0]];
lightYellow: Color ~ ImagerColor.ColorFromRGB [[6.0/7.0, 6.0/7.0, 3.0/7.0]];
lightMagenta: Color ~ ImagerColor.ColorFromRGB [[5.0/7.0, 0.0, 5.0/7.0]];
BlendColours: RefTab.EachPairAction ~
BEGIN
Takes the layers covering a tile and blend an RBG-colour out of them.
[key: Key, value: Value] RETURNS [quit: BOOLEAN ← FALSE]
components: Blend ~ NARROW [val];
n: REAL ← Float [components.count];
comp: PACKED ARRAY Layer OF BOOLEAN ← components.flavours;
mix: ImagerColor.RGB ← unColour;
IF (components.blend # NIL) THEN RETURN [FALSE]; -- caching across sessions
SELECT n
FROM
0 => ERROR; -- should never have been allocated
1 =>
BEGIN
i: Layer ← 0;
WHILE NOT comp[i] DO i ← SUCC [i] ENDLOOP;
components.blend ← NectarineColors.LayerColour [i]
END;
ENDCASE =>
BEGIN
poly, diff, met, met2, cut, cut2, well: Layer ← 0;
Find exception layers.
FOR i: Layer
IN Layer
DO
IF comp[i]
THEN
SELECT
CD.LayerKey[i]
FROM
$pol => poly ← i;
$ndif, $pdif => diff ← i;
$met => met ← i;
$met2 => met2 ← i;
$nwel => well ← i;
$cut => cut ← i;
$cut2 => {cut ← i; cut2 ← i};
ENDCASE => NULL
ENDLOOP;
Cuts always win.
IF (cut # 0) THEN components.blend ← IF (cut2 # 0) THEN blue ELSE black
ELSE
BEGIN
-- Assume: all other colours have the same weight.
IF (poly # 0)
AND (diff # 0)
THEN
BEGIN
-- Handle gates.
Reinitialize mix by yellow and eliminate poly and diff. Since gates are very important, they are given double weight.
mix ← doubleYellowRGB;
comp[poly] ← comp[diff] ← FALSE
END;
IF (poly # 0)
AND (met # 0)
AND (diff = 0)
THEN
BEGIN
-- Handle metal over poly.
mix ← magentaRGB; n ← n - 1.0;
comp[poly] ← comp[met] ← FALSE
END;
FOR i: Layer
IN Layer
DO
-- Compute mean colour.
IF comp[i]
THEN
BEGIN
v: ImagerColor.RGB ~ RGBFromColour [NectarineColors.LayerColour[i]];
mix.R ← mix.R + v.R; mix.G ← mix.G + v.G; mix.B ← mix.B + v.B
END
ENDLOOP;
IF (met2 # 0)
THEN
BEGIN
-- make metal-2 transparent
mix.R ← mix.R - 4.0/7.0; mix.B ← mix.B - 4.0/7.0; n ← n - 4.0/7.0
END;
IF (well # 0)
THEN
BEGIN
-- make wells transparent
mix.R ← mix.R - 5.0/7.0; mix.G ← mix.G - 5.0/7.0; n ← n - 5.0/7.0;
mix.B ← mix.B - (3.0/7.0 * 2.0/7.0) -- take out well lightener
END;
mix.R ← mix.R / n; mix.G ← mix.G / n; mix.B ← mix.B / n;
components.blend ← ImagerColor.ColorFromRGB [mix]
END
END;
RETURN [FALSE]
END; -- BlendColours
BlendAllColours:
PROC ~
BEGIN
The logarithm of the number of colours is two, that of the rectangles is six.
[] ← colourTable.Pairs [BlendColours]
END; -- BlendAllColours
Hash:
PROC [k: RefTab.Key]
RETURNS [
CARDINAL] ~
BEGIN
PROC [Key] RETURNS [CARDINAL]
TRUSTED
BEGIN
RETURN [Checksum.ComputeChecksum [0, SIZE [BlendKey], LOOPHOLE [k]]]
END
END; -- Hash
Match:
PROC [key1, key2: RefTab.Key]
RETURNS [
BOOL] ~
BEGIN
RefTab.EqualProc
k1: BlendKey ~ NARROW [key1, BlendKey]; k2: BlendKey ~ NARROW [key2, BlendKey];
RETURN [(k1^ = k2^)]
END; -- Match
Conversions
ImagerRect:
PROC [r: Rect]
RETURNS [Rectangle] ~
BEGIN
base: CD.Position ~ CDBasics.BaseOfRect [r];
size: CD.Position ~ CDBasics.SizeOfRect [r];
RETURN [[Float[base.x], Float[base.y], Float[size.x], Float[size.y]]]
END; -- ImagerRect
ImagerVec:
PROC [p:
CD.Position]
RETURNS [Imager.
VEC] ~
BEGIN
RETURN [[Float[p.x], Float[p.y]]]
END; -- ImagerVec
CdPos: PROC [v: Imager.VEC] RETURNS [CD.Position] ~ BEGIN
RETURN [[Round[v.x], Round[v.y]]]
END; -- CdPos
RGBFromColour:
PROC [c: Color]
RETURNS [rgb: ImagerColor.
RGB] ~
INLINE
BEGIN
Assume that LayerColour had previously been called.
WITH c
SELECT FROM
constant: Imager.ConstantColor => rgb ← ImagerColorPrivate.RGBFromColor [constant];
ENDCASE => rgb ← unColour;
RETURN [rgb]
END; -- RGBFromColour
ImportantMessage:
PROC [msg:
ROPE] ~
BEGIN
Writes a message in the ChipNDale terminal viewer and in the Message Window at the top of the LF screen and makes it blink.
MessageWindow.Clear []; MessageWindow.Append [msg]; MessageWindow.Blink []
END; -- ImportantMessage
Trace:
PROC [i:
INTEGER] ~
BEGIN
MessageWindow.Clear []; MessageWindow.Append [IO.PutR1 [IO.int [i]]]
END; -- Trace
Initializations
InitializeViewerClasses
END.
gbb June 11, 1987 11:53:55 am PDT
Added a monitor handle because from Cedar 7.0 on, when a break-point is put in a paint procedure, the whole column with the viewer remains locked.
changes to: OPEN, Paint
gbb June 11, 1987 12:07:16 pm PDT
Added outline feature from Nectarine.
changes to: DIRECTORY, OPEN, ChangeStrokeWidth (local of Paint), ChangeColour (local of Paint), FastMaskVector (local of Paint), SouthRim (local of Paint), EastRim (local of Paint), NorthRim (local of Paint), WestRim (local of Paint), NewPrintTile (local of Paint), PrintTile (local of Paint), Paint, END
gbb June 11, 1987 5:35:49 pm PDT
Solved a race condition with the Imager.
Got rid by brute force from the special colours, since the mechanism does not work. Probably not all colours are registered, or the Imager cannot find them any more or whatever: out they are.
changes to: DIRECTORY, IMPORTS, GeometryView, InitializeViewer, SetLayerColourTable
gbb June 25, 1987 2:13:59 pm PDT
Gets layers colors from Nectarine instead of ChipNDale.
changes to: DIRECTORY, IMPORTS, GeometryView, Everything, BlendColours