Work towards using mutable vectors for storing parameters
This commit is contained in:
+6
-2
@@ -24,6 +24,7 @@ import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygo
|
||||
--import Data.Tuple.Extra
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified SDL
|
||||
import qualified Data.Vector.Unboxed.Mutable as UMV
|
||||
|
||||
divideSize :: Int -> Size -> Size
|
||||
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
|
||||
@@ -148,8 +149,11 @@ pokeBindFoldable
|
||||
-> IO (PicShads Int)
|
||||
pokeBindFoldable pdata m = do
|
||||
let shads = _pictureShaders pdata
|
||||
elist <- pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m
|
||||
bindShader shads elist
|
||||
counts <- UMV.replicate 6 0
|
||||
pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m
|
||||
shads' <- picShadToMV shads
|
||||
bindShader shads' counts
|
||||
elist <- vToPicShad counts
|
||||
return elist
|
||||
|
||||
zeroCounts :: PicShads Int
|
||||
|
||||
+16
-2
@@ -11,9 +11,13 @@ module Shader
|
||||
import Shader.Data
|
||||
import Shader.Parameters
|
||||
import Shader.ExtraPrimitive
|
||||
import Shader.Poke
|
||||
--import Layers
|
||||
--import MatrixHelper
|
||||
|
||||
import qualified Data.Vector.Unboxed.Mutable as UMV
|
||||
import qualified Data.Vector.Mutable as MV
|
||||
import Control.Monad.Primitive
|
||||
import Foreign
|
||||
import Control.Monad
|
||||
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
||||
@@ -53,8 +57,18 @@ bindShaderLay shads = mapM_ (uncurry f) . IM.toList
|
||||
where
|
||||
f lay counts = sequence_ $ bindArrayBuffersLayer lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
|
||||
|
||||
bindShader :: PicShads VShader -> PicShads Int -> IO ()
|
||||
bindShader shads counts = sequence_ $ bindArrayBuffers <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
|
||||
--bindShader :: PicShads VShader -> PicShads Int -> IO ()
|
||||
----bindShader shads counts = sequence_ $ bindArrayBuffers <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
|
||||
--bindShader shads count = do
|
||||
-- s <- picShadToMV shads
|
||||
-- c <- picShadToUMV count
|
||||
-- bindShader' s c
|
||||
|
||||
bindShader :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> IO ()
|
||||
bindShader shads counts = MV.imapM_ f shads
|
||||
where
|
||||
f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _vshaderVAO $ shad)
|
||||
|
||||
|
||||
bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
|
||||
bindShaderBuffers = zipWithM_ f
|
||||
|
||||
+54
-23
@@ -7,6 +7,10 @@ module Shader.Poke
|
||||
, pokeVerxs
|
||||
, pokeLayVerxs
|
||||
, poke224s
|
||||
, picShadToUMV
|
||||
, picShadToMV
|
||||
, vToPicShad
|
||||
, vToPicShadMV
|
||||
) where
|
||||
import Shader.Data
|
||||
import Shader.Parameters
|
||||
@@ -22,35 +26,62 @@ import Control.Monad
|
||||
--import qualified Control.Foldl as F
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
--import Control.Lens
|
||||
import qualified Data.Vector.Unboxed.Mutable as MV
|
||||
import qualified Data.Vector.Unboxed.Mutable as UMV
|
||||
import qualified Data.Vector.Mutable as MV
|
||||
import qualified Data.Vector.Fusion.Stream.Monadic as VS
|
||||
import Control.Monad.Primitive
|
||||
|
||||
pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
|
||||
pokeVerxs vbos vxs = do
|
||||
count <- MV.replicate 6 0
|
||||
--SP.mapM_ (pokeVerx vbos count) $ SP.each vxs
|
||||
pokeVerxs
|
||||
:: PicShads VBO
|
||||
-> UMV.MVector (PrimState IO) Int
|
||||
-> [Verx]
|
||||
-> IO ()
|
||||
pokeVerxs vbos count vxs = do
|
||||
--count <- UMV.replicate 6 0
|
||||
VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
|
||||
vToPicShad count
|
||||
-- F.foldM (F.FoldM
|
||||
-- (\_ vx -> pokeVerx vbos count vx >> addCountVerx count vx)
|
||||
-- (return ())
|
||||
-- (const (vToPicShad count))
|
||||
-- )
|
||||
-- vxs
|
||||
--vToPicShad count
|
||||
|
||||
vToPicShad :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
{-# INLINE vToPicShad #-}
|
||||
vToPicShad mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
vToPicShad mv = mapM (UMV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
|
||||
pokeVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
vToPicShadMV :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
{-# INLINE vToPicShadMV #-}
|
||||
vToPicShadMV mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
|
||||
picShadToUMV :: PicShads Int -> IO (UMV.MVector (PrimState IO) Int)
|
||||
{-# INLINE picShadToUMV #-}
|
||||
picShadToUMV (PicShads a b c d e f) = do
|
||||
theVec <- UMV.new 6
|
||||
UMV.write theVec 0 a
|
||||
UMV.write theVec 1 b
|
||||
UMV.write theVec 2 c
|
||||
UMV.write theVec 3 d
|
||||
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
|
||||
theVec <- MV.new 6
|
||||
MV.write theVec 0 a
|
||||
MV.write theVec 1 b
|
||||
MV.write theVec 2 c
|
||||
MV.write theVec 3 d
|
||||
MV.write theVec 4 e
|
||||
MV.write theVec 5 f
|
||||
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 <- MV.unsafeRead offsets sn
|
||||
typeOff <- UMV.unsafeRead offsets sn
|
||||
let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize)
|
||||
poke34 thePtr thePos theCol
|
||||
pokeArrayOff thePtr 7 ext
|
||||
MV.unsafeModify offsets (+1) sn
|
||||
UMV.unsafeModify offsets (+1) sn
|
||||
where
|
||||
sn = _unShadNum theShadNum
|
||||
|
||||
@@ -96,14 +127,14 @@ pokePoint3s ptr vals0 = go vals0 0
|
||||
where
|
||||
off i = n*3 + i
|
||||
|
||||
pokeLayVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
pokeLayVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
--{-# INLINE pokeLayVerx #-}
|
||||
pokeLayVerx vbos counts vx = do
|
||||
theOff <- MV.unsafeRead counts vecPos
|
||||
theOff <- UMV.unsafeRead counts vecPos
|
||||
let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
|
||||
poke34 thePtr thePos theCol
|
||||
pokeArrayOff thePtr 7 (_vxExt vx)
|
||||
MV.unsafeModify counts (+ 1) vecPos
|
||||
UMV.unsafeModify counts (+ 1) vecPos
|
||||
where
|
||||
sn = _unShadNum (_vxShadNum vx)
|
||||
vecPos = theLayer * 6 + sn
|
||||
@@ -128,16 +159,16 @@ vboFromType ps sn = case sn of
|
||||
|
||||
pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
|
||||
pokeLayVerxs vbos vxs = do
|
||||
counts <- MV.replicate (6*6) 0
|
||||
counts <- UMV.replicate (6*6) 0
|
||||
--SP.mapM_ (pokeLayVerx vbos counts) $ SP.each vxs
|
||||
VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
|
||||
vToLayPicShad counts
|
||||
|
||||
vToLayPicShad :: MV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int))
|
||||
vToLayPicShad :: UMV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int))
|
||||
{-# INLINE vToLayPicShad #-}
|
||||
vToLayPicShad mv = foldM f IM.empty [0..5]
|
||||
where
|
||||
f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ MV.unsafeSlice (i * 6) 6 mv)
|
||||
f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ UMV.unsafeSlice (i * 6) 6 mv)
|
||||
|
||||
pokeStride :: Int -> Int
|
||||
{-# INLINE pokeStride #-}
|
||||
|
||||
+2
-1
@@ -17,7 +17,8 @@
|
||||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver: lts-17.1
|
||||
#resolver: lts-17.1
|
||||
resolver: lts-18.5
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
||||
Reference in New Issue
Block a user