HALFEDGE: make 'indirectToDirect' a safe function
We had to add NoFace/NoEdge/NoVert constructors to our half-edge data structures, because using "Maybe HeEdge a" as the result value of 'indirectToDirect' causes an infinite recursion, since the whole data structure (which is cyclic and infinite) has to be evaluated in order to know which constructor to use. Unfortunately this makes the code quite hard to read. TODO: add pseudo-code
This commit is contained in:
parent
0151df162c
commit
70ce5ca511
@ -24,9 +24,11 @@ module Graphics.HalfEdge (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Algebra.Vector
|
import Algebra.Vector
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
import Data.Functor
|
|
||||||
import qualified Data.IntMap.Lazy as Map
|
import qualified Data.IntMap.Lazy as Map
|
||||||
|
import Data.Maybe
|
||||||
import Parser.Meshparser
|
import Parser.Meshparser
|
||||||
import Safe
|
import Safe
|
||||||
|
|
||||||
@ -35,21 +37,21 @@ import Safe
|
|||||||
data HeVert a = HeVert {
|
data HeVert a = HeVert {
|
||||||
vcoord :: a -- the coordinates of the vertex
|
vcoord :: a -- the coordinates of the vertex
|
||||||
, emedge :: HeEdge a -- one of the half-edges emanating from the vertex
|
, emedge :: HeEdge a -- one of the half-edges emanating from the vertex
|
||||||
|
} | NoVert
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
-- |The face data structure for the half-edge.
|
-- |The face data structure for the half-edge.
|
||||||
data HeFace a = HeFace {
|
data HeFace a = HeFace {
|
||||||
bordedge :: HeEdge a -- one of the half-edges bordering the face
|
bordedge :: HeEdge a -- one of the half-edges bordering the face
|
||||||
}
|
} | NoFace
|
||||||
|
|
||||||
-- |The actual half-edge data structure.
|
-- |The actual half-edge data structure.
|
||||||
data HeEdge a = HeEdge {
|
data HeEdge a = HeEdge {
|
||||||
startvert :: HeVert a -- start-vertex of the half-edge
|
startvert :: HeVert a -- start-vertex of the half-edge
|
||||||
, oppedge :: Maybe (HeEdge a) -- oppositely oriented adjacent half-edge
|
, oppedge :: HeEdge a -- oppositely oriented adjacent half-edge
|
||||||
, edgeface :: HeFace a -- face the half-edge borders
|
, edgeface :: HeFace a -- face the half-edge borders
|
||||||
, nextedge :: HeEdge a -- next half-edge around the face
|
, nextedge :: HeEdge a -- next half-edge around the face
|
||||||
}
|
} | NoEdge
|
||||||
|
|
||||||
-- This is a helper data structure of half-edge edges
|
-- This is a helper data structure of half-edge edges
|
||||||
-- for tying the knots in 'indirectToDirect'.
|
-- for tying the knots in 'indirectToDirect'.
|
||||||
@ -132,7 +134,6 @@ indirectHeVerts hes' = go hes' Map.empty 0
|
|||||||
-- |Tie the knots!
|
-- |Tie the knots!
|
||||||
-- It is assumed that the list of points is indexed in order of their
|
-- It is assumed that the list of points is indexed in order of their
|
||||||
-- appearance in the obj mesh file.
|
-- appearance in the obj mesh file.
|
||||||
-- TODO: make this function safe.
|
|
||||||
indirectToDirect :: [a] -- ^ list of points
|
indirectToDirect :: [a] -- ^ list of points
|
||||||
-> [IndirectHeEdge]
|
-> [IndirectHeEdge]
|
||||||
-> [IndirectHeFace]
|
-> [IndirectHeFace]
|
||||||
@ -142,22 +143,32 @@ indirectToDirect pts pe@(e:_) fs vertarr
|
|||||||
= thisEdge e
|
= thisEdge e
|
||||||
where
|
where
|
||||||
thisEdge (IndirectHeEdge ei sv _ fi off)
|
thisEdge (IndirectHeEdge ei sv _ fi off)
|
||||||
= HeEdge (thisVert (vertarr Map.! sv) sv)
|
= case (fs `atMay` fi, pe `atMay` (ei + off), Map.lookup sv vertarr) of
|
||||||
|
(Just x, Just y, Just z) -> HeEdge (thisVert z sv)
|
||||||
(getOppEdge sv fi)
|
(getOppEdge sv fi)
|
||||||
(thisFace (fs !! fi))
|
(thisFace x)
|
||||||
(thisEdge . (!!) pe $ (ei + off))
|
(thisEdge y)
|
||||||
|
_ -> NoEdge
|
||||||
thisFace (IndirectHeFace (_, vi:_))
|
thisFace (IndirectHeFace (_, vi:_))
|
||||||
= HeFace (thisEdge (pe !! vi))
|
= case pe `atMay` vi of
|
||||||
|
Just x -> HeFace (thisEdge x)
|
||||||
|
Nothing -> NoFace
|
||||||
|
thisFace (IndirectHeFace _) = NoFace
|
||||||
thisVert (IndirectHeVert eedg _) coordi
|
thisVert (IndirectHeVert eedg _) coordi
|
||||||
= HeVert (pts !! (coordi - 1))
|
= case (pts `atMay` (coordi - 1), pe `atMay` (eedg - 1)) of
|
||||||
(thisEdge (pe !! (eedg - 1)))
|
(Just x, Just y) -> HeVert x (thisEdge y)
|
||||||
|
_ -> NoVert
|
||||||
getOppEdge sv fi
|
getOppEdge sv fi
|
||||||
= (\x -> thisEdge (pe !! x))
|
= case join
|
||||||
<$>
|
$ headMay
|
||||||
(headMay
|
. filter ((/=) fi . indexf)
|
||||||
. filter (\x -> (/=) fi . indexf $ (pe !! x))
|
. catMaybes
|
||||||
|
. fmap (pe `atMay`)
|
||||||
. edgelist
|
. edgelist
|
||||||
$ (vertarr Map.! sv))
|
<$> Map.lookup sv vertarr of
|
||||||
|
Just x -> thisEdge x
|
||||||
|
Nothing -> NoEdge
|
||||||
|
indirectToDirect _ _ _ _ = NoEdge
|
||||||
|
|
||||||
|
|
||||||
-- |Build the half-edge data structure from a list of points
|
-- |Build the half-edge data structure from a list of points
|
||||||
|
Loading…
Reference in New Issue
Block a user