DIRECTORY
Atom,
CD,
CDBasics,
CDBasicsInline,
CDCells,
CDDirectory,
CDDrawQueue,
CDEvents,
CDInstances,
CDImports,
CDIO,
CDOps,
CDOpsExtras,
CDPrivate,
CDProperties,
CDSequencer,
CDValue,
Convert,
IO,
Process, 
RefTab,
Rope,
SafeStorage,
SymTab,
RuntimeError USING [UNCAUGHT],
TerminalIO,
UserProfile;

CDOpsImpl: CEDAR MONITOR 
IMPORTS Atom, CD, CDBasics, CDBasicsInline, CDCells, CDDirectory, CDDrawQueue, CDEvents, CDInstances, CDIO, CDOps, CDPrivate, CDProperties, CDValue, Convert, IO, Process, RefTab, Rope, RuntimeError, SafeStorage, SymTab, TerminalIO, UserProfile
EXPORTS CDOps, CDOpsExtras
SHARES CD = 
BEGIN
createEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$CreateNewDesign];
resetDesignEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$ResetDesign];
renameEvent: CDEvents.EventRegistration _ CDEvents.RegisterEventType[$RenameDesign];
beforeRenameEvent: CDEvents.EventRegistration _ CDEvents.RegisterEventType[$BeforeRenameDesign];

DrawDesc: TYPE = RECORD [area: CD.Rect, clear: BOOL];
DelayedRedrawRec: TYPE = RECORD [
delayedList: LIST OF DrawDesc_NIL,
length: INT _ 0
];

GetDelayedRedrawRef: PROC [design: CD.Design] RETURNS [REF DelayedRedrawRec] = {
WITH design.delayedRedrawsPriv SELECT FROM
dr: REF DelayedRedrawRec => RETURN [dr];
ENDCASE => {
dr: REF DelayedRedrawRec = NEW[DelayedRedrawRec_[NIL]];
design.delayedRedrawsPriv _ dr;
RETURN [dr]
};
};


InternalResetDesign: PROC [design: CD.Design] = {
dummy: CD.Object _ CDCells.CreateEmptyCell[];
specific: CD.CellSpecific _ NARROW[dummy.specific]; 
specific.dummyCell _ TRUE;
dummy.bbox _ CDBasics.universe;
design.cdDirectory1 _ SymTab.Create[];
design.cdDirectory2 _ RefTab.Create[];
design.unDoBuffers _ CD.InitPropRef[];
design^.actual _ LIST[CD.PushRec[
dummyCell: CDInstances.NewInst[ob: dummy],
mightReplace: NIL,
specific: specific
]];
};

CreateDesign: PUBLIC PROC [technology: CD.Technology] RETURNS [design: CD.Design] = {
IF technology=NIL THEN ERROR CD.Error[calling, "NIL technology"];
design _ NEW[CD.DesignRec_[
properties: CD.InitPropRef[],
technology: technology,
unDoBuffers: CD.InitPropRef[], 
cdDirectoryPriv2: NEW[LONG POINTER _ NIL] 
]];
IF finalizing THEN SafeStorage.EnableFinalization[design];
InternalResetDesign[design]; -- must not cause redraw since event not yet processed
[] _ CDEvents.ProcessEvent[createEvent, design]; 
};

SetMutability: PUBLIC PROC [design: CD.Design, mutability: CD.Mutability _ editable] = {
DoIt: ENTRY PROC [] = {
ENABLE UNWIND => NULL;
IF design.mutability#editable AND design.mutability#findOut THEN 
RETURN WITH ERROR CD.Error[designMutability];
design.mutability _ mutability;
};
IF design=NIL THEN ERROR CD.Error[calling];
IF design.mutability=mutability THEN RETURN;
DoIt[];
[] _ CDEvents.ProcessEvent[mutabilityChange, design];
};

ResetDesign: PUBLIC PROC [design: CD.Design] = {
InternalResetDesign[design];
[] _ CDEvents.ProcessEvent[resetDesignEvent, design]; 
design.delayedRedrawsPriv _ NIL;
ImmediateRedraw[design];
};

RenameDesign: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [done: BOOL] = {
oldName: Rope.ROPE _ design.name;
IF Rope.IsEmpty[name] THEN RETURN [FALSE];
done _ ~CDEvents.ProcessEvent[beforeRenameEvent, design, name, TRUE];
IF done THEN {
design.name _ name;
[] _ CDEvents.ProcessEvent[renameEvent, design, oldName, FALSE];
};
};

RealTopCell: PUBLIC PROC [design: CD.Design] RETURNS [dummyCell: CD.Object] = {
FOR l: LIST OF CD.PushRec _ design^.actual, l.rest DO
IF l.rest=NIL THEN RETURN [l.first.dummyCell.ob]
ENDLOOP
};

PushedTopCell: PUBLIC PROC [design: CD.Design] RETURNS [dummyCell: CD.Object] = {
RETURN [design^.actual.first.dummyCell.ob];
};

MakeImmutable: PUBLIC PROC [ob: CD.Object] RETURNS [done: BOOL _ TRUE] = {
done _ MakeImmutableAndSetNameHints[ob, NIL];
};

