DIRECTORY
CDBasics, CoreGeometry, Bagness, PrincOps, RefTab;

BagnessImpl: CEDAR PROGRAM
IMPORTS 
CDBasics, CoreGeometry, RefTab
EXPORTS 
Bagness
= BEGIN OPEN Bagness;

Instances: TYPE = CoreGeometry.Instances;
BagKeepProc: TYPE = PROC [bag: Bag] RETURNS [keep: BOOL _ TRUE];

BagIsNotEmpty: PUBLIC PROC [bag: Bag] RETURNS [BOOL] = {
RETURN [bag.head # NIL]
};
BagTouchesInstance: PUBLIC PROC [bag: Bag, instance: Instance, touch: TouchProc] RETURNS [BOOL _ FALSE] = {
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] = {
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] = {
RETURN [[head: NIL, tail: NIL, bbox: CDBasics.empty]]
};

InsertInstance: PUBLIC PROC [bag: Bag, instance: Instance] RETURNS [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] = {
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] = {
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] = {
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]
};
BagCount: PUBLIC PROC [bagList: BagList] RETURNS [count: NAT _ 0] = {
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] = {
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] = {
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] = {
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] = {
FuseNextBag: PROC [bag: 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] = {
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] = {
RETURN [[bags: NIL, bbox: CDBasics.empty]]
};
InsertBag: PUBLIC PROC [bagList: BagList, bag: Bag] RETURNS [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] = {
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] = {
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] = {
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]]
};

RefInstance: TYPE = REF Instance;

RefInstanceEqual: RefTab.EqualProc = {
ref1: RefInstance _ NARROW[key1];
ref2: RefInstance _ NARROW[key2];
RETURN [ref1^ = ref2^]
};

RefInstanceHash: RefTab.HashProc = {
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 };

InstTabCreate: PUBLIC PROC [mod: NAT _ 17] RETURNS [InstTab] = {
RETURN [RefTab.Create[mod: mod, equal: RefInstanceEqual, hash: RefInstanceHash]]
};

InstTabFetch: PUBLIC PROC [instTab: InstTab, inst: Instance] RETURNS [found: BOOL, val: Val] = {
RETURN RefTab.Fetch[x: instTab, key: NEW[Instance _ inst]]
};

InstTabReplace: PUBLIC PROC [instTab: InstTab, inst: Instance, val: Val _ NIL] RETURNS [BOOL] = {
RETURN [RefTab.Replace[x: instTab, key: NEW[Instance _ inst], val: val]]
};

InstTabDelete: PUBLIC PROC [instTab: InstTab, inst: Instance] RETURNS [BOOL] = {
RETURN [RefTab.Delete[x: instTab, key: NEW[Instance _ inst]]]
};

InstTabInsert: PUBLIC PROC [instTab: InstTab, inst: Instance, val: Val _ NIL] RETURNS [BOOL] = {
RETURN [RefTab.Insert[x: instTab, key: NEW[Instance _ inst], val: val]]
};

END.
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.

Bag Procs
Decides if bag is not empty.

Decides if instance touches an instance of bag.

Decides if any instance of bag1 touches an instance of bag2.

Returns a new empty bag.
Inserts instance into bag.

Destructive appending of onto and from.

Deletes all instances from bag which don't satisfy keep and updates bbox.

Returns a copy of bag with trans applied to each instance.  Reverses order of instances.

BagList Procs
Returns the number of bags in bagList.
Destructive fusion of instance into bagList.
Destructive fusion of bagList and bag.  Not efficient for fusing lists of bags.
Destructive fusion of bagList1 and bagList2.
More efficient destructive fusion of bagList1 and bagList2 when both overlap and contain several bags.
Destructive fusion of bagList1 and bag.
Destructive merge of bagList1 and bagList2.  Runs faster when bagList1 is shorter.

Returns a new empty bagList.

Inserts bag into bagList.

Returns a copy of bagList with trans applied to every bag.
Deletes all bags from bagList which don't satisfy keep.  Doesn't update bbox.
Deletes all instances from bagList which don't satisfy keep and updates bbox.
InstTab Procs
Decides whether two RefInstances are the same.

