justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Buggy (but fastish) merge of shadows into shapes

Browse Source
This commit is contained in:
justin
2021-09-21 10:09:40 +01:00
parent e98ada22fd
commit 8854b195cc
3 changed files with 54 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Poke.hs
+35 -32
View File
@@ -45,54 +45,57 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
pokeShape
:: Ptr Float -- ^ vertex data pointer
-> Ptr Float -- ^ edge data pointer
-> Ptr GLushort -- ^ vertex indices pointer
-> Ptr GLushort -- ^ edge indices pointer
-> Shape
-> IO (Int,Int,Int,Int)
pokeShape vptr eptr iptr ieptr = bifoldlM
(pokeShapeObjs vptr iptr ieptr)
(pokeShapeEs eptr ieptr) (0,0,0,0)
-> IO (Int,Int,Int)
pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0) . fst
pokeShapeObjs
:: Ptr Float
-> Ptr GLushort
-> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeObj] -> IO (Int, Int,Int,Int)
pokeShapeObjs ptr iptr _ count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList
-> Ptr GLushort -> (Int,Int,Int) -> [ShapeObj] -> IO (Int,Int,Int)
pokeShapeObjs ptr iptr ieptr count = VS.foldlM' (pokeShapeObj ptr iptr ieptr) count . VS.fromList
pokeShapeObj :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int,Int)
pokeShapeObj ptr iptr counts (ShapeObj shType shVerts) = case shType of
TopPrism size -> pokeTopPrism size ptr iptr counts shVerts
pokeShapeObj :: Ptr Float -> Ptr GLushort -> Ptr GLushort
-> (Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int)
pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
TopPrism size -> pokeTopPrism size ptr iptr ieptr counts shVerts
pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int)
pokeTopPrism size ptr iptr count svs = do
count' <- pokeTopPrismIndices size iptr count
pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
-> Ptr GLushort -> (Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int)
pokeTopPrism size ptr iptr ieptr count svs = do
count' <- pokeTopPrismIndices size iptr count >>= pokeTopPrismEdgeIndices size ieptr
VS.foldlM' (pokeJustV ptr) count' (VS.fromList svs)
pokeTopPrismIndices :: Int -> Ptr GLushort -> (Int,Int,Int,Int) -> IO (Int,Int,Int,Int)
pokeTopPrismIndices size iptr (nv,ne,ni,nei) = do
pokeTopPrismIndices :: Int -> Ptr GLushort -> (Int,Int,Int) -> IO (Int,Int,Int)
pokeTopPrismIndices size iptr (nv,ni,nei) = do
ni' <- foldM (pokeTopPrismIndex nv iptr) ni (topPrismIndices size)
return (nv,ne,ni',nei)
return (nv,ni',nei)
pokeTopPrismEdgeIndices :: Int -> Ptr GLushort -> (Int,Int,Int) -> IO (Int,Int,Int)
pokeTopPrismEdgeIndices size ieptr (nv,ni,nei) = do
nei' <- foldM (pokeTopPrismEdgeIndex nv ieptr) nei (topPrismEdgeIndices size)
return (nv,ni,nei')
pokeTopPrismEdgeIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
pokeTopPrismEdgeIndex nv iptr ni ioff = do
pokeElemOff iptr ni (fromIntegral $ nv + ioff)
return (ni + 1)
pokeTopPrismIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
pokeTopPrismIndex nv iptr ni ioff = do
pokeElemOff iptr ni (fromIntegral $ nv + ioff)
return (ni + 1)
pokeShapeEs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [Point3] -> IO (Int,Int,Int,Int)
pokeShapeEs ptr ieptr count = VS.foldlM' (pokeShapeE ptr ieptr) count . VS.fromList
pokeShapeE :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> Point3 -> IO (Int,Int,Int,Int)
pokeShapeE eptr ieptr (nv,n,ni,nei) (V3 a b c) = do
pokeElemOff eptr (n * 3) a
pokeElemOff eptr (n * 3 + 1) b
pokeElemOff eptr (n * 3 + 2) c
pokeElemOff ieptr nei (fromIntegral n)
return $ (nv,n + 1,ni,nei+1)
topPrismEdgeIndices :: Int -> [Int]
topPrismEdgeIndices n = undefined
topPrismEdgeIndices n = concatMap f [0..n-1]
where
f i =
[ i, (i+2) `mod` n, i+1, (i+4) `mod` n
, i, i+1, (i+4) `mod` n, (i+3) `mod` n
, i+1, (i+5) `mod` n, i, (i+3) `mod` n
]
topPrismIndices :: Int -> [Int]
topPrismIndices n = concatMap f [1..n-2] -- triangles on top face
@@ -104,8 +107,8 @@ topPrismIndices n = concatMap f [1..n-2] -- triangles on top face
g x = [2*x,2*x+1,2*x+3
,2*x,2*x+3,2*x+2]
pokeJustV :: Ptr Float -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int)
pokeJustV ptr (nv,ne,ni,nei) sh = do
pokeJustV :: Ptr Float -> (Int,Int,Int) -> ShapeV -> IO (Int,Int,Int)
pokeJustV ptr (nv,ni,nei) sh = do
pokeElemOff ptr (off 0) a
pokeElemOff ptr (off 1) b
pokeElemOff ptr (off 2) c
@@ -113,7 +116,7 @@ pokeJustV ptr (nv,ne,ni,nei) sh = do
pokeElemOff ptr (off 4) e
pokeElemOff ptr (off 5) f
pokeElemOff ptr (off 6) g
return (nv+1,ne,ni,nei)
return (nv+1,ni,nei)
where
off i = nv*7 + i
V3 a b c = _svPos sh