CoreViewImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Written by Giordano Bruno Beretta, January 22, 1987 10:44:14 am PST
gbb March 26, 1987 12:01:24 pm PST
Visualizes the Manhattan geometry in a Core layout.
DIRECTORY
CD USING [LayerKey, Object, Position, undefLayer],
CDBasics USING [BaseOfRect, ComposeTransform, MapRect, NonEmpty, SizeOfRect],
CDColors USING [ColorTable, DisplayMode, DisplayType, globalColors],
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, NewTesselation, RectProc, Region, ResetTesselation, Tesselation, Tile, TileProc],
Cursors USING [CursorType],
HashTable USING [Create, EachPairAction, Fetch, Insert, Key, Pairs, Table],
Icons USING [NewIconFromFile],
Imager USING [black, ClipRectangle, Color, Context, ConstantColor, Font, MakeGray, MaskRectangle, MaskVectorI, Rectangle, ScaleT, SetColor, SetFont, SetPriorityImportant, SetStrokeEnd, SetStrokeJoint, SetStrokeWidth, SetXY, ShowRope, TranslateT, VEC, white],
ImagerBackdoor USING [GetBounds],
ImagerColor USING [ColorFromRGB, RGB],
ImagerColorPrivate USING [ComponentFromColor],
ImagerTransformation USING [Transformation],
IO USING [card, int, PutR1],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, CreateMenu, Menu, MenuEntry],
MessageWindow USING [Append, Blink, Clear],
Real USING [FixI, Float],
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, CDColors, Checksum, CoreGeometry, CoreOps, CoreClasses, CStitching, HashTable, Icons, Imager, ImagerBackdoor, ImagerColor, ImagerColorPrivate, IO, Menus, MessageWindow, Real, 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;
Transf: TYPE ~ CoreGeometry.Transformation;
CoreInst: TYPE ~ CoreGeometry.CellInstance;
FakeInst: TYPE ~ CoreGeometry.Instance;
Wire: TYPE ~ CoreGeometry.Wire;
Layer: TYPE ~ CoreGeometry.Layer;
debugViewer: PUBLIC Viewer;
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];
State: TYPE = REF StateRec;
StateRec: TYPE = RECORD [
previousColour: Color ← NIL,
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;
viewer ← InitializeViewer [cell, normal, state];
IF (EnumerateCore [cell, identity, EveryCell, state]) THEN RETURN;
SetLayerColourTable; BlendAllColours;
ViewerOps.PaintViewer [viewer: viewer, hint: client]
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 ~ NARROW [viewer.data];
InsertRect: CStitching.RectProc ~
BEGIN
[plane: REF Tesselation, rect: Rect, oldValue: REF, data: REF]
plane.ChangeRect [rect: rect, new: label]
END; -- InsertRect
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 => EveryWire [cell, cell.public, transf, state];
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]
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];
classMenu.AppendMenuEntry [abortButton];
classMenu.AppendMenuEntry [zoomInButton];
classMenu.AppendMenuEntry [zoomOutButton];
classMenu.AppendMenuEntry [everythingButton];
BEGIN
OPEN classN;
flavor ← normal;
paint ← Paint;
destroy ← Destroy;
scroll ← VerticalTranslation;
hscroll ← HorizontalTranslation;
menu ← classMenu;
icon ← Icons.NewIconFromFile ["[DATools]<DATools6.1>CoreView>CoreView.Icon", 0];
cursor ← crossHairsCircle
END;
classL^ ← classN^;
classL.flavor ← labelled;
classL.icon ← Icons.NewIconFromFile ["[DATools]<DATools6.1>CoreView>CoreView.Icon", 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: Imager.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];
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
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;
state.previousColour ← NIL;
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.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 [mitered]; context.SetStrokeWidth [0]; context.SetStrokeEnd [square];
context.SetFont [VFonts.defaultFont];
SELECT self.class.flavor
FROM
normal =>
state.tess.EnumerateArea [rect: CStitching.all, eachTile: PrintTile, 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 ← FixI [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + FixI [(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 ← FixI [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + FixI [(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 ← FixI [((window.y + window.h) * factor) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + FixI [(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 + FixI [(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 ← FixI [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + FixI [(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 ← FixI [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + FixI [(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 ← FixI [((window.x + window.w) * factor) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + FixI [(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 + FixI [(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 ← FixI [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + FixI [(window.h / boundingBox.h) * 100.0];
leftSB ← FixI [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + FixI [(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 ← FixI [(window.y + window.h) / (boundingBox.y + boundingBox.h) * 100.0];
bottomSB ← topSB + FixI [(window.h / boundingBox.h) * 100.0];
leftSB ← FixI [(window.x + window.w) / (boundingBox.x + boundingBox.w) * 100.0];
rightSB ← leftSB + FixI [(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; 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: HashTable.Table ~ HashTable.Create [557, Match, Hash]; -- or 997
layerColorTable: ARRAY Layer OF Color; -- must be set for each task
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].value, 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];
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: HashTable.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 [value];
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 ← 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 [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
LayerColour:
PROC [l: Layer]
RETURNS [Color] ~
INLINE
BEGIN
Ensure that only one colour representation is used.
RETURN [layerColorTable[l]]
END; -- LayerColour
SetLayerColourTable:
PROC ~
BEGIN
Spread out hues & make "more subtractive".
FOR i: Layer
IN Layer
DO
SELECT
CD.LayerKey[i]
FROM
$nwel => layerColorTable[i] ← lightYellow;
$met => layerColorTable[i] 𡤌yan;
$met2 => layerColorTable[i] ← lightMagenta;
In ChipNdale 23 cut (cut-2) was always black (blue), but in rel. 24 was displayed black (blue) and printed blue (green).
$cut => layerColorTable[i] ← black;
$cut2 => layerColorTable[i] ← blue;
ENDCASE => layerColorTable[i] ← CDColors.globalColors[bit8][normal].cols[i]
ENDLOOP
END; -- SetLayerColourTable
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: HashTable.Key]
RETURNS [
CARDINAL] ~
BEGIN
PROC [Key] RETURNS [CARDINAL]
TRUSTED
BEGIN
RETURN [Checksum.ComputeChecksum [0, SIZE [BlendKey], LOOPHOLE [k]]]
END
END; -- Hash
Match:
PROC [a, b: HashTable.Key]
RETURNS [
BOOL] ~
BEGIN
HashTable.EqualProc
k1: BlendKey ~ NARROW [a, BlendKey]; k2: BlendKey ~ NARROW [b, 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 =>
BEGIN
rgb.R ← ImagerColorPrivate.ComponentFromColor [constant, $Red];
rgb.G ← ImagerColorPrivate.ComponentFromColor [constant, $Green];
rgb.B ← ImagerColorPrivate.ComponentFromColor [constant, $Blue]
END;
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.