
<<CDDirectoryExtrasImpl.mesa   (a Chipndale module)>>
<<Copyright © 1984 by Xerox Corporation.  All rights reserved.>>
<<by Christian Jacobi   November 16, 1984 11:40:08 am PST>>
<<last edited Christian Jacobi   November 20, 1984 12:06:09 pm PST>>

DIRECTORY
CD,
CDApplications,
CDBasics,
CDDirectoryExtras,
CDDirectory,
CDEvents,
CDInterestRects,
CDObjectProcs,
CDOps,
CDOrient,
CDProperties,
CDValue,
CDX,
TerminalIO;

CDDirectoryExtrasImpl: CEDAR PROGRAM 
IMPORTS CDApplications, CDBasics, CDDirectory, CDEvents, CDInterestRects, CDObjectProcs, CDOps, CDOrient, CDProperties, CDValue, 
CDX, TerminalIO
EXPORTS CDDirectoryExtras =
BEGIN

furtherKey: ATOM = $ReplaceDirectChild;

ReplaceRec: TYPE = CDDirectoryExtras.ReplaceRec;

ReplaceDChildsProc: TYPE = CDDirectoryExtras.ReplaceDChildsProc;

ReplaceList: TYPE = CDDirectoryExtras.ReplaceList;
<<ReplaceList: TYPE = LIST OF REF ReplaceRec;>>

DangerousGetChangeEvent: PROC [] RETURNS [CDEvents.EventRegistration] =
<<--remove this silly procedure as fast as possible>>
BEGIN
x: REF = CDValue.Fetch[key: $CDxPrivateAfterChange];
IF x#NIL THEN TRUSTED {RETURN [LOOPHOLE[x]]}
ELSE {
changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange];
CDValue.Store[key: $CDxPrivateAfterChange, value: changeEvent];
RETURN [changeEvent]
}
END;
changeEvent: CDEvents.EventRegistration ~ DangerousGetChangeEvent[];

InstallReplaceDChildProc: PUBLIC PROC [type: REF CD.ObjectProcs, rdcp: ReplaceDChildsProc] =
BEGIN
CDObjectProcs.StoreFurther[type, furtherKey, NEW[ReplaceDChildsProc_rdcp]];
END;

DoReplaceDirectChild: PUBLIC ReplaceDChildsProc = 
BEGIN
refP: REF = CDObjectProcs.FetchFurther[me.p, furtherKey];
IF refP#NIL THEN
WITH refP SELECT FROM
rdc: REF ReplaceDChildsProc => changed _ rdc^[me, design, replace];
ENDCASE => NULL;
IF changed THEN {
[] _ CDEvents.ProcessEvent[changeEvent, design, me];
}
END;

ReplaceObject: PUBLIC PROC [design: CD.Design, 
old: CD.ObPtr, 
new: CD.ObPtr,  
off: CD.DesignPosition_[0, 0]
] =
<<--all over in the design replace old by new>>
<<--may be delayed>>
BEGIN
repRef: REF ReplaceRec _ NEW[ReplaceRec_[
old: old,
oldSize: old.size,
newSize: new.size,
new: new,
off: off
]];
IF design=NIL THEN ERROR;
FOR plist: LIST OF CD.PushRec _ design.actual, plist.rest WHILE plist#NIL DO
IF plist.first.mightReplace#NIL AND plist.first.mightReplace.ob=old THEN
TerminalIO.WriteRope["** Tries to replace pushed in cell; does not work\n"];
ENDLOOP;
ReplaceAllChilds[design, repRef]
END;

RepositionObject: PUBLIC PROC [design: CD.Design, 
ob: CD.ObPtr, 
oldSize: CD.DesignPosition,
baseOff: CD.DesignPosition_[0, 0]
] =
<<--all over in the design tries to reposition ob;>>
<<--may be delayed>>
BEGIN
repRef: REF ReplaceRec _ NEW[ReplaceRec_[
old: ob,
oldSize: oldSize,
newSize: ob.size,
new: ob,
off: baseOff
]];
oldOrigin: CD.DesignPosition = CDX.ClientOrigin[ob];
CDX.SetClientOrigin[design, ob, CDBasics.SubPoints[oldOrigin, baseOff]];
IF design=NIL THEN ERROR;
ReplaceAllChilds[design, repRef]
END;
<<>>
ReplaceAllChilds: PROC [design: CD.Design, repRef: REF ReplaceRec] =
<<--design#NIL>>
BEGIN
ref: REF ReplaceList _ NARROW[
CDValue.Fetch[boundTo: design, key: repositioningListKey, propagation: design]
];
IF ref#NIL THEN {  -- we are inside replace process, remember object
IF ref^=NIL THEN ref^ _ LIST[repRef]
ELSE {
FOR l: ReplaceList _ ref^, l.rest DO
IF l.first.old=repRef.old THEN 
<<--impossible; call me to debug this>>
ERROR;
IF l.rest=NIL THEN {l.rest _ LIST[repRef]; EXIT}
ENDLOOP;
};
RETURN
};
<<-- we are not inside reposition process, start one>>
ref _ NEW[ReplaceList_LIST[repRef]];
CDValue.Store[boundTo: design, key: repositioningListKey, value: ref];
WHILE ref^#NIL DO
repList: ReplaceList _ ref^;
ref^ _ NIL;
DoReplaceAllChilds[design, repList];
ENDLOOP;
CDValue.Store[boundTo: design, key: repositioningListKey, value: NIL];
CDOps.DelayedRedraw[design];
END;

