{- HLINT ignore "Avoid lambda using `infix`" -}
{- HLINT ignore "Use head" -}
-- {-# LINE 1 "convexhull.hsc" #-}

{-# LANGUAGE ForeignFunctionInterface #-}
module Geometry.ConvexHull.CConvexHull
  ( 
    cConvexHullToConvexHull
  , c_convexhull 
  )
  where
import           Control.Monad             ( (<$!>) )
import           Geometry.ConvexHull.Types ( ConvexHull(..)
                                           , Facet(..)
                                           , Ridge(..)
                                           , Vertex(..) )
import           Data.IntMap.Strict        ( IntMap, fromAscList )
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List                 ( zip4 )
import qualified Data.HashMap.Strict.InsOrd as H
import           Data.Tuple.Extra          ( both )
import           Foreign                   ( Ptr
                                           , Storable(
                                               pokeByteOff
                                             , poke
                                             , peek
                                             , alignment
                                             , sizeOf
                                             , peekByteOff
                                             )
                                           , peekArray )
import           Foreign.C.Types           ( CInt, CDouble, CUInt(..) )
import           Foreign.C.String          ( CString )
import           Geometry.Qhull.Types      ( Family(Family, None), IndexPair(Pair) )



data CVertex = CVertex {
    CVertex -> CUInt
__id :: CUInt
  , CVertex -> Ptr CDouble
__point :: Ptr CDouble
}

instance Storable CVertex where
    sizeOf :: CVertex -> Key
sizeOf    CVertex
__ = (Key
16)
-- {-# LINE 42 "convexhull.hsc" #-}

    alignment :: CVertex -> Key
alignment CVertex
__ = Key
8
-- {-# LINE 43 "convexhull.hsc" #-}

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

      Ptr CDouble
point'  <- (\Ptr CVertex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex
hsc_ptr Key
8) Ptr CVertex
ptr
-- {-# LINE 46 "convexhull.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CVertex { __id :: CUInt
__id = CUInt
id'
                     , __point :: Ptr CDouble
__point = Ptr CDouble
point' }
    poke :: Ptr CVertex -> CVertex -> IO ()
poke Ptr CVertex
ptr (CVertex CUInt
r1 Ptr CDouble
r2)
      = do
          (\Ptr CVertex
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex
hsc_ptr Key
0) Ptr CVertex
ptr CUInt
r1
-- {-# LINE 51 "convexhull.hsc" #-}

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


cVerticesToMap :: Int -> [CVertex] -> IO (IntMap [Double])
cVerticesToMap :: Key -> [CVertex] -> IO (IntMap [Double])
cVerticesToMap Key
dim [CVertex]
cvertices = do
  let ids :: [Key]
ids = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVertex -> CUInt
__id) [CVertex]
cvertices
  [[Double]]
points <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CVertex
cv -> 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 (CVertex -> Ptr CDouble
__point CVertex
cv)))
                 [CVertex]
cvertices
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [(Key, a)] -> IntMap a
IM.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ids [[Double]]
points)

cVerticesToMap' :: Int -> [CVertex] -> IO (IntMap [Double])
cVerticesToMap' :: Key -> [CVertex] -> IO (IntMap [Double])
cVerticesToMap' Key
dim [CVertex]
cvertices = do
  let ids :: [Key]
ids = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVertex -> CUInt
__id) [CVertex]
cvertices
  [[Double]]
points <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CVertex
cv -> 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 (CVertex -> Ptr CDouble
__point CVertex
cv)))
                 [CVertex]
cvertices
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [(Key, a)] -> IntMap a
fromAscList (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ids [[Double]]
points)

data CVertex' = CVertex' {
    CVertex' -> CUInt
__id' :: CUInt
  , CVertex' -> Ptr CDouble
__point' :: Ptr CDouble
  , CVertex' -> Ptr CUInt
__neighfacets :: Ptr CUInt
  , CVertex' -> CUInt
__nneighfacets :: CUInt
  , CVertex' -> Ptr CUInt
__neighvertices :: Ptr CUInt
  , CVertex' -> CUInt
__nneighvertices :: CUInt
  , CVertex' -> Ptr CUInt
__neighridges :: Ptr CUInt
  , CVertex' -> CUInt
__nneighridges :: CUInt
}

instance Storable CVertex' where
    sizeOf :: CVertex' -> Key
