diff --git a/package.yaml b/package.yaml index 5994a021b..aeb0ca773 100644 --- a/package.yaml +++ b/package.yaml @@ -48,6 +48,7 @@ dependencies: - directory - QuickCheck - extra + #- streaming library: source-dirs: src diff --git a/src/Geometry/Data.hs b/src/Geometry/Data.hs index 7e03194f4..a657021a6 100644 --- a/src/Geometry/Data.hs +++ b/src/Geometry/Data.hs @@ -32,6 +32,7 @@ fromV3 :: V3 a -> (a,a,a) fromV3 (V3 a b c) = (a,b,c) uncurryV :: (a -> a -> b) -> V2 a -> b +{-# INLINE uncurryV #-} uncurryV f (V2 x y) = f x y fstV2 :: V2 a -> a diff --git a/src/Render.hs b/src/Render.hs index 78233e04c..9ee638e78 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -171,7 +171,7 @@ pokeBindFoldableLayer pokeBindFoldableLayer pdata m = do let shads = _pictureShaders pdata - slist'' <- pokeLayVerxsPart (fmap (_vaoVBO . _vshaderVAO) shads) m (pure $ pure 0) + slist'' <- pokeLayVerxsFold (fmap (_vaoVBO . _vshaderVAO) shads) m bindShaderLay shads slist'' return slist'' diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index f7b7c6680..d4346ad09 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -7,6 +7,7 @@ module Shader.Poke , pokePoint33s , pokeVerxs , pokeLayVerxs + , pokeLayVerxsFold , pokeLayVerxsPart , pokeLayVerxsPartM , pokeLayVerxsM @@ -18,19 +19,24 @@ import Picture.Data import Geometry.Data import Layers +--import qualified Streaming.Prelude as SP --import Data.Maybe --import Data.List import Foreign import Control.Monad ---import qualified Control.Foldl as F +import qualified Control.Foldl as F --import qualified Data.IntMap.Strict as IM --import Control.Lens pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int) -pokeVerxs vbos vxs0 = go vxs0 (pure 0) - where - go [] !count = return count - go (!vx:vxs) !count = pokeVerx vbos count vx >> (go vxs $! addCountVerx count vx) +pokeVerxs vbos = F.foldM $ F.FoldM + (\count vx -> pokeVerx vbos count vx >> return (addCountVerx count vx)) + (pure $ pure 0) + return +--pokeVerxs vbos vxs0 = go vxs0 (pure 0) +-- where +-- go [] !count = return count +-- go (!vx:vxs) !count = pokeVerx vbos count vx >> (go vxs $! addCountVerx count vx) -- this is very brittle, but want to optimise speed if possible here pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO () @@ -121,6 +127,12 @@ pokePoint3s ptr vals0 = go vals0 0 where off i = n*3 + i +pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (Layers (PicShads Int)) +pokeLayVerxsFold !vbos = F.foldM $ F.FoldM + (\counts vx -> pokeLayVerx vbos counts vx >> return (addLayCountVerx counts vx)) + (pure $ pure $ pure 0) + return + pokeLayVerxsM :: PicShads VBO -> [Verx] -> IO (Layers (PicShads Int)) pokeLayVerxsM !vbos = foldM f (pure $ pure 0) where @@ -145,7 +157,7 @@ pokeLayVerxs !vbos vxs0 = go vxs0 (pure (pure 0)) -- this is very brittle, but want to optimise speed if possible here pokeLayVerx :: PicShads VBO -> Layers (PicShads Int) -> Verx -> IO () -{-# INLINE pokeLayVerx #-} +--{-# INLINE pokeLayVerx #-} pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vxLayer = theLay} = case theType of PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) ((_psPoly offsets + layOff) * 7 * floatSize)) thePos theCol PolyzV x -> poke34 thePtr thePos theCol