Continue transfer to mutable vectors
This commit is contained in:
+4
-1
@@ -12,6 +12,7 @@ import Dodge.Config.Load
|
||||
import Dodge.Config.Update
|
||||
import Dodge.SoundLogic.LoadSound
|
||||
import Dodge.Debug.Flag.Data
|
||||
import Data.Preload.Render
|
||||
import Picture
|
||||
import Render
|
||||
import Preload.Render
|
||||
@@ -20,6 +21,7 @@ import Preload
|
||||
import Sound.Data
|
||||
import Music
|
||||
import Data.Preload
|
||||
import Shader.Poke
|
||||
|
||||
import Control.Lens
|
||||
--import Foreign (Word32)
|
||||
@@ -54,8 +56,9 @@ doSideEffects preData w = do
|
||||
|
||||
endTicks <- SDL.ticks
|
||||
let lastFrameTicks = _frameTimer preData
|
||||
shads <- picShadToMV $ _pictureShaders $ _renderData preData
|
||||
when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable
|
||||
(_renderData preData)
|
||||
shads
|
||||
(setDepth (-1)
|
||||
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
|
||||
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
|
||||
|
||||
+5
-3
@@ -76,10 +76,12 @@ doDrawing pdata w = do
|
||||
then renderTextureWalls pdata nWalls
|
||||
else renderBlankWalls pdata nWalls
|
||||
|
||||
_ <- renderFoldable pdata $ polysToPic $ foregroundPics w
|
||||
let shads = _pictureShaders pdata
|
||||
vShads <- picShadToMV shads
|
||||
|
||||
_ <- renderFoldable vShads $ polysToPic $ foregroundPics w
|
||||
|
||||
vnums <- pokeBindFoldableLayer pdata $ worldPictures w
|
||||
let shads = _pictureShaders pdata
|
||||
renderLayer 0 shads vnums
|
||||
|
||||
nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
|
||||
@@ -174,7 +176,7 @@ doDrawing pdata w = do
|
||||
blend $= Enabled
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
|
||||
_ <- renderFoldable pdata $ fixedCoordPictures w
|
||||
_ <- renderFoldable vShads $ fixedCoordPictures w
|
||||
depthMask $= Enabled
|
||||
|
||||
eTicks <- SDL.ticks
|
||||
|
||||
+23
-17
@@ -26,6 +26,7 @@ import qualified Data.IntMap.Strict as IM
|
||||
import qualified SDL
|
||||
import qualified Data.Vector.Unboxed.Mutable as UMV
|
||||
import qualified Data.Vector.Mutable as MV
|
||||
import Control.Monad.Primitive
|
||||
|
||||
divideSize :: Int -> Size -> Size
|
||||
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
|
||||
@@ -145,16 +146,13 @@ drawTextureOnFramebuffer fs fbo to = do
|
||||
drawShader fs 4
|
||||
|
||||
pokeBindFoldable
|
||||
:: PicShads VShader
|
||||
:: MV.MVector (PrimState IO) VShader
|
||||
-> UMV.MVector (PrimState IO) Int
|
||||
-> [Verx]
|
||||
-> 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
|
||||
elist <- vToPicShad counts
|
||||
return elist
|
||||
-> IO ()
|
||||
pokeBindFoldable shads counts m = do
|
||||
pokeVerxs shads counts m
|
||||
bindShader shads counts
|
||||
|
||||
zeroCounts :: PicShads Int
|
||||
zeroCounts = PicShads 0 0 0 0 0 0
|
||||
@@ -170,17 +168,14 @@ pokeBindFoldableLayer pdata m = do
|
||||
return slist''
|
||||
|
||||
renderFoldable
|
||||
:: RenderData
|
||||
:: MV.MVector (PrimState IO) VShader
|
||||
-> [Verx]
|
||||
-> IO Word32
|
||||
renderFoldable pdata struct = do
|
||||
renderFoldable shads struct = do
|
||||
pokeStartTicks <- SDL.ticks
|
||||
let shads = _pictureShaders pdata
|
||||
count <- pokeBindFoldable shads struct
|
||||
s <- picShadToMV shads
|
||||
c <- picShadToUMV count
|
||||
MV.imapM_ (drawShaderLay' 0 c) s
|
||||
--sequence_ (drawShaderLay 0 <$> shads <*> count)
|
||||
counts <- UMV.replicate 6 0
|
||||
pokeBindFoldable shads counts struct
|
||||
MV.imapM_ (drawShaderLay' 0 counts) shads
|
||||
pokeEndTicks <- SDL.ticks
|
||||
return $ pokeEndTicks - pokeStartTicks
|
||||
------------------------------end renderFoldable
|
||||
@@ -188,6 +183,17 @@ renderFoldable pdata struct = do
|
||||
renderLayer :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
|
||||
renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i
|
||||
|
||||
renderLayer'
|
||||
:: Int
|
||||
-> MV.MVector (PrimState IO) VShader
|
||||
-> IM.IntMap (UMV.MVector (PrimState IO) Int)
|
||||
-> IO ()
|
||||
renderLayer' theLayer shads counts = MV.imapM_ f shads
|
||||
where
|
||||
layCounts = counts IM.! theLayer
|
||||
f shadIndex theShader = UMV.read layCounts shadIndex >>= drawShaderLay theLayer theShader
|
||||
--undefined -- sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i
|
||||
|
||||
pokeTwoOff
|
||||
:: Ptr Float
|
||||
-> Int
|
||||
|
||||
+4
-4
@@ -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,15 +82,15 @@ 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' theLayer shaderOffsetsVector shaderIndex fs = do
|
||||
i <- UMV.read shaderOffsetsVector shaderIndex
|
||||
currentProgram $= Just (_vshaderProgram fs)
|
||||
bindVertexArrayObject $= Just (_vao $ _vshaderVAO fs)
|
||||
case _vshaderTexture fs of
|
||||
Just ShaderTexture{_textureObject = txo}
|
||||
-> textureBinding Texture2D $= Just txo
|
||||
_ -> return ()
|
||||
glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i)
|
||||
glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ theLayer*numSubElements) (fromIntegral i)
|
||||
|
||||
drawShader :: FullShader -> Int -> IO ()
|
||||
{-# INLINE drawShader #-}
|
||||
|
||||
+14
-19
@@ -31,14 +31,22 @@ import qualified Data.Vector.Mutable as MV
|
||||
import qualified Data.Vector.Fusion.Stream.Monadic as VS
|
||||
import Control.Monad.Primitive
|
||||
|
||||
pokeVerxs
|
||||
:: PicShads VBO
|
||||
--pokeVerxs
|
||||
-- :: PicShads VBO
|
||||
-- -> UMV.MVector (PrimState IO) Int
|
||||
-- -> [Verx]
|
||||
-- -> IO ()
|
||||
--pokeVerxs vbos count vxs = do
|
||||
-- s <- picShadToMV vbos
|
||||
-- VS.mapM_ (pokeVerx s count) $ VS.fromList vxs
|
||||
|
||||
pokeVerxs
|
||||
:: 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
|
||||
VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
|
||||
|
||||
vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
{-# INLINE vToPicShad #-}
|
||||
@@ -71,23 +79,10 @@ picShadToMV (PicShads a b c d e f) = do
|
||||
MV.write theVec 5 f
|
||||
return theVec
|
||||
|
||||
|
||||
|
||||
pokeVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
--{-# INLINE pokeVerx #-}
|
||||
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
|
||||
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
|
||||
theShad <- fmap (_vaoVBO . _vshaderVAO) $ MV.read vbos sn
|
||||
let thePtr = plusPtr (_vboPtr theShad) (typeOff * pokeStride sn * floatSize)
|
||||
poke34 thePtr thePos theCol
|
||||
pokeArrayOff thePtr 7 ext
|
||||
|
||||
Reference in New Issue
Block a user