sizeOf    CVertex'
__ = (Key
64)
-- {-# LINE 80 "convexhull.hsc" #-}

    alignment :: CVertex' -> Key
alignment CVertex'
__ = Key
8
-- {-# LINE 81 "convexhull.hsc" #-}

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

      Ptr CDouble
point'           <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
8) Ptr CVertex'
ptr
-- {-# LINE 84 "convexhull.hsc" #-}

      Ptr CUInt
neighfacets'     <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
16) Ptr CVertex'
ptr
-- {-# LINE 85 "convexhull.hsc" #-}

      CUInt
nneighfacets'    <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
24) Ptr CVertex'
ptr
-- {-# LINE 86 "convexhull.hsc" #-}

      Ptr CUInt
neighvertices'   <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
32) Ptr CVertex'
ptr
-- {-# LINE 87 "convexhull.hsc" #-}

      CUInt
nneighsvertices' <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
40) Ptr CVertex'
ptr
-- {-# LINE 88 "convexhull.hsc" #-}

      Ptr CUInt
neighridges'     <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
48) Ptr CVertex'
ptr
-- {-# LINE 89 "convexhull.hsc" #-}

      CUInt
nneighridges'    <- (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CVertex'
hsc_ptr Key
56) Ptr CVertex'
ptr
-- {-# LINE 90 "convexhull.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CVertex' { __id' :: CUInt
__id'            = CUInt
id'
                      , __point' :: Ptr CDouble
__point'         = Ptr CDouble
point'
                      , __neighfacets :: Ptr CUInt
__neighfacets    = Ptr CUInt
neighfacets'
                      , __nneighfacets :: CUInt
__nneighfacets   = CUInt
nneighfacets'
                      , __neighvertices :: Ptr CUInt
__neighvertices  = Ptr CUInt
neighvertices'
                      , __nneighvertices :: CUInt
__nneighvertices = CUInt
nneighsvertices'
                      , __neighridges :: Ptr CUInt
__neighridges    = Ptr CUInt
neighridges'
                      , __nneighridges :: CUInt
__nneighridges   = CUInt
nneighridges'
                      }
    poke :: Ptr CVertex' -> CVertex' -> IO ()
poke Ptr CVertex'
ptr (CVertex' CUInt
r1 Ptr CDouble
r2 Ptr CUInt
r3 CUInt
r4 Ptr CUInt
r5 CUInt
r6 Ptr CUInt
r7 CUInt
r8)
      = do
          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
0) Ptr CVertex'
ptr CUInt
r1
-- {-# LINE 102 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
8) Ptr CVertex'
ptr Ptr CDouble
r2
-- {-# LINE 103 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
16) Ptr CVertex'
ptr Ptr CUInt
r3
-- {-# LINE 104 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
24) Ptr CVertex'
ptr CUInt
r4
-- {-# LINE 105 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
32) Ptr CVertex'
ptr Ptr CUInt
r5
-- {-# LINE 106 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
40) Ptr CVertex'
ptr CUInt
r6
-- {-# LINE 107 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
48) Ptr CVertex'
ptr Ptr CUInt
r7
-- {-# LINE 108 "convexhull.hsc" #-}

          (\Ptr CVertex'
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CVertex'
hsc_ptr Key
56) Ptr CVertex'
ptr CUInt
r8
-- {-# LINE 109 "convexhull.hsc" #-}


cVerticesToVertexMap :: Int -> [CVertex'] -> IO (IntMap Vertex)
cVerticesToVertexMap :: Key -> [CVertex'] -> IO (IntMap Vertex)
cVerticesToVertexMap Key
dim [CVertex']
cvertices = do
  let ids :: [Key]
ids             = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVertex' -> CUInt
__id') [CVertex']
cvertices
      nneighfacets :: [Key]
nneighfacets    = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVertex' -> CUInt
__nneighfacets) [CVertex']
cvertices
      nneighsvertices :: [Key]
nneighsvertices = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVertex' -> CUInt
__nneighvertices) [CVertex']
cvertices
      nneighridges :: [Key]
nneighridges    = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVertex' -> CUInt
__nneighridges) [CVertex']
cvertices
  [[Double]]
points <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CVertex'
cv -> 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 (CVertex' -> Ptr CDouble
__point' CVertex'
cv)))
                 [CVertex']
cvertices
  [[Key]]
neighfacets <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Key
i, CVertex'
cv) -> 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
i (CVertex' -> Ptr CUInt
__neighfacets CVertex'
cv)))
                       (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
nneighfacets [CVertex']
cvertices)
  [[Key]]
neighvertices <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Key
i, CVertex'
cv) ->
                          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
