diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index ac4d84f23..32216dcfd 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -54,7 +54,7 @@ followImpulses w (f,g) cr (f, cr) (_crImpulse $ _crActionPlan cr) where - g' = snd $ next g + g' = snd $ genWord8 g followImpulse :: Creature diff --git a/src/Render.hs b/src/Render.hs index 1df7c37ed..013dc7f01 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -150,9 +150,9 @@ pokeBindFoldable -> IO (PicShads Int) pokeBindFoldable shads m = do counts <- UMV.replicate 6 0 - pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m - shads' <- picShadToMV shads - bindShader shads' counts + shadV <- picShadToMV shads + pokeVerxs shadV counts m + bindShader shadV counts elist <- vToPicShad counts return elist @@ -165,7 +165,8 @@ pokeBindFoldableLayer -> IO (IM.IntMap (PicShads Int)) pokeBindFoldableLayer pdata m = do let shads = _pictureShaders pdata - slist'' <- pokeLayVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m + shadV <- picShadToMV shads + slist'' <- pokeLayVerxs shadV m bindShaderLay shads slist'' return slist'' diff --git a/src/Shader.hs b/src/Shader.hs index 56fd38c37..455e1ed3c 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -12,7 +12,7 @@ module Shader import Shader.Data import Shader.Parameters import Shader.ExtraPrimitive -import Shader.Poke +--import Shader.Poke --import Layers --import MatrixHelper @@ -82,8 +82,8 @@ drawShaderLay l fs i = do drawShaderLay' :: Int -> UMV.MVector (PrimState IO) Int -> Int -> VShader -> IO () {-# INLINE drawShaderLay' #-} -drawShaderLay' l countsVector index fs = do - i <- UMV.read countsVector index +drawShaderLay' l countsVector shadIn fs = do + i <- UMV.read countsVector shadIn currentProgram $= Just (_vshaderProgram fs) bindVertexArrayObject $= Just (_vao $ _vshaderVAO fs) case _vshaderTexture fs of diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index f94516a44..02326267a 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -32,13 +32,22 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS import Control.Monad.Primitive pokeVerxs - :: PicShads VBO + :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> [Verx] -> IO () -pokeVerxs vbos count vxs = do - s <- picShadToMV vbos - VS.mapM_ (pokeVerx' s count) $ VS.fromList vxs +pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs + +pokeVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do + typeOff <- UMV.unsafeRead offsets sn + basePtr <- fmap (_vboPtr . _vaoVBO . _vshaderVAO) $ MV.read vbos sn + let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize) + poke34 thePtr thePos theCol + pokeArrayOff thePtr 7 ext + UMV.unsafeModify offsets (+1) sn + where + sn = _unShadNum theShadNum vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int) {-# INLINE vToPicShad #-} @@ -59,6 +68,7 @@ picShadToUMV (PicShads a b c d e f) = do UMV.write theVec 4 e UMV.write theVec 5 f return theVec + picShadToMV :: PicShads a -> IO (MV.MVector (PrimState IO) a) {-# INLINE picShadToMV #-} picShadToMV (PicShads a b c d e f) = do @@ -72,29 +82,6 @@ picShadToMV (PicShads a b c d e f) = do return theVec - -pokeVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO () ---{-# INLINE pokeVerx #-} -pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do - typeOff <- UMV.unsafeRead offsets sn - let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize) - poke34 thePtr thePos theCol - pokeArrayOff thePtr 7 ext - UMV.unsafeModify offsets (+1) sn - where - sn = _unShadNum theShadNum - -pokeVerx' :: MV.MVector (PrimState IO) VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO () -pokeVerx' vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do - typeOff <- UMV.unsafeRead offsets sn - theShad <- MV.read vbos sn - let thePtr = plusPtr (_vboPtr theShad) (typeOff * pokeStride sn * floatSize) - poke34 thePtr thePos theCol - pokeArrayOff thePtr 7 ext - UMV.unsafeModify offsets (+1) sn - where - sn = _unShadNum theShadNum - poke34 :: Ptr Float -> Point3 -> Point4 -> IO () {-# INLINE poke34 #-} poke34 ptr (V3 a b c) (V4 d e f g) = do @@ -137,23 +124,6 @@ pokePoint3s ptr vals0 = go vals0 0 where off i = n*3 + i -pokeLayVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO () ---{-# INLINE pokeLayVerx #-} -pokeLayVerx vbos counts vx = do - theOff <- UMV.unsafeRead counts vecPos - let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) - poke34 thePtr thePos theCol - pokeArrayOff thePtr 7 (_vxExt vx) - UMV.unsafeModify counts (+ 1) vecPos - where - sn = _unShadNum (_vxShadNum vx) - vecPos = theLayer * 6 + sn - theLayer = _vxLayer vx - thePos = _vxPos vx - theCol = _vxCol vx - basePtr = _vboPtr $ vboFromType vbos sn - layOff = theLayer * numSubElements - theStride = pokeStride sn vboFromType :: PicShads VBO -> Int -> VBO {-# INLINE vboFromType #-} @@ -167,13 +137,31 @@ vboFromType ps sn = case sn of _ -> undefined -pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int)) +pokeLayVerxs :: MV.MVector (PrimState IO) VShader -> [Verx] -> IO (IM.IntMap (PicShads Int)) pokeLayVerxs vbos vxs = do counts <- UMV.replicate (6*6) 0 - --SP.mapM_ (pokeLayVerx vbos counts) $ SP.each vxs VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs vToLayPicShad counts +pokeLayVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +--{-# INLINE pokeLayVerx #-} +pokeLayVerx vbos counts vx = do + theOff <- UMV.unsafeRead counts vecPos + basePtr <- fmap (_vboPtr . _vaoVBO . _vshaderVAO) $ MV.unsafeRead vbos sn + let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) + poke34 thePtr thePos theCol + pokeArrayOff thePtr 7 (_vxExt vx) + UMV.unsafeModify counts (+ 1) vecPos + where + sn = _unShadNum (_vxShadNum vx) + vecPos = theLayer * 6 + sn + theLayer = _vxLayer vx + thePos = _vxPos vx + theCol = _vxCol vx + --basePtr = _vboPtr $ vboFromType vbos sn + layOff = theLayer * numSubElements + theStride = pokeStride sn + vToLayPicShad :: UMV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int)) {-# INLINE vToLayPicShad #-} vToLayPicShad mv = foldM f IM.empty [0..5]