-- {-# LINE 1 "delaunay.hsc" #-}

{-# LANGUAGE ForeignFunctionInterface #-}
module Geometry.Delaunay.CDelaunay
  ( 
    cTessellationToTessellation
  , c_tessellation 
  )
  where
import           Control.Monad              ( (<$!>) )
import qualified Data.HashMap.Strict.InsOrd as H
import           Data.IntMap.Strict         ( fromAscList, (!) )
import qualified Data.IntSet                as IS
import           Data.List                  ( findIndex )
import           Data.Maybe                 ( fromJust, isJust )
import           Data.Tuple.Extra           ( both, fst3, snd3, thd3, (&&&) )
import           Geometry.Delaunay.Types    ( Tessellation(..),
                                              Tile(..),
                                              TileFacet(..),
                                              Simplex(..),
                                              Site(..) )
import           Foreign  ( Ptr,
                            Storable(pokeByteOff, poke, peek, alignment, sizeOf, peekByteOff),
                            peekArray )
import           Foreign.C.Types            ( CInt, CDouble(..), CUInt(..) )
import           Geometry.Qhull.Types       ( Family(Family, None), IndexPair(Pair) )

data CSite = CSite {
    CSite -> CUInt
__id             :: CUInt
  , CSite -> Ptr CUInt
__neighsites     :: Ptr CUInt
  , CSite -> CUInt
__nneighsites    :: CUInt
  , CSite -> Ptr CUInt
__neighridgesids :: Ptr CUInt
  , CSite -> CUInt
__nneighridges   :: CUInt
  , CSite -> Ptr CUInt
__neightiles     :: Ptr CUInt
  , CSite -> CUInt
__nneightiles    :: CUInt
}

instance Storable CSite where
    sizeOf :: CSite -> Key
sizeOf    CSite
__ = (Key
56)
-- {-# LINE 29 "delaunay.hsc" #-}

    alignment :: CSite -> Key
alignment CSite
__ = Key
8
-- {-# LINE 30 "delaunay.hsc" #-}

    peek :: Ptr CSite -> IO CSite
peek Ptr CSite
ptr = do
      CUInt
id'              <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
0) Ptr CSite
ptr
-- {-# LINE 32 "delaunay.hsc" #-}

      Ptr CUInt
neighsites'      <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
8) Ptr CSite
ptr
-- {-# LINE 33 "delaunay.hsc" #-}

      CUInt
nneighsites'     <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
16) Ptr CSite
ptr
-- {-# LINE 34 "delaunay.hsc" #-}

      Ptr CUInt
neighridgesids'  <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
24) Ptr CSite
ptr
-- {-# LINE 35 "delaunay.hsc" #-}

      CUInt
nneighridges'    <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
32) Ptr CSite
ptr
-- {-# LINE 36 "delaunay.hsc" #-}

      Ptr CUInt
neightiles'      <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
40) Ptr CSite
ptr
-- {-# LINE 37 "delaunay.hsc" #-}

      CUInt
nneightiles'     <- (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSite
hsc_ptr Key
48) Ptr CSite
ptr
-- {-# LINE 38 "delaunay.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CSite { __id :: CUInt
__id             = CUInt
id'
                   , __neighsites :: Ptr CUInt
__neighsites     = Ptr CUInt
neighsites'
                   , __nneighsites :: CUInt
__nneighsites    = CUInt
nneighsites'
                   , __neighridgesids :: Ptr CUInt
__neighridgesids = Ptr CUInt
neighridgesids'
                   , __nneighridges :: CUInt
__nneighridges   = CUInt
nneighridges'
                   , __neightiles :: Ptr CUInt
__neightiles     = Ptr CUInt
neightiles'
                   , __nneightiles :: CUInt
__nneightiles    = CUInt
nneightiles'
                  }
    poke :: Ptr CSite -> CSite -> IO ()
poke Ptr CSite
ptr (CSite CUInt
r1 Ptr CUInt
r2 CUInt
r3 Ptr CUInt
r4 CUInt
r5 Ptr CUInt
r6 CUInt
r7)
      = do
          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
0) Ptr CSite
ptr CUInt
r1
-- {-# LINE 49 "delaunay.hsc" #-}

          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
8) Ptr CSite
ptr Ptr CUInt
r2
-- {-# LINE 50 "delaunay.hsc" #-}

          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
16) Ptr CSite
ptr CUInt
r3
-- {-# LINE 51 "delaunay.hsc" #-}

          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
24) Ptr CSite
ptr Ptr CUInt
r4
-- {-# LINE 52 "delaunay.hsc" #-}

          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
32) Ptr CSite
ptr CUInt
r5
-- {-# LINE 53 "delaunay.hsc" #-}

          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
40) Ptr CSite
ptr Ptr CUInt
r6
-- {-# LINE 54 "delaunay.hsc" #-}

          (\Ptr CSite
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSite
hsc_ptr Key
48) Ptr CSite
ptr CUInt
r7
-- {-# LINE 55 "delaunay.hsc" #-}


cSiteToSite :: [[Double]] -> CSite -> IO (Int, Site, [(Int,Int)])
cSiteToSite :: [[Double]] -> CSite -> IO (Key, Site, [(Key, Key)])
cSiteToSite [[Double]]
sites CSite
csite = do
  let id' :: Key
id'          = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSite -> CUInt
__id CSite
csite
      nneighsites :: Key
nneighsites  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSite -> CUInt
__nneighsites CSite
csite
      nneighridges :: Key
nneighridges = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSite -> CUInt
__nneighridges CSite
csite
      nneightiles :: Key
nneightiles  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSite -> CUInt
__nneightiles CSite
csite
      point :: [Double]
point        = [[Double]]
sites forall a. [a] -> Key -> a
!! Key
id'
  [Key]
neighsites <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                       (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nneighsites (CSite -> Ptr CUInt
__neighsites CSite
csite))
  [Key]
neighridges <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                        (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nneighridges (CSite -> Ptr CUInt
__neighridgesids CSite
csite))
  [Key]
neightiles <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                       (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nneightiles (CSite -> Ptr CUInt
__neightiles CSite
csite))
  forall (m :: * -> *) a. Monad m => a -> m a
return ( Key
id'
         , Site {
                  _point :: [Double]
_point          = [Double]
point
                , _neighsitesIds :: IndexSet
_neighsitesIds  = [Key] -> IndexSet
IS.fromAscList [Key]
neighsites
                , _neighfacetsIds :: IndexSet
_neighfacetsIds = [Key] -> IndexSet
IS.fromAscList [Key]
neighridges
                , _neightilesIds :: IndexSet
_neightilesIds  = [Key] -> IndexSet
IS.fromAscList [Key]
neightiles
                }
         , forall a b. (a -> b) -> [a] -> [b]
map (\Key
j -> (Key
id', Key
j)) (Key -> [Key] -> [Key]
filterAscList Key
id' [Key]
neighsites) )
  where
    filterAscList :: Int -> [Int] -> [Int]
    filterAscList :: Key -> [Key] -> [Key]
filterAscList Key
n [Key]
list =
      let i :: Maybe Key
i = forall a. (a -> Bool) -> [a] -> Maybe Key
findIndex (forall a. Ord a => a -> a -> Bool
> Key
n) [Key]
list in
      if forall a. Maybe a -> Bool
isJust Maybe Key
i
        then forall a. Key -> [a] -> [a]
drop (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Key
i) [Key]
list
        else []

data CSimplex = CSimplex {
    CSimplex -> Ptr CUInt
__sitesids :: Ptr CUInt
  , CSimplex -> Ptr CDouble
__center   :: Ptr CDouble
  , CSimplex -> CDouble
__radius   :: CDouble
  , CSimplex -> CDouble
__volume   :: CDouble
}

instance Storable CSimplex where
    sizeOf :: CSimplex -> Key
sizeOf    CSimplex
__ = (Key
32)
-- {-# LINE 85 "delaunay.hsc" #-}

    alignment :: CSimplex -> Key
alignment CSimplex
__ = Key
8
-- {-# LINE 86 "delaunay.hsc" #-}

    peek :: Ptr CSimplex -> IO CSimplex
peek Ptr CSimplex
ptr = do
      Ptr CUInt
sitesids'    <- (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSimplex
hsc_ptr Key
0) Ptr CSimplex
ptr
-- {-# LINE 88 "delaunay.hsc" #-}

      Ptr CDouble
center'      <- (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSimplex
hsc_ptr Key
8) Ptr CSimplex
ptr
-- {-# LINE 89 "delaunay.hsc" #-}

      CDouble
radius'      <- (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSimplex
hsc_ptr Key
16) Ptr CSimplex
ptr
-- {-# LINE 90 "delaunay.hsc" #-}

      CDouble
volume'      <- (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSimplex
hsc_ptr Key
24) Ptr CSimplex
ptr
-- {-# LINE 91 "delaunay.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CSimplex { __sitesids :: Ptr CUInt
__sitesids    = Ptr CUInt
sitesids'
                      , __center :: Ptr CDouble
__center      = Ptr CDouble
center'
                      , __radius :: CDouble
__radius      = CDouble
radius'
                      , __volume :: CDouble
__volume      = CDouble
volume'
                    }
    poke :: Ptr CSimplex -> CSimplex -> IO ()
poke Ptr CSimplex
ptr (CSimplex Ptr CUInt
r1 Ptr CDouble
r2 CDouble
r3 CDouble
r4)
      = do
          (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSimplex
hsc_ptr Key
0) Ptr CSimplex
ptr Ptr CUInt
r1
-- {-# LINE 99 "delaunay.hsc" #-}

          (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSimplex
hsc_ptr Key
8) Ptr CSimplex
ptr Ptr CDouble
r2
-- {-# LINE 100 "delaunay.hsc" #-}

          (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSimplex
hsc_ptr Key
16) Ptr CSimplex
ptr CDouble
r3
-- {-# LINE 101 "delaunay.hsc" #-}

          (\Ptr CSimplex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSimplex
hsc_ptr Key
24) Ptr CSimplex
ptr CDouble
r4
-- {-# LINE 102 "delaunay.hsc" #-}


cSimplexToSimplex :: [[Double]] -> Int -> CSimplex -> IO Simplex
cSimplexToSimplex :: [[Double]] -> Key -> CSimplex -> IO Simplex
cSimplexToSimplex [[Double]]
sites Key
simplexdim CSimplex
csimplex = do
  let radius :: Double
radius      = CDouble -> Double
cdbl2dbl forall a b. (a -> b) -> a -> b
$ CSimplex -> CDouble
__radius CSimplex
csimplex
      volume :: Double
volume      = CDouble -> Double
cdbl2dbl forall a b. (a -> b) -> a -> b
$ CSimplex -> CDouble
__volume CSimplex
csimplex
      dim :: Key
dim         = forall (t :: * -> *) a. Foldable t => t a -> Key
length (forall a. [a] -> a
head [[Double]]
sites)
  [Key]
sitesids <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                     (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
simplexdim (CSimplex -> Ptr CUInt
__sitesids CSimplex
csimplex))
  let points :: IntMap [Double]
points = forall a. [(Key, a)] -> IntMap a
fromAscList
               (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
sitesids (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Key -> a
(!!) [[Double]]
sites) [Key]
sitesids))
  [Double]
center <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map CDouble -> Double
cdbl2dbl) (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
dim (CSimplex -> Ptr CDouble
__center CSimplex
csimplex))
  forall (m :: * -> *) a. Monad m => a -> m a
return Simplex { _vertices' :: IntMap [Double]
_vertices'       = IntMap [Double]
points
                 , _circumcenter :: [Double]
_circumcenter = [Double]
center
                 , _circumradius :: Double
_circumradius = Double
radius
                 , _volume' :: Double
_volume'       = Double
volume }
  where
    cdbl2dbl :: CDouble -> Double
    cdbl2dbl :: CDouble -> Double
cdbl2dbl CDouble
x = if forall a. RealFloat a => a -> Bool
isNaN CDouble
x then Double
0forall a. Fractional a => a -> a -> a
/Double
0 else forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x

data CSubTile = CSubTile {
    CSubTile -> CUInt
__id'        :: CUInt
  , CSubTile -> CSimplex
__subsimplex :: CSimplex
  , CSubTile -> CUInt
__ridgeOf1   :: CUInt
  , CSubTile -> CInt
__ridgeOf2   :: CInt
  , CSubTile -> Ptr CDouble
__normal     :: Ptr CDouble
  , CSubTile -> CDouble
__offset     :: CDouble
}

instance Storable CSubTile where
    sizeOf :: CSubTile -> Key
sizeOf    CSubTile
__ = (Key
72)
-- {-# LINE 132 "delaunay.hsc" #-}

    alignment :: CSubTile -> Key
alignment CSubTile
__ = Key
8
-- {-# LINE 133 "delaunay.hsc" #-}

    peek :: Ptr CSubTile -> IO CSubTile
peek Ptr CSubTile
ptr = do
      CUInt
id'       <- (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSubTile
hsc_ptr Key
0) Ptr CSubTile
ptr
-- {-# LINE 135 "delaunay.hsc" #-}

      CSimplex
simplex'  <- (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSubTile
hsc_ptr Key
8) Ptr CSubTile
ptr
-- {-# LINE 136 "delaunay.hsc" #-}

      CUInt
ridgeOf1' <- (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSubTile
hsc_ptr Key
40) Ptr CSubTile
ptr
-- {-# LINE 137 "delaunay.hsc" #-}

      CInt
ridgeOf2' <- (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSubTile
hsc_ptr Key
44) Ptr CSubTile
ptr
-- {-# LINE 138 "delaunay.hsc" #-}

      Ptr CDouble
normal'   <- (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSubTile
hsc_ptr Key
48) Ptr CSubTile
ptr
-- {-# LINE 139 "delaunay.hsc" #-}

      CDouble
offset'   <- (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CSubTile
hsc_ptr Key
56) Ptr CSubTile
ptr
-- {-# LINE 140 "delaunay.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CSubTile { __id' :: CUInt
__id'        = CUInt
id'
                      , __subsimplex :: CSimplex
__subsimplex = CSimplex
simplex'
                      , __ridgeOf1 :: CUInt
__ridgeOf1   = CUInt
ridgeOf1'
                      , __ridgeOf2 :: CInt
__ridgeOf2   = CInt
ridgeOf2'
                      , __normal :: Ptr CDouble
__normal     = Ptr CDouble
normal'
                      , __offset :: CDouble
__offset     = CDouble
offset' }
    poke :: Ptr CSubTile -> CSubTile -> IO ()
poke Ptr CSubTile
ptr (CSubTile CUInt
r1 CSimplex
r2 CUInt
r3 CInt
r4 Ptr CDouble
r5 CDouble
r6)
      = do
          (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSubTile
hsc_ptr Key
0) Ptr CSubTile
ptr CUInt
r1
-- {-# LINE 149 "delaunay.hsc" #-}

          (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSubTile
hsc_ptr Key
8) Ptr CSubTile
ptr CSimplex
r2
-- {-# LINE 150 "delaunay.hsc" #-}

          (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSubTile
hsc_ptr Key
40) Ptr CSubTile
ptr CUInt
r3
-- {-# LINE 151 "delaunay.hsc" #-}

          (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSubTile
hsc_ptr Key
44) Ptr CSubTile
ptr CInt
r4
-- {-# LINE 152 "delaunay.hsc" #-}

          (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSubTile
hsc_ptr Key
48) Ptr CSubTile
ptr Ptr CDouble
r5
-- {-# LINE 153 "delaunay.hsc" #-}

          (\Ptr CSubTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CSubTile
hsc_ptr Key
56) Ptr CSubTile
ptr CDouble
r6
-- {-# LINE 154 "delaunay.hsc" #-}


cSubTiletoTileFacet :: [[Double]] -> CSubTile -> IO (Int, TileFacet)
cSubTiletoTileFacet :: [[Double]] -> CSubTile -> IO (Key, TileFacet)
cSubTiletoTileFacet [[Double]]
points CSubTile
csubtile = do
  let dim :: Key
dim        = forall (t :: * -> *) a. Foldable t => t a -> Key
length (forall a. [a] -> a
head [[Double]]
points)
      ridgeOf1 :: Key
ridgeOf1   = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSubTile -> CUInt
__ridgeOf1 CSubTile
csubtile
      ridgeOf2 :: Key
ridgeOf2   = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSubTile -> CInt
__ridgeOf2 CSubTile
csubtile
      ridgeOf :: [Key]
ridgeOf    = if Key
ridgeOf2 forall a. Eq a => a -> a -> Bool
== -Key
1 then [Key
ridgeOf1] else [Key
ridgeOf1, Key
ridgeOf2]
      id' :: Key
id'        = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CSubTile -> CUInt
__id' CSubTile
csubtile
      subsimplex :: CSimplex
subsimplex = CSubTile -> CSimplex
__subsimplex CSubTile
csubtile
      offset :: Double
offset     = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ CSubTile -> CDouble
__offset CSubTile
csubtile
  Simplex
simplex <- [[Double]] -> Key -> CSimplex -> IO Simplex
cSimplexToSimplex [[Double]]
points Key
dim CSimplex
subsimplex
  [Double]
normal <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac) (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
dim (CSubTile -> Ptr CDouble
__normal CSubTile
csubtile))
  forall (m :: * -> *) a. Monad m => a -> m a
return (Key
id', TileFacet { _subsimplex :: Simplex
_subsimplex = Simplex
simplex
                         , _facetOf :: IndexSet
_facetOf    = [Key] -> IndexSet
IS.fromAscList [Key]
ridgeOf
                         , _normal' :: [Double]
_normal'     = [Double]
normal
                         , _offset' :: Double
_offset'     = Double
offset })

data CTile = CTile {
    CTile -> CUInt
__id''        :: CUInt
  , CTile -> CSimplex
__simplex     :: CSimplex
  , CTile -> Ptr CUInt
__neighbors   :: Ptr CUInt
  , CTile -> CUInt
__nneighbors  :: CUInt
  , CTile -> Ptr CUInt
__ridgesids   :: Ptr CUInt
  , CTile -> CUInt
__nridges     :: CUInt
  , CTile -> CInt
__family      :: CInt
  , CTile -> CInt
__orientation :: CInt
}

instance Storable CTile where
    sizeOf :: CTile -> Key
sizeOf    CTile
__ = (Key
80)
-- {-# LINE 184 "delaunay.hsc" #-}

    alignment :: CTile -> Key
alignment CTile
__ = Key
8
-- {-# LINE 185 "delaunay.hsc" #-}

    peek :: Ptr CTile -> IO CTile
peek Ptr CTile
ptr = do
      CUInt
id'         <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
0) Ptr CTile
ptr
-- {-# LINE 187 "delaunay.hsc" #-}

      CSimplex
simplex'    <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
8) Ptr CTile
ptr
-- {-# LINE 188 "delaunay.hsc" #-}

      Ptr CUInt
neighbors'  <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
40) Ptr CTile
ptr
-- {-# LINE 189 "delaunay.hsc" #-}

      CUInt
nneighbors' <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
48) Ptr CTile
ptr
-- {-# LINE 190 "delaunay.hsc" #-}

      Ptr CUInt
ridgesids'  <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
56) Ptr CTile
ptr
-- {-# LINE 191 "delaunay.hsc" #-}

      CUInt
nridges'    <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
64) Ptr CTile
ptr
-- {-# LINE 192 "delaunay.hsc" #-}

      CInt
family'     <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
68) Ptr CTile
ptr
-- {-# LINE 193 "delaunay.hsc" #-}

      CInt
orient      <- (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTile
hsc_ptr Key
72) Ptr CTile
ptr
-- {-# LINE 194 "delaunay.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CTile { __id'' :: CUInt
__id''        = CUInt
id'
                   , __simplex :: CSimplex
__simplex     = CSimplex
simplex'
                   , __neighbors :: Ptr CUInt
__neighbors   = Ptr CUInt
neighbors'
                   , __nneighbors :: CUInt
__nneighbors  = CUInt
nneighbors'
                   , __ridgesids :: Ptr CUInt
__ridgesids   = Ptr CUInt
ridgesids'
                   , __nridges :: CUInt
__nridges     = CUInt
nridges'
                   , __family :: CInt
__family      = CInt
family'
                   , __orientation :: CInt
__orientation = CInt
orient
                  }
    poke :: Ptr CTile -> CTile -> IO ()
poke Ptr CTile
ptr (CTile CUInt
r1 CSimplex
r2 Ptr CUInt
r3 CUInt
r4 Ptr CUInt
r5 CUInt
r6 CInt
r7 CInt
r8)
      = do
          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
0) Ptr CTile
ptr CUInt
r1
-- {-# LINE 206 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
8) Ptr CTile
ptr CSimplex
r2
-- {-# LINE 207 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
40) Ptr CTile
ptr Ptr CUInt
r3
-- {-# LINE 208 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
48) Ptr CTile
ptr CUInt
r4
-- {-# LINE 209 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
56) Ptr CTile
ptr Ptr CUInt
r5
-- {-# LINE 210 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
64) Ptr CTile
ptr CUInt
r6
-- {-# LINE 211 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
68) Ptr CTile
ptr CInt
r7
-- {-# LINE 212 "delaunay.hsc" #-}

          (\Ptr CTile
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTile
hsc_ptr Key
72) Ptr CTile
ptr CInt
r8
-- {-# LINE 213 "delaunay.hsc" #-}


cTileToTile :: [[Double]] -> CTile -> IO (Int, Tile)
cTileToTile :: [[Double]] -> CTile -> IO (Key, Tile)
cTileToTile [[Double]]
points CTile
ctile = do
  let id' :: Key
id'        = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTile -> CUInt
__id'' CTile
ctile
      csimplex :: CSimplex
csimplex   = CTile -> CSimplex
__simplex CTile
ctile
      nneighbors :: Key
nneighbors = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTile -> CUInt
__nneighbors CTile
ctile
      nridges :: Key
nridges    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTile -> CUInt
__nridges CTile
ctile
      family :: CInt
family     = CTile -> CInt
__family CTile
ctile
      orient :: CInt
orient     = CTile -> CInt
__orientation CTile
ctile
      dim :: Key
dim        = forall (t :: * -> *) a. Foldable t => t a -> Key
length (forall a. [a] -> a
head [[Double]]
points)
  Simplex
simplex <- [[Double]] -> Key -> CSimplex -> IO Simplex
cSimplexToSimplex [[Double]]
points (Key
dimforall a. Num a => a -> a -> a
+Key
1) CSimplex
csimplex
  [Key]
neighbors <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                      (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nneighbors (CTile -> Ptr CUInt
__neighbors CTile
ctile))
  [Key]
ridgesids <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                      (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nridges (CTile -> Ptr CUInt
__ridgesids CTile
ctile))
  forall (m :: * -> *) a. Monad m => a -> m a
return (Key
id', Tile {  _simplex :: Simplex
_simplex      = Simplex
simplex
                     , _neighborsIds :: IndexSet
_neighborsIds = [Key] -> IndexSet
IS.fromAscList [Key]
neighbors
                     , _facetsIds :: IndexSet
_facetsIds    = [Key] -> IndexSet
IS.fromAscList [Key]
ridgesids
                     , _family' :: Family
_family'       = if CInt
family forall a. Eq a => a -> a -> Bool
== -CInt
1
                                        then Family
None
                                        else Key -> Family
Family (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
family)
                     , _toporiented :: Bool
_toporiented  = CInt
orient forall a. Eq a => a -> a -> Bool
== CInt
1 })

data CTessellation = CTessellation {
    CTessellation -> Ptr CSite
__sites     :: Ptr CSite
  , CTessellation -> Ptr CTile
__tiles     :: Ptr CTile
  , CTessellation -> CUInt
__ntiles    :: CUInt
  , CTessellation -> Ptr CSubTile
__subtiles  :: Ptr CSubTile
  , CTessellation -> CUInt
__nsubtiles :: CUInt
}

instance Storable CTessellation where
    sizeOf :: CTessellation -> Key
sizeOf    CTessellation
__ = (Key
40)
-- {-# LINE 246 "delaunay.hsc" #-}

    alignment :: CTessellation -> Key
alignment CTessellation
__ = Key
8
-- {-# LINE 247 "delaunay.hsc" #-}

    peek :: Ptr CTessellation -> IO CTessellation
peek Ptr CTessellation
ptr = do
      Ptr CSite
sites'     <- (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTessellation
hsc_ptr Key
0) Ptr CTessellation
ptr
-- {-# LINE 249 "delaunay.hsc" #-}

      Ptr CTile
tiles'     <- (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTessellation
hsc_ptr Key
8) Ptr CTessellation
ptr
-- {-# LINE 250 "delaunay.hsc" #-}

      CUInt
ntiles'    <- (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTessellation
hsc_ptr Key
16) Ptr CTessellation
ptr
-- {-# LINE 251 "delaunay.hsc" #-}

      Ptr CSubTile
subtiles'  <- (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTessellation
hsc_ptr Key
24) Ptr CTessellation
ptr
-- {-# LINE 252 "delaunay.hsc" #-}

      CUInt
nsubtiles' <- (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CTessellation
hsc_ptr Key
32) Ptr CTessellation
ptr
-- {-# LINE 253 "delaunay.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CTessellation {
                     __sites :: Ptr CSite
__sites     = Ptr CSite
sites'
                   , __tiles :: Ptr CTile
__tiles     = Ptr CTile
tiles'
                   , __ntiles :: CUInt
__ntiles    = CUInt
ntiles'
                   , __subtiles :: Ptr CSubTile
__subtiles  = Ptr CSubTile
subtiles'
                   , __nsubtiles :: CUInt
__nsubtiles = CUInt
nsubtiles'
                  }
    poke :: Ptr CTessellation -> CTessellation -> IO ()
poke Ptr CTessellation
ptr (CTessellation Ptr CSite
r1 Ptr CTile
r2 CUInt
r3 Ptr CSubTile
r4 CUInt
r5)
      = do
          (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTessellation
hsc_ptr Key
0) Ptr CTessellation
ptr Ptr CSite
r1
-- {-# LINE 263 "delaunay.hsc" #-}

          (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTessellation
hsc_ptr Key
8) Ptr CTessellation
ptr Ptr CTile
r2
-- {-# LINE 264 "delaunay.hsc" #-}

          (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTessellation
hsc_ptr Key
16) Ptr CTessellation
ptr CUInt
r3
-- {-# LINE 265 "delaunay.hsc" #-}

          (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTessellation
hsc_ptr Key
24) Ptr CTessellation
ptr Ptr CSubTile
r4
-- {-# LINE 266 "delaunay.hsc" #-}

          (\Ptr CTessellation
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CTessellation
hsc_ptr Key
32) Ptr CTessellation
ptr CUInt
r5
-- {-# LINE 267 "delaunay.hsc" #-}


foreign import ccall unsafe "tessellation" c_tessellation
  :: Ptr CDouble -- sites

  -> CUInt       -- dim

  -> CUInt       -- nsites

  -> CUInt       -- 0/1, point at infinity

  -> CUInt       -- 0/1, include degenerate

  -> CDouble     -- volume threshold

  -> Ptr CUInt   -- exitcode

  -> IO (Ptr CTessellation)

cTessellationToTessellation :: [[Double]] -> CTessellation -> IO Tessellation
cTessellationToTessellation :: [[Double]] -> CTessellation -> IO Tessellation
cTessellationToTessellation [[Double]]
vertices CTessellation
ctess = do
  let ntiles :: Key
ntiles    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTessellation -> CUInt
__ntiles CTessellation
ctess
      nsubtiles :: Key
nsubtiles = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CTessellation -> CUInt
__nsubtiles CTessellation
ctess
      nsites :: Key
nsites    = forall (t :: * -> *) a. Foldable t => t a -> Key
length [[Double]]
vertices
  [CSite]
sites''    <- forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nsites (CTessellation -> Ptr CSite
__sites CTessellation
ctess)
  [CTile]
tiles''    <- forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
ntiles (CTessellation -> Ptr CTile
__tiles CTessellation
ctess)
  [CSubTile]
subtiles'' <- forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nsubtiles (CTessellation -> Ptr CSubTile
__subtiles CTessellation
ctess)
  [(Key, Site, [(Key, Key)])]
sites'     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([[Double]] -> CSite -> IO (Key, Site, [(Key, Key)])
cSiteToSite [[Double]]
vertices) [CSite]
sites''
  let sites :: IntMap Site
sites = forall a. [(Key, a)] -> IntMap a
fromAscList (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a, b, c) -> a
fst3 forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& forall a b c. (a, b, c) -> b
snd3) [(Key, Site, [(Key, Key)])]
sites')
      edgesIndices :: [(Key, Key)]
edgesIndices = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b c. (a, b, c) -> c
thd3 [(Key, Site, [(Key, Key)])]
sites'
      edges :: [(IndexPair, ([Double], [Double]))]
edges = forall a b. (a -> b) -> [a] -> [b]
map ((Key, Key) -> IndexPair
toPair forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& forall a b. (a -> b) -> (a, a) -> (b, b)
both (Site -> [Double]
_point forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IntMap a -> Key -> a
(!) IntMap Site
sites))) [(Key, Key)]
edgesIndices
  [(Key, Tile)]
tiles'     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([[Double]] -> CTile -> IO (Key, Tile)
cTileToTile [[Double]]
vertices) [CTile]
tiles''
  [(Key, TileFacet)]
subtiles'  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([[Double]] -> CSubTile -> IO (Key, TileFacet)
cSubTiletoTileFacet [[Double]]
vertices) [CSubTile]
subtiles''
  forall (m :: * -> *) a. Monad m => a -> m a
return Tessellation
         { _sites :: IntMap Site
_sites      = IntMap Site
sites
         , _tiles :: IntMap Tile
_tiles      = forall a. [(Key, a)] -> IntMap a
fromAscList [(Key, Tile)]
tiles'
         , _tilefacets :: IntMap TileFacet
_tilefacets = forall a. [(Key, a)] -> IntMap a
fromAscList [(Key, TileFacet)]
subtiles'
         , _edges' :: EdgeMap
_edges'     = forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
H.fromList [(IndexPair, ([Double], [Double]))]
edges }
  where
    toPair :: (Key, Key) -> IndexPair
toPair (Key
i,Key
j) = Key -> Key -> IndexPair
Pair Key
i Key
j