This commit is contained in:
2022-06-27 15:58:53 +01:00
parent 9ec6f7d91b
commit 8d5800d806
2 changed files with 17 additions and 94 deletions
+1 -4
View File
@@ -62,15 +62,12 @@ doDrawing pdata u = do
windowPoints
(_floorTiles w)
)
( pokeShape'
( pokeShape
(_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
(_eboPtr $ _shapeEBO pdata)
(_eboPtr $ _silhouetteEBO pdata)
ws
)
-- nShapeVs <- UMV.read shapeCounts 0
-- nIndices <- UMV.read shapeCounts 1
-- nSilIndices <- UMV.read shapeCounts 2
nWalls <- UMV.read wlwiflCounts 0
nWins <- UMV.read wlwiflCounts 1
nFls <- UMV.read wlwiflCounts 2
+16 -90
View File
@@ -4,7 +4,6 @@ module Shader.Poke
, pokeArrayOff
, pokePoint33s
, pokeShape
, pokeShape'
, pokeWallsWindowsFloor
) where
import Shader.Data
@@ -82,111 +81,54 @@ pokeW ptr counts iv ((V2 a b,V2 c d),V4 e f g h) = do
UMV.unsafeModify counts (+1) iv
pokeShape
:: Ptr Float
-> Ptr GLushort
-> Ptr GLushort
-> UMV.MVector (PrimState IO) Int
-> [ShapeObj]
-> IO ()
pokeShape ptr iptr ieptr counts = VS.mapM_ (pokeShapeObj ptr iptr ieptr counts) . VS.fromList
pokeShape'
:: Ptr Float
-> Ptr GLushort
-> Ptr GLushort
-> [ShapeObj]
-> IO (Int,Int,Int)
pokeShape' ptr iptr ieptr = VS.foldM (pokeShapeObj' ptr iptr ieptr) (0,0,0) . VS.fromList
pokeShape ptr iptr ieptr = VS.foldM (pokeShapeObj ptr iptr ieptr) (0,0,0) . VS.fromList
pokeShapeObj
:: Ptr Float
-> Ptr GLushort
-> Ptr GLushort
-> UMV.MVector (PrimState IO) Int
-> (Int,Int,Int)
-> ShapeObj
-> IO ()
-> IO (Int,Int,Int)
{-# INLINE pokeShapeObj #-}
pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr 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 - 2) ptr iptr ieptr counts shVerts
pokeTopPrism' :: Int -> Ptr Float -> Ptr GLushort
pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
-> Ptr GLushort
-> (Int,Int,Int)
-> [ShapeV]
-> IO (Int,Int,Int)
pokeTopPrism' size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
nv' <- VS.foldM (pokeJustV' ptr) nv (VS.fromList svs)
nshapeindices' <- UV.foldM (pokeTopPrismIndex' nv iptr) nshapeindices
{-# INLINE pokeTopPrism #-}
pokeTopPrism size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
nv' <- VS.foldM (pokeJustV ptr) nv (VS.fromList svs)
nshapeindices' <- UV.foldM (pokeTopPrismIndex nv iptr) nshapeindices
(memoTopPrismIndices V.! size)
nedgeindices' <- UV.foldM (pokeTopPrismEdgeIndex' nv ieptr) nedgeindices
nedgeindices' <- UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nedgeindices
(memoTopPrismEdgeIndices V.! size)
return ( nv', nshapeindices', nedgeindices')
pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
-> Ptr GLushort
-> UMV.MVector (PrimState IO) Int
-> [ShapeV]
-> IO ()
pokeTopPrism size ptr iptr ieptr counts svs = do
nv <- UMV.unsafeRead counts 0
nshapeindices <- UMV.unsafeRead counts 1
nedgeindices <- UMV.unsafeRead counts 2
-- MP.bindM3 (\_ _ _ -> return ())
-- (UV.mapM_ (pokeTopPrismIndex nv iptr counts) (memoTopPrismIndices V.! size))
-- (UV.mapM_ (pokeTopPrismEdgeIndex nv ieptr counts) (memoTopPrismEdgeIndices V.! size))
-- (VS.mapM_ (pokeJustV ptr counts) (VS.fromList svs) )
nv' <- VS.foldM (pokeJustV' ptr) nv (VS.fromList svs)
nshapeindices' <- UV.foldM (pokeTopPrismIndex' nv iptr) nshapeindices
(memoTopPrismIndices V.! size)
nedgeindices' <- UV.foldM (pokeTopPrismEdgeIndex' nv ieptr) nedgeindices
(memoTopPrismEdgeIndices V.! size)
UMV.unsafeWrite counts 0 nv'
UMV.unsafeWrite counts 1 nshapeindices'
UMV.unsafeWrite counts 2 nedgeindices'
pokeTopPrismEdgeIndex' :: Int -> Ptr GLushort
pokeTopPrismEdgeIndex :: Int -> Ptr GLushort
-> Int
-> Int
-> IO Int
pokeTopPrismEdgeIndex' nv eiptr nedgeindices ioff = do
pokeTopPrismEdgeIndex nv eiptr nedgeindices ioff = do
pokeElemOff eiptr nedgeindices (fromIntegral $ nv + ioff)
return $ nedgeindices + 1
--pokeTopPrismEdgeIndex :: Int -> Ptr GLushort
-- -> UMV.MVector (PrimState IO) Int
-- -> Int
-- -> IO ()
--pokeTopPrismEdgeIndex nv eiptr counts ioff = do
-- nei <- UMV.unsafeRead counts 2
-- pokeElemOff eiptr nei (fromIntegral $ nv + ioff)
-- UMV.unsafeModify counts (+1) 2
pokeTopPrismIndex' :: Int -> Ptr GLushort
pokeTopPrismIndex :: Int -> Ptr GLushort
-> Int
-> Int
-> IO Int
pokeTopPrismIndex' nv iptr nshapeindices ioff = do
pokeTopPrismIndex nv iptr nshapeindices ioff = do
pokeElemOff iptr nshapeindices (fromIntegral $ nv + ioff)
return $ nshapeindices + 1
--pokeTopPrismIndex :: Int -> Ptr GLushort
-- -> UMV.MVector (PrimState IO) Int
-- -> Int
-- -> IO ()
--pokeTopPrismIndex nv iptr counts ioff = do
-- ni <- UMV.unsafeRead counts 1
-- pokeElemOff iptr ni (fromIntegral $ nv + ioff)
-- UMV.unsafeModify counts (+1) 1
memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
memoTopPrismEdgeIndices = V.generate 10
$ UV.fromList . topPrismEdgeIndices . (+ 2)
@@ -219,11 +161,11 @@ 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
pokeJustV :: Ptr Float
-> Int
-> ShapeV
-> IO Int
pokeJustV' ptr nv sh = do
pokeJustV ptr nv sh = do
let off i = nv*7 + i
pokeElemOff ptr (off 0) a
pokeElemOff ptr (off 1) b
@@ -237,22 +179,6 @@ pokeJustV' ptr nv sh = do
V3 a b c = _svPos sh
V4 d e f g = _svCol sh
--pokeJustV :: Ptr Float -> UMV.MVector (PrimState IO) Int -> ShapeV -> IO ()
--pokeJustV ptr counts sh = do
-- nv <- UMV.unsafeRead counts 0
-- let off i = nv*7 + i
-- pokeElemOff ptr (off 0) a
-- pokeElemOff ptr (off 1) b
-- pokeElemOff ptr (off 2) c
-- pokeElemOff ptr (off 3) d
-- pokeElemOff ptr (off 4) e
-- pokeElemOff ptr (off 5) f
-- pokeElemOff ptr (off 6) g
-- UMV.unsafeModify counts (+1) 0
-- where
-- V3 a b c = _svPos sh
-- V4 d e f g = _svCol sh
pokeLayVerxs
:: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int