CDOpsImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
by Christian Jacobi, July 12, 1983 10:56 am
last edited by Christian Jacobi, May 22, 1986 5:11:56 pm PDT
Last Edited by: Jacobi June 6, 1986 12:07:30 pm PDT
DIRECTORY
Atom,
CD,
CDBasics,
CDCells,
CDDrawQueue,
CDEvents,
CDInstances,
CDIO,
CDOps,
CDOrient,
CDProperties,
CDRects,
CDSimpleOps,
CDValue,
HashTable,
Process,
Rope USING [ROPE],
SafeStorage,
TerminalIO,
UserProfile;
CDOpsImpl:
CEDAR
MONITOR
IMPORTS Atom, CD, CDBasics, CDCells, CDDrawQueue, CDEvents, CDInstances, CDIO, CDOps, CDOrient, CDProperties, CDRects, CDSimpleOps, CDValue, HashTable, Process, SafeStorage, TerminalIO, UserProfile
EXPORTS CDOps
SHARES CD =
BEGIN
createEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$CreateNewDesign];
resetDesignEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$ResetDesign];
delayedKey: REF ← NEW[INT];
DelRec:
TYPE =
RECORD [
delayedList: LIST OF Remember←NIL,
length: INT ← 0
];
GetDelRec:
PROC [design:
CD.Design]
RETURNS [
REF DelRec] =
BEGIN
x: REF ← CDValue.Fetch[boundTo: design, key: delayedKey, propagation: design];
IF x#NIL AND ISTYPE[x, REF DelRec] THEN RETURN [NARROW[x]]
ELSE {
dr: REF DelRec = NEW[DelRec←[NIL]];
CDValue.Store[design, delayedKey, dr];
RETURN [dr]
}
END;
Remember: TYPE = RECORD [area: CD.Rect, clear: BOOL];
InternalResetDesign:
PROC[design:
CD.Design] =
--is local since it does not cause a redraw
BEGIN
dummy: CD.Object ← CDCells.CreateEmptyCell[];
dummy.size ← CDBasics.highposition;
design.cdDirectoryPriv ← HashTable.Create[101, HashTable.RopeEqual, HashTable.HashRope];
design^.actual ←
LIST[
CD.PushRec[
dummyCell: CDInstances.NewInst[ob: dummy],
mightReplace: NIL,
specific: NARROW[dummy.specificRef],
deletedList: NIL]];
END;
CreateDesign:
PUBLIC
PROC [technology:
CD.Technology]
RETURNS [design:
CD.Design] =
BEGIN
IF technology=NIL THEN ERROR CD.Error[callingError, "NIL technology"];
design ←
NEW[
CD.DesignRec←[
properties: CD.InitPropRef[],
technology: technology,
reserved: NEW[LONG POINTER ← NIL] --type has no property write proc
]];
IF finalizing THEN SafeStorage.EnableFinalization[design];
InternalResetDesign[design]; -- must not cause redraw since event not yet processed
[] ← CDEvents.ProcessEvent[createEvent, design];
END;
ResetDesign:
PUBLIC
PROC [design:
CD.Design] =
BEGIN
InternalResetDesign[design];
[] ← CDEvents.ProcessEvent[resetDesignEvent, design];
CDValue.Store[design, delayedKey, NIL];
Redraw[design];
END;
RemoveInstance:
PUBLIC
PROC [design:
CD.Design, inst:
CD.Instance, draw:
BOOL←
TRUE] =
BEGIN
il: CD.InstanceList ← CDOps.InstList[design];
IF il#
NIL
THEN
IF il.first=inst THEN CDOps.SetInstList[design, il.rest]
ELSE
FOR l:
CD.InstanceList ← il, l.rest
WHILE l.rest#
NIL
DO
IF l.rest.first=inst THEN {l.rest←l.rest.rest; EXIT}
ENDLOOP;
IF draw THEN DelayedRedraw[design, CDInstances.InstRectO[inst]];
END;
SelectNewMode:
PROC[design:
CD.Design]
RETURNS [
BOOL] =
BEGIN
mode: INT = CDValue.FetchInt[boundTo: design, key: $CDxSelectNewMode, propagation: technology, ifNotFound: 0];
RETURN [mode=1]
END;
IncludeObjectI:
PUBLIC
PROC[design:
CD.Design, ob:
CD.Object, location:
CD.Position, orientation:
CD.Orientation] =
BEGIN
inst: CD.Instance;
IF ob#
NIL
THEN {
inst ← CDInstances.NewInstI[ob: ob, location: location, orientation: orientation ];
IF SelectNewMode[design]
THEN {
CDSimpleOps.DeselectAll[design];
inst.selected ← TRUE;
};
IncludeInstance[design, inst];
}
END;
IncludeInstance:
PUBLIC PROC [design:
CD.Design, inst:
CD.Instance, draw:
BOOL←
TRUE] =
BEGIN
IF inst=NIL THEN ERROR CD.Error[callingError, "Include of NIL application"];
IF inst.ob=NIL THEN ERROR CD.Error[callingError, "Include application with NIL object"];
CDOps.SetInstList[design, CONS[inst, CDOps.InstList[design]]];
IF draw THEN DelayedRedraw[design, CDInstances.InstRectO[inst], TRUE];
END;
IncludeInstanceList:
PUBLIC
PROC [design:
CD.Design, il:
CD.InstanceList, draw:
BOOL←
TRUE] =
BEGIN
FOR list:
CD.InstanceList ← il, list.rest
WHILE list#
NIL
DO
IncludeInstance[design, list.first, draw];
ENDLOOP;
END;
Redraw:
PUBLIC
PROC [design:
CD.Design, r:
CD.Rect�Ops.all, eraseFirst:
BOOL←
TRUE] =
BEGIN
CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[IF eraseFirst THEN $redraw ELSE $draw, r]];
END;
CheckForShorten:
PROC [dl:
REF DelRec] =
INLINE {
IF dl.length>20
THEN {
clear: BOOL ← FALSE;
r: CD.Rect ← CDBasics.empty;
FOR lst:
LIST
OF Remember ← dl.delayedList, lst.rest
WHILE lst#
NIL
DO
clear ← clear OR lst.first.clear;
r ← CDBasics.Surround[r, lst.first.area]
ENDLOOP;
dl.delayedList ← LIST[Remember[area: r, clear: clear]];
dl.length ← 1
};
};
DelayedRedraw:
PUBLIC
ENTRY
PROC [design:
CD.Design, r:
CD.Rect, eraseFirst:
BOOL←
TRUE] =
BEGIN
ENABLE UNWIND => NULL;
IF design#
NIL
THEN {
dl: REF DelRec = GetDelRec[design];
IF dl.delayedList=
NIL
THEN {
dl.delayedList ← LIST[Remember[area: r, clear: eraseFirst]];
dl.length ← 1
}
ELSE {
list: LIST OF Remember ← dl.delayedList;
DO
--ASSERTION1: {list#NIL}
--ASSERTION2: {no list rectangle is completely covered by an other one}
IF CDBasics.Intersect[list.first.area, r]
THEN {
IF CDBasics.Inside[r, list.first.area]
THEN {
--r is contained somewhere; we dont include it
--it is unlikely that a small area is cleared and a big one not
list.first.clear ← list.first.clear OR eraseFirst;
--assertion2 => no other elements could be removed
RETURN
}
ELSE
IF CDBasics.Inside[list.first.area, r]
THEN {
--r contains an element; we remove this element and all others
-- which are contained in r
--it is unlikely that a small area is cleared and a big one not
remember: LIST OF Remember ← list;
eraseFirst ← list.first.clear OR eraseFirst;
list.first.area ← r;
--remove all other element contained in r; to maintain assertion2
WHILE list.rest#
NIL
DO
assert3: list#NIL
IF CDBasics.Inside[list.rest.first.area, r]
THEN {
eraseFirst ← list.rest.first.clear OR eraseFirst;
list.rest ← list.rest.rest; --does not change list -> keeps assertion3
dl.length ← dl.length-1;
}
ELSE list ← list.rest --since list.rest#NIL -> keeps assertion3
ENDLOOP;
remember.first.clear ← eraseFirst;
RETURN
}
};
IF list.rest#NIL THEN list←list.rest
ELSE {
list.rest ← LIST[Remember[area: r, clear: eraseFirst]];
dl.length ← dl.length+1;
CheckForShorten[dl];
RETURN
}
ENDLOOP;
} --of dl.delayedList#NIL
} --of design#NIL
END;
DoTheDelayedRedraws:
PUBLIC
ENTRY
PROC [design:
CD.Design] =
BEGIN
ENABLE UNWIND => NULL;
sq: REF DelRec = GetDelRec[design];
UNTIL sq.delayedList=
NIL
DO
CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[(IF sq.delayedList.first.clear THEN $redraw ELSE $draw), sq.delayedList.first.area]];
sq.delayedList ← sq.delayedList.rest
ENDLOOP;
sq.length ← 0;
END;
DrawDesign:
PUBLIC
PROC[design:
CD.Design, pr:
CD.DrawRef] =
BEGIN
FOR w:
LIST
OF
CD.PushRec ← design^.actual, w.rest
WHILE w#
NIL
DO
IF pr.stopFlag^ THEN EXIT;
pr.drawChild[w.first.dummyCell, [0, 0], CDOrient.original, pr];
ENDLOOP;
END;
RedrawInstance:
PUBLIC
PROC[design:
CD.Design, inst:
CD.Instance←
NIL, erase:
BOOL←
TRUE] =
BEGIN
IF inst#NIL THEN DelayedRedraw[design, CDInstances.InstRectO[inst], erase]
ELSE DelayedRedraw[design, CDBasics.universe, erase]
END;
QuickDrawDesign:
PUBLIC
PROC[design:
CD.Design, pr:
CD.DrawRef] =
BEGIN
SomeCommon:
PROC[ob:
CD.Object, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] RETURNS [BOOLEAN] =
INLINE BEGIN
RETURN CDBasics.Intersect[CDOrient.RectAt[pos, ob.size, orient], pr.interestClip]
END;
DrawAndShowSelectionList:
PROC [list:
CD.InstanceList, pr:
CD.DrawRef] =
INLINE BEGIN
FOR w:
CD.InstanceList ← list, w.rest
WHILE w#
NIL
DO
IF SomeCommon[w.first.ob, w.first.location, w.first.orientation, pr]
THEN {
IF pr.stopFlag^ THEN EXIT;
w.first.ob.class.quickDrawMe[w.first, w.first.location, w.first.orientation, pr];
IF w.first.selected
THEN
w.first.ob.class.showMeSelected[w.first, w.first.location, w.first.orientation, pr];
};
ENDLOOP;
END;
QuickDrawPushedCell:
PROC [cp:
CD.CellPtr, pr:
CD.DrawRef] =
INLINE BEGIN
IF pr.borders AND cp.drawBorder THEN pr.drawOutLine[cp.ir, CD.outlineLayer, pr];
FOR w:
CD.InstanceList ← cp.contents, w.rest
WHILE w#
NIL
DO
IF SomeCommon[w.first.ob, w.first.location, w.first.orientation, pr]
THEN {
IF pr.stopFlag^ THEN EXIT;
w.first.ob.class.quickDrawMe[w.first, w.first.location, w.first.orientation, pr];
}
ENDLOOP;
END;
-- drawDesign
pr.setGround[pr: pr, pushedOut: FALSE];
DrawAndShowSelectionList[CDOps.InstList[design], pr];
IF design^.actual.rest#
NIL
THEN {
pr.drawOutLine[design^.actual.first.specific.ir, CD.outlineLayer, pr];
IF pr.environment
THEN {
pr.setGround[pr: pr, pushedOut: TRUE];
FOR w:
LIST
OF
CD.PushRec ← design^.actual.rest, w.rest
WHILE w#
NIL
DO
IF pr.stopFlag^ THEN EXIT;
QuickDrawPushedCell[w.first.specific, pr];
ENDLOOP;
};
}
END;
PointedInstance:
PUBLIC
PROC [design:
CD.Design, pos:
CD.Position]
RETURNS [CD.Instance] =
BEGIN
RETURN [ CDInstances.InstanceAt[CDOps.InstList[design], pos] ];
END;
SelectedInstance:
PUBLIC PROC [design:
CD.Design]
RETURNS [first:
CD.Instance←NIL, multiple:
BOOL�LSE] =
--first: returns ref to any selected application if there is one or more, otherwise nil.
--multiple: more than one application is selected
BEGIN
FOR w:
CD.InstanceList ← CDOps.InstList[design], w.rest
WHILE w#
NIL
DO
IF w.first.selected
THEN
IF first=NIL THEN first←w.first
ELSE {multiple←TRUE; RETURN}
ENDLOOP;
END;
ObjectInfo:
PUBLIC
PROC[ob:
CD.Object]
RETURNS [Rope.
ROPE] =
BEGIN
IF ob=NIL THEN RETURN ["nil object"]
ELSE IF ob.class.describe#NIL THEN RETURN [ob.class.describe[ob]]
ELSE RETURN [Atom.GetPName[ob.class.objectType]]
END;
LayerName:
PUBLIC
PROC[lev:
CD.Layer]
RETURNS [Rope.
ROPE] =
BEGIN
uniqueKey: ATOM = CD.LayerKey[lev];
IF uniqueKey=NIL THEN RETURN ["bad layer"];
RETURN [Atom.GetPName[uniqueKey]]
END;
ReOrderInstance:
PUBLIC
PROC [design:
CD.Design, inst:
CD.Instance] =
--on return: design has exactly one occurrence of inst, and it is at the end.
--(includes inst if necessary and removes double occurences)
BEGIN
il: CD.InstanceList ← CDOps.InstList[design];
found: BOOL ← FALSE;
IF inst=NIL THEN ERROR CD.Error[callingError, "Reorder of NIL application"];
WHILE il#NIL AND il.first=inst DO {found←TRUE; il ← il.rest} ENDLOOP;
IF il=
NIL
THEN {
IF found THEN il←LIST[inst]
ELSE ERROR CD.Error[callingError, "Reorder of application not in design"];
}
ELSE
FOR l:
CD.InstanceList ← il, l.rest
DO
-- l#NIL AND l.first#inst holds at this point
WHILE l.rest#NIL AND l.rest.first=inst DO {found←TRUE; l.rest ← l.rest.rest} ENDLOOP;
IF l.rest=
NIL
THEN {
IF found THEN l.rest ← LIST[inst]
ELSE ERROR CD.Error[callingError, "Reorder of application not contained in design"];
EXIT
}
ENDLOOP;
CDOps.SetInstList[design, il];
END;
-- Finalization --
-- designs are finalized to break circularities involving objects or instances
Draw
Collected:
PROC [inst: CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
pr.drawRect[CDOrient.RectAt[pos, inst.ob.size, orient], CD.errorLayer, pr]
END;
ReadCollected:
CD.InternalReadProc
--PROC [] RETURNS [Object]-- =
BEGIN
sz: CD.Position = CDIO.ReadPos[];
ob: CD.Object = CDRects.CreateRect[sz, CD.errorLayer];
r: Rope.ROPE = "*design of this object has been destroyed; bug in creator program\n";
CDProperties.PutObjectProp[ob, $SignalName, r];
TerminalIO.WriteRope[r];
RETURN [ob]
END;
WriteCollected:
CD.InternalWriteProc
-- PROC [me: Object] -- =
BEGIN
CDIO.WritePos[CD.InterestSize[me]];
TerminalIO.WriteRope["*write object which has been destroyed\n"];
END;
gCollectedClass:
CD.ObjectClass =
CD.RegisterObjectClass[$GCollected, [
drawMe: DrawCollected,
quickDrawMe: DrawCollected,
internalRead: ReadCollected,
internalWrite: WriteCollected,
description: "garbage object; design has been destroyed"
]];
DestroyEachObject: HashTable.EachPairAction =
BEGIN
WITH value
SELECT
FROM
ob:
CD.Object =>
IF ob.class=
NIL
OR ob.class.inDirectory
THEN {
ob.class ← gCollectedClass;
ob.layer ← CD.errorLayer;
ob.specificRef ← NIL;
ob.properties ← NIL;
};
ENDCASE => NULL;
END;
FinalizeDesign:
PROC [d:
CD.Design] =
BEGIN
d.properties ← NIL;
IF d.cdDirectoryPriv#
NIL
AND CDValue.Fetch[d, $KeepObjects]=
NIL
THEN
[] ← NARROW[d.cdDirectoryPriv, HashTable.Table].Pairs[DestroyEachObject];
WHILE d.actual#
NIL
DO
d.actual.first.dummyCell.properties ← NIL;
IF d.actual.first.mightReplace#NIL THEN d.actual.first.mightReplace.properties ← NIL;
d.actual.first.deletedList ← NIL;
d.actual ← d.actual.rest;
ENDLOOP;
d.cdDirectoryPriv ← NIL;
d.cdValuePriv ← NIL;
d.cdSequencerPriv ← NIL;
d.cdDrawQueuePriv ← NIL;
END;
FinalizerProcess:
PROC[fooFQ: SafeStorage.FinalizationQueue] =
BEGIN
DO
d: CD.Design = NARROW[SafeStorage.FQNext[fooFQ]];
FinalizeDesign[d];
ENDLOOP
END;
finalizing: BOOL = UserProfile.Boolean["ChipNDale.DoFinalization", TRUE];
IF finalizing
THEN {
fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[];
SafeStorage.EstablishFinalization[CODE[CD.DesignRec], 0, fooFQ];
TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]};
};
CDValue.RegisterKey[$KeepObjects];
END.