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

Redo mutable changes

Browse Source
This commit is contained in:
jgk
2021-08-12 01:14:58 +02:00
parent 724f9a86f8
commit f1200c4501
4 changed files with 43 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Rationality.hs
+1 -1
View File
@@ -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
src/Render.hs
+5 -4
View File
@@ -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''
src/Shader.hs
+3 -3
View File
@@ -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
src/Shader/Poke.hs
+34 -46
View File
@@ -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]