HALFEDGE: initial implementation for half-edge data structures

See http://www.flipcode.com/archives/The_Half-Edge_Data_Structure.shtml

CG2.cabal

@@ -65,6 +65,7 @@ executable Gtk
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gtk
                        Graphics.Diagram.Plotter
+                       Graphics.HalfEdge
                        GUI.Gtk
                        MyPrelude
                        Parser.Meshparser
@@ -76,6 +77,7 @@ executable Gtk
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
+                       array >= 0.5.0.0,
                        base >=4.6,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
@@ -113,6 +115,7 @@ executable Gif
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gif
                        Graphics.Diagram.Plotter
+                       Graphics.HalfEdge
                        MyPrelude
                        Parser.Meshparser
                        Parser.PathParser
@@ -124,16 +127,18 @@ executable Gif
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6,
+                       array >= 0.5.0.0,
+                       base >=4.6 && <4.8,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
                        dequeue >= 0.1.5,
-                       diagrams-lib >=1.3,
+                       diagrams-lib >=1.2 && <1.3,
-                       diagrams-cairo >=1.3,
+                       diagrams-cairo >=1.2 && <1.3,
-                       diagrams-contrib >= 1.3.0.0,
+                       diagrams-contrib >= 1.1.2.1,
                        JuicyPixels >= 3.1.7.1,
-                       safe >= 0.3.8,
+                       multiset-comb >= 0.2.1,
-                       transformers >=0.4
+                       transformers >=0.4 && <0.5,
+                       safe >= 0.3.8
 
   -- Directories containing source files.
   -- hs-source-dirs:
@@ -158,6 +163,7 @@ executable Test
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gif
                        Graphics.Diagram.Plotter
+                       Graphics.HalfEdge
                        MyPrelude
                        Parser.Meshparser
                        Parser.PathParser
@@ -171,13 +177,18 @@ executable Test
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6,
+                       array >= 0.5.0.0,
+                       base >=4.6 && <4.8,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
-                       diagrams-lib >=1.3,
+                       dequeue >= 0.1.5,
-                       diagrams-cairo >=1.3,
+                       diagrams-lib >=1.2 && <1.3,
-                       diagrams-contrib >= 1.3.0.0,
+                       diagrams-cairo >=1.2 && <1.3,
+                       diagrams-contrib >= 1.1.2.1,
+                       JuicyPixels >= 3.1.7.1,
+                       multiset-comb >= 0.2.1,
                        QuickCheck >= 2.4.2,
+                       transformers >=0.4 && <0.5,
                        safe >= 0.3.8
 
   -- Directories containing source files.

Graphics/HalfEdge.hs