MakeImmutableAndSetNameHints: PUBLIC PROC [ob: CD.Object, design: CD.Design] RETURNS [done: BOOL _ TRUE] = {
EachChild: CDDirectory.EachObjectProc = {
IF ~me.immutable THEN {
IF ~MakeImmutableAndSetNameHints[me, design] THEN {done _ FALSE; quit _ TRUE}
};
};
IF ~ob.immutable THEN {
IF ~ob.class.xDesign 
THEN [] _ CDDirectory.EnumerateChildObjects[ob, EachChild] 
ELSE WITH ob.specific SELECT FROM
ip: CDImports.ImportSpecific => {
bo: CD.Object _ ip.boundOb;
IF bo#NIL THEN 
done _ MakeImmutableAndSetNameHints[bo, ip.boundDesign];
};
ENDCASE => done _ FALSE;
IF done THEN {
IF design#NIL THEN {
name: Rope.ROPE ~ CDDirectory.Name[ob, design];
IF ~Rope.IsEmpty[name] THEN CDProperties.PutObjectProp[ob, $Describe, name];
};
ob.immutable _ TRUE
}
}
};

--xx undelete and friends xxxxxxxxxxxxxxxxxx

remSize: CARDINAL = 20;
UndeleteBuffer: TYPE = RECORD[
a: ARRAY [0..remSize) OF REF _ ALL[NIL],
next: CARDINAL_0
];

Forgett: PROC [what: REF] = {
WITH what SELECT FROM
il: CD.InstanceList => 
FOR l: CD.InstanceList _ il, l.rest WHILE l#NIL DO
l.first.properties _ NIL; l.first.ob _ NIL;
ENDLOOP;
inst: CD.Instance => {inst.properties _ NIL; inst.ob _ NIL};
ENDCASE => NULL;
};

GetUndeleteBuffer: PROC [d: CD.Design, create: BOOL_TRUE] RETURNS [buff: REF UndeleteBuffer_NIL] = {
WITH CDProperties.GetListProp[d.unDoBuffers^, $delete] SELECT FROM
dl: REF UndeleteBuffer => buff _ dl;
ENDCASE => IF create THEN {
buff _ NEW[UndeleteBuffer];
CDProperties.PutProp[d.unDoBuffers, $delete, buff];
};
};

FlushRemember: PUBLIC PROC [design: CD.Design]  = {
dl: REF UndeleteBuffer _ GetUndeleteBuffer[design, FALSE];
IF dl#NIL THEN {
dl.next _ (dl.next+remSize-1) MOD remSize;
DO
dl.next _ (dl.next+remSize-1) MOD remSize;
IF dl.a[dl.next]=NIL THEN EXIT;
Forgett[dl.a[dl.next]];
dl.a[dl.next] _ NIL;
ENDLOOP;
};
design.unDoBuffers _ CD.InitPropRef[];
};

GetRemembered: PUBLIC PROC [design: CD.Design] RETURNS [CD.InstanceList_NIL] = {
GiveRemembered: PROC [d: CD.Design] RETURNS [x: REF] = {
dl: REF UndeleteBuffer _ GetUndeleteBuffer[d];
IF dl=NIL THEN RETURN [NIL];
dl.next _ (dl.next+remSize-1) MOD remSize;
x _ dl.a[dl.next];
dl.a[dl.next] _ NIL;
RETURN [x];
};
WITH GiveRemembered[design] SELECT FROM
il: CD.InstanceList => RETURN [il];
inst: CD.Instance => RETURN [LIST[inst]];
ENDCASE => RETURN [NIL];
};

Remember: PUBLIC PROC [design: CD.Design, what: REF] = {
dl: REF UndeleteBuffer _ GetUndeleteBuffer[design, TRUE];
Forgett[dl.a[dl.next]];
dl.a[dl.next] _ what;
dl.next _ (dl.next+1) MOD remSize;
};


--xxxxxxxxxxxxxxxxxxxx



RemoveInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance, draw: BOOL_TRUE] = {
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 Redraw[design, CDInstances.InstRectO[inst]];
};

SelectNewMode: PROC [design: CD.Design] RETURNS [BOOL] = {
mode: INT = CDValue.FetchInt[boundTo: design, key: $CDxSelectNewMode, propagation: technology, ifNotFound: 0];
RETURN [mode=1]
};

IncludeObject: PUBLIC PROC [design: CD.Design, ob: CD.Object, trans: CD.Transformation] RETURNS [inst: CD.Instance_NIL]= {
IF ob=NIL THEN ERROR;
inst _ NEW[CD.InstanceRep _ [ob: ob, trans: trans]];
IF SelectNewMode[design] THEN {
DeselectAll[design];
inst.selected _ TRUE;
};
IncludeInstance[design, inst];
};

FitObjectI: PUBLIC PROC [ob: CD.Object, location: CD.Position _ [0, 0], orientation: CD.Orientation _ CD.Orientation[original]] RETURNS [trans: CD.Transformation] = {
trans.orient _ orientation;
trans.off _ CDBasics.SubPoints[location, CDBasics.BaseOfRect[CDBasics.MapRect[CD.InterestRect[ob], [[0, 0], orientation]]]];
};

IncludeObjectI: PUBLIC PROC[design: CD.Design, ob: CD.Object, location: CD.Position, orientation: CD.Orientation] RETURNS [CD.Instance]= {
RETURN [ IncludeObject[design, ob, FitObjectI[ob, location, orientation]] ];
};

IncludeInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance, draw: BOOL_TRUE] = {
IF inst=NIL THEN ERROR CD.Error[calling, "bad instance"];
IF inst.ob=NIL THEN ERROR CD.Error[calling, "bad object"];
CDOps.SetInstList[design, CONS[inst, CDOps.InstList[design]]];
IF draw THEN Redraw[design, CDInstances.InstRectO[inst], TRUE];
};

