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