i (CVertex' -> Ptr CUInt
__neighvertices CVertex'
cv)))
                        (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
nneighsvertices [CVertex']
cvertices)
  [[Key]]
neighridges <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Key
i, CVertex'
cv) ->
                       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
i (CVertex' -> Ptr CUInt
__neighridges CVertex'
cv)))
                     (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
nneighridges [CVertex']
cvertices)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [(Key, a)] -> IntMap a
IM.fromList
           (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ids (forall a b. (a -> b) -> [a] -> [b]
map (\([Double]
pt, [Key]
fneighs, [Key]
vneighs, [Key]
eneighs) ->
                          Vertex { _point :: [Double]
_point         = [Double]
pt
                                 , _neighfacets :: IntSet
_neighfacets   = [Key] -> IntSet
IS.fromAscList [Key]
fneighs
                                 , _neighvertices :: IntSet
_neighvertices = [Key] -> IntSet
IS.fromAscList [Key]
vneighs
                                 , _neighridges :: IntSet
_neighridges   = [Key] -> IntSet
IS.fromAscList [Key]
eneighs })
                          (forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [[Double]]
points [[Key]]
neighfacets [[Key]]
neighvertices [[Key]]
neighridges)))

data CRidge = CRidge {
    CRidge -> Ptr CVertex
__rvertices :: Ptr CVertex
  , CRidge -> CUInt
__ridgeOf1 :: CUInt
  , CRidge -> CUInt
__ridgeOf2 :: CUInt
  , CRidge -> CUInt
__ridgeSize :: CUInt
  , CRidge -> CUInt
__ridgeid   :: CUInt
  , CRidge -> Ptr (Ptr CUInt)
__redges :: Ptr (Ptr CUInt)
  , CRidge -> CUInt
__nredges :: CUInt
}

instance Storable CRidge where
    sizeOf :: CRidge -> Key
sizeOf    CRidge
__ = (Key
40)
-- {-# LINE 149 "convexhull.hsc" #-}

    alignment :: CRidge -> Key
alignment CRidge
__ = Key
8
-- {-# LINE 150 "convexhull.hsc" #-}

    peek :: Ptr CRidge -> IO CRidge
peek Ptr CRidge
ptr = do
      Ptr CVertex
rvertices <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
0) Ptr CRidge
ptr
-- {-# LINE 152 "convexhull.hsc" #-}

      CUInt
ridgeOf1' <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
8) Ptr CRidge
ptr
-- {-# LINE 153 "convexhull.hsc" #-}

      CUInt
ridgeOf2' <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
12) Ptr CRidge
ptr
-- {-# LINE 154 "convexhull.hsc" #-}

      CUInt
ridgeSize <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
16) Ptr CRidge
ptr
-- {-# LINE 155 "convexhull.hsc" #-}

      CUInt
ridgeid   <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
20) Ptr CRidge
ptr
-- {-# LINE 156 "convexhull.hsc" #-}

      Ptr (Ptr CUInt)
edges'    <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
24) Ptr CRidge
ptr
-- {-# LINE 157 "convexhull.hsc" #-}

      CUInt
nedges'   <- (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CRidge
hsc_ptr Key
32) Ptr CRidge
ptr
-- {-# LINE 158 "convexhull.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CRidge { __rvertices :: Ptr CVertex
__rvertices = Ptr CVertex
rvertices
                    , __ridgeOf1 :: CUInt
__ridgeOf1  = CUInt
ridgeOf1'
                    , __ridgeOf2 :: CUInt
__ridgeOf2  = CUInt
ridgeOf2'
                    , __ridgeSize :: CUInt
__ridgeSize = CUInt
ridgeSize
                    , __ridgeid :: CUInt
__ridgeid   = CUInt
ridgeid
                    , __redges :: Ptr (Ptr CUInt)
__redges    = Ptr (Ptr CUInt)
edges'
                    , __nredges :: CUInt
__nredges   = CUInt
nedges' }
    poke :: Ptr CRidge -> CRidge -> IO ()
poke Ptr CRidge
ptr (CRidge Ptr CVertex
r1 CUInt
r2 CUInt
r3 CUInt
r4 CUInt
r5 Ptr (Ptr CUInt)
r6 CUInt
r7)
      = do
          (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CRidge
hsc_ptr Key
0) Ptr CRidge
ptr Ptr CVertex
r1
-- {-# LINE 168 "convexhull.hsc" #-}

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

          (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CRidge
hsc_ptr Key
12) Ptr CRidge
ptr CUInt
r3
-- {-# LINE 170 "convexhull.hsc" #-}

          (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CRidge
hsc_ptr Key
16) Ptr CRidge
ptr CUInt
r4
-- {-# LINE 171 "convexhull.hsc" #-}

          (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CRidge
hsc_ptr Key
20) Ptr CRidge
ptr CUInt
r5
-- {-# LINE 172 "convexhull.hsc" #-}

          (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CRidge
hsc_ptr Key
24) Ptr CRidge
ptr Ptr (Ptr CUInt)
r6
-- {-# LINE 173 "convexhull.hsc" #-}

          (\Ptr CRidge
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CRidge
hsc_ptr Key
32) Ptr CRidge
ptr CUInt
r7
-- {-# LINE 174 "convexhull.hsc" #-}


cRidgeToRidge :: Int -> CRidge -> IO (Int, Ridge)
cRidgeToRidge :: Key -> CRidge -> IO (Key, Ridge)
cRidgeToRidge Key
dim CRidge
cridge = do
  let f1 :: Key
f1     = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CRidge -> CUInt
__ridgeOf1 CRidge
cridge
      f2 :: Key
f2     = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CRidge -> CUInt
__ridgeOf2 CRidge
cridge
      n :: Key
n      = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CRidge -> CUInt
__ridgeSize CRidge
cridge
      rid :: Key
rid    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CRidge -> CUInt
__ridgeid CRidge
cridge
      nedges :: Key
nedges = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CRidge -> CUInt
__nredges CRidge
cridge
  [CVertex]
vertices <- forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
n (CRidge -> Ptr CVertex
__rvertices CRidge
cridge)
  IntMap [Double]
rvertices <- Key -> [CVertex] -> IO (IntMap [Double])
cVerticesToMap' Key
dim [CVertex]
vertices
  [(Key, Key)]
edges' <- if Key
dim forall a. Ord a => a -> a -> Bool
> Key
3
            then forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map (\[CUInt]
x -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUInt]
xforall a. [a] -> Key -> a
!!Key
0), forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUInt]
xforall a. [a] -> Key -> a
!!Key
1))))
                        (forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
2))
                               (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nedges (CRidge -> Ptr (Ptr CUInt)
__redges CRidge
cridge)))
            else forall (m :: * -> *) a. Monad m => a -> m a
return []
  let edges :: InsOrdHashMap IndexPair ([Double], [Double])
edges = if Key
dim forall a. Ord a => a -> a -> Bool
> Key
3
              then forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
H.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (\(Key
i,Key
j) -> Key -> Key -> IndexPair
Pair Key
i Key
j) [(Key, Key)]
edges')
                                   (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> (a, a) -> (b, b)
both (forall a. IntMap a -> Key -> a
(IM.!) IntMap [Double]
rvertices)) [(Key, Key)]
edges'))
              else forall k v. InsOrdHashMap k v
H.empty
  forall (m :: * -> *) a. Monad m => a -> m a
return (Key
rid, Ridge { _rvertices :: IntMap [Double]
_rvertices = IntMap [Double]
rvertices
                     , _ridgeOf :: IntSet
_ridgeOf   = [Key] -> IntSet
IS.fromAscList [Key
f1,Key
f2]
                     , _redges :: InsOrdHashMap IndexPair ([Double], [Double])
_redges    = InsOrdHashMap IndexPair ([Double], [Double])
edges })

data CFace = CFace {
    CFace -> Ptr CVertex
__fvertices :: Ptr CVertex
  , CFace -> CUInt
__nvertices' :: CUInt
  , CFace -> Ptr CUInt
__ridges :: Ptr CUInt
  , CFace -> CUInt
__nridges' :: CUInt
  , CFace -> Ptr CDouble
__center :: Ptr CDouble
  , CFace -> Ptr CDouble
__normal :: Ptr CDouble
  , CFace -> CDouble
__offset :: CDouble
  , CFace -> CInt
__orientation :: CInt
  , CFace -> CDouble
__area :: CDouble
  , CFace -> Ptr CUInt
__neighbors :: Ptr CUInt
  , CFace -> CUInt
__neighborsize :: CUInt
  , CFace -> CInt
__family :: CInt
  , CFace -> Ptr (Ptr CUInt)
__edges :: Ptr (Ptr CUInt)
  , CFace -> CUInt
__nedges :: CUInt
}

instance Storable CFace where
    sizeOf :: CFace -> Key
sizeOf    CFace
__ = (Key
112)
-- {-# LINE 216 "convexhull.hsc" #-}

    alignment :: CFace -> Key
alignment CFace
__ = Key
8
-- {-# LINE 217 "convexhull.hsc" #-}

    peek :: Ptr CFace -> IO CFace
peek Ptr CFace
ptr = do
      Ptr CVertex
fvertices'   <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
0) Ptr CFace
ptr
-- {-# LINE 219 "convexhull.hsc" #-}

      CUInt
nvertices'   <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
8) Ptr CFace
ptr
-- {-# LINE 220 "convexhull.hsc" #-}

      Ptr CUInt
ridges'      <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
24) Ptr CFace
ptr
-- {-# LINE 221 "convexhull.hsc" #-}

      CUInt
nridges'     <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
32) Ptr CFace
ptr
-- {-# LINE 222 "convexhull.hsc" #-}

      Ptr CDouble
center'      <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
40) Ptr CFace
ptr
-- {-# LINE 223 "convexhull.hsc" #-}

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

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

      CInt
orientation' <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
64) Ptr CFace
ptr
-- {-# LINE 226 "convexhull.hsc" #-}

      CDouble
area'        <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
72) Ptr CFace
ptr
-- {-# LINE 227 "convexhull.hsc" #-}

      Ptr CUInt
neighbors'   <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
80) Ptr CFace
ptr
-- {-# LINE 228 "convexhull.hsc" #-}

      CUInt
neighsize    <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
88) Ptr CFace
ptr
-- {-# LINE 229 "convexhull.hsc" #-}

      CInt
family'      <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
92) Ptr CFace
ptr
-- {-# LINE 230 "convexhull.hsc" #-}

      Ptr (Ptr CUInt)
edges'       <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
96) Ptr CFace
ptr
-- {-# LINE 231 "convexhull.hsc" #-}

      CUInt
nedges'      <- (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CFace
hsc_ptr Key
104) Ptr CFace
ptr
-- {-# LINE 232 "convexhull.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CFace { __fvertices :: Ptr CVertex
__fvertices    = Ptr CVertex
fvertices'
                   , __nvertices' :: CUInt
__nvertices'   = CUInt
nvertices'
                   , __ridges :: Ptr CUInt
__ridges       = Ptr CUInt
ridges'
                   , __nridges' :: CUInt
__nridges'     = CUInt
nridges'
                   , __center :: Ptr CDouble
__center       = Ptr CDouble
center'
                   , __normal :: Ptr CDouble
__normal       = Ptr CDouble
normal'
                   , __offset :: CDouble
__offset       = CDouble
offset'
                   , __orientation :: CInt
__orientation  = CInt
orientation'
                   , __area :: CDouble
__area         = CDouble
area'
                   , __neighbors :: Ptr CUInt
__neighbors    = Ptr CUInt
neighbors'
                   , __neighborsize :: CUInt
__neighborsize = CUInt
neighsize
                   , __family :: CInt
__family       = CInt
family'
                   , __edges :: Ptr (Ptr CUInt)
__edges        = Ptr (Ptr CUInt)
edges'
                   , __nedges :: CUInt
__nedges       = CUInt
nedges'
                 }
    poke :: Ptr CFace -> CFace -> IO ()
poke Ptr CFace
ptr (CFace Ptr CVertex
r1 CUInt
r2 Ptr CUInt
r3 CUInt
r4 Ptr CDouble
r5 Ptr CDouble
r6 CDouble
r7 CInt
r8 CDouble
r9 Ptr CUInt
r10 CUInt
r11 CInt
r12 Ptr (Ptr CUInt)
r13 CUInt
r14)
      = do
          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
0)     Ptr CFace
ptr Ptr CVertex
r1
-- {-# LINE 250 "convexhull.hsc" #-}

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

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
24)    Ptr CFace
ptr Ptr CUInt
r3
-- {-# LINE 252 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
32)      Ptr CFace
ptr CUInt
r4
-- {-# LINE 253 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
40)       Ptr CFace
ptr Ptr CDouble
r5
-- {-# LINE 254 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
48)       Ptr CFace
ptr Ptr CDouble
r6
-- {-# LINE 255 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
56)       Ptr CFace
ptr CDouble
r7
-- {-# LINE 256 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
64)  Ptr CFace
ptr CInt
r8
-- {-# LINE 257 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
72)         Ptr CFace
ptr CDouble
r9
-- {-# LINE 258 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
80)    Ptr CFace
ptr Ptr CUInt
r10
-- {-# LINE 259 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
88) Ptr CFace
ptr CUInt
r11
-- {-# LINE 260 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
92)       Ptr CFace
ptr CInt
r12
-- {-# LINE 261 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
96)        Ptr CFace
ptr Ptr (Ptr CUInt)
r13
-- {-# LINE 262 "convexhull.hsc" #-}

          (\Ptr CFace
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CFace
hsc_ptr Key
104)       Ptr CFace
ptr CUInt
r14
-- {-# LINE 263 "convexhull.hsc" #-}


cFaceToFacet :: Int -> CFace -> IO Facet
cFaceToFacet :: Key -> CFace -> IO Facet
cFaceToFacet Key
dim CFace
cface = do
  let area :: Double
area        = forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFace -> CDouble
__area CFace
cface)
      neighsize :: Key
neighsize   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CFace -> CUInt
__neighborsize CFace
cface)
      offset :: Double
offset      = forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFace -> CDouble
__offset CFace
cface)
      orientation :: Key