@@ -0,0 +1,198 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+-- |This module provides methods to build a cyclic half-edge data structure
+-- from an already parsed obj mesh file. As such, it depends on details
+-- of the parsed data structures.
+--
+-- In particular, 'indirectHeFaces', 'indirectHeVerts' and 'indirectToDirect'
+-- assume specific structure of some input lists. Check their respective
+-- documentation.
+--
+-- As the data structure has a lot of cross-references and the knots are
+-- not really known at compile-time, we have to use helper data structures
+-- such as arrays, lists or vectors under the hood and tie the knots through
+-- index lookups.
+--
+-- For an explanation of the abstract concept of the half-edge data structure,
+-- check <http://www.flipcode.com/archives/The_Half-Edge_Data_Structure.shtml>
+module Graphics.HalfEdge (
+    HeVert(..)
+  , HeFace(..)
+  , HeEdge(..)
+  , buildHeEdge
+  , buildHeEdgeFromStr
+) where
+
+import Algebra.Vector
+import Control.Monad.ST
+import Data.Array.Unboxed
+import Data.Array.ST
+import qualified Data.ByteString.Char8 as B
+import Data.Functor
+import Parser.Meshparser
+import Safe
+
+
+-- |The vertex data structure for the half-edge.
+data HeVert a = HeVert {
+    vcoord  :: a        -- the coordinates of the vertex
+  , emedge  :: HeEdge a -- one of the half-edges emanating from the vertex
+
+}
+
+-- |The face data structure for the half-edge.
+data HeFace a = HeFace {
+  bordedge :: HeEdge a -- one of the half-edges bordering the face
+}
+
+-- |The actual half-edge data structure.
+data HeEdge a = HeEdge {
+    startvert :: HeVert a         -- start-vertex of the half-edge
+  , oppedge   :: Maybe (HeEdge a) -- oppositely oriented adjacent half-edge
+  , edgeface  :: HeFace a         -- face the half-edge borders
+  , nextedge  :: HeEdge a         -- next half-edge around the face
+}
+
+-- This is a helper data structure of half-edge edges
+-- for tying the knots in 'indirectToDirect'.
+data IndirectHeEdge = IndirectHeEdge {
+    edgeindex  :: Int  -- edge index
+  , svindex    :: Int  -- index of start-vertice
+  , nvindex    :: Int  -- index of next-vertice
+  , indexf     :: Int  -- index of face
+  , offsetedge :: Int  -- offset to get the next edge
+}
+
+-- This is a helper data structure of half-edge vertices
+-- for tying the knots in 'indirectToDirect'.
+data IndirectHeVert = IndirectHeVert {
+    emedgeindex  :: Int    -- emanating edge index (starts at 1)
+  , edgelist     :: [Int]  -- index of edge that points to this vertice
+}
+
+-- This is a helper data structure of half-edge faces
+-- for tying the knots in 'indirectToDirect'.
+data IndirectHeFace =
+  IndirectHeFace (Int, [Int]) -- (faceIndex, [verticeindex])
+
+
+-- |Construct the indirect data structure for half-edge faces.
+-- This function assumes that the input faces are parsed exactly like so:
+--
+-- @
+-- f 1 3 4 5
+-- f 4 6 1 3
+-- @
+--
+-- becomes
+--
+-- > [[1,3,4,5],[4,6,1,3]]
+indirectHeFaces :: [[Int]]          -- ^ list of faces with their respective
+                                    --   list of vertice-indices
+                -> [IndirectHeFace]
+indirectHeFaces = fmap IndirectHeFace . zip [0..]
+
+
+-- |Construct the indirect data structure for half-edge edges.
+indirectHeEdges :: [IndirectHeFace] -> [IndirectHeEdge]
+indirectHeEdges = concat . fmap indirectHeEdge
+  where
+    indirectHeEdge :: IndirectHeFace -> [IndirectHeEdge]
+    indirectHeEdge   (IndirectHeFace (_, []))  = []
+    indirectHeEdge p@(IndirectHeFace (_, pv@(v:_))) = go p 0
+      where
+        go (IndirectHeFace (_, [])) _
+          = []
+        -- connect last to first element
+        go (IndirectHeFace (fi, [vlast])) ei
+          = [IndirectHeEdge ei vlast v fi (negate $ length pv - 1)]
+        -- regular non-last element
+        go (IndirectHeFace (fi, vfirst:vnext:vrest)) ei
+          = (:) (IndirectHeEdge ei vfirst vnext fi 1)
+                (go (IndirectHeFace (fi, vnext:vrest)) (ei + 1))
+
+
+-- |Construct the indirect data structure for half-edge vertices.
+-- It is assumed that the list of points is indexed in order of their
+-- appearance in the obj mesh file.
+indirectHeVerts :: [a]                      -- ^ list of points
+                -> [IndirectHeEdge]         -- ^ list of indirect edges
+                -> Array Int IndirectHeVert -- ^ output list, starts at index 1
+indirectHeVerts pts hes'
+  = runSTArray $ do
+    arr <- newArray (1, length pts) (IndirectHeVert 0 [])
+      :: ST s (STArray s Int IndirectHeVert)
+    -- build the array
+    let go [] _ = return ()
+        go (IndirectHeEdge _ _ nv _ offset:hes) i
+          = do
+            (IndirectHeVert _ xs) <- readArray arr nv
+            writeArray arr nv (IndirectHeVert (i + offset) (i:xs))
+            go hes (i + 1)
+    go hes' 0
+    return arr
+
+
+-- |Tie the knots!
+-- It is assumed that the list of points is indexed in order of their
+-- appearance in the obj mesh file.
+-- TODO: make this function safe.
+indirectToDirect :: [a]                      -- ^ list of points
+                 -> [IndirectHeEdge]
+                 -> [IndirectHeFace]
+                 -> Array Int IndirectHeVert -- ^ assumed to start at index 1
+                 -> HeEdge a
+indirectToDirect pts pe@(e:_) fs vertarr
+  = thisEdge e
+  where
+    thisEdge (IndirectHeEdge ei sv _ fi off)
+      = HeEdge (thisVert (vertarr ! sv) sv)
+               (getOppEdge sv fi)
+               (thisFace (fs !! fi))
+               (thisEdge . (!!) pe $ (ei + off))
+    thisFace (IndirectHeFace (_, vi:_))
+      = HeFace (thisEdge (pe !! vi))
+    thisVert (IndirectHeVert eedg _) coordi
+      = HeVert (pts !! (coordi - 1))
+               (thisEdge (pe !! (eedg - 1)))
+    getOppEdge sv fi
+      = (\x -> thisEdge (pe !! x))
+        <$>
+        (headMay
+          . filter (\x -> (/=) fi . indexf $ (pe !! x))
+          . edgelist
+          $ (vertarr ! sv))
+
+
+-- |Build the half-edge data structure from a list of points
+-- and from a list of faces.
+-- The points are assumed to have been parsed in order of their appearance
+-- in the .obj mesh file, so that the indices match.
+-- The faces are assumed to have been parsed in order of their appearance
+-- in the .obj mesh file as follows:
+--
+-- @
+-- f 1 3 4 5
+-- f 4 6 1 3
+-- @
+--
+-- becomes
+--
+-- > [[1,3,4,5],[4,6,1,3]]
+buildHeEdge :: [a] -> [[Int]] -> Maybe (HeEdge a)
+buildHeEdge [] _   = Nothing
+buildHeEdge _ []   = Nothing
+buildHeEdge pts fs
+  = let faces' = indirectHeFaces fs
+        edges' = indirectHeEdges faces'
+        verts' = indirectHeVerts pts edges'
+    in Just $ indirectToDirect pts edges' faces' verts'
+
+
+-- |Build the HeEdge data structure from the .obj mesh file contents.
+buildHeEdgeFromStr :: B.ByteString -- ^ contents of an .obj mesh file
+                   -> Maybe (HeEdge PT)
+buildHeEdgeFromStr bmesh =
+  let pts    = meshVertices bmesh
+      fs     = meshFaces bmesh
+  in  buildHeEdge pts fs