Hashes RefInstance.
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.
Creates new table with suggested initial hash size.
Returns TRUE and sends back associated value iff inst is in instTab.
Returns TRUE after overwriting old value for existing inst-value pair.
If no previous value for inst, returns FALSE without inserting new pair.
Deletes inst-value pair associated with given inst.
Returns TRUE if deletion actually occurred, FALSE if no such inst.
Returns TRUE after inserted new pair.
If previous value existed for key, returns FALSE without changing value.
Κ$˜
codeš
œ™Kš
œ<™<Kš
œ*™*—K™K™FK™š
Οk	˜	Kš
œ2˜2—K˜KšΡblnœœ
˜šœ
˜Kš
œ˜—šœ
˜Kš
œ˜—šœœ
œ	˜K˜Kšœœ˜)—
head™	Kšœ
œœœœœ˜@K˜š
Οn
œœ
œœœ˜8™Kšœ
œ
˜K˜—K™—šŸœœ
œ2œœœ˜k™/•StartOfExpansion#[instance: 
CoreGeometry.Instance]šœMœ
˜TKšœP˜V—K˜—K™—šŸ
œœ
œ%œœœ˜Y™<–m[touch: 
CoreGeometry.TouchProc, instances1: 
CoreGeometry.Instances, instances2: 
CoreGeometry.Instances]šœ2˜8šœ*œ	œ
˜AšœD˜JKšœœ
˜
—Kš
˜——K˜—K™—šŸ	œœ
œœ
˜+™Kšœ	œœ˜5K˜—K˜—šŸœœ
œ œ
˜L™šœ˜šœ
˜Kšœœ
˜$—š
˜Kšœœ˜$——K–#[instance: 
CoreGeometry.Instance]š
œV˜VKšœ˜K˜—K™—šŸ	œœ
œœ
˜:š
œ'™'šœ
œ
œ
˜Kšœ˜—šœ
œ
œ
˜Kšœ˜—Kš
œ˜Kš
œ˜K–#[instance: 
CoreGeometry.Instance]š
œ<˜<Kšœ˜
K˜—K™—šŸœœ
œ œ
˜F™IKš
œ˜šœœ
œ ˜9Kš
œ˜Kšœ
˜—šœœ
œ˜Kš
œ˜Kš
œ7˜7šœœ
˜šœ%˜'šœ˜Kš
œa˜aKš
œ˜K˜
—šœ
˜Kš
œ"˜"——Kš
˜—K˜—Kšœ˜K˜—K™—šŸœœ
œ#œ
˜M™XJš
œ˜šœœ
œ˜Kšœœ=˜Wšœœ
˜!KšœœF˜UKšœ
˜—Kš
œE˜EK˜—Kšœ˜K˜—K™——™
š
Ÿœœ
œœ	œ	˜E™&šœ&œœ
˜<Kš
œ˜Kš
˜—K˜—K˜—šŸœœ
œ:œ˜hš
œ,™,šœP˜Rš
˜šœ&œœ
˜<šœG˜MKšœ
œ
˜—š
˜š
œ
˜
Kš
œ˜Kš
œA˜Ašœœ
œΟc˜3šœM˜Ošœ˜Kš
œA˜AKš
œ˜K˜
—šœ
˜K˜——Kš
˜—Kš
œ˜—šœ ˜*KšœœE˜X——Kš
˜——šœ
˜KšœœE˜X——Kš
œ^˜^Kšœ
˜K˜—K˜—šŸœœ0œ˜Rš
œO™Ošœ&œœ
˜<šœ:œ
˜AKšœ
œ
˜—š
˜šœ ˜.Kš
œ˜šœœ
œ ˜3šœ?˜Ašœ 
˜Kš
œA˜AKš
œ˜K˜
—š
˜Kš
œ˜——Kšœ
˜—Kš
œ3˜3Kš
œ˜—šœ ˜Kšœœ˜'——Kšœ
˜—Kš
œA˜AKšœ
˜K˜—K˜—šŸœœ
œ1œ˜^™,šœœ
˜Kšœ˜—šœœ
˜Kšœ˜—šœ
œ:œ
˜EKšœ8˜>—šœœ
˜ KšœF˜L—šœœ
œ
˜!KšœF˜L—KšœN˜TK˜—K˜—šŸœœ1œ˜a™fšŸœœ˜ š
œ'™'Kš
œ˜šœ'œœ
˜=šœ:œ
˜AKšœ
œ
˜—Kš
œ˜š
˜šœ ˜.Kš
œ˜Kš
œ˜šœœ
œ ˜3šœ?˜Ašœ˜Kš
œA˜AKš
œO˜OKš
œ˜Kš
œ$˜$K˜
—šœ˜Kš
œ˜Kš
œ˜K˜
——Kšœ
˜—Kš
œ>˜>Kš
˜Kš
œ˜—šœ ˜!Kšœœ˜1Kšœœ˜Kš
œ˜——Kš
˜—K˜——Kšœœ
˜šœ'œœ
˜=Kšœœ˜&Kšœ
˜—šœ'œœ
˜=Kš
œ˜Kšœ
˜—šœ'œœ
˜=Kš
œ?˜?Kš
œ˜Kšœ
˜—Kš
œH˜HKšœ˜K˜—K˜—šŸœœ
œœ˜Mš
œR™Ršœ˜šœ
˜Kšœ˜—šœ˜Kš
œ˜šœœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
˜—Kš
œH˜HKšœ˜K˜——K˜K™——šŸ
œœ
œœ˜3™Kšœ	œ˜*K˜—K™—šŸ	œœ
œœ˜Iš
œ™Kšœœ˜'Kš
œA˜AKšœ
˜K˜—K™—šŸœœ
œ+œ˜i™:Kš
œ˜šœ&œœ
˜<Kšœœ>˜TKšœ
˜—Kš
œP˜PK˜—K˜—šŸœœ'œ˜N™Mšœœ
œ˜<Kš
œ ˜ Kšœ
˜—šœœ
˜šœ˜Kš
œ˜šœ
œ
˜šœ˜šœ
˜Kš
œ˜—šœ
˜Kš
œ˜——Kš
˜—Kš
œ˜——Kšœ
˜K˜—K˜—šŸœœ
œ(œ˜Xš
œM™MKš
œ˜šœ&œœ
˜<Kš
œ3˜3Kš
œG˜GKšœ
˜—Kšœ6˜<K˜—K˜——™
Kšœ
œœ
˜!K˜šŸœ˜&™.K™Kšœœ˜!Kšœœ˜!Kšœ˜K˜—K˜—šŸœ˜$™Kšœœ˜Kšœhœ˜…
K˜K˜——šŸœœœœœœ
œ
œ˜RKšœ(œœ[™ 
K˜—š
Ÿ
œœ
œœœ˜@š
œ3™3KšœJ˜PK˜—K˜—š
Ÿœœ
œ$œ	œ˜`šœœ8™DKšœœ˜:K˜—K˜—šŸœœ
œ/œœœ˜aKšœœ:™Fšœ'œ™HKšœ"œ˜HK˜—K˜—š
Ÿ
œœ
œ$œœ˜PKš
œ3™3šœœ œ™BKšœ!œ˜=K˜—K˜—šŸ
œœ
œ/œœœ˜`Kšœœ™%šœ+œ™HKšœ!œ˜GK˜—K˜——Kšœ
˜—…—&Ž<Θ