module Geometry.Delaunay.Types
  (
    Site (..)
  , Simplex (..)
  , TileFacet (..)
  , Tile (..)
  , Tessellation (..)
  )
  where
import           Data.IntMap.Strict   ( IntMap )
import qualified Data.IntMap.Strict    as IM
import           Data.IntSet          ( IntSet )
import           Geometry.Qhull.Types ( HasCenter(..),
                                        HasVolume(..),
                                        HasEdges(..),
                                        HasVertices(..),
                                        HasNormal(..),
                                        HasFamily(..),
                                        Family,
                                        EdgeMap,
                                        IndexSet,
                                        IndexMap )

data Site = Site {
    Site -> [Double]
_point          :: [Double]
  , Site -> IndexSet
_neighsitesIds  :: IndexSet
  , Site -> IndexSet
_neighfacetsIds :: IntSet
  , Site -> IndexSet
_neightilesIds  :: IntSet
} deriving Int -> Site -> ShowS
[Site] -> ShowS
Site -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Site] -> ShowS
$cshowList :: [Site] -> ShowS
show :: Site -> String
$cshow :: Site -> String
showsPrec :: Int -> Site -> ShowS
$cshowsPrec :: Int -> Site -> ShowS
Show

data Simplex = Simplex {
    Simplex -> IndexMap [Double]
_vertices'    :: IndexMap [Double]
  , Simplex -> [Double]
_circumcenter :: [Double]
  , Simplex -> Double
_circumradius :: Double
  , Simplex -> Double
_volume'      :: Double
} deriving Int -> Simplex -> ShowS
[Simplex] -> ShowS
Simplex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Simplex] -> ShowS
$cshowList :: [Simplex] -> ShowS
show :: Simplex -> String
$cshow :: Simplex -> String
showsPrec :: Int -> Simplex -> ShowS
$cshowsPrec :: Int -> Simplex -> ShowS
Show

instance HasCenter Simplex where
  _center :: Simplex -> [Double]
_center = Simplex -> [Double]
_circumcenter

instance HasVertices Simplex where
  _vertices :: Simplex -> IndexMap [Double]
_vertices = Simplex -> IndexMap [Double]
_vertices'

instance HasVolume Simplex where
  _volume :: Simplex -> Double
_volume = Simplex -> Double
_volume'

data TileFacet = TileFacet {
    TileFacet -> Simplex
_subsimplex :: Simplex
  , TileFacet -> IndexSet
_facetOf    :: IntSet
  , TileFacet -> [Double]
_normal'    :: [Double]
  , TileFacet -> Double
_offset'    :: Double
} deriving Int -> TileFacet -> ShowS
[TileFacet] -> ShowS
TileFacet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TileFacet] -> ShowS
$cshowList :: [TileFacet] -> ShowS
show :: TileFacet -> String
$cshow :: TileFacet -> String
showsPrec :: Int -> TileFacet -> ShowS
$cshowsPrec :: Int -> TileFacet -> ShowS
Show

instance HasNormal TileFacet where
  _normal :: TileFacet -> [Double]
_normal = TileFacet -> [Double]
_normal'
  _offset :: TileFacet -> Double
_offset = TileFacet -> Double
_offset'

instance HasVertices TileFacet where
  _vertices :: TileFacet -> IndexMap [Double]
_vertices = Simplex -> IndexMap [Double]
_vertices' forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFacet -> Simplex
_subsimplex

instance HasVolume TileFacet where
  _volume :: TileFacet -> Double
_volume = Simplex -> Double
_volume' forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFacet -> Simplex
_subsimplex

instance HasCenter TileFacet where
  _center :: TileFacet -> [Double]
_center = Simplex -> [Double]
_circumcenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFacet -> Simplex
_subsimplex

data Tile = Tile {
    Tile -> Simplex
_simplex      :: Simplex
  , Tile -> IndexSet
_neighborsIds :: IntSet
  , Tile -> IndexSet
_facetsIds    :: IntSet
  , Tile -> Family
_family'      :: Family
  , Tile -> Bool
_toporiented  :: Bool
} deriving Int -> Tile -> ShowS
[Tile] -> ShowS
Tile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tile] -> ShowS
$cshowList :: [Tile] -> ShowS
show :: Tile -> String
$cshow :: Tile -> String
showsPrec :: Int -> Tile -> ShowS
$cshowsPrec :: Int -> Tile -> ShowS
Show

instance HasFamily Tile where
  _family :: Tile -> Family
_family = Tile -> Family
_family'

instance HasVertices Tile where
  _vertices :: Tile -> IndexMap [Double]
_vertices = Simplex -> IndexMap [Double]
_vertices' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tile -> Simplex
_simplex

instance HasVolume Tile where
  _volume :: Tile -> Double
_volume = Simplex -> Double
_volume' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tile -> Simplex
_simplex

instance HasCenter Tile where
  _center :: Tile -> [Double]
_center = Simplex -> [Double]
_circumcenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tile -> Simplex
_simplex

data Tessellation = Tessellation {
    Tessellation -> IndexMap Site
_sites      :: IndexMap Site
  , Tessellation -> IntMap Tile
_tiles      :: IntMap Tile
  , Tessellation -> IntMap TileFacet
_tilefacets :: IntMap TileFacet
  , Tessellation -> EdgeMap
_edges'     :: EdgeMap
} deriving Int -> Tessellation -> ShowS
[Tessellation] -> ShowS
Tessellation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tessellation] -> ShowS
$cshowList :: [Tessellation] -> ShowS
show :: Tessellation -> String
$cshow :: Tessellation -> String
showsPrec :: Int -> Tessellation -> ShowS
$cshowsPrec :: Int -> Tessellation -> ShowS
Show

instance HasEdges Tessellation where
  _edges :: Tessellation -> EdgeMap
_edges = Tessellation -> EdgeMap
_edges'

instance HasVertices Tessellation where
  _vertices :: Tessellation -> IndexMap [Double]
_vertices Tessellation
tess = forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Site -> [Double]
_point (Tessellation -> IndexMap Site
_sites Tessellation
tess)

instance HasVolume Tessellation where
  _volume :: Tessellation -> Double
_volume Tessellation
tess = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a. IntMap a -> [a]
IM.elems forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (Simplex -> Double
_volume' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tile -> Simplex
_simplex) (Tessellation -> IntMap Tile
_tiles Tessellation
tess))