module Data.Glome.Csg (difference, intersection) where import Data.Glome.Vec import Data.Glome.Solid import Data.List -- Constructive Solid Geometry -- (boolean operations for solids) -- todo: implement shadow tests data Difference = Difference SolidItem SolidItem deriving Show data Intersection = Intersection [SolidItem] deriving Show --Difference-- -- | Create a new object based on the subtraction of the second item -- from the first. This only works if the items have a well-defined -- inside and outside. Triangles and discs, for instance, have no -- volume, so subtracting them from anything won't do anything. difference :: SolidItem -> SolidItem -> SolidItem difference a b = SolidItem $ Difference a b rayint_difference :: Difference -> Ray -> Flt -> Texture -> Rayint rayint_difference dif@(Difference sa sb) r@(Ray orig dir) d t = let ria = rayint sa r d t in case ria of RayMiss -> RayMiss RayHit ad ap an at -> if inside sb orig then case rayint sb r d t of RayMiss -> RayMiss RayHit bd bp bn bt -> if bd < ad then if inside sa bp then RayHit bd bp (vinvert bn) bt else rayint_advance (SolidItem dif) r d t bd else rayint_advance (SolidItem dif) r d t bd else if inside sb ap then rayint_advance (SolidItem dif) r d t ad else RayHit ad ap an at --Intersection-- -- | Create a new item from the boolean intersection of a -- list of solids. A point is inside the object iff it is -- inside every primitive. We can construct polyhedra from -- intersections of planes, but this isn't the most efficient -- way to do that. intersection :: [SolidItem] -> SolidItem intersection slds = SolidItem $ Intersection slds -- fixme: there's some numerical instability near edges rayint_intersection :: Intersection -> Ray -> Flt -> Texture -> Rayint rayint_intersection (Intersection slds) r@(Ray orig dir) d t = if null slds || d < 0 then RayMiss else let s = head slds in case tail slds of [] -> rayint s r d t ss -> if inside s orig then case rayint s r d t of RayMiss -> rayint (Intersection ss) r d t RayHit sd sp sn st -> case rayint (Intersection ss) r sd t of RayMiss -> rayint_advance (SolidItem (Intersection slds)) r d t sd hit -> hit else case rayint s r d t of RayMiss -> RayMiss RayHit sd sp sn st -> if inside (Intersection ss) sp then RayHit sd sp sn st else rayint_advance (SolidItem (Intersection slds)) r d t sd inside_difference :: Difference -> Vec -> Bool inside_difference (Difference sa sb) pt = (inside sa pt) && (not $ inside sb pt) -- note: inside is True for an empty intersection. -- this is actually the preferred semantics in -- some cases, strange as it may seem. inside_intersection :: Intersection -> Vec -> Bool inside_intersection (Intersection slds) pt = foldl' (&&) True (map (\x -> inside x pt) slds) bound_difference :: Difference -> Bbox bound_difference (Difference sa sb) = bound sa bound_intersection :: Intersection -> Bbox bound_intersection (Intersection slds) = if null slds then empty_bbox else foldl' bboverlap everything_bbox (map bound slds) primcount_difference :: Difference -> Pcount primcount_difference (Difference sa sb) = pcadd (primcount sa) (primcount sb) primcount_intersection :: Intersection -> Pcount primcount_intersection (Intersection slds) = foldl (pcadd) pcnone (map primcount slds) instance Solid Difference where rayint = rayint_difference inside = inside_difference bound = bound_difference primcount = primcount_difference instance Solid Intersection where rayint = rayint_intersection inside = inside_intersection bound = bound_intersection primcount = primcount_intersection