orientation = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CFace -> CInt
__orientation CFace
cface)
      family :: Key
family      = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CFace -> CInt
__family CFace
cface)
      nridges :: Key
nridges     = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CFace -> CUInt
__nridges' CFace
cface)
      nvertices :: Key
nvertices   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CFace -> CUInt
__nvertices' CFace
cface)
      nedges :: Key
nedges      = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CFace -> CUInt
__nedges CFace
cface)
  [Double]
center    <- 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 (CFace -> Ptr CDouble
__center CFace
cface))
  [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 (CFace -> Ptr CDouble
__normal CFace
cface))
  IntMap [Double]
vertices  <- forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (Key -> [CVertex] -> IO (IntMap [Double])
cVerticesToMap Key
dim)
                     (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nvertices (CFace -> Ptr CVertex
__fvertices CFace
cface))
  [Key]
ridges  <- 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 (CFace -> Ptr CUInt
__ridges CFace
cface))
  [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
neighsize (CFace -> Ptr CUInt
__neighbors CFace
cface))
  [(Key, Key)]
edges' <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map (\[CUInt]
x -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUInt]
xforall a. [a] -> Key -> a
!!Key
0), forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUInt]
xforall a. [a] -> Key -> a
!!Key
1))))
                      (forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
2))
                             (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nedges (CFace -> Ptr (Ptr CUInt)
__edges CFace
cface)))
  let edges :: InsOrdHashMap IndexPair ([Double], [Double])
