--------------------------------------------------------------------------------
-- |
-- Module : Geometry.SetOperations.Volume
-- Copyright : (C) 2017 Maksymilian Owsianny
-- License : BSD-style (see LICENSE)
-- Maintainer : Maksymilian.Owsianny@gmail.com
--
-- Set Operations of Polytopes by Boundary Filtering.
--
--------------------------------------------------------------------------------
module Geometry.SetOperations.Volume
( Volume (..)
, makeVolume
, emptyVolume
, mergeVolumes
, Volume2D, Volume3D
) where
import Protolude
import Linear (V2, V3)
import Geometry.SetOperations.Merge
import Geometry.SetOperations.Types
import Geometry.SetOperations.BSP
import Geometry.SetOperations.Facet
import Geometry.SetOperations.Clip
import Geometry.Plane.General
--------------------------------------------------------------------------------
-- | Volume, currently represented as a list of Facets and a BSP Tree.
data Volume b v n = Volume
{ volumeFacets :: [Facet b v n]
, volumeTree :: BSP (Plane v n)
}
type Volume2D = Volume (FB2 V2 Double) V2 Double
type Volume3D = Volume (FB3 V3 Double) V3 Double
-- | Construct Volume from a list of Facets representing it's boundary.
makeVolume :: Clip b v n => [Facet b v n] -> Volume b v n
makeVolume fs = Volume fs (constructBSP facetPlane fs)
-- | Empty volume.
emptyVolume :: Volume b v n
emptyVolume = Volume [] Out
--------------------------------------------------------------------------------
{-# SPECIALIZE
mergeVolumes :: SetOperation -> Volume2D -> Volume2D -> Volume2D #-}
{-# SPECIALIZE
mergeVolumes :: SetOperation -> Volume3D -> Volume3D -> Volume3D #-}
-- | Merge two Volumes under a specified Set Operation.
mergeVolumes :: (Clip b v n, Functor v, Num n)
=> SetOperation -> Volume b v n -> Volume b v n -> Volume b v n
mergeVolumes op volumeA volumeB = case op of
Difference -> filterBoth isOut isInFlip
Intersection -> filterBoth isIn isIn
Union -> filterBoth isOut isOut
SymmetricDifference -> filterBoth isEither isEither
where
isInFlip x fs = case x of Red -> []; Green -> map flipFacet fs
isIn x fs = case x of Red -> []; Green -> fs
isOut x fs = case x of Red -> fs; Green -> []
isEither x fs = case x of Red -> fs; Green -> map flipFacet fs
Volume facetsA treeA = volumeA
Volume facetsB treeB = volumeB
filterBoth f g = makeVolume $
filterWith f facetsA treeB <>
filterWith g facetsB treeA
filterWith _ [] _ = []
filterWith f fs t = case t of
Leaf x -> f x fs
Node treeL p treeR ->
filterWith f partL treeL <>
filterWith f partR treeR
where (partL, partR) = splitWith (splitFacet p) fs