CDCellsImpl.mesa (part of ChipNDale)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, June 24, 1983 5:00 pm
last edited Christian Jacobi, April 15, 1985 5:22:32 pm PST
DIRECTORY
CD,
CDApplications,
CDCallSpecific,
CDCells,
CDDirectory,
CDMenus,
CDEvents,
CDBasics,
CDInterestRects,
CDIO,
CDMarks,
CDOps,
CDOrient,
CDProperties,
CDRects,
Process USING [Yield],
Rope,
TokenIO,
TerminalIO;
CDCellsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDApplications, CDCallSpecific, CDIO, CDDirectory, CDEvents, CDBasics, CDMarks, CDMenus, CDOps, CDOrient, CDProperties, CDRects, Process, Rope, TokenIO, TerminalIO, CDInterestRects
EXPORTS CDCells
SHARES CDDirectory =
BEGIN
-- -- -- -- -- -- -- -- -- -- -- --
pForCells: REF CD.ObjectProcs = CD.RegisterObjectType[$Cell];
beforeReplace: CDEvents.EventRegistration =
CDEvents.RegisterEventType[$BeforeCellReplacement];
afterReplace: CDEvents.EventRegistration
= CDEvents.RegisterEventType[$AfterCellReplacement];
pushEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$AfterPush];
popEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$AfterPop];
fullPopMenu: REF = CDMenus.CreateMenu["Pop from cell"];
partialPopMenu: REF = CDMenus.CreateMenu["Pop from cell"];
emptyPopMenu: REF = CDMenus.CreateMenu["Pop from cell: empty cell"];
lastOutputDesign: CD.Design ← NIL;
Init:
PROC [] =
BEGIN
dp: REF CDDirectory.DirectoryProcs = CDDirectory.InstallDirectoryProcs[pForCells];
dp.enumerateChildObjects ← EnumerateChildObjects;
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.interestRect ← InterestRectCells;
pForCells.oldInsideRect ← OldInsideRect;
pForCells.origin ← OriginForCells;
CDInterestRects.InstallOldSetInterest[pForCells, OldSetInterest];
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];
[] ← CDProperties.RegisterProperty[$InsideRect];
CDProperties.InstallProcs[prop: $InsideRect,
new: CDProperties.PropertyProcsRec[
makeCopy: CDProperties.DontCopy,
internalWrite: NIL,
internalRead: InternalReadProperty,
exclusive: TRUE
]
];
CDEvents.RegisterEventProc[$WriteTechnologyPrivate, RememberDesignOnWriting];
END;
InternalReadProperty:
PROC [prop:
ATOM]
RETURNS [val:
REF] =
--old stuff for io format version 4
BEGIN
x1: INT = TokenIO.ReadInt[];
y1: INT = TokenIO.ReadInt[];
x2: INT = TokenIO.ReadInt[];
y2: INT = TokenIO.ReadInt[];
val ← NEW[CD.DesignRect ← [x1, y1, x2, y2]]
END;
InterestRectCells:
PROC [ob:
CD.ObPtr]
RETURNS [
CD.DesignRect] =
BEGIN
RETURN [NARROW[ob.specificRef, CD.CellPtr].ir]
END;
OriginForCells:
PROC [ob:
CD.ObPtr]
RETURNS [
CD.DesignPosition] =
BEGIN
RETURN [NARROW[ob.specificRef, CD.CellPtr].origin]
END;
OldInsideRect:
PROC [ob:
CD.ObPtr]
RETURNS [
CD.DesignRect] =
BEGIN
RETURN [NARROW[ob.specificRef, CD.CellPtr].dIr]
END;
OldSetInterest:
PROC [ob:
CD.ObPtr, r:
CD.DesignRect] =
BEGIN
cptr: CD.CellPtr = NARROW[ob.specificRef];
cptr.ir ← r;
cptr.useDIr ← FALSE;
END;
SetInsideRect:
PROC [ob:
CD.ObPtr, r:
CD.DesignRect�sics.empty] =
BEGIN
cptr: CD.CellPtr = NARROW[ob.specificRef];
IF CDBasics.NonEmpty[r] THEN cptr.dIr ← r
ELSE cptr.dIr ← CDBasics.RectAt[[0,0], ob.size]
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;
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^ ← oldCp^;
newCp.contents ← CDApplications.CopyList[oldCp.contents];
newOb.properties ← CDProperties.CopyProps[newOb.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.table[pr.nestDepth𡤁]=aptr THEN pr.nestDepth ← pr.nestDepth-1;
cptr: CD.CellPtr = NARROW[aptr.ob.specificRef];
r: CD.DesignRect;
pr.nesting.table[pr.nestDepth] ← aptr;
pr.nestDepth ← pr.nestDepth+1;
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.interestClip]
THEN {
IF pr.stopFlag^ THEN EXIT;
pr.drawChild[
w.first,
CDBasics.BaseOfRect[r],
CDOrient.ComposeOrient[w.first.orientation, orient],
pr];
}
ENDLOOP;
pr.nestDepth ← pr.nestDepth-1;
Process.Yield[];
END;
QuickDrawMeForCells:
PROC [aptr:
CD.ApplicationPtr, pos:
CD.DesignPosition, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE
UNWIND =>
IF pr.nesting.table[pr.nestDepth𡤁]=aptr THEN pr.nestDepth ← pr.nestDepth-1;
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.table[pr.nestDepth] ← aptr;
pr.nestDepth ← pr.nestDepth+1;
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.interestClip]
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[];
pr.nestDepth ← pr.nestDepth-1;
}
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: CD.InterestRect[aptr.ob],
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.BoundingRectO[use]; -- coordsys of use, non oriented
ob.size ← CDOrient.OrientedSize[CDBasics.SizeOfRect[gOutR], orient];
cp.contents ← CDApplications.DeComposedCopy[use, CDBasics.BaseOfRect[gOutR], ob.size, orient];
cp.ir ← cp.dIr ← CDApplications.BoundingRectI[cp.contents];
RETURN [ob]
END;
IncludeAndNameCell:
PROC [design:
CD.Design, cp:
CD.ObPtr, interactive:
BOOL←
TRUE, allowAbort:
BOOL←
FALSE]
RETURNS [done:
BOOL] =
BEGIN
name: Rope.ROPE;
cptr: CD.CellPtr = NARROW[cp.specificRef];
IF ~interactive
THEN {
[] ← CDDirectory.Include[design, cp];
RETURN [done←TRUE];
}
ELSE
--interactive
DO
fiddle: BOOL ← FALSE;
aborted: BOOL ← FALSE;
name ← TerminalIO.RequestRope["enter object name: "
! TerminalIO.UserAbort => {aborted←TRUE; fiddle ← TRUE; CONTINUE}
];
IF aborted
THEN {
TerminalIO.WriteRope[" **name input aborted\n"];
IF allowAbort THEN RETURN [done←FALSE];
};
IF Rope.IsEmpty[name]
THEN {
fiddle ← TRUE;
name ← "-no name";
};
IF Rope.Fetch[name, name.Length[]-1]='@
THEN {
fiddle ← TRUE;
name ← Rope.Substr[name, 0, name.Length[]-1];
};
IF CDDirectory.Include[design, cp, name, fiddle]
THEN {
TerminalIO.WriteRope[cptr.name];
TerminalIO.WriteRope[" included\n"];
RETURN [done←TRUE];
};
TerminalIO.WriteRope[name];
TerminalIO.WriteRope[" does already exist\nnot accepted, please repeat\n"];
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.BoundingRectO[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;
IsCellAp:
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;
DoPushInCell:
PROC [design:
CD.Design, originalApp:
CD.ApplicationPtr]
RETURNS [done: BOOL←FALSE] =
BEGIN
IF IsCellAp[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^ ← cptr^;
newCptr.contents ← CDApplications.ComposedCopy[
al: newCptr.contents,
cellPos: originalApp.location,
cellSize: originalApp.ob.size,
cellOrient: originalApp.orientation
];
dummyCellAp ←
NEW[
CD.Application←[
ob: dummy,
selected: TRUE,
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; --cd coords
currentAptr, pushedAptr: CD.ApplicationPtr;
currentCellOb, pushedCellOb: 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;
DoReplace:
PROC [] =
BEGIN
[] ← CDEvents.ProcessEvent[beforeReplace, 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
OR currentCellPtr.ir#pushedCellPtr.ir
OR currentCellPtr.dIr#pushedCellPtr.dIr
THEN {
-- both in design coordinates
oldSize: CD.DesignPosition ← pushedAptr.ob.size;
newFakeOrigin: CD.DesignPosition; --absolute coordinates
newInOldCoordinates: CD.DesignPosition; --coordinates of old cell
pushedAptr.ob.size ←
CDOrient.OrientedSize[CDBasics.SizeOfRect[currentRect], pushedAptr.orientation];
newFakeOrigin ← CDOrient.MapPoint[
pointInCell: [0, 0],
cellSize: pushedAptr.ob.size,
cellInstOrient: pushedAptr.orientation,
cellInstPos: currentAptr.location
].pointInWorld;
newInOldCoordinates ← CDOrient.DeMapPoint[
pointInWorld: newFakeOrigin,
cellSize: oldSize,
cellInstOrient: pushedAptr.orientation,
cellInstPos: pushedAptr.location
].pointInCell;
pushedCellPtr.origin ← CDBasics.SubPoints[pushedCellPtr.origin, newInOldCoordinates];
IF ~pushedCellPtr.useDIr
THEN
pushedCellPtr.ir ← CDBasics.MoveRect[pushedCellPtr.ir, CDBasics.NegOffset[newInOldCoordinates]];
CDDirectory.RepositionObject[design: design,
ob: pushedAptr.ob,
oldSize: oldSize,
baseOff: newInOldCoordinates
];
};
pushedAptr.location ← currentAptr.location;
CDOps.IncludeApplication[design, pushedAptr, FALSE];
[] ← CDEvents.ProcessEvent[afterReplace, design, pushedAptr.ob];
END;
DoNewCell:
PROC [interactive:
BOOL←
FALSE] =
BEGIN
TerminalIO.WriteRope["new cell\n"];
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 ~pushedCellPtr.useDIr
THEN {
gIntRect:
CD.DesignRect = CDOrient.MapRect[
itemInCell: pushedCellPtr.ir,
cellSize: pushedAptr.ob.size,
cellInstOrient: pushedAptr.orientation,
cellInstPos: pushedAptr.location
];
currentCellPtr.ir ← CDOrient.DeMapRect[
itemInWorld: gIntRect,
cellSize: currentAptr.ob.size,
cellInstOrient: currentAptr.orientation,
cellInstPos: currentAptr.location
];
};
CDOps.IncludeApplication[design, currentAptr, FALSE];
CDDirectory.PropagateChange[currentAptr.ob, design];
END;
menu: REF ← fullPopMenu;
IF design^.actual.rest=NIL THEN {TerminalIO.WriteRope["not in cell\n"]; RETURN [FALSE]};
pushedAptr ← design^.actual.first.mightReplace;
pushedCellOb ← pushedAptr.ob;
pushedCellPtr ← NARROW[pushedCellOb.specificRef];
pushedRect ← CDOrient.RectAt[pushedAptr.location, pushedCellOb.size, pushedAptr.orientation];
TerminalIO.WriteRope["Pop from cell "];
TerminalIO.WriteRope[pushedCellPtr.name];
TerminalIO.WriteLn[];
CDApplications.DeSelectList[CDOps.AppList[design]];
currentRect ← CDApplications.BoundingRectO[CDOps.AppList[design]]; -- design coordinates
currentCellOb ← CreateCellObject[CDOps.AppList[design], pushedAptr.orientation];
currentCellPtr ← NARROW[currentCellOb.specificRef];
currentCellPtr.useDIr ← pushedCellPtr.useDIr;
IF currentCellPtr.useDIr THEN currentCellPtr.ir ← currentCellPtr.dIr
ELSE currentCellPtr.ir ← pushedCellPtr.ir;
currentAptr ←
NEW[
CD.Application←[
ob: currentCellOb,
location: CDBasics.BaseOfRect[currentRect],
orientation: pushedAptr.orientation,
selected: TRUE,
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;
recursive: BOOL;
IF m=newcell
THEN {
DoNewCell[interactive: FALSE];
RETURN [TRUE]
};
mark ← CDMarks.GetNewMark[design !
CDMarks.PreviousMarkWasNotReleased => GOTO requestProblem];
CDMarks.MarkUnMarkedInclusiveChildren[design, currentCellOb, mark];
recursive ← (pushedAptr.ob.marked=mark);
CDMarks.ReleaseMark[design, mark !
CD.Error => {
TerminalIO.WriteRope["**internal problem releasing mark; better save design and destroy the viewer(s)\n"];
CONTINUE
}
];
IF recursive
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
requestProblem =>
TerminalIO.WriteRope["**internal problem requesting mark; 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.BoundingRectO[cptr.contents]];
ENDCASE => ERROR;
END;
ComputeBoundsI:
PROC [ob:
CD.ObPtr] =
BEGIN
WITH ob.specificRef
SELECT
FROM
cptr: CD.CellPtr => cptr.dIr ← CDApplications.BoundingRectI[cptr.contents];
ENDCASE => 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[]>=8
THEN {
--now
specific.simplifyOn ← TokenIO.ReadInt[];
specific.useDIr ← (TokenIO.ReadInt[]=0);
IF ~specific.useDIr THEN specific.ir ← ReadRect[];
specific.origin.x ← TokenIO.ReadInt[];
specific.origin.y ← TokenIO.ReadInt[];
}
ELSE {
-- old versions
IF
CDIO.VersionKey[]<1
THEN {
specific.name ← TokenIO.ReadRope[];
}
ELSE {
specific.simplifyOn ← TokenIO.ReadInt[];
};
};
specific.contents ← CDIO.ReadApplicationList[];
specific.dIr ← CDApplications.BoundingRectI[specific.contents];
IF specific.useDIr THEN specific.ir ← specific.dIr;
RETURN [ob];
END;
WriteRect:
PROC[r:
CD.Rect] =
BEGIN
TokenIO.WriteInt[r.x1];
TokenIO.WriteInt[r.y1];
TokenIO.WriteInt[r.x2];
TokenIO.WriteInt[r.y2];
END;
ReadRect:
PROC []
RETURNS [
CD.Rect] =
BEGIN
r: CD.Rect;
r.x1 ← TokenIO.ReadInt[];
r.y1 ← TokenIO.ReadInt[];
r.x2 ← TokenIO.ReadInt[];
r.y2 ← TokenIO.ReadInt[];
RETURN [r]
END;
RememberDesignOnWriting: CDEvents.EventProc =
-- PROC [event: REF, design: CD.Design, x: REF]
BEGIN
lastOutputDesign ← design
END;
WriteCell:
CD.InternalWriteProc
-- PROC [me: ObPtr] -- =
BEGIN
HandleEmptyCells:
PROC [me:
CD.ObPtr]
RETURNS [shouldReturn:
BOOL←
FALSE] =
--most empty cells are bugs;
--however, the pushed in cells might be empty legally
BEGIN
design: CD.Design ← lastOutputDesign;
IF design#
NIL
THEN {
FOR l:
LIST
OF
CD.PushRec ← design.actual, l.rest
WHILE l#
NIL
DO
--pushed in cells might be empty legally
IF l.first.dummyCell#NIL AND l.first.dummyCell.ob=me THEN RETURN;
ENDLOOP;
--all other cells should not be empty
TerminalIO.WriteRope[Rope.Cat["** cell ", specific.name, " was empty\n"]];
CDIO.WriteApplicationList[
LIST[
CDApplications.NewApplicationI[
ob: CDRects.CreateRect[[CD.lambda, CD.lambda], CD.highLightError]
]]];
shouldReturn ← TRUE;
}
END;
specific: CD.CellPtr = NARROW[me.specificRef];
TokenIO.WriteInt[me.size.x];
TokenIO.WriteInt[me.size.y];
TokenIO.WriteInt[specific.simplifyOn];
IF specific.useDIr AND specific.ir=specific.dIr THEN TokenIO.WriteInt[0]
ELSE {
TokenIO.WriteInt[1];
WriteRect[specific.ir];
};
TokenIO.WriteInt[specific.origin.x];
TokenIO.WriteInt[specific.origin.y];
IF specific.contents=NIL AND HandleEmptyCells[me].shouldReturn THEN RETURN;
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.ReplaceDChildsProc =
-- PROC[me: CD.ObPtr, design: CD.Design, replace: LIST OF REF ReplaceRec] --
BEGIN
specific: CD.CellPtr = NARROW[me.specificRef];
needReposition: BOOL = ReplaceDirectChildForDummyCells[me, replace];
newIr: CD.DesignRect = CDApplications.BoundingRectI[NARROW[me.specificRef, CD.CellPtr].contents];
IF needReposition
OR specific.dIr#newIr
THEN {
changed ← RepositionCell[me, design];
}
END;
ReplaceDirectChildForDummyCells:
PUBLIC
PROC [cellOb:
CD.ObPtr, replace: CDDirectory.ReplaceList]
RETURNS [needReposition:
BOOL] =
BEGIN
PointRect:
PROC [p:
CD.Position]
RETURNS [
CD.Rect] =
INLINE {
RETURN [[x1: p.x, y1: p.y, x2: p.x, y2: p.y]]
};
cp: CD.CellPtr = NARROW[cellOb.specificRef];
needReposition ← FALSE;
FOR replaceList: CDDirectory.ReplaceList ← replace, replaceList.rest
WHILE replaceList#
NIL
DO
rep: REF CDDirectory.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.MapPoint[
pointInCell: rep.off,
cellSize: rep.oldSize,
cellInstOrient: appList.first.orientation,
cellInstPos: appList.first.location
];
fakePos:
CD.DesignPosition = CDOrient.MapPoint[
pointInCell: [0, 0],
cellSize: rep.newSize,
cellInstOrient: appList.first.orientation,
cellInstPos: [0, 0]
];
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
cp: CD.CellPtr = NARROW[cellOb.specificRef];
oldSize: CD.DesignPosition ← cellOb.size;
oldR: CD.DesignRect ← CDBasics.RectAt[[0,0], oldSize];
oldDIr: CD.DesignRect ← cp.dIr;
newR: CD.DesignRect = ComputeBounds[cellOb];
newSize: CD.DesignPosition ← CDBasics.SizeOfRect[newR];
newBase: CD.DesignPosition = CDBasics.BaseOfRect[newR];
newDIr: CD.DesignRect ← CDApplications.BoundingRectI[cp.contents];
didReposition ← oldR#newR OR oldSize#newSize OR (cp.useDIr AND oldDIr#newDIr);
IF didReposition
THEN {
IF cp.contents=
NIL
THEN {
--actually this is an error; but it could be produced by some silly client program,
--so we do not abort
TerminalIO.WriteRope[Rope.Cat["** tried to reposition an empty cell ",
CDOps.Info[cellOb], "\n"]];
RETURN
};
IF newBase#[0, 0]
THEN {
CDApplications.TranslateList[cp.contents, CDBasics.NegOffset[newBase]];
newDIr ← CDBasics.MoveRect[newDIr, CDBasics.NegOffset[newBase]];
cp.origin ← CDBasics.SubPoints[cp.origin, newBase];
};
cellOb.size ← newSize;
cp.dIr ← newDIr;
IF cp.useDIr THEN cp.ir ← newDIr
ELSE cp.ir ← CDBasics.MoveRect[cp.ir, CDBasics.NegOffset[newBase]];
CDDirectory.RepositionObject[
design: design,
ob: cellOb,
oldSize: oldSize,
baseOff: newBase
]
}
END;
SetInterestRect:
PUBLIC
PROC [cellOb:
CD.ObPtr, r:
CD.DesignRect ← [0, 0, -1, -1]] =
--defaulting r means to use a reasonable default for the interest rect
BEGIN
cp: CD.CellPtr = NARROW[cellOb.specificRef];
cp.useDIr ← ~CDBasics.NonEmpty[r];
IF cp.useDIr THEN cp.ir ← cp.dIr ELSE cp.ir ← r
END;
Init[];
END.