{-# LINE 1 "Triangulation.hsc" #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} module Geometry.HCDT.Triangulation ( cTriangulationToTriangulation , cCTriangulationToConstrainedTriangulation , vertexToCVertex , edgeToCEdge , c_delaunay , c_cdelaunay , CTriangulation (..) , CVertex (..) , CCTriangulation (..) , CEdge (..) ) where import Geometry.HCDT.Types import Foreign import Foreign.C.Types import qualified Data.IntMap.Strict as IM data CVertex = CVertex { __x :: CDouble , __y :: CDouble } instance Storable CVertex where sizeOf __ = (16) {-# LINE 29 "Triangulation.hsc" #-} alignment __ = 8 {-# LINE 30 "Triangulation.hsc" #-} peek ptr = do x' <- (`peekByteOff` 0) ptr {-# LINE 32 "Triangulation.hsc" #-} y' <- (`peekByteOff` 8) ptr {-# LINE 33 "Triangulation.hsc" #-} return CVertex { __x = x', __y = y' } poke ptr (CVertex r1 r2) = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr r1 {-# LINE 37 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr r2 {-# LINE 38 "Triangulation.hsc" #-} cVertexToVertex :: CVertex -> IO Vertex cVertexToVertex cvertex = do let x = realToFrac $ __x cvertex let y = realToFrac $ __y cvertex return $ Vertex x y vertexToCVertex :: Vertex -> IO CVertex vertexToCVertex (Vertex x y) = do return $ CVertex { __x = realToFrac x, __y = realToFrac y } data CEdge = CEdge { __i :: CUInt , __j :: CUInt } instance Storable CEdge where sizeOf __ = (8) {-# LINE 56 "Triangulation.hsc" #-} alignment __ = 4 {-# LINE 57 "Triangulation.hsc" #-} peek ptr = do i' <- (`peekByteOff` 0) ptr {-# LINE 59 "Triangulation.hsc" #-} j' <- (`peekByteOff` 4) ptr {-# LINE 60 "Triangulation.hsc" #-} return CEdge { __i = i' , __j = j' } poke ptr (CEdge r1 r2) = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr r1 {-# LINE 65 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr r2 {-# LINE 66 "Triangulation.hsc" #-} cEdgeToEdge :: CEdge -> IO Edge cEdgeToEdge cedge = do let i = fromIntegral $ __i cedge let j = fromIntegral $ __j cedge return $ Edge i j edgeToCEdge :: Edge -> IO CEdge edgeToCEdge (Edge i j) = do return $ CEdge { __i = fromIntegral i, __j = fromIntegral j } data CTriangle = CTriangle { __i1 :: CUInt , __i2 :: CUInt , __i3 :: CUInt } instance Storable CTriangle where sizeOf __ = (12) {-# LINE 85 "Triangulation.hsc" #-} alignment __ = 4 {-# LINE 86 "Triangulation.hsc" #-} peek ptr = do i1' <- (`peekByteOff` 0) ptr {-# LINE 88 "Triangulation.hsc" #-} i2' <- (`peekByteOff` 4) ptr {-# LINE 89 "Triangulation.hsc" #-} i3' <- (`peekByteOff` 8) ptr {-# LINE 90 "Triangulation.hsc" #-} return CTriangle { __i1 = i1' , __i2 = i2' , __i3 = i3' } poke ptr (CTriangle r1 r2 r3) = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr r1 {-# LINE 96 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr r2 {-# LINE 97 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr r3 {-# LINE 98 "Triangulation.hsc" #-} cTriangleToTriangle :: CTriangle -> IO Triangle cTriangleToTriangle ctriangle = do let i1 = fromIntegral $ __i1 ctriangle let i2 = fromIntegral $ __i2 ctriangle let i3 = fromIntegral $ __i3 ctriangle return $ Triangle i1 i2 i3 data CTriangulation = CTriangulation { __vertices :: Ptr CVertex , __nvertices :: CSize , __triangles :: Ptr CTriangle , __ntriangles :: CSize , __edges :: Ptr CEdge , __nedges :: CSize } instance Storable CTriangulation where sizeOf __ = (48) {-# LINE 117 "Triangulation.hsc" #-} alignment __ = 8 {-# LINE 118 "Triangulation.hsc" #-} peek ptr = do vs <- (`peekByteOff` 0) ptr {-# LINE 120 "Triangulation.hsc" #-} nvs <- (`peekByteOff` 8) ptr {-# LINE 121 "Triangulation.hsc" #-} ts <- (`peekByteOff` 16) ptr {-# LINE 122 "Triangulation.hsc" #-} nts <- (`peekByteOff` 24) ptr {-# LINE 123 "Triangulation.hsc" #-} es <- (`peekByteOff` 32) ptr {-# LINE 124 "Triangulation.hsc" #-} nes <- (`peekByteOff` 40) ptr {-# LINE 125 "Triangulation.hsc" #-} return CTriangulation { __vertices = vs , __nvertices = nvs , __triangles = ts , __ntriangles = nts , __edges = es , __nedges = nes } poke ptr (CTriangulation r1 r2 r3 r4 r5 r6) = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr r1 {-# LINE 134 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr r2 {-# LINE 135 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr r3 {-# LINE 136 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr r4 {-# LINE 137 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr r5 {-# LINE 138 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 40) ptr r6 {-# LINE 139 "Triangulation.hsc" #-} data CCTriangulation = CCTriangulation { __vertices' :: Ptr CVertex , __nvertices' :: CSize , __triangles' :: Ptr CTriangle , __ntriangles' :: CSize , __edges' :: Ptr CEdge , __nedges' :: CSize , __fixededges' :: Ptr CEdge , __nfixededges' :: CSize } instance Storable CCTriangulation where sizeOf __ = (64) {-# LINE 153 "Triangulation.hsc" #-} alignment __ = 8 {-# LINE 154 "Triangulation.hsc" #-} peek ptr = do vs <- (`peekByteOff` 0) ptr {-# LINE 156 "Triangulation.hsc" #-} nvs <- (`peekByteOff` 8) ptr {-# LINE 157 "Triangulation.hsc" #-} ts <- (`peekByteOff` 16) ptr {-# LINE 158 "Triangulation.hsc" #-} nts <- (`peekByteOff` 24) ptr {-# LINE 159 "Triangulation.hsc" #-} es <- (`peekByteOff` 32) ptr {-# LINE 160 "Triangulation.hsc" #-} nes <- (`peekByteOff` 40) ptr {-# LINE 161 "Triangulation.hsc" #-} fes <- (`peekByteOff` 48) ptr {-# LINE 162 "Triangulation.hsc" #-} nfes <- (`peekByteOff` 56) ptr {-# LINE 163 "Triangulation.hsc" #-} return CCTriangulation { __vertices' = vs , __nvertices' = nvs , __triangles' = ts , __ntriangles' = nts , __edges' = es , __nedges' = nes , __fixededges' = fes , __nfixededges' = nfes } poke ptr (CCTriangulation r1 r2 r3 r4 r5 r6 r7 r8) = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr r1 {-# LINE 174 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr r2 {-# LINE 175 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr r3 {-# LINE 176 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr r4 {-# LINE 177 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr r5 {-# LINE 178 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 40) ptr r6 {-# LINE 179 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 48) ptr r7 {-# LINE 180 "Triangulation.hsc" #-} (\hsc_ptr -> pokeByteOff hsc_ptr 56) ptr r8 {-# LINE 181 "Triangulation.hsc" #-} cTriangulationToTriangulation :: CTriangulation -> IO Triangulation cTriangulationToTriangulation ctriangulation = do let nvertices = fromIntegral $ __nvertices ctriangulation ntriangles = fromIntegral $ __ntriangles ctriangulation nedges = fromIntegral $ __nedges ctriangulation vertices <- peekArray nvertices (__vertices ctriangulation) triangles <- peekArray ntriangles (__triangles ctriangulation) edges <- peekArray nedges (__edges ctriangulation) vertices' <- mapM cVertexToVertex vertices triangles' <- mapM cTriangleToTriangle triangles edges' <- mapM cEdgeToEdge edges return $ Triangulation { _vertices = IM.fromAscList (zip [0 .. nvertices-1] vertices') , _triangles = triangles' , _edges = edges' } cCTriangulationToConstrainedTriangulation :: CCTriangulation -> IO ConstrainedTriangulation cCTriangulationToConstrainedTriangulation cctriangulation = do let nvertices = fromIntegral $ __nvertices' cctriangulation ntriangles = fromIntegral $ __ntriangles' cctriangulation nedges = fromIntegral $ __nedges' cctriangulation nfedges = fromIntegral $ __nfixededges' cctriangulation vertices <- peekArray nvertices (__vertices' cctriangulation) triangles <- peekArray ntriangles (__triangles' cctriangulation) edges <- peekArray nedges (__edges' cctriangulation) fedges <- peekArray nfedges (__fixededges' cctriangulation) vertices' <- mapM cVertexToVertex vertices triangles' <- mapM cTriangleToTriangle triangles edges' <- mapM cEdgeToEdge edges fedges' <- mapM cEdgeToEdge fedges let triangulation = Triangulation { _vertices = IM.fromAscList (zip [0 .. nvertices-1] vertices') , _triangles = triangles' , _edges = edges' } return ConstrainedTriangulation { _triangulation = triangulation , _fixedEdges = fedges' } foreign import ccall unsafe "delaunay" c_delaunay :: Ptr CVertex -> CSize -> IO (Ptr CTriangulation) foreign import ccall unsafe "cdelaunay" c_cdelaunay :: Ptr CVertex -> CSize -> Ptr CEdge -> CSize -> IO (Ptr CCTriangulation)