Use rounded shapes instead of TopPrism
This commit is contained in:
+33
-24
@@ -96,15 +96,16 @@ pokeShapeObj ::
|
||||
Surface ->
|
||||
IO (Int, Int, Int)
|
||||
{-# INLINE pokeShapeObj #-}
|
||||
pokeShapeObj ptr iptr ieptr counts (Surface shtype shVerts col) = case shtype of
|
||||
TopPrism size -> pokeTopPrism midp col size ptr iptr ieptr counts (VFSM.fromList shVerts)
|
||||
FlatFaces size -> pokeBox col size ptr iptr ieptr counts shVerts
|
||||
RoundedFaces size -> pokeRoundedFaces col size ptr iptr ieptr counts shVerts
|
||||
Cylinder size -> pokeCylinder col size ptr iptr ieptr counts shVerts
|
||||
pokeShapeObj ptr iptr ieptr counts (Surface shtype shVerts col shadfid) = case shtype of
|
||||
TopPrism size -> pokeTopPrism shadfid midp col size ptr iptr ieptr counts (VFSM.fromList shVerts)
|
||||
FlatFaces size -> pokeBox shadfid col size ptr iptr ieptr counts shVerts
|
||||
RoundedFaces size -> pokeRoundedFaces shadfid col size ptr iptr ieptr counts shVerts
|
||||
Cylinder size -> pokeCylinder shadfid col size ptr iptr ieptr counts shVerts
|
||||
where
|
||||
midp = centroidNum shVerts
|
||||
|
||||
pokeRoundedFaces ::
|
||||
ShadowFidelity ->
|
||||
Point4 ->
|
||||
Int ->
|
||||
Ptr Float ->
|
||||
@@ -113,20 +114,23 @@ pokeRoundedFaces ::
|
||||
(Int, Int, Int) ->
|
||||
[Point3] ->
|
||||
IO (Int, Int, Int)
|
||||
pokeRoundedFaces col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
|
||||
{-# INLINE pokeRoundedFaces #-}
|
||||
pokeRoundedFaces sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
|
||||
nv' <- pokeRoundedCurve col ptr tc bc svs nv
|
||||
nsi' <-
|
||||
UV.foldM'
|
||||
(pokeIndex nv iptr)
|
||||
nsi
|
||||
(memoTopPrismIndices V.! (size - 3))
|
||||
nei' <-
|
||||
UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
nei' <- case sfid of
|
||||
NoShadowFidelity -> return nei
|
||||
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
memoTopPrismEdgeIndices V.! (size - 3)
|
||||
return (nv', nsi', nei')
|
||||
pokeRoundedFaces _ _ _ _ _ _ _ = undefined
|
||||
pokeRoundedFaces _ _ _ _ _ _ _ _ = undefined
|
||||
|
||||
pokeCylinder ::
|
||||
ShadowFidelity ->
|
||||
Point4 ->
|
||||
Int ->
|
||||
Ptr Float ->
|
||||
@@ -135,24 +139,27 @@ pokeCylinder ::
|
||||
(Int, Int, Int) ->
|
||||
[Point3] ->
|
||||
IO (Int, Int, Int)
|
||||
pokeCylinder col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
|
||||
{-# INLINE pokeCylinder #-}
|
||||
pokeCylinder sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
|
||||
nv' <- pokeRoundedCurve col ptr tc bc svs nv >>= pokeCylinderCaps col ptr tc bc svs
|
||||
nsi' <-
|
||||
UV.foldM'
|
||||
(pokeIndex nv iptr)
|
||||
nsi
|
||||
(memoCylinderIndices V.! (size - 3))
|
||||
nei' <-
|
||||
UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
nei' <- case sfid of
|
||||
NoShadowFidelity -> return nei
|
||||
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
memoTopPrismEdgeIndices V.! (size - 3)
|
||||
return (nv', nsi', nei')
|
||||
pokeCylinder _ _ _ _ _ _ _ = undefined
|
||||
pokeCylinder _ _ _ _ _ _ _ _ = undefined
|
||||
|
||||
pokeRoundedCurve :: Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
|
||||
{-# INLINE pokeRoundedCurve #-}
|
||||
pokeRoundedCurve col ptr tc bc = go True
|
||||
where
|
||||
go True (x : xs) n = pokeJustV tc col ptr n x >>= go False xs
|
||||
go False (x : xs) n = pokeJustV bc col ptr n x >>= go True xs
|
||||
go True (x : xs) n = pokeJustV tc col ptr n x >>= go False xs
|
||||
go False (x : xs) n = pokeJustV bc col ptr n x >>= go True xs
|
||||
go _ [] n = return n
|
||||
|
||||
pokeCylinderCaps :: Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
|
||||
@@ -163,6 +170,7 @@ pokeCylinderCaps col ptr tc bc = go True
|
||||
go _ [] n = return n
|
||||
|
||||
pokeBox ::
|
||||
ShadowFidelity ->
|
||||
Point4 ->
|
||||
Int ->
|
||||
Ptr Float ->
|
||||
@@ -172,15 +180,16 @@ pokeBox ::
|
||||
[Point3] ->
|
||||
IO (Int, Int, Int)
|
||||
{-# INLINE pokeBox #-}
|
||||
pokeBox col size ptr iptr ieptr (nv, nsi, nei) svs = do
|
||||
pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do
|
||||
nv' <- VFSM.foldM' (pokeBoxSurface col ptr svsv) nv $ VFSM.fromList $ boxSurfaces size
|
||||
nsi' <-
|
||||
UV.foldM'
|
||||
(pokeIndex nv iptr)
|
||||
nsi
|
||||
(memoFlatIndices V.! (size -3))
|
||||
nei' <-
|
||||
UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
nei' <- case sfid of
|
||||
NoShadowFidelity -> return nei
|
||||
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
memoBoxEdgeIndices V.! (size - 3)
|
||||
return (nv', nsi', nei')
|
||||
where
|
||||
@@ -216,6 +225,7 @@ boxSurfaces' n =
|
||||
[ map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]
|
||||
|
||||
pokeTopPrism ::
|
||||
ShadowFidelity ->
|
||||
Point3 ->
|
||||
Point4 ->
|
||||
Int ->
|
||||
@@ -226,18 +236,17 @@ pokeTopPrism ::
|
||||
VFSM.Stream IO Point3 ->
|
||||
IO (Int, Int, Int)
|
||||
{-# INLINE pokeTopPrism #-}
|
||||
pokeTopPrism cp col size ptr iptr ieptr (nv, nsi, nei) svs = do
|
||||
pokeTopPrism sfid cp col size ptr iptr ieptr (nv, nsi, nei) svs = do
|
||||
nv' <- VFSM.foldlM' (pokeJustV cp col ptr) nv svs
|
||||
nsi' <-
|
||||
UV.foldM'
|
||||
(pokeIndex nv iptr)
|
||||
nsi
|
||||
(memoTopPrismIndices V.! (size - 3))
|
||||
nei' <-
|
||||
UV.foldM'
|
||||
(pokeIndex nv ieptr)
|
||||
nei
|
||||
(memoTopPrismEdgeIndices V.! (size - 3))
|
||||
nei' <- case sfid of
|
||||
NoShadowFidelity -> return nei
|
||||
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
|
||||
memoTopPrismEdgeIndices V.! (size - 3)
|
||||
return (nv', nsi', nei')
|
||||
|
||||
pokeIndex ::
|
||||
|
||||
Reference in New Issue
Block a user