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�LSE] --
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.