CDCellsImpl.mesa (part of Chipndale)
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved.
by Christian Jacobi June 24, 1983 5:00 pm
last edited Christian Jacobi November 19, 1984 7:45:23 pm PST
DIRECTORY
CD,
CDApplications,
CDCallSpecific,
CDCells,
CDDirectory,
CDDirectoryExtras,
CDMenus,
CDEvents,
CDBasics,
CDIO,
CDMarks,
CDInterestRects,
CDOps,
CDOrient,
CDProperties,
CDValue,
Process USING [Yield],
Rope,
TokenIO,
TerminalIO;
CDCellsImpl:
CEDAR
PROGRAM
IMPORTS CDDirectoryExtras, CD, CDApplications, CDCallSpecific, CDInterestRects, CDIO, CDDirectory, CDEvents, CDBasics, CDMarks, CDMenus, CDOps, CDOrient, CDProperties, CDValue, Process, Rope, TokenIO, TerminalIO
EXPORTS CDCells
SHARES CDDirectory, CDDirectoryExtras =
BEGIN
-- -- -- -- -- -- -- -- -- -- -- --
pForCells: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Cell];
beforeReplacement: CDEvents.EventRegistration
~ CDEvents.RegisterEventType[$BeforeCellReplacement];
afterReplacement: CDEvents.EventRegistration
~ CDEvents.RegisterEventType[$AfterCellReplacement];
pushEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterPush];
popEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterPop];
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[];
fullPopMenu: REF = CDMenus.CreateMenu["Pop from cell"];
partialPopMenu: REF = CDMenus.CreateMenu["Pop from cell"];
emptyPopMenu: REF = CDMenus.CreateMenu["Pop from cell: empty cell"];
Init:
PROC [] =
BEGIN
dp: REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[pForCells];
dp.enumerateChildObjects ← EnumerateChildObjects;
dp.adjustItself ← AdjustItself;
dp.repositionElements ← RepositionElementsForCell;
dp.computeBounds ← ComputeBounds;
dp.key ← Key;
dp.name ← Name;
dp.setName ← SetName;
dp.another ← Another;
dp.replaceDirectChilds ← ReplaceDirectChildForCells;
pForCells.drawMe ← DrawMeForCells;
pForCells.quickDrawMe ← QuickDrawMeForCells;
pForCells.showMeSelected ← DrawCellSelection;
pForCells.internalRead ← ReadCell;
pForCells.internalWrite ← WriteCell;
pForCells.describe ← Describe;
pForCells.insideRect ← InsideRect; XXX
CDDirectoryExtras.InstallReplaceDChildProc[pForCells, NewReplaceDirectChildForCells];
CDCallSpecific.Register[$Expand, pForCells, Expand];
CDMenus.CreateEntry[fullPopMenu, "flush", $flush];
CDMenus.CreateEntry[partialPopMenu, "flush", $flush];
CDMenus.CreateEntry[emptyPopMenu, "flush", $flush];
CDMenus.CreateEntry[fullPopMenu, "new cell", $new];
CDMenus.CreateEntry[partialPopMenu, "new cell", $new];
CDMenus.CreateEntry[fullPopMenu, "replace", $replace];
END;
XXX InsideRect: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
BEGIN
x: REF = GetPropFromOb[from: ob, prop: $InsideRect]
RETURN [NARROW[x, REF CD.DesignRect]^]
END;
XXX SetInsideRect: PROC [ob: CD.ObPtr, r: CD.DesignRect] =
BEGIN
rp: REF CD.DesignRect = NEW[CD.DesignRect←r];
PutPropOnOb[onto: ob, prop: $InsideRect, value: rp]
END;
SetName:
PROC [me:
CD.ObPtr, r: Rope.
ROPE] =
BEGIN
cptr: CD.CellPtr = NARROW[me.specificRef];
cptr.name ← r
END;
Name:
PROC [me:
CD.ObPtr]
RETURNS [Rope.
ROPE] =
BEGIN
cptr: CD.CellPtr = NARROW[me.specificRef];
RETURN [cptr.name]
END;
Key:
PROC [me:
CD.ObPtr]
RETURNS [Rope.
ROPE] =
BEGIN
cptr: CD.CellPtr = NARROW[me.specificRef];
RETURN [cptr.key]
END;
EnumerateChildObjects:
PROC [me:
CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x:
REF] =
BEGIN
cptr: CD.CellPtr = NARROW[me.specificRef];
FOR w:
CD.ApplicationList ← cptr.contents, w.rest
WHILE w#
NIL
DO
p[w.first.ob, x]
ENDLOOP
END;
Another:
PROC [me:
CD.ObPtr, from, to:
CD.Design]
RETURNS [
CD.ObPtr] =
BEGIN
oldCp: CD.CellPtr = NARROW[me.specificRef];
newOb: CD.ObPtr = CreateEmptyCell[];
newCp: CD.CellPtr = NARROW[newOb.specificRef];
newOb.size ← me.size;
newCp.name ← oldCp.name;
newCp.key ← oldCp.key;
newCp.simplifyOn ← oldCp.simplifyOn;
newCp.contents ← CDApplications.CopyList[oldCp.contents];
newOb.properties ← CDProperties.CopyProps[me.properties];
[] ← CDDirectory.Include[to, newOb];
RETURN [newOb]
END;
DrawMeForCells:
PROC [aptr:
CD.ApplicationPtr, pos:
CD.DesignPosition, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE UNWIND => IF pr.nesting.first=aptr THEN pr.nesting ← pr.nesting.rest;
cptr: CD.CellPtr ~ NARROW[aptr.ob.specificRef];
r: CD.DesignRect;
pr.nesting ← CONS[aptr, pr.nesting];
FOR w:
CD.ApplicationList ← cptr.contents, w.rest
WHILE w#
NIL
DO
r ← CDOrient.MapRect[
itemInCell: CDOrient.RectAt[w.first.location, w.first.ob.size, w.first.orientation],
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos];
IF CDBasics.Intersect[r, pr.worldClip]
THEN {
IF pr.stopFlag^ THEN EXIT;
pr.drawChild[
w.first,
CDBasics.BaseOfRect[r],
CDOrient.ComposeOrient[w.first.orientation, orient],
pr];
}
ENDLOOP;
Process.Yield[];
IF pr.nesting.first=aptr THEN pr.nesting ← pr.nesting.rest
END;
QuickDrawMeForCells:
PROC [aptr:
CD.ApplicationPtr, pos:
CD.DesignPosition, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE UNWIND => IF pr.nesting.first=aptr THEN pr.nesting ← pr.nesting.rest;
cptr: CD.CellPtr ~ NARROW[aptr.ob.specificRef];
r: REAL;
IF (r ← pr.scaleHint*aptr.ob.size.y)<cptr.simplifyOn
AND pr.scaleHint>0
THEN {
pr.outLineProc[CDOrient.RectAt[pos, aptr.ob.size, orient], pr];
IF r>9 THEN pr.drawComment[CDOrient.RectAt[pos, aptr.ob.size, orient], cptr.name, pr];
}
ELSE {
r: CD.DesignRect;
pr.nesting ← CONS[aptr, pr.nesting];
FOR w:
CD.ApplicationList ← cptr.contents, w.rest
WHILE w#
NIL
DO
r ← CDOrient.MapRect[
itemInCell: CDOrient.RectAt[w.first.location, w.first.ob.size, w.first.orientation],
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos];
IF CDBasics.Intersect[r, pr.worldClip]
THEN {
IF pr.stopFlag^ THEN EXIT;
w.first.ob.p.quickDrawMe[
w.first,
CDBasics.BaseOfRect[r],
CDOrient.ComposeOrient[w.first.orientation, orient],
pr];
}
ENDLOOP;
Process.Yield[];
IF pr.nesting.first=aptr THEN pr.nesting ← pr.nesting.rest
}
END;
DrawCellSelection:
PROC [aptr:
CD.ApplicationPtr, pos:
CD.DesignPosition, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
IF (pr.scaleHint*aptr.ob.size.y)<
NARROW[aptr.ob.specificRef,
CD.CellPtr].simplifyOn
AND pr.scaleHint>0 THEN pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], CD.highLightShade, pr]
ELSE {
pr.outLineProc[
CDOrient.MapRect[
itemInCell: CDInterestRects.GetInterestRect[aptr.ob].r,
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos
],
pr
]
}
END;
RemoveSelectedFromWorld:
PROC [design:
CD.Design]
RETURNS [
CD.ApplicationList] =
-- removes the selected applications from design and returns them
BEGIN
remove, keep: CD.ApplicationList ← NIL;
[others: keep, selected: remove] ← CDApplications.SplitSelected[CDOps.AppList[design]];
CDOps.SetAppList[design, keep];
RETURN [remove]
END;
CreateEmptyCell:
PUBLIC
PROC []
RETURNS [
CD.ObPtr] =
-- does not includes the cell into any design or celldirectory
-- does not name the cell
BEGIN
ob: CD.ObPtr ~ NEW[CD.ObjectDefinition];
cp: CD.CellPtr ~ NEW[CD.CellRecord];
ob.p ← pForCells;
ob.size ← [0, 0];
ob.specificRef ← cp;
cp.simplifyOn ← 50;
RETURN [ob]
END;
CreateCellObject:
PROC [use:
CD.ApplicationList, orient:
CD.Orientation�Orient.original]
RETURNS [
CD.ObPtr] =
-- not yet included in design
BEGIN
ob: CD.ObPtr ~ CreateEmptyCell[];
cp: CD.CellPtr ~ NARROW[ob.specificRef];
gOutR: CD.DesignRect ~ CDApplications.BoundingRect[use]; -- coordsys of use, non oriented
-- gInR: CD.DesignRect ~ BoundingRectI[use]; XXX
ob.size ← CDOrient.OrientedSize[CDBasics.SizeOfRect[gOutR], orient];
cp.name ← NIL;
cp.contents ← CDApplications.DeComposedCopy[use, CDBasics.BaseOfRect[gOutR], ob.size, orient];
RETURN [ob]
END;
IncludeAndNameCell:
PROC [design:
CD.Design, cp:
CD.ObPtr, interactive:
BOOL←
TRUE, allowAbort:
BOOL←
FALSE]
RETURNS [done:
BOOL�LSE] =
BEGIN
aborted: BOOL ← FALSE;
name: Rope.ROPE;
cptr: CD.CellPtr ~ NARROW[cp.specificRef];
IF ~interactive THEN [] ← CDDirectory.Include[design, cp]
ELSE
DO
ENABLE TerminalIO.UserAbort => {aborted ← TRUE; CONTINUE};
IF aborted
THEN {
TerminalIO.WriteRope[" **name input aborted\n"];
IF allowAbort THEN RETURN;
name ← "-no name";
}
ELSE name ← TerminalIO.RequestRope["enter name for cell: "];
IF CDDirectory.Include[design: design, object: cp, alternateName: name, fiddleName: aborted
OR Rope.IsEmpty[name]]
THEN {
TerminalIO.WriteRope["Cell "]; TerminalIO.WriteRope[cptr.name];
TerminalIO.WriteRope[" included\n"];
done ← TRUE;
RETURN;
};
TerminalIO.WriteRope["Cell "]; TerminalIO.WriteRope[cptr.name];
TerminalIO.WriteRope[" does already exist\n"];
TerminalIO.WriteRope["name not accepted, please repeat\n"];
aborted ← FALSE;
ENDLOOP;
END;
CreateCellSelected:
PUBLIC
PROC [design:
CD.Design, name: Rope.
ROPE←
NIL]
RETURNS [done: BOOL←FALSE, cellOb: CD.ObPtr←NIL] =
-- if name is NIL: interactive read for name
-- cell is included in directory
BEGIN
sel: CD.ApplicationList ~ RemoveSelectedFromWorld[design];
app: CD.ApplicationPtr ~ NEW[CD.Application];
b: CD.DesignRect ~ CDApplications.BoundingRect[sel];
cptr: CD.CellPtr;
app.ob ← cellOb ← CreateCellObject[use: sel];
cptr ← NARROW[cellOb.specificRef];
cptr.name ← name;
app.location ← CDBasics.BaseOfRect[b];
app.selected ← TRUE;
IF
NOT CDBasics.NonEmpty[b]
THEN {
TerminalIO.WriteRope["no empty cell\n"];
RETURN [done: FALSE, cellOb: NIL]
};
IF name=
NIL
THEN {
IF ~IncludeAndNameCell[design: design, cp: cellOb, allowAbort:
TRUE, interactive:
TRUE].done
THEN {
--undo the command
CDOps.IncludeApplicationList[design, sel, FALSE];
RETURN [done: FALSE, cellOb: NIL]
};
}
ELSE [] ← CDDirectory.Include[design, cellOb];
CDOps.IncludeApplication[design, app, TRUE]; -- redraw removes seletion
RETURN [done: TRUE, cellOb: cellOb]
END;
IsCell:
PROC [aptr:
CD.ApplicationPtr]
RETURNS [yes:
BOOL ←
FALSE] =
--verbose if aptr is not a cell
BEGIN
IF aptr=NIL THEN TerminalIO.WriteRope[" no object\n"]
ELSE IF aptr.ob=NIL OR aptr.ob.specificRef=NIL THEN TerminalIO.WriteRope[" bad object\n"]
ELSE
IF NOT
ISTYPE[aptr.ob.specificRef,
CD.CellPtr]
THEN {
TerminalIO.WriteRope[" object is not cell but "];
TerminalIO.WriteRope[CDOps.Info[aptr.ob]];
TerminalIO.WriteLn[];
}
ELSE yes ← TRUE
END;
PushInCellSelected:
PUBLIC
PROC [design:
CD.Design]
RETURNS [done:
BOOL ←
FALSE] =
BEGIN
first: CD.ApplicationPtr;
multiple: BOOL;
[first, multiple] ← CDOps.SelectedApplication[design];
IF multiple THEN TerminalIO.WriteRope[" multiple selected object\n"]
ELSE done ← DoPushInCell[design, first];
END;
PushInCellPointed:
PUBLIC
PROC [design:
CD.Design, pos:
CD.DesignPosition]
RETURNS [done:
BOOL ←
FALSE] =
BEGIN
done ← DoPushInCell[design, CDOps.PointedApplication[design, pos]]
END;
DoPushInCell:
PROC [design:
CD.Design, originalApp:
CD.ApplicationPtr]
RETURNS [done: BOOL←FALSE] =
BEGIN
IF IsCell[originalApp]
THEN {
cptr: CD.CellPtr ~ NARROW[originalApp.ob.specificRef];
dummy: CD.ObPtr ~ CreateEmptyCell[];
newCptr: CD.CellPtr ~ NARROW[dummy.specificRef];
dummyCellAp: CD.ApplicationPtr;
dummy.size ← CDBasics.highposition;
FOR l:
LIST
OF
CD.PushRec ← design.actual, l.rest
WHILE l#
NIL
DO
IF l.first.mightReplace#
NIL
AND l.first.mightReplace.ob=originalApp.ob
THEN {
TerminalIO.WriteRope[" push not possible; [already pushed in "];
TerminalIO.WriteRope[CDOps.Info[l.first.mightReplace.ob]];
TerminalIO.WriteRope["]\n"];
RETURN [FALSE]
}
ENDLOOP;
newCptr.name ← cptr.name;
newCptr.contents ← CDApplications.ComposedCopy[
al: cptr.contents,
cellPos: originalApp.location,
cellSize: originalApp.ob.size,
cellOrient: originalApp.orientation
];
dummyCellAp ← CDApplications.NewApplicationI[
ob: dummy,
properties: CDProperties.CopyProps[originalApp.properties]
];
dummy.properties ← CDProperties.CopyProps[originalApp.ob.properties];
CDOps.RemoveApplication[design, originalApp];
design^.actual ←
CONS[
CD.PushRec[dummyCell: dummyCellAp, specific: newCptr, mightReplace: originalApp],
design^.actual];
[] ← CDEvents.ProcessEvent[pushEvent, design];
RETURN [TRUE];
}
END;
PopFromCell:
PUBLIC
PROC [design:
CD.Design,
m: CDCells.Method←interactive, name: Rope.ROPE←NIL]
RETURNS [done:
BOOL] =
BEGIN
done ← IPopFromCell[design, m, name];
IF done THEN [] ← CDEvents.ProcessEvent[popEvent, design];
END;
IPopFromCell:
PROC [design:
CD.Design, m: CDCells.Method, name: Rope.
ROPE]
RETURNS [done:
BOOL�LSE] =
BEGIN
currentRect, pushedRect: CD.DesignRect;
currentAptr, pushedAptr: CD.ApplicationPtr;
currentCellOb: CD.ObPtr;
currentCellPtr, pushedCellPtr: CD.CellPtr;
DoFlush:
PROC [] =
BEGIN
b: BOOL ← design^.actual.first.indirectlyChanged;
TerminalIO.WriteRope["flush\n"];
design^.actual ← design^.actual.rest;
design^.actual.first.indirectlyChanged ← TRUE;
IF b THEN design^.actual.first.indirectlyChanged ← TRUE;
CDOps.IncludeApplication[design, pushedAptr, FALSE];
END;
BasePointRect:
PROC [r:
CD.Rect]
RETURNS [
CD.Rect] =
INLINE {
RETURN [[x1: r.x1, y1: r.y1, x2: r.x1, y2: r.y1]]
};
DoReplace:
PROC [] =
BEGIN
[] ← CDEvents.ProcessEvent[beforeReplacement, design, pushedAptr.ob];
TerminalIO.WriteRope["replace\n"];
--HACK for CDDirectory XXX
CDProperties.PutPropOnObject[onto: currentCellOb, prop: $Owner, val: design];
design^.actual ← design^.actual.rest;
design^.actual.first.indirectlyChanged ← TRUE;
pushedAptr.ob.properties ← currentCellOb.properties; is a second copy anyway
pushedCellPtr.contents ← currentCellPtr.contents;
IF pushedRect#currentRect
THEN {
-- both in design coordinates
oldSize: CD.DesignPosition ← pushedAptr.ob.size;
newFakeOrigin: CD.DesignRect; --absolute coordinates
newInOldCoordinates: CD.DesignRect; --coordinates of old cell
pushedAptr.ob.size ←
CDOrient.OrientedSize[CDBasics.SizeOfRect[currentRect], pushedAptr.orientation];
newFakeOrigin ← CDOrient.MapRect[
itemInCell: [0, 0, 0, 0],
cellSize: pushedAptr.ob.size,
cellInstOrient: pushedAptr.orientation,
cellInstPos: currentAptr.location
].itemInWorld;
newInOldCoordinates ← CDOrient.DeMapRect[
itemInWorld: newFakeOrigin,
cellSize: oldSize,
cellInstOrient: pushedAptr.orientation,
cellInstPos: pushedAptr.location
].itemInCell;
CDDirectoryExtras.RepositionObject[design: design,
ob: pushedAptr.ob,
oldSize: oldSize,
baseOff: CDBasics.BaseOfRect[newInOldCoordinates]
];
};
pushedAptr.location ← currentAptr.location;
CDOps.IncludeApplication[design, pushedAptr, FALSE];
[] ← CDEvents.ProcessEvent[afterReplacement, design, pushedAptr.ob];
END;
DoNewCell:
PROC [interactive:
BOOL←
FALSE] =
BEGIN
interestRect: CD.DesignRect;
useInnerrect: BOOL;
TerminalIO.WriteRope["new cell\n"];
[interestRect, useInnerrect] ← CDInterestRects.GetInterestRect[pushedAptr.ob];
currentAptr.ob ← currentCellOb;
design^.actual ← design^.actual.rest;
design^.actual.first.indirectlyChanged ← TRUE;
design^.actual.first.changed ← TRUE;
IF ~IncludeAndNameCell[design, currentCellOb, interactive, FALSE].done THEN ERROR;
IF ~useInnerrect
THEN {
gIntRect:
CD.DesignRect = CDOrient.MapRect[
itemInCell: interestRect,
cellSize: pushedAptr.ob.size,
cellInstOrient: pushedAptr.orientation,
cellInstPos: pushedAptr.location
];
interestRect ← CDOrient.DeMapRect[
itemInWorld: gIntRect,
cellSize: currentAptr.ob.size,
cellInstOrient: currentAptr.orientation,
cellInstPos: currentAptr.location
];
CDInterestRects.SetInterestRect[currentCellOb, interestRect]
};
CDOps.IncludeApplication[design, currentAptr, FALSE];
END;
menu: REF ← fullPopMenu;
IF design^.actual.rest=NIL THEN {TerminalIO.WriteRope["not in cell\n"]; RETURN [FALSE]};
pushedAptr ← design^.actual.first.mightReplace;
pushedCellPtr ← NARROW[pushedAptr.ob.specificRef];
pushedRect ← CDOrient.RectAt[pushedAptr.location,
pushedAptr.ob.size, pushedAptr.orientation]; -- design cordinates
TerminalIO.WriteRope["Pop from cell "];
TerminalIO.WriteRope[pushedCellPtr.name];
TerminalIO.WriteLn[];
CDApplications.DeSelectList[CDOps.AppList[design]];
currentRect ← CDApplications.BoundingRect[CDOps.AppList[design]]; -- design coordinates
currentCellOb ← CreateCellObject[use: CDOps.AppList[design], orient: pushedAptr.orientation];
currentCellPtr ← NARROW[currentCellOb.specificRef];
currentAptr ← CDApplications.NewApplicationI[ob: currentCellOb,
location: CDBasics.BaseOfRect[currentRect],
orientation: pushedAptr.orientation,
properties: CDProperties.CopyProps[pushedAptr.properties]
];
currentCellOb.properties ← CDProperties.CopyProps[pushedAptr.ob.properties];
BEGIN -- allows local declarations
interestRect: CD.DesignRect;
useInnerrect: BOOL;
[interestRect, useInnerrect] ← CDInterestRects.GetInterestRect[pushedAptr.ob];
IF ~useInnerrect THEN {
gIntRect: CD.DesignRect = CDOrient.MapRect[
itemInCell: interestRect,
cellSize: pushedAptr.ob.size,
cellInstOrient: pushedAptr.orientation,
cellInstPos: pushedAptr.location
];
interestRect ← CDOrient.DeMapRect[
itemInWorld: gIntRect,
cellSize: currentAptr.ob.size,
cellInstOrient: currentAptr.orientation,
cellInstPos: currentAptr.location
];
CDInterestRects.SetInterestRect[currentCellOb, interestRect]
};
END;
IF m=flush
OR (m=interactive
AND ~design^.actual.first.changed)
THEN {
DoFlush[];
RETURN [TRUE]
};
IF CDBasics.NonEmpty[currentRect]
THEN {
mark: CDMarks.MarkRange;
IF m=newcell THEN {DoNewCell[interactive: FALSE]; RETURN [TRUE]};
mark ← CDMarks.GetNewMark[design! CD.Error => GOTO markProblem];
CDMarks.MarkUnMarkedInclusiveChildren[design, currentCellOb, mark];
IF pushedAptr.ob.marked=mark
THEN {
-- recursive
TerminalIO.WriteRope[" Original cell used inside, replace not possible\n"];
IF m=replace THEN RETURN[FALSE];
menu ← partialPopMenu;
}
ELSE {
--ok, normal case
IF m=replace THEN {DoReplace[]; RETURN [TRUE]};
}
}
ELSE {
-- empty
TerminalIO.WriteRope[" create empty cell not possible\n"];
IF m#interactive THEN {DoFlush[]; RETURN [TRUE]};
menu ← emptyPopMenu;
};
SELECT CDMenus.CallMenu[menu]
FROM
$flush => DoFlush[];
$replace => DoReplace[];
$new => DoNewCell[interactive: TRUE];
ENDCASE => {TerminalIO.WriteRope["skipped\n"]; RETURN [FALSE]};
RETURN [TRUE];
EXITS
markProblem => TerminalIO.WriteRope["internal problem; not done\n"];
END;
-- -- -- -- -- -- -- -- -- -- -- --
Expand: CDCallSpecific.CallProc =
BEGIN
cptr: CD.CellPtr ~ NARROW[aptr.ob.specificRef];
removeMe ← TRUE;
repaintMe ← TRUE;
include ← CDApplications.ComposedCopy[
cptr.contents, aptr.location, aptr.ob.size, aptr.orientation];
repaintInclude ← TRUE;
END;
-- -- -- -- -- -- -- -- -- -- -- --
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;
XXX BoundingRectI: PUBLIC PROC[list: CD.ApplicationList, selectedOnly: BOOLEAN←FALSE] RETURNS [CD.DesignRect] =
BEGIN
bound: CD.DesignRect�sics.empty;
FOR tem: LIST OF CD.ApplicationPtr ← list, tem.rest WHILE tem#NIL DO
IF selectedOnly AND NOT tem.first.selected THEN LOOP;
bound ← CDBasics.Surround[bound, CDApplications.ARectI[tem.first]]
ENDLOOP;
RETURN [bound]
END;
XXX ComputeBoundsI: 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 [BoundingRectI[cptr.contents]];
ENDCASE => ERROR;
END;
AdjustItself:
PROC [objToReposition:
CD.ObPtr, newBound:
CD.DesignRect] =
--newBound is expected to be in coordinate system of objToReposition itself
BEGIN
objToReposition.size ← CDBasics.SizeOfRect[newBound];
WITH objToReposition.specificRef
SELECT
FROM
cptr:
CD.CellPtr =>
CDApplications.TranslateList[cptr.contents,
CDBasics.NegOffset[CDBasics.BaseOfRect[newBound]]];
ENDCASE => ERROR;
ERROR
END;
RepositionElementsForCell:
PROC [me:
CD.ObPtr,
objToReposition: CD.ObPtr,
oldSize: CD.DesignPosition, -- of objToReposition
newBound: CD.DesignRect, -- of objToReposition
design: CD.Design] =
BEGIN
RepositionApplication:
PROC [aptr:
CD.ApplicationPtr] =
--INLINE--
-- repositions an application if it calls objToReposition
-- oldSize: size of the original objToReposition
-- objToReposition object needing reposition
-- newBound: bound of new objToReposition in coords of old objToReposition
BEGIN
changeMade ← TRUE;
--XXX--TerminalIO.WriteRope["changeMade ← TRUE\n"];
aptr.location ← CDOrient.MapPosition[
itemInCell: newBound,
cellSize: oldSize,
cellInstOrient: aptr.orientation,
cellInstPos: aptr.location
];
END;
changeMade: BOOL ← FALSE;
cptr: CD.CellPtr = NARROW[me.specificRef];
--XXX--TerminalIO.WriteRope["enter RepositionElementsForCell "];
--XXX--TerminalIO.WriteRope[CDDirectory.Name[me]];
--XXX--TerminalIO.WriteRope["\n"];
FOR w:
CD.ApplicationList ← cptr.contents, w.rest
WHILE w#
NIL
DO
IF w.first.ob=objToReposition THEN RepositionApplication[w.first];
ENDLOOP;
IF changeMade
THEN
IF CDBasics.RectAt[[0, 0], me.size]#CDApplications.BoundingRect[cptr.contents]
THEN
CDDirectory.RepositionAnObject[design, me];
--XXX--TerminalIO.WriteRope["leave RepositionElementsForCell\n"];
ERROR
END;
-- -- -- -- -- -- -- -- -- -- -- --
ReadCell:
CD.InternalReadProc
--PROC [] RETURNS [ObPtr]-- =
BEGIN
ob: CD.ObPtr ~ CreateEmptyCell[];
specific: CD.CellPtr ~ NARROW[ob.specificRef];
ob.size.x ← TokenIO.ReadInt[];
ob.size.y ← TokenIO.ReadInt[];
IF
CDIO.VersionKey[]<1
THEN {
specific.name ← TokenIO.ReadRope[];
}
ELSE {
specific.simplifyOn ← TokenIO.ReadInt[];
};
specific.contents ← CDIO.ReadApplicationList[];
RETURN [ob];
END;
WriteCell:
CD.InternalWriteProc
-- PROC [me: ObPtr] -- =
BEGIN
specific: CD.CellPtr ~ NARROW[me.specificRef];
TokenIO.WriteInt[me.size.x];
TokenIO.WriteInt[me.size.y];
TokenIO.WriteInt[specific.simplifyOn];
CDIO.WriteApplicationList[specific.contents];
END;
Describe:
PROC[me:
CD.ObPtr]
RETURNS [Rope.
ROPE] =
BEGIN
specific: CD.CellPtr = NARROW[me.specificRef];
RETURN [Rope.Concat["cell ", specific.name]]
END;
ReplaceDirectChildForCells: CDDirectory.ReplaceDirectChildProc =
BEGIN
cp: CD.CellPtr = NARROW[me.specificRef];
FOR list: CD.ApplicationList ← cp.contents, list.rest WHILE list#NIL DO
IF list.first.ob=old THEN {
nr: CD.DesignRect = new.p.insideRect[new];
or: CD.DesignRect = old.p.insideRect[old];
IF nr#or OR new.size#old.size OR off#[0, 0] THEN {
newOff: CD.DesignPosition = CDOrient.MapPosition[
itemInCell: CDBasics.MoveRect[[x1: nr.x1, y1: nr.y1, x2: nr.x1, y2: nr.y1], CDBasics.NegOffset[off]],
cellSize: new.size,
cellInstOrient: list.first.orientation,
cellInstPos: [0, 0]
];
oldOff: CD.DesignPosition = CDOrient.MapPosition[
itemInCell: [x1: or.x1, y1: or.y1, x2: or.x1, y2: or.y1],
cellSize: old.size,
cellInstOrient: list.first.orientation,
cellInstPos: [0, 0]
];
list.first.location ← CDBasics.SubPoints[
CDBasics.AddPoints[list.first.location, oldOff],
newOff
];
};
found ← TRUE;
list.first.ob ← new
};
ENDLOOP;
-- XXX change interface to list of replace records
-- that makes a nested loop before this comment, but the if
-- statement after this comment is executed only once; this stops recursion!!
IF found THEN {
oldr: CD.DesignRect = me.p.insideRect[me];
newr: CD.DesignRect = ComputeBounds[me];
IF oldr#newr THEN {
newBase: CD.DesignPosition = CDBasics.BaseOfRect[newr];
oldBase: CD.DesignPosition = CDBasics.BaseOfRect[oldr];
noffset: CD.DesignPosition = CDBasics.SubPoints[newBase, oldBase];
IF noffset#[0, 0] THEN
CDApplications.TranslateList[cp.contents, CDBasics.NegOffset[noffset]];
me.size ← CDBasics.SizeOfRect[newr];
CDDirectory.ReplaceObject[
design: NIL --HackyGetDesign[me], - -XXX
old: me, new: me,
off: noffset
]
}
};
ERROR
END;
NewReplaceDirectChildForCells: CDDirectoryExtras.ReplaceDChildsProc =
-- PROC[me: CD.ObPtr, design: CD.Design, replace: LIST OF REF ReplaceRec] --
BEGIN
needReposition: BOOL = CDDirectoryExtras.ReplaceDirectChildForDummyCells[me, replace];
IF needReposition
THEN
changed ← CDDirectoryExtras.RepositionCell[me, design];
END;
-- -- -- -- -- -- -- -- -- -- -- --
RemoveApplication:
PUBLIC PROC [design:
CD.Design, cell:
CD.ObPtr, aptr:
CD.ApplicationPtr, draw:
BOOL←
TRUE]
RETURNS [removed:
CD.ApplicationPtr←
NIL, repositioned:
BOOL←
FALSE] =
--If necessary, modifies the boundary and translates all applications of the cell,
-- and further, translates all the instances of the cell. This changes the
-- parent cells, which therefore may be repositioned recursively too.
--noop if cell does not contain aptr (directly).
--Do not assume aptr^ to be freed for other use but use removed;
-- removed=NIL: aptr has not successfully been removed
-- removed#NIL: aptr is removed, removed is a copy of aptr for arbitrary re-use.
BEGIN
cp: CD.CellPtr = NARROW[cell.specificRef];
IF aptr=NIL THEN RETURN;
IF cp.contents#
NIL
THEN {
IF cp.contents.first=aptr
THEN {
removed ← cp.contents.first;
cp.contents ← cp.contents.rest
}
ELSE
FOR list:
CD.ApplicationList ← cp.contents, list.rest
WHILE list.rest#
NIL
DO
IF list.rest.first=aptr
THEN {
removed ← list.rest.first;
list.rest ← list.rest.rest;
EXIT
}
ENDLOOP;
};
IF aptr.ob=NIL THEN RETURN [NIL];
IF draw AND design#NIL THEN CDOps.DelayedRedraw[design: design, eraseFirst: TRUE];
repositioned ← CDDirectoryExtras.RepositionCell[cell, design];
[] ← CDEvents.ProcessEvent[changeEvent, design, cell];
END;
IncludeApplication:
PUBLIC PROC [design:
CD.Design, cell:
CD.ObPtr, aptr:
CD.ApplicationPtr, draw:
BOOL←
TRUE, relativeTo:
CD.ApplicationPtr←
NIL]
RETURNS [repositioned:
BOOL←
FALSE] =
--aptr^ is supposed to be referenced by aptr exclusively, and aptr^ may be changed by
-- IncludeApplication.
--If necessary, modifies the boundary and translates all applications of the cell,
-- and further, translates all the instances of the cell. This changes the
-- parent cells, which therefore may be repositioned recursively too.
--relativeTo#NIL: handy but trivial hook for clients which fear that repositioning
-- fools their origin: aptr is first translated by relativeTo.location: if relativeTo
-- points to an application of the cell itself, repositioning changes relativeTo^
-- exactly the right amount to compensate for the repositioning. It is the clients
-- responsibility that relativeTo is actual contained by cell.
BEGIN
cp: CD.CellPtr = NARROW[cell.specificRef];
IF aptr=NIL OR aptr.ob=NIL OR aptr=relativeTo THEN ERROR;
--check first if application is already contained by cell
FOR list:
CD.ApplicationList ← cp.contents, list.rest
WHILE list#
NIL
DO
IF list.first=aptr THEN RETURN
ENDLOOP;
IF relativeTo#
NIL
THEN
aptr.location ← CDBasics.AddPoints[relativeTo.location, aptr.location];
cp.contents ← CONS[aptr, cp.contents];
IF draw AND design#NIL THEN CDOps.DelayedRedraw[design: design, eraseFirst: FALSE];
repositioned ← CDDirectoryExtras.RepositionCell[cell, design];
[] ← CDEvents.ProcessEvent[changeEvent, design, cell]
END;
-- -- -- -- -- -- -- -- -- -- -- --
Init[];
END.