Allow shadow fidelity option, fix bug in rendering box shadows

This commit is contained in:
2023-03-25 17:22:58 +00:00
parent cdc4a84d4b
commit d989acd6f2
26 changed files with 410 additions and 258 deletions
+24 -24
View File
@@ -95,15 +95,18 @@ pokeW ptr i' ((V2 a b, V2 c d), V4 e f g h) = do
return $ i' + 1
pokeShape ::
(Surface -> Bool) ->
Ptr Float ->
Ptr GLushort ->
Ptr GLushort ->
(Int, Int, Int) ->
[Surface] ->
IO (Int, Int, Int)
pokeShape ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj ptr iptr ieptr) is . VFSM.fromList
pokeShape shadowtest ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
. VFSM.fromList
pokeShapeObj ::
(Surface -> Bool) ->
Ptr Float ->
Ptr GLushort ->
Ptr GLushort ->
@@ -111,13 +114,15 @@ pokeShapeObj ::
Surface ->
IO (Int, Int, Int)
{-# INLINE pokeShapeObj #-}
pokeShapeObj ptr iptr ieptr counts (Surface shtype shVerts col shadfid) = case shtype of
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
pokeShapeObj shadowtest ptr iptr ieptr counts surf@(Surface shtype shVerts col _ _) = case shtype of
FlatFaces size -> pokeBox blockshadows col size ptr iptr ieptr counts shVerts
RoundedFaces size -> pokeRoundedFaces blockshadows col size ptr iptr ieptr counts shVerts
Cylinder size -> pokeCylinder blockshadows col size ptr iptr ieptr counts shVerts
where
blockshadows = shadowtest surf
pokeRoundedFaces ::
ShadowFidelity ->
Bool ->
Point4 ->
Int ->
Ptr Float ->
@@ -134,15 +139,14 @@ pokeRoundedFaces sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = d
(pokeIndex nv iptr)
nsi
(memoTopPrismIndices V.! (size - 3))
nei' <- case sfid of
NoShadowFidelity -> return nei
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
nei' <- if sfid then return nei
else UV.foldM' (pokeIndex nv ieptr) nei $
memoTopPrismEdgeIndices V.! (size - 3)
return (nv', nsi', nei')
pokeRoundedFaces _ _ _ _ _ _ _ _ = undefined
pokeCylinder ::
ShadowFidelity ->
Bool ->
Point4 ->
Int ->
Ptr Float ->
@@ -159,9 +163,9 @@ pokeCylinder sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
(pokeIndex nv iptr)
nsi
(memoCylinderIndices V.! (size - 3))
nei' <- case sfid of
NoShadowFidelity -> return nei
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
nei' <- if sfid
then return nei
else UV.foldM' (pokeIndex nv ieptr) nei $
memoTopPrismEdgeIndices V.! (size - 3)
return (nv', nsi', nei')
pokeCylinder _ _ _ _ _ _ _ _ = undefined
@@ -182,7 +186,7 @@ pokeCylinderCaps col ptr tc bc = go True
go _ [] n = return n
pokeBox ::
ShadowFidelity ->
Bool ->
Point4 ->
Int ->
Ptr Float ->
@@ -199,9 +203,8 @@ pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do
(pokeIndex nv iptr)
nsi
(memoFlatIndices V.! (size -3))
nei' <- case sfid of
NoShadowFidelity -> return nei
FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
nei' <- if sfid then return nei
else UV.foldM' (pokeIndex nv ieptr) nei $
memoBoxEdgeIndices V.! (size - 3)
return (nv', nsi', nei')
where
@@ -297,15 +300,12 @@ boxEdgeIndices ::
[Int]
boxEdgeIndices n = concatMap f [0 .. n -1]
where
f i =
map
g
[ 0 , 1 , n , 2
, 0 , n , -1 , n + 1
, n , n + 1 , n -1 , 1
f i = [ g 0 , g 1 ,n + g 0 , g 2
, g 0 , n + g 0 , n + g (-1) , g 1
, n + g 0 , n + g 1 , n + g (-1) , g 1
]
where
g j = (i + j) `mod` (2 * n)
g j = (i + j) `mod` n
cylinderIndices :: Int -> [Int]
cylinderIndices n =