DoReplaceAllChilds: PUBLIC PROC [design: CD.Design, repList: ReplaceList] =
BEGIN

ReplaceForOne: CDDirectory.EachEntryAction = 
<<-- PROC [name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL_FALSE] -- >>
BEGIN
[] _ DoReplaceDirectChild[me: ob, design: design, replace: repList];
END;

FOR list: ReplaceList _ repList, list.rest WHILE list#NIL DO
list.first.newSize _ list.first.new.size;
ENDLOOP;
[] _ CDDirectory.Enumerate[design, ReplaceForOne];
FOR plist: LIST OF CD.PushRec _ design.actual, plist.rest WHILE plist#NIL DO
app: CD.ApplicationPtr _ plist.first.mightReplace;
CDProperties.PutPropOnObject[plist.first.dummyCell.ob, $Owner, design]; --HACK XXX XXX
FOR rlist: ReplaceList _ repList, rlist.rest WHILE rlist#NIL DO
rep: REF ReplaceRec = rlist.first;
IF app#NIL AND app.ob=rep.old THEN {
realPos: CD.DesignPosition = CDOrient.MapPosition[
itemInCell: PointRect[rep.off],
cellSize: rep.oldSize,
cellInstOrient: app.orientation,
cellInstPos: app.location
].posInWorld;
fakePos: CD.DesignPosition = CDOrient.MapPosition[
itemInCell: [0, 0, 0, 0],
cellSize: rep.newSize,
cellInstOrient: app.orientation,
cellInstPos: [0, 0]
].posInWorld;
app.location _ CDBasics.SubPoints[realPos, fakePos];
}
ENDLOOP;
[] _ ReplaceDirectChildForDummyCells[plist.first.dummyCell.ob, repList];
ENDLOOP;
END;

PointRect: PROC [p: CD.Position] RETURNS [CD.Rect] = INLINE {
RETURN [[x1: p.x, y1: p.y, x2: p.x, y2: p.y]]
};

ReplaceDirectChildForDummyCells: PUBLIC PROC [cellOb: CD.ObPtr, replace: ReplaceList] RETURNS [needReposition: BOOL] =
BEGIN
cp: CD.CellPtr = NARROW[cellOb.specificRef];
needReposition _ FALSE;
FOR replaceList: ReplaceList _ replace, replaceList.rest WHILE replaceList#NIL DO
rep: REF ReplaceRec = replaceList.first;
IF rep.old=cellOb THEN LOOP;
FOR appList: CD.ApplicationList _ cp.contents, appList.rest WHILE appList#NIL DO
IF appList.first.ob=rep.old THEN {
IF rep.newSize#rep.oldSize OR rep.off#[0, 0] THEN {
realPos: CD.DesignPosition = CDOrient.MapPosition[
itemInCell: PointRect[rep.off],
cellSize: rep.oldSize,
cellInstOrient: appList.first.orientation,
cellInstPos: appList.first.location
].posInWorld;
fakePos: CD.DesignPosition = CDOrient.MapPosition[
itemInCell: [0, 0, 0, 0],
cellSize: rep.newSize,
cellInstOrient: appList.first.orientation,
cellInstPos: [0, 0]
].posInWorld;
appList.first.location _ CDBasics.SubPoints[realPos, fakePos];
needReposition _ TRUE;
};
appList.first.ob _ rep.new
};
ENDLOOP;
ENDLOOP;
END;

RepositionCell: PUBLIC PROC [cellOb: CD.ObPtr, design: CD.Design] RETURNS [didReposition: BOOLEAN] =
BEGIN
ComputeBounds: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
<<--returns bounds in coordinate system of ob itself>>
BEGIN
WITH ob.specificRef SELECT FROM
cptr: CD.CellPtr => RETURN [CDApplications.BoundingRect[cptr.contents]]; 
ENDCASE => ERROR;
END;
oldR: CD.DesignRect _ cellOb.p.insideRect[cellOb];
oldSize: CD.DesignPosition _ cellOb.size;
newR: CD.DesignRect = ComputeBounds[cellOb];
newSize: CD.DesignPosition _ CDBasics.SizeOfRect[newR];
newBase: CD.DesignPosition = CDBasics.BaseOfRect[newR];
IF (didReposition _ oldR#newR OR oldSize#newSize) THEN {
cp: CD.CellPtr = NARROW[cellOb.specificRef];
IF newBase#[0, 0] THEN 
CDApplications.TranslateList[cp.contents, CDBasics.NegOffset[newBase]];
cellOb.size _ newSize;
IF design#NIL THEN
RepositionObject[
design: design, 
ob: cellOb, 
oldSize: oldSize,
baseOff: newBase
]
}
END;

repositioningListKey: REF ATOM ~ NEW[ATOM_$RepositioningList];
CDValue.EnregisterKey[repositioningListKey];
CDObjectProcs.RegisterFurther[furtherKey];
END.