> module Merge Module deals with the merging of BSP trees > (union,intersection,subtract_YORK,complement) > where > import BSPT (BSPT(..),Status(..),bsp',bsp'',mkCell,partFaces,foldBSPT) > import EuclidGMS (Point,Line,Face(..),Region,Location(..),Partition,Faces, > newRegion,getPart,bisect,location,section,flip_YORK, Segment) > import Stdlib (mappair) > import GeomNum > import Libfuns > -- -------- Type decls ------------------------ Definitions of boolean operators. Note use of higher order function merge. > union :: BSPT -> BSPT -> BSPT > union = merge rules > where > rules :: BSPT -> BSPT -> BSPT > rules cell@(Cell In _ _) tree = cell > rules cell@(Cell Out _ _) tree = tree > rules tree cell@(Cell In _ _) = cell > rules tree cell@(Cell Out _ _) = tree > intersection :: BSPT -> BSPT -> BSPT > intersection = merge rules > where > rules :: BSPT -> BSPT -> BSPT > rules cell@(Cell In _ _) tree = tree > rules cell@(Cell Out _ _) tree = cell > rules tree cell@(Cell In _ _) = tree > rules tree cell@(Cell Out _ _) = cell > subtract_YORK :: BSPT -> BSPT -> BSPT > subtract_YORK x y = intersection x (complement y) merge - Merge is a higher order function that produces either the intersection or the union of the objects according to the function passed in. Merger effectively merges two BSPT trees into one. This Note the basic algorithm is to split one BSP into two by partitioning by the root partition of the other (function partTree) and then to merge the respective halves of each. When one tree is found to be a cell the merge is dependent on the semantics of op. Note bsp'' is used to used to reconstruct the tree - this maintains credibility of sub-hyperplane data, it also removes redundant partitions. > merge :: (BSPT -> BSPT -> BSPT) -> BSPT -> BSPT -> BSPT > merge op (Cell x r a) tree = op (Cell x r a) tree > merge op tree (Cell x r a) = op tree (Cell x r a) > merge op (BSP p nodeinfo left right) tree > = bsp'' p nodeinfo left' right' > where > left'= merge op left rear > right'= merge op right fore > (rear,fore) = partTree p tree partTree - partitions a single BSPT into two BSP trees. The half in positive halfspace of p and the half in the negative halfspace of p where p is the partition. The partitioning is dependent on the relationship of the root partitions of the the trees involved on the region in question. The function classify returns the appropriate partitioning function - this is then applied to the tree. > partTree :: Partition -> BSPT -> (BSPT,BSPT) > partTree part (Cell x region a) = (mkCell x (newRegion region part), > mkCell x (newRegion region (flip_YORK part))) > partTree part@(Fc sp p) tree@(BSP (Fc st t) (_,region) _ _) > = case (location p st, location t sp) of > (Coincident,_) -> if p==t > then onParallel part tree > else onAntiparallel part tree > (ToTheFore,ToTheFore) -> pinPostinPos part tree > (ToTheFore,ToTheRear) -> pinNegtinPos part tree > (ToTheRear,ToTheFore) -> pinPostinNeg part tree > (ToTheRear,ToTheRear) -> pinNegtinNeg part tree > (_,_) -> inBoth part tree partitioning functions - depending on the classification, the appropriate partitioning function produces two tree from the argument tree. These are the rear and fore of the tree with respect to the partition > onParallel :: Partition -> BSPT -> (BSPT,BSPT) > onParallel p (BSP t _ rear fore) = (rear,fore) > onAntiparallel :: Partition -> BSPT -> (BSPT,BSPT) > onAntiparallel p (BSP t _ rear fore) = (fore,rear) > pinPostinNeg :: Partition -> BSPT -> (BSPT,BSPT) > pinPostinNeg p (BSP t (faces,region) tRear tFore) > = (bsp' t (faces,newRegion region p) tRear tForepRear, > tForepFore) > where > (tForepRear,tForepFore) = partTree p tFore > pinPostinPos :: Partition -> BSPT -> (BSPT,BSPT) > pinPostinPos p (BSP t (faces,region) tRear tFore) > = (tForepRear, > bsp' t (faces,newRegion region (flip_YORK p)) tRear tForepFore) > where > (tForepRear,tForepFore) = partTree p tFore > pinNegtinPos :: Partition -> BSPT -> (BSPT,BSPT) > pinNegtinPos p (BSP t (faces,region) tRear tFore) > = (tRearpRear, > bsp' t (faces,newRegion region (flip_YORK p)) tRearpFore tFore) > where > (tRearpRear,tRearpFore) = partTree p tRear > pinNegtinNeg :: Partition -> BSPT -> (BSPT,BSPT) > pinNegtinNeg p (BSP t (faces,region) tRear tFore) > = (bsp' t (faces,newRegion region p) tRearpRear tFore, > tRearpFore) > where > (tRearpRear,tRearpFore) = partTree p tRear > inBoth :: Partition -> BSPT -> (BSPT,BSPT) > inBoth p (BSP t (faces,region) tRear tFore) > = (bsp' tLeft (rearFaces,leftRegion) tRearpRear tForepRear, > bsp' tRight (foreFaces,rightRegion) tRearpFore tForepFore) > where > (tRearpRear,tRearpFore) = partTree pLeft tRear > (tForepRear,tForepFore) = partTree pRight tFore > (rearFaces,_,foreFaces) = partFaces p' faces > (leftRegion,rightRegion) = mappair (newRegion region) (pLeft,pRight) > (tLeft,tRight) = bisect t p' > (pLeft,pRight) = bisect p (getPart t) > p' = getPart p complement - invert a BSPT - NB: faces not reversed > complement :: BSPT -> BSPT > complement = foldBSPT compCell BSP > where > compCell In = Cell Out > compCell Out = Cell In