edges = forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
H.fromList
              (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (\(Key
i,Key
j) -> Key -> Key -> IndexPair
Pair Key
i Key
j) [(Key, Key)]
edges')
                   (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> (a, a) -> (b, b)
both (forall a. IntMap a -> Key -> a
(IM.!) IntMap [Double]
vertices)) [(Key, Key)]
edges'))
  forall (m :: * -> *) a. Monad m => a -> m a
return Facet { _fvertices :: IntMap [Double]
_fvertices    = IntMap [Double]
vertices
               , _fridges :: IntSet
_fridges      = [Key] -> IntSet
IS.fromAscList [Key]
ridges
               , _centroid :: [Double]
_centroid     = [Double]
center
               , _normal' :: [Double]
_normal'      = [Double]
normal
               , _offset' :: Double
_offset'      = Double
offset
               , _orientation' :: Key
_orientation' = Key
orientation
               , _area :: Double
_area         = Double
area
               , _neighbors :: IntSet
_neighbors    = [Key] -> IntSet
IS.fromAscList [Key]
neighbors
               , _family' :: Family
_family'      = if Key
family forall a. Eq a => a -> a -> Bool
== -Key
1 then Family
None else Key -> Family
Family Key
family
               , _fedges :: InsOrdHashMap IndexPair ([Double], [Double])
_fedges       = InsOrdHashMap IndexPair ([Double], [Double])
edges }

data CConvexHull = CConvexHull {
    CConvexHull -> CUInt
__dim    :: CUInt
  , CConvexHull -> Ptr CVertex'
__allvertices :: Ptr CVertex'
  , CConvexHull -> CUInt
__nvertices :: CUInt
  , CConvexHull -> Ptr CFace
__faces :: Ptr CFace
  , CConvexHull -> CUInt
__nfaces :: CUInt
  , CConvexHull -> Ptr CRidge
__allridges :: Ptr CRidge
  , CConvexHull -> CUInt
__nridges :: CUInt
  , CConvexHull -> Ptr (Ptr CUInt)
__alledges :: Ptr (Ptr CUInt)
  , CConvexHull -> CUInt
__nalledges :: CUInt
  , CConvexHull -> CUInt
__triangle :: CUInt
}

instance Storable CConvexHull where
    sizeOf :: CConvexHull -> Key
sizeOf    CConvexHull
__ = (Key
72)
-- {-# LINE 314 "convexhull.hsc" #-}

    alignment :: CConvexHull -> Key
alignment CConvexHull
__ = Key
8
-- {-# LINE 315 "convexhull.hsc" #-}

    peek :: Ptr CConvexHull -> IO CConvexHull
peek Ptr CConvexHull
ptr = do
      CUInt
dim'         <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
0) Ptr CConvexHull
ptr
-- {-# LINE 317 "convexhull.hsc" #-}

      Ptr CVertex'
vertices'    <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
8) Ptr CConvexHull
ptr
-- {-# LINE 318 "convexhull.hsc" #-}

      CUInt
nvertices'   <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
16) Ptr CConvexHull
ptr
-- {-# LINE 319 "convexhull.hsc" #-}

      Ptr CFace
faces'       <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
24) Ptr CConvexHull
ptr
-- {-# LINE 320 "convexhull.hsc" #-}

      CUInt
nfaces'      <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
32) Ptr CConvexHull
ptr
-- {-# LINE 321 "convexhull.hsc" #-}

      Ptr CRidge
allridges'   <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
40) Ptr CConvexHull
ptr
-- {-# LINE 322 "convexhull.hsc" #-}

      CUInt
nridges'     <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
48) Ptr CConvexHull
ptr
-- {-# LINE 323 "convexhull.hsc" #-}

      Ptr (Ptr CUInt)
alledges'    <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
56) Ptr CConvexHull
ptr
-- {-# LINE 324 "convexhull.hsc" #-}

      CUInt
nedges'      <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
64) Ptr CConvexHull
ptr
-- {-# LINE 325 "convexhull.hsc" #-}

      CUInt
triangle'    <- (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr CConvexHull
hsc_ptr Key
68) Ptr CConvexHull
ptr
-- {-# LINE 326 "convexhull.hsc" #-}

      forall (m :: * -> *) a. Monad m => a -> m a
return CConvexHull { __dim :: CUInt
__dim         = CUInt
dim'
                         , __allvertices :: Ptr CVertex'
__allvertices = Ptr CVertex'
vertices'
                         , __nvertices :: CUInt
__nvertices   = CUInt
nvertices'
                         , __faces :: Ptr CFace
__faces       = Ptr CFace
faces'
                         , __nfaces :: CUInt
__nfaces      = CUInt
nfaces'
                         , __allridges :: Ptr CRidge
__allridges   = Ptr CRidge
allridges'
                         , __nridges :: CUInt
__nridges     = CUInt
nridges'
                         , __alledges :: Ptr (Ptr CUInt)
__alledges    = Ptr (Ptr CUInt)
alledges'
                         , __nalledges :: CUInt
__nalledges   = CUInt
nedges'
                         , __triangle :: CUInt
__triangle    = CUInt
triangle'
                     }
    poke :: Ptr CConvexHull -> CConvexHull -> IO ()
poke Ptr CConvexHull
ptr (CConvexHull CUInt
r1 Ptr CVertex'
r2 CUInt
r3 Ptr CFace
r4 CUInt
r5 Ptr CRidge
r6 CUInt
r7 Ptr (Ptr CUInt)
r8 CUInt
r9 CUInt
r10)
      = do
          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
0) Ptr CConvexHull
ptr CUInt
r1
-- {-# LINE 340 "convexhull.hsc" #-}

          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
8) Ptr CConvexHull
ptr Ptr CVertex'
r2
-- {-# LINE 341 "convexhull.hsc" #-}

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

          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
24) Ptr CConvexHull
ptr Ptr CFace
r4
-- {-# LINE 343 "convexhull.hsc" #-}

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

          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
40) Ptr CConvexHull
ptr Ptr CRidge
r6
-- {-# LINE 345 "convexhull.hsc" #-}

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

          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
56) Ptr CConvexHull
ptr Ptr (Ptr CUInt)
r8
-- {-# LINE 347 "convexhull.hsc" #-}

          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
64) Ptr CConvexHull
ptr CUInt
r9
-- {-# LINE 348 "convexhull.hsc" #-}

          (\Ptr CConvexHull
hsc_ptr -> forall a b. Storable a => Ptr b -> Key -> a -> IO ()
pokeByteOff Ptr CConvexHull
hsc_ptr Key
68) Ptr CConvexHull
ptr CUInt
r10
-- {-# LINE 349 "convexhull.hsc" #-}


foreign import ccall unsafe "convexHull" c_convexhull
  :: Ptr CDouble -- points

  -> CUInt -- dim

  -> CUInt -- npoints

  -> CUInt -- triangulate

  -> CUInt -- print to stdout

  -> CString -- summary file

  -> Ptr CUInt -- exitcode

  -> IO (Ptr CConvexHull)

cConvexHullToConvexHull :: CConvexHull -> IO ConvexHull
cConvexHullToConvexHull :: CConvexHull -> IO ConvexHull
cConvexHullToConvexHull CConvexHull
cconvexhull = do
  let dim :: Key
dim       = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CConvexHull -> CUInt
__dim CConvexHull
cconvexhull)
      nvertices :: Key
nvertices = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CConvexHull -> CUInt
__nvertices CConvexHull
cconvexhull)
      nfaces :: Key
nfaces    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CConvexHull -> CUInt
__nfaces CConvexHull
cconvexhull)
      nridges :: Key
nridges   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CConvexHull -> CUInt
__nridges CConvexHull
cconvexhull)
      nedges :: Key