IncludeInstanceList: PUBLIC PROC [design: CD.Design, il: CD.InstanceList, draw: BOOL_TRUE] = {
FOR list: CD.InstanceList _ il, list.rest WHILE list#NIL DO
IncludeInstance[design, list.first, draw];
ENDLOOP;
};

ImmediateRedraw: PUBLIC PROC [design: CD.Design, r: CD.Rect_CDOps.all, eraseFirst: BOOL_TRUE] = {
CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[IF eraseFirst THEN $redraw ELSE $draw, r]];
};


CheckForShorten: PROC [dl: REF DelayedRedrawRec] = INLINE {
IF dl.length>20 THEN {
clear: BOOL _ FALSE;
r: CD.Rect _ CDBasics.empty;
FOR lst: LIST OF DrawDesc _ 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[DrawDesc[area: r, clear: clear]];
dl.length _ 1
};
};

Redraw: PUBLIC ENTRY PROC [design: CD.Design, r: CD.Rect, eraseFirst: BOOL_TRUE] = {
ENABLE UNWIND => NULL;
IF design#NIL THEN {
dl: REF DelayedRedrawRec = GetDelayedRedrawRef[design];
IF dl.delayedList=NIL THEN {
dl.delayedList _  LIST[DrawDesc[area: r, clear: eraseFirst]];
dl.length _ 1
}
ELSE {
list: LIST OF DrawDesc _ dl.delayedList;
DO
IF CDBasics.Intersect[list.first.area, r] THEN {
IF CDBasics.Inside[r, list.first.area] THEN { 
list.first.clear _ list.first.clear OR eraseFirst;
RETURN
}
ELSE IF CDBasics.Inside[list.first.area, r] THEN {
remember: LIST OF DrawDesc _ list;
eraseFirst _ list.first.clear OR eraseFirst;
list.first.area _ r;
WHILE list.rest#NIL DO
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[DrawDesc[area: r, clear: eraseFirst]];
dl.length _ dl.length+1;
CheckForShorten[dl];
RETURN
}
ENDLOOP;
} --of dl.delayedList#NIL
} --of design#NIL
};

DoTheDelayedRedraws: PUBLIC ENTRY PROC [design: CD.Design] = {
ENABLE UNWIND => NULL;
sq: REF DelayedRedrawRec;
sq _ GetDelayedRedrawRef[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;
};

RedrawInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance_NIL, erase: BOOL_TRUE] = {
IF inst#NIL THEN Redraw[design, CDInstances.InstRectO[inst], erase]
ELSE Redraw[design, CDBasics.universe, erase]
};

DrawDesign: PUBLIC PROC[design: CD.Design, pr: CD.DrawRef] = {
IF pr.selections THEN
FOR il: CD.InstanceList _ CDOps.InstList[design], il.rest WHILE il#NIL DO
IF il.first.selected AND CDBasicsInline.IntersectRI[pr.interestClip, il.first] THEN {
IF pr.stopFlag^ THEN RETURN;
pr.drawChildSel[pr, il.first.ob, il.first.trans];
};
ENDLOOP;
FOR il: CD.InstanceList _ CDOps.InstList[design], il.rest WHILE il#NIL DO
IF CDBasicsInline.IntersectRI[pr.interestClip, il.first] THEN {
IF pr.stopFlag^ THEN RETURN;
pr.drawChild[pr, il.first.ob, il.first.trans, il.first.properties];
}
ENDLOOP;
IF pr.environment THEN
FOR w: LIST OF CD.PushRec _ design^.actual.rest, w.rest WHILE w#NIL DO
IF pr.stopFlag^ THEN RETURN;
pr.drawChild[pr, w.first.dummyCell.ob, [[0, 0], original]];
ENDLOOP;
}; 

QuickDrawDesign: PUBLIC PROC [design: CD.Design, pr: CD.DrawRef] = {

QuickDrawPushedCell: PROC [cp: CD.CellSpecific, pr: CD.DrawRef] = INLINE {
IF pr.borders AND cp.drawBorder THEN pr.drawOutLine[pr, cp.ir, CD.outlineLayer];
FOR w: CD.InstanceList _ cp.contents, w.rest WHILE w#NIL DO
IF CDBasicsInline.IntersectRI[pr.interestClip, w.first] THEN {
IF pr.stopFlag^ THEN EXIT;
w.first.ob.class.quickDrawMe[pr, w.first.ob, w.first.trans, w.first.properties];
}
ENDLOOP;
}; 
pr.setGround[pr: pr, pushedOut: FALSE];
FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
IF w.first.selected AND CDBasicsInline.IntersectRI[pr.interestClip, w.first] THEN {
IF pr.stopFlag^ THEN RETURN;
w.first.ob.class.quickDrawMe[pr, w.first.ob, w.first.trans, w.first.properties];
IF pr.selections THEN
w.first.ob.class.showMeSelected[pr, w.first.ob, w.first.trans, w.first.properties];
};
ENDLOOP;
FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
IF ~w.first.selected AND CDBasicsInline.IntersectRI[pr.interestClip, w.first] THEN {
IF pr.stopFlag^ THEN RETURN;
w.first.ob.class.quickDrawMe[pr, w.first.ob, w.first.trans, w.first.properties];
};
ENDLOOP;
IF design^.actual.rest#NIL THEN {
pr.drawOutLine[pr, design^.actual.first.specific.ir, CD.outlineLayer];
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 RETURN;
QuickDrawPushedCell[w.first.specific, pr];
ENDLOOP;
};
};
}; 

SelectedInstance: PUBLIC PROC [design: CD.Design] RETURNS [first: CD.Instance_NIL, multiple: BOOL_FALSE] = {
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;
};

