PWObjectsImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reversed.
Created by Bertrand Serlet, February 3, 1985 12:49:51 pm PST
Last edited by Bertrand Serlet, March 17, 1987 11:36:31 pm PST
DIRECTORY
CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDEvents, CDInstances, CDProperties, GList, HashTable, IO, PWObjects, Rope, TerminalIO;
PWObjectsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDEvents, CDInstances, CDProperties, GList, HashTable, IO, Rope, TerminalIO
EXPORTS PWObjects
SHARES CDDirectory =
BEGIN OPEN PWObjects;
ROPE: TYPE = Rope.ROPE;
ROPES: TYPE = LIST OF ROPE;
Abuts
abutXClass:
PUBLIC
CD.ObjectClass ← RegisterClass[objectType: $AbutX, expand: ExpandAbut, enumerateChildObjects: EnumerateChildObjectsAbut, replaceDirectChilds: ReplaceDirectChildsAbut, interestRect: AbutInterestRect];
abutYClass:
PUBLIC
CD.ObjectClass ← RegisterClass[objectType: $AbutY, expand: ExpandAbut, enumerateChildObjects: EnumerateChildObjectsAbut, replaceDirectChilds: ReplaceDirectChildsAbut, interestRect: AbutInterestRect];
AbutSpecific: TYPE = REF AbutSpecificRec;
AbutSpecificRec:
TYPE =
RECORD [
ir: CD.Rect, -- for algorithmic efficiency
subObjects: SEQUENCE size: NAT OF CD.Object
];
CreateNewAbutX:
PUBLIC CreateAbutProc = {
abutSpecific: AbutSpecific ← NEW [AbutSpecificRec[GList.Length[subObjects]]];
new: CD.Object;
FOR i:
NAT
IN [0 .. abutSpecific.size)
DO
abutSpecific[i] ← subObjects.first; subObjects ← subObjects.rest;
ENDLOOP;
newAbut ← NEW [CD.ObjectRep ← [class: abutXClass, specific: abutSpecific]];
new ← ExpandAbut[newAbut, NIL, NIL].new;
newAbut.bbox ← new.bbox;
abutSpecific.ir ← CD.InterestRect[new];
};
CreateNewAbutY:
PUBLIC CreateAbutProc = {
abutSpecific: AbutSpecific ← NEW [AbutSpecificRec[GList.Length[subObjects]]];
new: CD.Object;
FOR i:
NAT
IN [0 .. abutSpecific.size)
DO
abutSpecific[i] ← subObjects.first; subObjects ← subObjects.rest;
ENDLOOP;
newAbut ← NEW [CD.ObjectRep ← [class: abutYClass, specific: abutSpecific]];
new ← ExpandAbut[newAbut, NIL, NIL].new;
newAbut.bbox ← new.bbox;
abutSpecific.ir ← CD.InterestRect[new];
};
EnumerateSubObjects:
PUBLIC
PROC [abut:
CD.Object, eachSubObject: EachSubObjectProc] = {
abutSpecific: AbutSpecific = NARROW [abut.specific];
pos: CD.Position ← [0, 0];
FOR i:
NAT
IN [0 .. abutSpecific.size)
DO
eachSubObject[abutSpecific[i], pos];
SELECT abut.class
FROM
abutXClass => pos.x ← pos.x + CD.InterestSize[abutSpecific[i]].x;
abutYClass => pos.y ← pos.y + CD.InterestSize[abutSpecific[i]].y;
ENDCASE => ERROR;
ENDLOOP;
};
Takes an abut and returns the cell which is equivalent to this abut. Cell resulting always belongs to the from design if me belongs to the from design. It is included in the to design if to#NIL
ExpandAbut: CDDirectory.ExpandProc = {
EachSubObject: EachSubObjectProc = {
instances ← CONS [CDInstances.NewInst[subObject, [CDBasics.SubPoints[pos, CD.InterestBase[subObject]]]], instances];
};
instances: LIST OF CD.Instance;
EnumerateSubObjects[me, EachSubObject];
new ← CreateCell[instances: instances, name: Rope.Cat[CDDirectory.Name[me], "-AbutExpanded"]];
IF into#NIL THEN [] ← CDDirectory.Include[into, new];
};
EnumerateChildObjectsAbut: CDDirectory.EnumerateChildObjectsProc = {
EachSubObject: EachSubObjectProc = {p[subObject, x]};
EnumerateSubObjects[me, EachSubObject];
};
ReplaceDirectChildsAbut: CDDirectory.ReplaceDChildsProc = {
EachSubObject: EachSubObjectProc = {
FOR l: CDDirectory.ReplaceList ← replace, l.rest
WHILE l#
NIL
DO
IF l.first.old=subObject THEN {changed ← TRUE; EXIT};
ENDLOOP;
};
bbox: CD.Rect ← me.bbox;
EnumerateSubObjects[me, EachSubObject];
IF ~changed THEN RETURN;
me.bbox ← ExpandAbut[me, NIL, NIL].new.bbox;
changed ← bbox = me.bbox;
CDDirectory.PropagateResize[design, me];
};
AbutInterestRect:
CD.RectProc = {
abutSpecific: AbutSpecific = NARROW [ob.specific];
RETURN [abutSpecific.ir];
};
Routing Cells
routingClass:
PUBLIC
CD.ObjectClass ← RegisterClass[objectType: $Routing, expand: ExpandRouting, interestRect: RoutingInterestRect];
ExpandRouting: CDDirectory.ExpandProc = {
routingSpecific: RoutingSpecific = NARROW [me.specific];
instances: LIST OF CD.Instance ← NIL;
FOR i:
NAT
IN [0 .. routingSpecific.size)
DO
node: Node ← routingSpecific[i];
FOR j:
NAT
IN [0 .. node.size)
DO
instances ←
CONS [
CDInstances.NewInst[
node[j].object,
[CDBasics.SubPoints[node[j].position, CD.InterestBase[node[j].object]]],
CDProperties.DCopyProps[node.properties]
],
instances];
ENDLOOP;
ENDLOOP;
new ← CreateCell[instances: instances, ir: routingSpecific.ir, name: Rope.Cat[CDDirectory.Name[me], "-RoutingExpanded"]];
IF CD.InterestRect[new]#routingSpecific.ir THEN ERROR; -- CD Broken!
};
CreateRouting:
PUBLIC
PROC [ir:
CD.Rect, nodes:
LIST
OF Node]
RETURNS [routing:
CD.Object] = {
size: NAT = NAT [GList.Length[nodes]];
routingSpecific: RoutingSpecific = NEW [RoutingRep[size]];
FOR i: NAT IN [0 .. size) DO routingSpecific[i] ← nodes.first; nodes ← nodes.rest ENDLOOP;
routingSpecific.ir ← ir;
routing ← NEW [CD.ObjectRep ← [class: routingClass, bbox: [0, 0, 0, 0], specific: routingSpecific]];
routing.bbox ← ExpandRouting[routing, NIL, NIL].new.bbox;
};
CreateNode:
PUBLIC
PROC [geometry:
LIST
OF PlacedObject, properties:
CD.PropList ←
NIL]
RETURNS [node: Node] = {
size: NAT ← 0;
FOR list: LIST OF PlacedObject ← geometry, list.rest WHILE list#NIL DO size ← size + 1 ENDLOOP;
node ← NEW [NodeRep[size]];
node.properties ← properties;
FOR i: NAT IN [0 .. size) DO node[i] ← geometry.first; geometry ← geometry.rest ENDLOOP;
};
CreateNodes:
PUBLIC
PROC [table: HashTable.Table]
RETURNS [nodes:
LIST
OF Node ←
NIL] = {
EachPair: HashTable.EachPairAction = {
name: Rope.ROPE = NARROW [key];
geometry: REF LIST OF PlacedObject = NARROW [value];
node: Node = CreateNode[geometry^, LIST [[key: $SignalName, val: name]]];
nodes ← CONS [node, nodes];
};
[] ← HashTable.Pairs[table, EachPair];
};
RoutingInterestRect:
CD.RectProc = {
routingSpecific: RoutingSpecific = NARROW [ob.specific];
RETURN [routingSpecific.ir];
};
Indirect
indirectClass:
PUBLIC
CD.ObjectClass ← RegisterClass[objectType: $Indirect, expand: ExpandIndirect, replaceDirectChilds: ReplaceDirectChildsIndirect];
In the future, add an IR proc, and maybe a Draw Proc?
CreateIndirect:
PUBLIC
PROC [sourceObject:
CD.Object]
RETURNS [indirectObject:
CD.Object] = {
IF sourceObject=NIL THEN RETURN [NIL];
indirectObject ← NEW [CD.ObjectRep ← [class: indirectClass, bbox: sourceObject.bbox, specific: sourceObject]];
};
ExpandIndirect: CDDirectory.ExpandProc = {new ←
NARROW [me.specific]};
ReplaceDirectChildsIndirect: CDDirectory.ReplaceDChildsProc = {
indirect: CD.Object = NARROW [me.specific];
bbox: CD.Rect ← me.bbox;
FOR l: CDDirectory.ReplaceList ← replace, l.rest
WHILE l#
NIL
DO
IF l.first.old=indirect THEN {changed ← TRUE; EXIT};
ENDLOOP;
IF ~changed THEN RETURN;
me.bbox ← indirect.bbox;
changed ← bbox = me.bbox;
CDDirectory.PropagateResize[design, me];
};
Lazy
lazyClass:
PUBLIC
CD.ObjectClass ← RegisterClass[objectType: $Lazy, expand: ExpandLazy, interestRect: LazyIR];
LazyData: TYPE = REF LazyDataRec;
LazyDataRec:
TYPE =
RECORD [info:
REF, createProc: CreateProc, ir:
CD.Rect];
CreateLazy:
PUBLIC
PROC [info:
REF, createProc: CreateProc, bbox, ir:
CD.Rect]
RETURNS [newLazy:
CD.Object] = {
newLazy ← NEW [CD.ObjectRep ← [class: lazyClass, specific: NEW [LazyDataRec ← [info: info, createProc: createProc, ir: ir]]]];
newLazy.bbox ← bbox;
};
LazyIR:
CD.RectProc = {lazyData: LazyData ←
NARROW [ob.specific];
RETURN [lazyData.ir]};
ExpandLazy: CDDirectory.ExpandProc = {
lazyData: LazyData ← NARROW [me.specific];
new ← lazyData.createProc[lazyData.info];
IF CD.InterestRect[new]#lazyData.ir OR new.bbox#me.bbox THEN ERROR;
IF into#NIL THEN [] ← CDDirectory.Include[into, new];
};
Implementors goodies
CreateCell:
PUBLIC
PROC [instances:
CD.InstanceList, ir:
CD.Rect ← [0,0,-1,-1], name:
ROPE ←
NIL, properties:
CD.PropList ←
NIL]
RETURNS [cell:
CD.Object]= {
cell ← CDCells.CreateCell[il: instances, ir: ir];
CDCells.ToSequenceMode[cell];
WHILE properties#
NIL
DO
CDProperties.PutObjectProp[cell, properties.first.key, properties.first.val];
properties ← properties.rest;
ENDLOOP;
IF name#
NIL
THEN {
cellSpecific: CD.CellSpecific ← NARROW [cell.specific];
cellSpecific.name ← name;
};
};
Mechanism for flushing during edits
propertiesToFlushOnEdit: LIST OF ATOM ← NIL;
childToParents: HashTable.Table ← HashTable.Create[];
Having a HashTable (of the right size) helps avoiding frequent allocations.
AddChildParent:
PROC [child, parent:
CD.Object] = {
parents: LIST OF CD.Object ← NARROW [HashTable.Fetch[childToParents, child].value];
IF GList.Member[parent, parents] THEN RETURN;
parents ← CONS [parent, parents];
[] ← HashTable.Store[childToParents, child, parents];
};
FlushPropertiesAfterReplace: CDEvents.EventProc = {
BuildTable: CDDirectory.EachEntryAction = {
EachChild: CDDirectory.EnumerateObjectsProc = {AddChildParent[me, ob]};
sch: ROPE ← NARROW [CDProperties.GetObjectProp[ob, $IconFor]];
schOb: CD.Object ← IF sch#NIL THEN CDDirectory.Fetch[design, sch].object ELSE NIL;
we include icons of sch
IF schOb#NIL THEN AddChildParent[schOb, ob];
In case ob is a mask, the corresponding sch (if any) "depends" on it. That's a hack!
schOb ← IF Rope.Match["*.mask", name] THEN CDDirectory.Fetch[design, Rope.Replace[base: name, start: Rope.Length[name]-4, with: "sch"]].object ELSE NIL;
IF schOb#NIL THEN AddChildParent[ob, schOb];
We add all the children
CDDirectory.EnumerateChildObjects[ob, EachChild];
};
changedObjects: LIST OF CD.Object ← LIST [NARROW [x]];
foundANewOne: BOOL ← TRUE;
flushedObjects: ROPE ← NIL;
[] ← CDDirectory.Enumerate[design, BuildTable];
WHILE foundANewOne
DO
foundANewOne ← FALSE;
FOR list:
LIST
OF
CD.Object ← changedObjects, list.rest
WHILE list#
NIL
DO
FOR parents:
LIST
OF
CD.Object ←
NARROW [HashTable.Fetch[childToParents, list.first].value], parents.rest
WHILE parents#
NIL
DO
IF GList.Member[parents.first, changedObjects] THEN LOOP;
changedObjects ← CONS [parents.first, changedObjects]; foundANewOne ← TRUE;
ENDLOOP;
ENDLOOP;
ENDLOOP;
FOR list:
LIST
OF
CD.Object ← changedObjects, list.rest
WHILE list#
NIL
DO
flushed: BOOL ← FALSE;
FOR props:
LIST
OF
ATOM ← propertiesToFlushOnEdit, props.rest
WHILE props#
NIL
DO
IF CDProperties.GetObjectProp[list.first, props.first]=NIL THEN LOOP;
flushed ← TRUE;
CDProperties.PutObjectProp[list.first, props.first, NIL];
ENDLOOP;
IF flushed THEN flushedObjects ← Rope.Cat[flushedObjects, " ", CDDirectory.Name[list.first]];
ENDLOOP;
IF flushedObjects#NIL THEN TerminalIO.PutF["Flushed caches for %g.\n ", IO.rope[flushedObjects]];
HashTable.Erase[childToParents]; -- we clean up that table!
};
RegisterProp:
PUBLIC
PROC [prop:
ATOM, copy:
BOOL ←
FALSE, flushOnEdit:
BOOL ←
FALSE]
RETURNS [sameAtom:
ATOM] = {
[] ← CDProperties.RegisterProperty[prop, $PW];
CDProperties.InstallProcs[prop, [makeCopy: IF copy THEN CDProperties.CopyVal ELSE CDProperties.DontCopy]];
IF flushOnEdit THEN propertiesToFlushOnEdit ← CONS [prop, propertiesToFlushOnEdit];
sameAtom ← prop;
};
RegisterClass:
PUBLIC
PROC [objectType:
ATOM, expand: CDDirectory.ExpandProc, enumerateChildObjects: CDDirectory.EnumerateChildObjectsProc ←
NIL, replaceDirectChilds: CDDirectory.ReplaceDChildsProc ←
NIL, interestRect:
CD.RectProc ←
NIL, drawMe, quickDrawMe, showMeSelected:
CD.DrawProc ←
NIL]
RETURNS [objectClass:
CD.ObjectClass] = {
dp: CDDirectory.DirectoryProcs ← [expand: expand];
objectClassRec: CD.ObjectClassRec ← [];
objectClassRec.showMeSelected ← CDDefaultProcs.ShowMeSelectedWithExpand;
objectClassRec.interestRect ← IF interestRect=NIL THEN CDDefaultProcs.InterestRectWithExpand ELSE interestRect;
objectClassRec.drawMe ← IF interestRect=NIL THEN CDDefaultProcs.DrawMe ELSE drawMe;
objectClassRec.quickDrawMe ← IF interestRect=NIL THEN CDDefaultProcs.QuickDrawMe ELSE quickDrawMe;
objectClassRec.showMeSelected ← IF interestRect=NIL THEN CDDefaultProcs.ShowMeSelected ELSE showMeSelected;
objectClassRec.directoryProcs ← NIL; objectClassRec.inDirectory ← FALSE;
IF enumerateChildObjects#NIL THEN dp.enumerateChildObjects ← enumerateChildObjects;
IF replaceDirectChilds#NIL THEN dp.replaceDirectChilds ← replaceDirectChilds;
objectClass ← CD.RegisterObjectClass[objectType, objectClassRec ! CD.Error => CONTINUE];
IF objectClass=NIL THEN objectClass ← CD.FetchObjectClass[objectType];
objectClass.directoryProcs ← CDDirectory.InstallDirectoryProcs[objectClass, dp ! CD.Error => CONTINUE];
};
CDEvents.RegisterEventProc[$AfterCellReplacement, FlushPropertiesAfterReplace];