Remove wall corner collision test for creatures

This commit is contained in:
2021-09-24 11:31:08 +01:00
parent 1883e0785e
commit 899cf6ef81
10 changed files with 47 additions and 76 deletions
+10 -40
View File
@@ -25,7 +25,7 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS
import Control.Monad.Primitive
--import Control.Parallel.Strategies
--import System.Environment
import Control.Monad.Parallel as MP
--import Control.Monad.Parallel as MP
--import Control.Monad
--import qualified Data.DList as DL
@@ -68,25 +68,22 @@ pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
-> Ptr GLushort -> (Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int)
{-# INLINE pokeTopPrism #-}
pokeTopPrism size ptr iptr ieptr (nv,ni,nei) svs = do
MP.bindM3 (\a b c -> return (a,b,c))
(VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs) )
(UV.foldM (pokeTopPrismIndex nv iptr) ni (memoTopPrismIndices V.! (size - 2)) )
(UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2)) )
-- ni' <- UV.foldM (pokeTopPrismIndex nv iptr) ni (memoTopPrismIndices V.! (size - 2))
-- nei' <- UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2))
-- nv' <- VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs)
-- return (nv',ni',nei')
-- MP.bindM3 (\a b c -> return (a,b,c))
-- (VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs) )
-- (UV.foldM (pokeTopPrismIndex nv iptr) ni (memoTopPrismIndices V.! (size - 2)) )
-- (UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2)) )
ni' <- UV.foldM (pokeTopPrismIndex nv iptr) ni (memoTopPrismIndices V.! (size - 2))
nei' <- UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2))
nv' <- VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs)
return (nv',ni',nei')
pokeTopPrismEdgeIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
{-# INLINE pokeTopPrismEdgeIndex #-}
pokeTopPrismEdgeIndex nv iptr ni ioff = do
pokeElemOff iptr ni (fromIntegral $ nv + ioff)
return (ni + 1)
pokeTopPrismIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
{-# INLINE pokeTopPrismIndex #-}
pokeTopPrismIndex nv iptr ni ioff = do
pokeElemOff iptr ni (fromIntegral $ nv + ioff)
return (ni + 1)
@@ -152,7 +149,7 @@ pokeLayVerxs
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
pokeLayVerxs vbos counts vxs = VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
pokeLayVerxs vbos counts = VS.mapM_ (pokeLayVerx vbos counts) . VS.fromList
pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-}
@@ -198,33 +195,6 @@ pokeArrayOff :: Ptr Float -> Int -> [Float] -> IO ()
{-# INLINE pokeArrayOff #-}
pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))
--pokeTwoOff
-- :: Ptr Float
-- -> Int
-- -> (Float,Float)
-- -> IO ()
--{-# INLINE pokeTwoOff #-}
--pokeTwoOff ptr n (x,y) = do
-- pokeElemOff ptr (2*n+0) x
-- pokeElemOff ptr (2*n+1) y
--pokeThreeOff
-- :: Ptr Float
-- -> Int
-- -> (Float,Float,Float)
-- -> IO ()
--{-# INLINE pokeThreeOff #-}
--pokeThreeOff ptr n (x,y,z) = do
-- pokeElemOff ptr (3*n+0) x
-- pokeElemOff ptr (3*n+1) y
-- pokeElemOff ptr (3*n+2) z
--pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
--{-# INLINE pokeFourOff #-}
--pokeFourOff ptr n (x,y,z,w) = do
-- pokeElemOff ptr (4*n+0) x
-- pokeElemOff ptr (4*n+1) y
-- pokeElemOff ptr (4*n+2) z
-- pokeElemOff ptr (4*n+3) w
pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
pokePoint33s ptr = VS.foldlM' (pokePoint33 ptr) 0 . VS.fromList