TheInstance: PUBLIC PROC [design: CD.Design, text: Rope.ROPE_NIL] RETURNS [inst: CD.Instance_NIL] = {
multiple: BOOL; 
IF text#NIL THEN TerminalIO.PutRope[text];
[inst, multiple] _ SelectedInstance[design];
IF multiple THEN {TerminalIO.PutRope["   multiple selection; failed\n"]; RETURN [NIL]};
IF inst=NIL THEN {TerminalIO.PutRope["   no selection; failed\n"]; RETURN [NIL]};
IF inst.ob=NIL THEN {inst_NIL; TerminalIO.PutRope["   bad object; failed\n"]};
};

LayerRope: PUBLIC PROC [layer: CD.Layer] RETURNS [Rope.ROPE] = {
uniqueKey: ATOM = CD.LayerKey[layer];
IF uniqueKey=NIL THEN RETURN ["bad layer"]; 
RETURN [Atom.GetPName[uniqueKey]]
};

InstRope: PUBLIC PROC [inst: CD.Instance, design: CD.Design, verbosity: INT_0] RETURNS [r: Rope.ROPE] = {
IF inst=NIL THEN r _ "nil instance"
ELSE r _ CD.Describe[inst.ob, inst.properties, design, verbosity];
};

ToRope: PUBLIC PROC [x: REF, whenFailed: REF_NIL] RETURNS [rope: Rope.ROPE_NIL] = {
WITH x SELECT FROM
r: Rope.ROPE => rope _ r;
rt: REF TEXT => rope _ Rope.FromRefText[rt];
ri: REF INT => rope _ Convert.RopeFromInt[ri^];
a: ATOM => rope _ Atom.GetPName[a];
l: CDPrivate.LayerRef => rope _ CDOps.LayerRope[l.number]; 
ob: CD.Object => rope _ CD.Describe[ob];
inst: CD.Instance => rope _ CD.Describe[inst.ob, inst.properties];
d: CD.Design  => rope _ d.name;
t: CD.Technology  => rope _ t.name;
rc: REF LONG CARDINAL => rope _ Convert.RopeFromCard[rc^];
ri: REF INTEGER => rope _ Convert.RopeFromInt[ri^];
ri: REF NAT => rope _ Convert.RopeFromInt[ri^];
rc: REF CARDINAL => rope _ Convert.RopeFromCard[rc^];
ENDCASE => 
SELECT whenFailed FROM
NIL =>  rope _ NIL;
$Interactive => {
RopeNeeded: SIGNAL [ ref: REF REF ] = CODE;
refRef: REF REF = NEW[REF _ x];
TerminalIO.PutRope["please enter a ROPE using the debugger"];
SIGNAL RopeNeeded[refRef];
rope _ ToRope[refRef^ ! RopeNeeded => ERROR];
};
ENDCASE => rope _ ToRope[whenFailed];
};

LambdaRope: PUBLIC PROC [n: CD.Number, lambda: CD.Number_1] RETURNS [Rope.ROPE] = {
IF n MOD lambda = 0 THEN RETURN IO.PutFR1[" %g", IO.int[n/lambda]]
ELSE {
r: Rope.ROPE _ " (";
IF n<0 THEN {n _ ABS[n]; r _ " -("};
IF n/lambda>0 THEN r _ IO.PutFR["%0g%0g+", IO.rope[r], IO.int[n/lambda]]; 
RETURN [IO.PutFR["%0g%0g/%0g)", IO.rope[r], IO.int[n MOD lambda], IO.int[lambda]]];
}
};

ReOrderInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance] = {
il: CD.InstanceList _ CDOps.InstList[design];
found: BOOL _ FALSE;
IF inst=NIL THEN ERROR CD.Error[calling, "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[calling, "Reorder of application not in design"];
}
ELSE 
FOR l: CD.InstanceList _ il, l.rest DO
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[calling, "reorder finds bad instance"];
EXIT
}
ENDLOOP;
CDOps.SetInstList[design, il];
};

GetGrid: PUBLIC PROC [design: CD.Design, hint: REF_NIL] RETURNS [CD.Number] = {
RETURN [CDPrivate.GetGrid[design, hint]]
};

PlaceInst: PUBLIC PROC [design: CD.Design, ob: CD.Object, hint: REF_NIL] RETURNS [inst: CD.Instance] =  {
lambda: CD.Number _ design.technology.lambda;
space, w1, w2: CD.Number;
grid: CD.Number _ MAX[1, GetGrid[design, hint]];
bb: CD.Rect _ CDOps.BoundingBox[design];
IF ~CDBasics.NonEmpty[bb] THEN bb _ [0, 0, 0, 0]; 
w1 _ MAX[lambda*5, bb.x2-bb.x1];
w2 _ MAX[lambda*5, CD.InterestSize[ob].x];
space _ MIN[w1, w2]/8+MAX[w1, w2]/80+lambda*4;
inst _ CDInstances.NewInst[ob: ob, 
trans: [[(bb.x2+space+grid-1)/grid*grid, (bb.y1+grid-1)/grid*grid]]
];
CDOps.IncludeInstance[design, inst];
};

BoundingBox: PUBLIC PROC [design: CD.Design, onlySelected: BOOL] RETURNS [r: CD.Rect _ CDBasics.empty] = {
IF onlySelected THEN r _ CDInstances.BoundingRectO[CDOps.InstList[design], TRUE]
ELSE
FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO
r _ CDBasics.Surround[r, CDInstances.BoundingRectO[
NARROW[l.first.dummyCell.ob.specific, CD.CellSpecific].contents ]]
ENDLOOP;
};

