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