nedges    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CConvexHull -> CUInt
__nalledges CConvexHull
cconvexhull)
      triangle :: Key
triangle  = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CConvexHull -> CUInt
__triangle CConvexHull
cconvexhull)
  IntMap Vertex
vertices <- forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (Key -> [CVertex'] -> IO (IntMap Vertex)
cVerticesToVertexMap Key
dim)
                    (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nvertices (CConvexHull -> Ptr CVertex'
__allvertices CConvexHull
cconvexhull))
  [Facet]
faces <- forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Key -> CFace -> IO Facet
cFaceToFacet Key
dim))
                       (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nfaces (CConvexHull -> Ptr CFace
__faces CConvexHull
cconvexhull))
  [(Key, Ridge)]
allridges <- forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Key -> CRidge -> IO (Key, Ridge)
cRidgeToRidge Key
dim))
                          (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nridges (CConvexHull -> Ptr CRidge
__allridges CConvexHull
cconvexhull))
  [(Key, Key)]
alledges' <- forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) (forall a b. (a -> b) -> [a] -> [b]
map (\[CUInt]
x -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUInt]
xforall a. [a] -> Key -> a
!!Key
0), forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUInt]
xforall a. [a] -> Key -> a
!!Key
1))))
                      (forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
2))
                             (forall a. Storable a => Key -> Ptr a -> IO [a]
peekArray Key
nedges (CConvexHull -> Ptr (Ptr CUInt)
__alledges CConvexHull
cconvexhull)))
  let alledges :: InsOrdHashMap IndexPair ([Double], [Double])