DeselectAll: PUBLIC PROC [design: CD.Design, setSelection: BOOL_FALSE] = {
bb: CD.Rect _ CDBasics.empty; cnt: INT _ 0; 
FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
IF w.first.selected#setSelection THEN {
cnt_cnt+1; bb _ CDBasics.Surround[bb, CDInstances.InstRectO[w.first]];
}
ENDLOOP;
FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
IF w.first.selected#setSelection THEN {
w.first.selected _ setSelection;
IF cnt>10 THEN RedrawInstance[design, w.first, ~setSelection]
};
ENDLOOP;
IF cnt<=10 THEN Redraw[design, bb, ~setSelection]
};


DrawCollected: CD.DrawProc = {
pr.drawRect[pr, CDBasics.MapRect[ob.bbox, trans], CD.errorLayer]
}; 

ReadCollected: CD.InternalReadProc = {
r: Rope.ROPE = "*design of this object has been destroyed; bug in creator program\n";
ob: CD.Object _ NEW[CD.ObjectRep_[class: gCollectedClass, layer: CD.errorLayer]];
IF CDIO.VersionKey[h]<=16 
THEN ob.bbox _ CDBasics.RectAt[[0, 0], CDIO.ReadPos[h]]
ELSE ob.bbox _ CDIO.ReadRect[h];
CDProperties.PutObjectProp[ob, $SignalName, r];
ob.immutable _ TRUE;
TerminalIO.PutRope[r];
RETURN [ob]
};

WriteCollected: CD.InternalWriteProc = {
CDIO.WriteRect[h, ob.bbox];
TerminalIO.PutRope["*write object which has been destroyed\n"];
};

gCollectedClass: CD.ObjectClass = CD.RegisterObjectClass[$GCollected, [
drawMe: DrawCollected,
quickDrawMe: DrawCollected,
internalRead: ReadCollected,
internalWrite: WriteCollected,
description: "garbage object; design has been destroyed"
]];
DestroyEachObject: CDDirectory.EachObjectProc = {
IF ~me.immutable AND (me.class=NIL OR me.class.composed) THEN {
me.class _ gCollectedClass; 
me.layer _ CD.errorLayer; 
me.properties _ NIL;
};
};

FinalizeDesign: PROC [d: CD.Design] = {
IF d.mutability=findOut THEN TRUSTED {
Process.Detach[FORK 
TerminalIO.PutF["%l**design %g garbage collected before mutability was set%l\n", 
IO.rope["ib"],
IO.rope[CD.DesignName[d]],
IO.rope[" "]
]
];
};
IF d.mutability=editable OR d.mutability=readonly THEN {
IF d.cdDirectory1#NIL AND d.cdDirectory2#NIL AND CDValue.Fetch[d, $DontGC]=NIL THEN
[] _ CDDirectory.EnumerateDesign[design: d, proc: DestroyEachObject, dir: TRUE, top: TRUE, recurse: TRUE, dummy: TRUE];
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 _ d.actual.rest;
ENDLOOP;
};
};

FinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = {
DO
d: CD.Design = NARROW[SafeStorage.FQNext[fooFQ]];
FinalizeDesign[d ! RuntimeError.UNCAUGHT => CONTINUE];
ENDLOOP
};

mutabilityChange: CDEvents.EventRegistration = CDEvents.RegisterEventType[$MutabilityChange];
finalizing: BOOL = UserProfile.Boolean["ChipNDale.DoFinalization", TRUE];
IF finalizing THEN {
fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[];
IF Atom.GetProp[$ChipNDalePrivate, $FinalizationEnabled]=$TRUE THEN
SafeStorage.ReEstablishFinalization[CODE[CD.DesignRec], 0, fooFQ]
ELSE {
SafeStorage.EstablishFinalization[CODE[CD.DesignRec], 0, fooFQ];
Atom.PutProp[$ChipNDalePrivate, $FinalizationEnabled, $TRUE];
};
TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]};
};
CDValue.RegisterKey[$DontGC];
END. 


