diff --git a/src/Render.hs b/src/Render.hs index c5184ebd7..645d98ca4 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -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 diff --git a/src/Shader.hs b/src/Shader.hs index 5ba477f86..ac131dce4 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -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 diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 9b8b29cfe..efe9f53a1 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -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 #-} diff --git a/stack.yaml b/stack.yaml index 5e53401aa..c32e218a6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -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.