```--------------------------------------------------------------------------------
-- |
-- Module     : Geometry.SetOperations.Volume
-- Copyright  : (C) 2017 Maksymilian Owsianny
-- 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

```