BagnessImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Bruce Wagar August 15, 1987 1:01:20 pm PDT
Implementation of the bagness data structures and associated routines.
DIRECTORY
CDBasics, CoreGeometry, Bagness, PrincOps, RefTab;
BagnessImpl: CEDAR PROGRAM
IMPORTS
CDBasics, CoreGeometry, RefTab
EXPORTS
Bagness
= BEGIN OPEN Bagness;
Instances: TYPE = CoreGeometry.Instances;
Bag Procs
BagKeepProc: TYPE = PROC [bag: Bag] RETURNS [keep: BOOL ← TRUE];
BagIsNotEmpty: PUBLIC PROC [bag: Bag] RETURNS [BOOL] = {
Decides if bag is not empty.
RETURN [bag.head # NIL]
};
BagTouchesInstance: PUBLIC PROC [bag: Bag, instance: Instance, touch: TouchProc] RETURNS [BOOL ← FALSE] = {
Decides if instance touches an instance of bag.
IF CDBasics.Intersect[r1: bag.bbox, r2: CoreGeometry.BBox[instance: instance]] THEN
RETURN [CoreGeometry.TouchList[touch: touch, instances: bag.head, instance: instance]]
};
BagTouchesBag: PUBLIC PROC [bag1, bag2: Bag, touch: TouchProc] RETURNS [BOOL ← FALSE] = {
Decides if any instance of bag1 touches an instance of bag2.
IF CDBasics.Intersect[r1: bag1.bbox, r2: bag2.bbox] THEN
FOR insts: Instances ← bag2.head, insts.rest UNTIL insts = NIL DO
IF BagTouchesInstance[bag: bag1, instance: insts.first, touch: touch] THEN
RETURN [TRUE]
ENDLOOP
};
CreateBag: PUBLIC PROC [] RETURNS [Bag] = {
Returns a new empty bag.
RETURN [[head: NIL, tail: NIL, bbox: CDBasics.empty]]
};
InsertInstance: PUBLIC PROC [bag: Bag, instance: Instance] RETURNS [Bag] = {
Inserts instance into bag.
IF bag.head = NIL
THEN
bag.head ← bag.tail ← LIST[instance]
ELSE
bag.head ← CONS[instance, bag.head];
bag.bbox ← CDBasics.Surround[r1: bag.bbox, r2: CoreGeometry.BBox[instance: instance]];
RETURN [bag]
};
BagAppend: PUBLIC PROC [onto, from: Bag] RETURNS [Bag] = {
Destructive appending of onto and from.
IF onto.head = NIL THEN
RETURN [from];
IF from.head = NIL THEN
RETURN [onto];
onto.tail.rest ← from.head;
onto.tail ← from.tail;
onto.bbox ← CDBasics.Surround[r1: onto.bbox, r2: from.bbox];
RETURN [onto]
};
BagPrune: PUBLIC PROC [bag: Bag, keep: InstKeepProc] RETURNS [Bag] = {
Deletes all instances from bag which don't satisfy keep and updates bbox.
bag.bbox ← CDBasics.empty;
UNTIL bag.head = NIL OR keep[instance: bag.head.first] DO
bag.head ← bag.head.rest
ENDLOOP;
IF bag.head # NIL THEN {
bag.tail ← bag.head;
bag.bbox ← CoreGeometry.BBox[instance: bag.head.first];
UNTIL bag.tail.rest = NIL DO
IF keep[instance: bag.tail.rest.first]
THEN {
bag.bbox ← CDBasics.Surround[r1: bag.bbox, r2: CoreGeometry.BBox[instance: bag.tail.rest.first]];
bag.tail ← bag.tail.rest
}
ELSE
bag.tail.rest ← bag.tail.rest.rest
ENDLOOP
};
RETURN [bag]
};
TransformBag: PUBLIC PROC [bag: Bag, trans: Transformation] RETURNS [Bag] = {
Returns a copy of bag with trans applied to each instance. Reverses order of instances.
head: Instances ← bag.head;
IF head # NIL THEN {
bag.head ← bag.tail ← LIST[CoreGeometry.Transform[trans: trans, instance: head.first]];
UNTIL (head ← head.rest) = NIL DO
bag.head ← CONS[CoreGeometry.Transform[trans: trans, instance: head.first], bag.head]
ENDLOOP;
bag.bbox ← CDBasics.MapRect[itemInCell: bag.bbox, cellInWorld: trans]
};
RETURN [bag]
};
BagList Procs
BagCount: PUBLIC PROC [bagList: BagList] RETURNS [count: NAT ← 0] = {
Returns the number of bags in bagList.
FOR bags: Bags ← bagList.bags, bags.rest UNTIL bags = NIL DO
count ← count + 1;
ENDLOOP
};
FuseInstance: PUBLIC PROC [bagList: BagList, instance: Instance, touch: TouchProc] RETURNS [BagList] = {
Destructive fusion of instance into bagList.
IF CDBasics.Intersect[r1: bagList.bbox, r2: CoreGeometry.BBox[instance: instance]]
THEN
FOR bags: Bags ← bagList.bags, bags.rest UNTIL bags = NIL DO
IF BagTouchesInstance[bag: bags.first, instance: instance, touch: touch] THEN
GO TO foundBag;
REPEAT
foundBag => {
bags2: Bags ← bags;
bags.first ← InsertInstance[bag: bags.first, instance: instance];
UNTIL bags2.rest = NIL DO -- fuse with other bags
IF BagTouchesInstance[bag: bags2.rest.first, instance: instance, touch: touch]
THEN {
bags.first ← BagAppend[onto: bags.first, from: bags2.rest.first];
bags2.rest ← bags2.rest.rest
}
ELSE
bags2 ← bags2.rest
ENDLOOP
};
FINISHED => -- otherwise, create new bag
bagList.bags ← CONS[InsertInstance[bag: CreateBag[], instance: instance], bagList.bags];
ENDLOOP
ELSE
bagList.bags ← CONS[InsertInstance[bag: CreateBag[], instance: instance], bagList.bags];
bagList.bbox ← CDBasics.Surround[r1: bagList.bbox, r2: CoreGeometry.BBox[instance: instance]];
RETURN [bagList]
};
FuseBag: PROC [bagList: BagList, bag: Bag, touch: TouchProc] RETURNS [BagList] = {
Destructive fusion of bagList and bag. Not efficient for fusing lists of bags.
FOR bags: Bags ← bagList.bags, bags.rest UNTIL bags = NIL DO
IF BagTouchesBag[bag1: bag, bag2: bags.first, touch: touch] THEN
GO TO foundBag;
REPEAT
foundBag => { -- bag touches an existing bag
bags2: Bags ← bags;
UNTIL bags2.rest = NIL DO -- fuse with other bags
IF BagTouchesBag[bag1: bag, bag2: bags2.rest.first, touch: touch]
THEN { -- fuse bags
bags.first ← BagAppend[onto: bags.first, from: bags2.rest.first];
bags2.rest ← bags2.rest.rest
}
ELSE
bags2 ← bags2.rest
ENDLOOP;
bags.first ← BagAppend[onto: bags.first, from: bag]
};
FINISHED => -- new bag
bagList.bags ← CONS[bag, bagList.bags];
ENDLOOP;
bagList.bbox ← CDBasics.Surround[r1: bagList.bbox, r2: bag.bbox];
RETURN [bagList]
};
FuseBagList: PUBLIC PROC [bagList1, bagList2: BagList, touch: TouchProc] RETURNS [BagList] = {
Destructive fusion of bagList1 and bagList2.
IF bagList2.bags = NIL THEN
RETURN [bagList1];
IF bagList1.bags = NIL THEN
RETURN [bagList2];
IF NOT CDBasics.Intersect[r1: bagList1.bbox, r2: bagList2.bbox] THEN
RETURN [MergeBagList[bagList1: bagList1, bagList2: bagList2]];
IF bagList2.bags.rest = NIL THEN
RETURN [FuseBag[bagList: bagList1, bag: bagList2.bags.first, touch: touch]];
IF bagList1.bags.rest = NIL THEN
RETURN [FuseBag[bagList: bagList2, bag: bagList1.bags.first, touch: touch]];
RETURN [FuseNontrivialBagList[bagList1: bagList1, bagList2: bagList2, touch: touch]]
};
FuseNontrivialBagList: PROC [bagList1, bagList2: BagList, touch: TouchProc] RETURNS [BagList] = {
More efficient destructive fusion of bagList1 and bagList2 when both overlap and contain several bags.
FuseNextBag: PROC [bag: Bag] = {
Destructive fusion of bagList1 and bag.
tempBags2: Bags ← tempBags;
FOR bags: Bags ← bagList1.bags, bags.rest UNTIL bags = NIL DO
IF BagTouchesBag[bag1: bag, bag2: bags.first, touch: touch] THEN
GO TO foundBag;
tempBags2 ← tempBags2.rest;
REPEAT
foundBag => { -- bag touches an existing bag
bags2: Bags ← bags;
tempBags3: Bags ← tempBags2;
UNTIL bags2.rest = NIL DO -- fuse with other bags
IF BagTouchesBag[bag1: bag, bag2: bags2.rest.first, touch: touch]
THEN {
bags.first ← BagAppend[onto: bags.first, from: bags2.rest.first];
tempBags2.first ← BagAppend[onto: tempBags2.first, from: tempBags3.rest.first];
bags2.rest ← bags2.rest.rest;
tempBags3.rest ← tempBags3.rest.rest
}
ELSE {
bags2 ← bags2.rest;
tempBags3 ← tempBags3.rest
}
ENDLOOP;
tempBags2.first ← BagAppend[onto: tempBags2.first, from: bag];
RETURN
};
FINISHED => { -- create new bag
bagList1.bags ← CONS[CreateBag[], bagList1.bags];
tempBags ← CONS[bag, tempBags]
};
ENDLOOP
};
tempBags: Bags ← NIL;
FOR bags: Bags ← bagList1.bags, bags.rest UNTIL bags = NIL DO
tempBags ← CONS[CreateBag[], tempBags]
ENDLOOP;
FOR bags: Bags ← bagList2.bags, bags.rest UNTIL bags = NIL DO
FuseNextBag[bag: bags.first]
ENDLOOP;
FOR bags: Bags ← bagList1.bags, bags.rest UNTIL bags = NIL DO
bags.first ← BagAppend[onto: bags.first, from: tempBags.first];
tempBags ← tempBags.rest
ENDLOOP;
bagList1.bbox ← CDBasics.Surround[r1: bagList1.bbox, r2: bagList2.bbox];
RETURN [bagList1]
};
MergeBagList: PUBLIC PROC [bagList1, bagList2: BagList] RETURNS [BagList] = {
Destructive merge of bagList1 and bagList2. Runs faster when bagList1 is shorter.
IF bagList2.bags = NIL
THEN
RETURN [bagList1]
ELSE {
bags: Bags ← bagList1.bags;
UNTIL bags = NIL DO
temp: Bags ← bags;
bags ← bags.rest;
temp.rest ← bagList2.bags;
bagList2.bags ← temp
ENDLOOP;
bagList2.bbox ← CDBasics.Surround[r1: bagList1.bbox, r2: bagList2.bbox];
RETURN [bagList2]
};
};
CreateBagList: PUBLIC PROC [] RETURNS [BagList] = {
Returns a new empty bagList.
RETURN [[bags: NIL, bbox: CDBasics.empty]]
};
InsertBag: PUBLIC PROC [bagList: BagList, bag: Bag] RETURNS [BagList] = {
Inserts bag into bagList.
bagList.bags ← CONS[bag, bagList.bags];
bagList.bbox ← CDBasics.Surround[r1: bagList.bbox, r2: bag.bbox];
RETURN [bagList]
};
TransformBagList: PUBLIC PROC [bagList: BagList, trans: Transformation] RETURNS [newBagList: BagList] = {
Returns a copy of bagList with trans applied to every bag.
newBagList ← CreateBagList[];
FOR bags: Bags ← bagList.bags, bags.rest UNTIL bags = NIL DO
newBagList.bags ← CONS[TransformBag[bag: bags.first, trans: trans], newBagList.bags]
ENDLOOP;
newBagList.bbox ← CDBasics.MapRect[itemInCell: bagList.bbox, cellInWorld: trans]
};
PruneBagList: PROC [bagList: BagList, keep: BagKeepProc] RETURNS [BagList] = {
Deletes all bags from bagList which don't satisfy keep. Doesn't update bbox.
UNTIL bagList.bags = NIL OR keep[bag: bagList.bags.first] DO
bagList.bags ← bagList.bags.rest
ENDLOOP;
IF bagList.bags # NIL
THEN {
bags: Bags ← bagList.bags;
UNTIL bags.rest = NIL DO
IF keep[bag: bags.rest.first]
THEN
bags ← bags.rest
ELSE
bags.rest ← bags.rest.rest
ENDLOOP
};
RETURN [bagList]
};
PruneInstances: PUBLIC PROC [bagList: BagList, keep: InstKeepProc] RETURNS [BagList] = {
Deletes all instances from bagList which don't satisfy keep and updates bbox.
bagList.bbox ← CDBasics.empty;
FOR bags: Bags ← bagList.bags, bags.rest UNTIL bags = NIL DO
bags.first ← BagPrune[bag: bags.first, keep: keep];
bagList.bbox ← CDBasics.Surround[r1: bagList.bbox, r2: bags.first.bbox]
ENDLOOP;
RETURN [PruneBagList[bagList: bagList, keep: BagIsNotEmpty]]
};
InstTab Procs
RefInstance: TYPE = REF Instance;
RefInstanceEqual: RefTab.EqualProc = {
Decides whether two RefInstances are the same.
ref1: RefInstance ← NARROW[key1];
ref2: RefInstance ← NARROW[key2];
RETURN [ref1^ = ref2^]
};
RefInstanceHash: RefTab.HashProc = {
Hashes RefInstance.
ref: RefInstance ← NARROW[key];
RETURN [
Mush[ref.obj.bbox.x2] + Mush[ref.obj.bbox.y2]
+ Mush[ref.trans.off.x] + Mush[ref.trans.off.y]
+ Mush[ORD[ref.trans.orient]]]
};
Mush: PROC [int: INT32] RETURNS [CARD16] = TRUSTED MACHINE CODE { PrincOps.zXOR };
XOR's together the two 16-bit halves of an INT32 into a single CARD16, promoting a good efficient hash function without possibility of bounds checking problems.
InstTabCreate: PUBLIC PROC [mod: NAT ← 17] RETURNS [InstTab] = {
Creates new table with suggested initial hash size.
RETURN [RefTab.Create[mod: mod, equal: RefInstanceEqual, hash: RefInstanceHash]]
};
InstTabFetch: PUBLIC PROC [instTab: InstTab, inst: Instance] RETURNS [found: BOOL, val: Val] = {
Returns TRUE and sends back associated value iff inst is in instTab.
RETURN RefTab.Fetch[x: instTab, key: NEW[Instance ← inst]]
};
InstTabReplace: PUBLIC PROC [instTab: InstTab, inst: Instance, val: Val ← NIL] RETURNS [BOOL] = {
Returns TRUE after overwriting old value for existing inst-value pair.
If no previous value for inst, returns FALSE without inserting new pair.
RETURN [RefTab.Replace[x: instTab, key: NEW[Instance ← inst], val: val]]
};
InstTabDelete: PUBLIC PROC [instTab: InstTab, inst: Instance] RETURNS [BOOL] = {
Deletes inst-value pair associated with given inst.
Returns TRUE if deletion actually occurred, FALSE if no such inst.
RETURN [RefTab.Delete[x: instTab, key: NEW[Instance ← inst]]]
};
InstTabInsert: PUBLIC PROC [instTab: InstTab, inst: Instance, val: Val ← NIL] RETURNS [BOOL] = {
Returns TRUE after inserted new pair.
If previous value existed for key, returns FALSE without changing value.
RETURN [RefTab.Insert[x: instTab, key: NEW[Instance ← inst], val: val]]
};
END.