alledges = let points :: IntMap [Double]
points = forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Vertex -> [Double]
_point IntMap Vertex
vertices in
                  forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
H.fromList
                  (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (\(Key
i,Key
j) -> Key -> Key -> IndexPair
Pair Key
i Key
j) [(Key, Key)]
alledges')
                       (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> (a, a) -> (b, b)
both (forall a. IntMap a -> Key -> a
(IM.!) IntMap [Double]
points)) [(Key, Key)]
alledges'))
  forall (m :: * -> *) a. Monad m => a -> m a
return ConvexHull {
                        _hvertices :: IntMap Vertex
_hvertices  = IntMap Vertex
vertices
                      , _hfacets :: IntMap Facet
_hfacets    = forall a. [(Key, a)] -> IntMap a
fromAscList (forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0 .. Key
nfacesforall a. Num a => a -> a -> a
-Key
1] [Facet]
faces)
                      , _hridges :: IntMap Ridge
_hridges    = forall a. [(Key, a)] -> IntMap a
fromAscList [(Key, Ridge)]
allridges
                      , _hedges :: InsOrdHashMap IndexPair ([Double], [Double])
_hedges     = InsOrdHashMap IndexPair ([Double], [Double])
alledges
                      , _simplicial :: Bool
_simplicial = Key
triangle forall a. Eq a => a -> a -> Bool
== (Key
1::Int)
                      , _dimension :: Key
_dimension  = Key
dim
                    }