ϊCDOpsImpl.mesa       (part of ChipNDale)
Copyright c 1983, 1987 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, July 12, 1983 10:56 am 
Last edited by: Christian Jacobi, August 20, 1987 2:03:20 pm PDT
--is local since it does not cause a redraw
--helps the garbage collector and may prevent circularities through properties
--ASSERTION1: {list#NIL}
--ASSERTION2: {no list rectangle is completely covered by an other one}
--r is contained somewhere; we dont include it
--it is unlikely that a small area is cleared and a big one not
--assertion2 => no other elements could be removed
--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
--remove all other element contained in r; to maintain assertion2
assert3: list#NIL
--selections of the top level cell
--the top level cell
--the pushed in cells 

--top level selections
--top level non selections
--the pushed in cells 
--first: returns ref to any selected application if there is one or more, otherwise nil.
--multiple: more than one application is selected
--on return: design has exactly one occurrence of inst, and it is at the end. 
--(includes inst if necessary and removes double occurences)
-- l#NIL AND l.first#inst holds at this point
-- xxxxxxxxxxxxxxxx



-- Finalization --
-- designs are finalized to break circularities involving objects or instances

--don't access specific; in error case, some procedure might be on its way
Κš˜
codeš
œ(™(Kšœ
Οm
œ7™BKš
œ4™4K™@—K˜š
Οk	˜	Kš
œ˜Kšžœ
˜Kš
œ	˜	Kš
œ˜K˜Kš
œ˜Kš
œ˜K˜	K˜Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœž˜	Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
žœžœ˜Kš
œ˜Kš
œ˜—K˜šΟn	œžœ
žœ
˜KšžœžœVžœ‰
˜σ
Kšžœ˜Kšžœ
žœ˜—Kš
ž˜K˜UK˜VK˜TK˜`K˜Kš	œ
žœžœžœžœ˜5šœžœžœ˜!Kšœ
žœ
žœ
žœ
˜"Kšœžœ˜K˜—K˜š
Ÿœžœ
žœ	žœžœ˜Pšžœžœ
ž˜*Kšœžœžœ˜(šžœ˜Kšœžœžœžœ˜7Kš
œ˜Kšžœ˜K˜——Kš
œ˜K˜—K˜šŸœžœ
žœ˜1Kš
Οc+™+Kšœžœ$˜-Kšœ
žœžœ˜4Kšœžœ
˜Kš
œ˜Kš
œ&˜&Kš
œ&˜&Kšœžœ˜&šœžœ
žœ	˜!Kš
œ*˜*Kšœžœ
˜Kš
œ˜Kš
œ˜—Kš
œ˜—K˜šŸœžœ
žœžœ
žœ
žœ˜UKš
žœžœ
žœ
žœ
žœ"˜Ašœ	žœ
žœ˜Kšœžœ˜Kš
œ˜Kšœ
žœ˜Kš	œžœ
žœ
žœžœ˜*Kš
œ˜—Kšžœžœ(˜:Kšœ 6˜SK˜1Kš
œ˜—K˜š
Ÿ
œžœ
žœ
žœžœ˜XšŸœžœ
žœ˜Kšžœ
žœžœ
˜šžœžœžœ
˜AKšžœ
žœ
žœ
žœ˜-—Kš
œ˜Kš
œ˜—Kš
žœžœ
žœ
žœ
žœ˜+Kšžœžœ
žœ
˜,Kš
œ˜Kš
œ5˜5Kš
œ˜—K˜šŸœžœ
žœ
žœ˜0Kš
œ˜K˜6Kšœžœ
˜ Kš
œ˜Kš
œ˜K˜—šŸœžœ
žœ
žœžœžœžœ˜WKšœžœ˜!Kšžœžœ
žœžœ˜*Kšœ?žœ˜Ešžœžœ˜Kš
œ˜Kšœ9žœ˜@K˜—Kš
œ˜—K˜š
Ÿœžœ
žœ	žœ
žœ˜Oš	žœžœ
žœ
žœ"ž˜5Kšžœžœ
žœ
žœ˜0Kš
ž˜—K˜—K˜š
Ÿ
œžœ
žœ	žœ
žœ˜QKšžœ%˜+K˜—K˜šŸ
œžœ
žœžœ	žœžœžœ˜JJšœ(žœ˜-J˜—K˜šŸœžœ
žœžœžœ	žœžœžœ˜lšŸ	œ ˜)šžœžœ˜Jšžœ+žœ	žœ	žœ
˜MJš
œ˜—J˜—šžœžœ˜šžœ˜Jšžœ7˜;šžœ
žœ
žœ
ž˜!š
œ!˜!Jšœžœ˜šžœžœ
žœ
˜Jš
œ8˜8—Jš
œ˜—Jšžœžœ
˜——šžœžœ˜šžœžœ
žœ˜Jšœžœ ˜/Jšžœžœ1˜LJ˜—Jšœž˜J˜
—J˜
—J˜—K˜Kš
œ,˜,K˜Kšœ	žœ˜šœžœžœ
˜Kšœžœžœ
žœžœ
žœ˜(Kšœžœ˜Kš
œ˜—K˜šŸœžœžœ˜Kš
 N™Nšžœžœ
ž˜šœžœ˜š	žœžœžœžœ
ž˜2Kšœžœžœ
˜+Kšžœ
˜——Kšœžœ žœžœ˜<Kšžœžœ
˜—Kš
œ˜—K˜šŸœžœžœžœ
žœžœžœžœ˜dšžœ3žœ
ž˜BKšœžœ˜$šžœžœžœ˜Kšœžœ˜Kš
œ3˜3K˜——K˜—K˜šŸ
œžœ
žœ
˜3Kšœžœ,žœ˜:šžœžœ
žœ˜Kšœžœ	˜*š
ž˜Kšœžœ	˜*Kšžœžœ
žœ
žœ
˜K˜Kšœžœ
˜Kšžœ
˜—K˜—Kšœžœ˜&K˜—K˜šŸ
œžœ
žœ	žœžœžœ˜Pš
Ÿœžœžœ	žœžœ˜8Kšœžœ'˜.Kš
žœžœ
žœ
žœžœ˜Kšœžœ	˜*K˜Kšœžœ
˜Kšžœ˜Kš
œ˜—šžœžœ
ž˜'Kšœžœžœ˜#Kšœžœ
žœžœ˜)Kšžœžœžœ˜—K˜—K˜šŸœžœ
žœžœ˜8Kšœžœ,žœ˜9K˜K˜Kšœžœ	˜"K˜—K˜K˜Kš
œ˜K˜K˜K˜šŸœžœ
žœ
žœžœžœ
žœ˜WKšœžœ'˜-šžœžœ
žœ
˜Kšžœžœ#˜8š
ž˜š	žœžœžœžœ
ž˜7Kšžœžœžœ
˜4Kšžœ
˜———Kšžœžœ-˜9Kš
œ˜—K˜š
Ÿ
œžœ	žœ	žœžœ˜:Kšœžœe˜nKšžœ	˜Kš
œ˜—K˜šŸ
œžœ
žœ
žœ
žœžœžœžœ
žœ˜zKšžœžœ
žœ
žœ
˜Kšœžœ
žœ'˜4šžœžœ˜Kš
œ˜Kšœžœ
˜K˜—Kš
œ˜Kš
œ˜K˜—šŸ
œžœžœžœ!žœžœžœ	žœ˜¦
Kš
œ˜KšœNžœ,˜|K˜—K˜šŸœžœ
žœ	žœ
žœžœžœžœžœ
˜Š
KšžœF˜LKš
œ˜K˜—šŸœžœ
žœžœžœ
žœ˜XKš
žœžœ
žœ
žœ
žœ ˜9Kš
žœ	žœ
žœ
žœ
žœ˜:Kšœžœ ˜>Kšžœžœ-žœ˜?Kš
œ˜—K˜šŸœžœ
žœ
žœ
žœžœ
žœ˜^š	žœžœžœžœ
ž˜;Kš
œ*˜*Kš
ž˜—Kš
œ˜—K˜šŸœžœ
žœ
žœžœžœ
žœ˜aKšœ:žœžœ	žœ˜eKš
œ˜K˜—K˜šŸœžœžœžœ˜;šžœžœ˜Kšœžœžœ
˜Kšœžœ˜šžœžœ
žœ%žœžœ
ž˜EKšœžœ˜!Kš
œ(˜(Kšžœ
˜—Kšœžœ"˜7Kš
œ
˜
K˜—K˜—K˜šŸœžœ
žœ
žœ
žœžœžœ
žœ˜TKšžœ
žœžœ
˜šžœžœ
žœ˜Kšœžœ0˜7šžœžœ
žœ˜Kšœžœ'˜=Kš
œ
˜
Kš
œ
˜
—šžœ˜Kšœžœ
žœ˜(š
ž˜Kš
œ™Kš
œG™Gšžœ(žœ˜0šžœ%žœ˜.K™.Kš
œ?™?Kšœ$žœ˜2Kš
œ2™2Kš
ž˜K˜
—šžœ
žœ%žœ˜2K™>K™Kš
œ?™?Kšœ
žœ
žœ˜"Kšœžœ˜,Kš
œ˜Kš
œA™Ašžœžœ
ž˜Kš
œ™šžœ*žœ˜2Kšœ#žœ˜1Kšœ *˜FKš
œ˜K˜
—Kšžœ )˜?Kšžœ
˜—Kš
œ"˜"Kš
ž˜K˜
—K˜—Kšžœžœ
žœ˜$šžœ˜Kšœžœ'˜7Kš
œ˜Kš
œ˜Kš
ž˜K˜
—Kšžœ
˜—Kšœ ˜—Kšœ ˜—Kš
œ˜—K˜š
Ÿœžœ
žœ
žœ
žœ˜>Kšžœ
žœžœ
˜Kšœžœ˜Kš
œ!˜!šžœžœ
ž˜Kšœ:žœžœ	žœ%˜
Kš
œ$˜$Kšžœ
˜—Kš
œ˜Kš
œ˜—K˜šŸœžœ
žœ	žœžœ
žœ	žœ
žœ˜\Kšžœžœ
žœ3˜CKšžœ)˜-Kš
œ˜—K˜š
Ÿ
œžœ
žœ	žœ
žœ
˜>Kš
 "™"šžœž˜š	žœžœ0žœžœ
ž˜Išžœžœ7žœ˜UKšžœžœ
žœ
˜Kš
œ1˜1K˜—Kšžœ
˜——Kš
 ™š	žœžœ0žœžœ
ž˜Išžœ7žœ˜?Kšžœžœ
žœ
˜Kš
œC˜CK˜
—Kšžœ
˜—Kš
 ™šžœž˜š
žœžœ
žœ
žœ'žœžœ
ž˜FKšžœžœ
žœ
˜Kš
œ;˜;Kšžœ
˜——Kš
œ˜K˜—š
Ÿœžœ
žœ	žœ
žœ
˜DK˜š
Ÿœžœžœžœžœ
˜JKšžœžœžœžœ˜Pš	žœžœ$žœžœ
ž˜;šžœ6žœ˜>Kšžœžœ
žœ
˜Kš
œP˜PK˜
—Kšžœ
˜—Kš
œ˜—K™Kšœ žœ˜'Kš
œ™š	žœžœ/žœžœ
ž˜Fšžœžœ6žœ˜SKšžœžœ
žœ
˜K˜Pšžœž˜K˜S—Kš
œ˜—Kšžœ
˜—Kš
œ™š	žœžœ/žœžœ
ž˜Fšžœžœ6žœ˜TKšžœžœ
žœ
˜K˜PKš
œ˜—Kšžœ
˜—Kš
œ™šžœžœ
žœ˜!Kšœ5žœ˜Fšžœžœ˜Kšœ žœ˜&š
žœžœ
žœ
žœ'žœžœ
ž˜FKšžœžœ
žœ
˜Kš
œ*˜*Kšžœ
˜—K˜—K˜—Kš
œ˜—K˜šŸœžœ
žœ	žœ	žœž
œ˜lš
œX™XKš
œ1™1—š	žœžœ/žœžœ
ž˜Fšžœž˜Kšžœžœ
žœ˜Kšžœžœžœ
˜—Kšžœ
˜—Kš
œ˜K˜—šŸœžœ
žœ
žœžœ
žœžœžœ
žœ˜eKšœ
žœ˜Kšžœžœ
žœ˜*Kš
œ,˜,Kšžœ
žœ9žœžœ˜WKš
žœžœ
žœ3žœžœ˜QKšžœ	žœ
žœžœ1˜NKš
œ˜K˜—šŸ	œžœ
žœžœžœžœ˜@Kšœžœžœ˜%Kšžœžœ
žœ
žœ˜,Kšžœ˜!Kš
œ˜—K˜šŸœžœ
žœžœ)žœžœ
žœ˜iKšžœžœ
žœ˜#Kšžœžœ7˜BKš
œ˜—K˜šŸœžœ
žœžœžœ
žœžœ
žœ
žœ˜Sšžœžœ
ž˜Kšœžœ
˜Kšœžœ
žœ ˜,Kšœžœ
žœ$˜/Kšœžœ˜#Kš
œ;˜;Kšœžœžœ˜(Kšœžœžœ$˜BKšœžœ˜Kšœžœ˜#Kšœžœ
žœ
žœ%˜:Kšœžœ
žœ$˜3Kšœžœ
žœ$˜/Kšœžœ
žœ%˜5šžœ˜šžœž˜Kšžœžœ
˜˜Kš
Ÿ
œžœžœ
žœžœ
˜+Kš	œžœ
žœžœ
žœ˜Kš
œ=˜=Kšžœ˜Kšœ&žœ˜-K˜—Kšžœ˜%———Kš
œ˜—K˜šŸ
œžœ
žœžœžœžœžœ˜SKšžœžœžœ
žœ
žœžœ˜Bšžœ˜Kšœžœ˜Kšžœžœžœ˜$Kš
žœžœžœžœ
žœ˜JKšžœžœžœ
žœžœ
žœ˜SK˜
—Kš
œ˜—K˜š
Ÿœžœ
žœ
žœžœ˜GKš
œN™NK™<Kšœžœ'˜-Kšœžœžœ
˜Kš
žœžœ
žœ
žœ
žœ.˜GKšžœžœ
žœžœžœžœ
˜Ešžœžœ
žœ˜Kšžœžœžœ˜Kšžœ
žœ
žœ8˜EK˜
—šžœ
˜šžœžœž˜&Kš
œ-™-Kšžœžœ
žœžœžœžœ
˜Ušžœžœ
žœ˜Kšžœžœ
žœž
˜"Kšžœ
žœ
žœ.˜;Kš
ž˜Kš
œ
˜
—Kšžœ
˜——Kš
œ˜Kš
œ˜—K˜šŸœžœ
žœ
žœžœ
žœžœžœ˜OJšžœ"˜(Jš
œ˜J˜—šŸ	œžœ
žœ
žœ
žœžœ
žœžœžœ˜iKšœžœ#˜-Kšœžœ˜Kšœžœ
žœ˜0Kšœžœ"˜(Kšžœžœ˜2Kšœžœ˜ Kšœžœžœ˜*Kšœžœžœ˜.š
œ#˜#Kš
œC˜CKš
œ˜—Kš
œ$˜$Kš
œ˜—K˜šŸœžœ
žœ
žœžœžœžœ˜jKšžœžœ7žœ
˜Pš
ž˜š
žœžœ
žœ
žœ!žœžœ
ž˜@˜3Kšžœ žœ˜B—Kšžœ
˜——Kš
œ˜K˜—Kš
œ™K™K™š
Ÿœžœ
žœžœ
žœ˜JKšœžœžœ˜,š	žœžœ/žœžœ
ž˜Fšžœžœ˜'Kš
œF˜FK˜
—Kšžœ
˜—š	žœžœ/žœžœ
ž˜Fšžœžœ˜'Kš
œ ˜ Kšžœžœ/˜=K˜—Kšžœ
˜—Jšžœ	žœ"˜1Jš
œ˜K˜—K™Kš
Οb™K™NK˜šŸΠbn	œžœ
˜Kšœ2žœ˜@Kš
œ˜K˜—š’
œžœ˜&KšœžœI˜UKš	œžœ
žœ
žœ+žœ˜Qšžœ
žœ˜Kšžœ#žœ˜7Kšžœžœ
˜ —Kš
œ/˜/Kšœžœ
˜Kš
œ˜Kšžœ˜Kš
œ˜—K˜š’œžœ˜(Kšžœ˜Kš
œ?˜?Kš
œ˜—K˜šœžœžœ#˜GKš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ8˜8Kš
œ˜—K™š’œ ˜1š
žœžœžœ
žœžœ˜?Kš
œ˜Kšœžœ
˜Kšœžœ
˜Kš
 J™JKš
œ˜—Kš
œ˜—K˜šŸœžœžœ˜'šžœžœ
žœ˜&šœžœ
˜š
œQ˜QKšžœ˜Kšžœžœ˜Kšžœ
˜Kš
œ
˜
—Kš
œ˜—K˜—šžœžœžœ˜8š
žœžœ
žœžœ
žœžœ
ž˜SKš	œJžœžœžœ	žœ˜w—šžœ
žœ
ž˜Kšœ&žœ
˜*Kšžœžœ
žœ*žœ
˜UKš
œ˜Kšžœ
˜—K˜—Kš
œ˜—K˜šŸœžœ*˜@š
ž˜Kšœžœ
žœ˜1Kšœ žœžœ˜6Kš
ž˜—Kš
œ˜—K˜Kš
œ]˜]Kšœžœ3žœ˜Išžœžœ˜Kš
œ;˜;šžœ=ž˜CKšœ$žœ
žœ˜A—šžœ˜Kšœ"žœ
žœ˜@Kš
œ=˜=Kš
œ˜—Kšžœžœ˜7K˜—Kš
œ˜Kšžœ˜K˜K˜—…—P$sΈ