diff --git a/src/Layers.hs b/src/Layers.hs index 4cd06ed83..591bc8bd2 100644 --- a/src/Layers.hs +++ b/src/Layers.hs @@ -71,7 +71,6 @@ sequenceLayers_ f lays = sequence_ $ f <$> layIndices <*> lays sequenceLayers :: (Int -> a -> IO b) -> Layers a -> IO (Layers b) sequenceLayers f lays = sequence $ f <$> layIndices <*> lays - data Layers a = Layers { _lay0 :: a , _lay1 :: a diff --git a/src/Render.hs b/src/Render.hs index 93dc27464..eafcf393b 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -12,16 +12,17 @@ import Picture.Data import Geometry.Data --import Polyhedra.Data --import Polyhedra -import Layers +--import Layers +import Data.Foldable --import Control.Lens -import Control.Monad +--import Control.Monad --import qualified Control.Foldl as F import Foreign hiding (rotate) import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T) --import Data.Foldable --import Data.Tuple.Extra ---import qualified Data.IntMap.Strict as IM +import qualified Data.IntMap.Strict as IM import qualified SDL divideSize :: Int -> Size -> Size @@ -156,20 +157,14 @@ pokeBindFoldable pdata m = do zeroCounts :: PicShads Int zeroCounts = PicShads 0 0 0 0 0 0 -pokeVerxLayers - :: PicShads VBO - -> [Verx] - -> Layers (PicShads Int) - -> IO (Layers (PicShads Int)) -pokeVerxLayers = undefined - pokeBindFoldableLayer :: RenderData -> Picture - -> IO (Layers (PicShads Int)) + -> IO (IM.IntMap (PicShads Int)) pokeBindFoldableLayer pdata m = do let shads = _pictureShaders pdata + --slist'' <- fmap toIMLayers $ pokeLayVerxsFold (fmap (_vaoVBO . _vshaderVAO) shads) m slist'' <- pokeLayVerxsFold (fmap (_vaoVBO . _vshaderVAO) shads) m bindShaderLay shads slist'' @@ -185,14 +180,15 @@ renderFoldable pdata struct = do count <- pokeBindFoldable pdata struct let shads = _pictureShaders pdata - mapM_ (uncurry (drawShaderLay 0)) ((,) <$> shads <*> count) + sequence_ (drawShaderLay 0 <$> shads <*> count) pokeEndTicks <- SDL.ticks return $ pokeEndTicks - pokeStartTicks ------------------------------end renderFoldable -renderLayer :: Int -> PicShads VShader -> Layers (PicShads Int) -> IO () -renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> getLay i counts +renderLayer :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO () +renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i + where pokeTwoOff :: Ptr Float diff --git a/src/Shader.hs b/src/Shader.hs index cf88199f3..0e99c9b51 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -13,14 +13,14 @@ module Shader import Shader.Data import Shader.Parameters import Shader.ExtraPrimitive -import Layers +--import Layers --import MatrixHelper import Foreign import Control.Monad import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Graphics.GL.Core43 ---import qualified Data.IntMap.Strict as IM +import qualified Data.IntMap.Strict as IM --import Data.Bifunctor --import Text.RawString.QQ --import Linear.Matrix @@ -60,8 +60,8 @@ bindArrayBuffersLayer numVs lay theVBO = do where stride = sum $ _vboAttribSizes theVBO -bindShaderLay :: PicShads VShader -> Layers (PicShads Int) -> IO () -bindShaderLay shads = sequenceLayers_ f +bindShaderLay :: PicShads VShader -> IM.IntMap (PicShads Int) -> IO () +bindShaderLay shads = mapM_ (uncurry f) . IM.toList where f lay counts = sequence_ $ bindArrayBuffersLayer' lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads) diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index f206da7bd..f240e5fec 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -13,7 +13,7 @@ import Shader.Data import Shader.Parameters import Picture.Data import Geometry.Data -import Layers +--import Layers --import qualified Streaming.Prelude as SP --import Data.Maybe @@ -21,8 +21,8 @@ import Layers import Foreign --import Control.Monad import qualified Control.Foldl as F ---import qualified Data.IntMap.Strict as IM ---import Control.Lens +import qualified Data.IntMap.Strict as IM +import Control.Lens pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int) pokeVerxs vbos = F.foldM $ F.FoldM @@ -36,7 +36,7 @@ pokeVerxs vbos = F.foldM $ F.FoldM -- this is very brittle, but want to optimise speed if possible here pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO () ---{-# INLINE pokeVerx #-} +{-# INLINE pokeVerx #-} pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) (_psPoly offsets * 7 * floatSize)) thePos theCol PolyzV x -> poke34 thePtr thePos theCol @@ -63,8 +63,6 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case t thePtr = plusPtr (_vboPtr $ _psArc vbos) (_psArc offsets * 10 * floatSize) EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) (_psEll offsets * 7 * floatSize)) thePos theCol - - poke34 :: Ptr Float -> Point3 -> Point4 -> IO () {-# INLINE poke34 #-} poke34 ptr (V3 a b c) (V4 d e f g) = do @@ -76,23 +74,6 @@ poke34 ptr (V3 a b c) (V4 d e f g) = do pokeElemOff ptr 5 f pokeElemOff ptr 6 g -addCountVerx' :: VertexType -> PicShads Int -> PicShads Int -{-# INLINE addCountVerx' #-} -addCountVerx' theType !ps@PicShads - { _psPoly = sPoly - , _psPolyz = sPolyz - , _psBez = sBez - , _psText = sText - , _psArc = sArc - , _psEll = sEll - } = case theType of - PolyV -> ps {_psPoly = sPoly + 1} - PolyzV _ -> ps {_psPolyz = sPolyz + 1} - BezV _ -> ps {_psBez = sBez + 1} - TextV _ -> ps {_psText = sText + 1} - ArcV _ -> ps {_psArc = sArc + 1} - EllV -> ps {_psEll = sEll + 1} - addCountVerx :: PicShads Int -> Verx -> PicShads Int {-# INLINE addCountVerx #-} addCountVerx !ps@PicShads @@ -142,15 +123,15 @@ pokePoint3s ptr vals0 = go vals0 0 where off i = n*3 + i -comLayVerx :: PicShads VBO -> Layers (PicShads Int) -> Verx -> IO (Layers (PicShads Int)) -{-# INLINE comLayVerx #-} +comLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO (IM.IntMap (PicShads Int)) +--{-# INLINE comLayVerx #-} comLayVerx vbos counts vx = do poke34 thePtr thePos theCol pokeVerxType thePtr theType - return $ addLayCountVerx' counts theLayer theType + return $ addLayCountVerx counts theLayer theType where theLayer = _vxLayer vx - layCounts = getLay theLayer counts + layCounts = counts IM.! theLayer theType = _vxType vx thePos = _vxPos vx theCol = _vxCol vx @@ -160,6 +141,7 @@ comLayVerx vbos counts vx = do theStride = pokeStride theType pokeVerxType :: Ptr Float -> VertexType -> IO () +{-# INLINE pokeVerxType #-} pokeVerxType thePtr vt = case vt of PolyzV x -> pokeElemOff thePtr 7 x BezV (V4 x y z w) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y @@ -168,9 +150,9 @@ pokeVerxType thePtr vt = case vt of ArcV (V3 x y z) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y >> pokeElemOff thePtr 9 z _ -> return () - intFromType :: PicShads Int -> VertexType -> Int +{-# INLINE intFromType #-} intFromType ps vt = case vt of PolyV -> _psPoly ps PolyzV{} -> _psPolyz ps @@ -180,6 +162,7 @@ intFromType ps vt = case vt of EllV -> _psEll ps vboFromType :: PicShads VBO -> VertexType -> VBO +{-# INLINE vboFromType #-} vboFromType ps vt = case vt of PolyV -> _psPoly ps PolyzV{} -> _psPolyz ps @@ -188,14 +171,20 @@ vboFromType ps vt = case vt of ArcV{} -> _psArc ps EllV -> _psEll ps -pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (Layers (PicShads Int)) +pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int)) pokeLayVerxsFold vbos = F.foldM $ F.FoldM - --(\counts vx -> pokeLayVerx vbos counts vx >> return (addLayCountVerx counts vx)) (comLayVerx vbos) - (pure . pure $ pure 0) + (return $ imLayers 0) return +imLayers :: a -> IM.IntMap (PicShads a) +{-# INLINE imLayers #-} +imLayers x = IM.fromList $ zip [0..5] $ repeat ps + where + ps = pure x + pokeStride :: VertexType -> Int +{-# INLINE pokeStride #-} pokeStride PolyV = 7 pokeStride PolyzV{} = 8 pokeStride BezV{} = 11 @@ -203,81 +192,21 @@ pokeStride TextV{} = 9 pokeStride ArcV{} = 10 pokeStride EllV = 7 --- this is very brittle, but want to optimise speed if possible here -pokeLayVerx :: PicShads VBO -> Layers (PicShads Int) -> Verx -> IO () -{-# 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 - >> pokeElemOff thePtr 7 x - where - thePtr = plusPtr (_vboPtr $ _psPolyz vbos) ((_psPolyz offsets + layOff) * 8 * floatSize) - BezV (V4 x y z w) -> poke34 thePtr thePos theCol - >> pokeElemOff thePtr 7 x - >> pokeElemOff thePtr 8 y - >> pokeElemOff thePtr 9 z - >> pokeElemOff thePtr 10 w - where - thePtr = plusPtr (_vboPtr $ _psBez vbos) ((_psBez offsets + layOff) * 11 * floatSize) - TextV (V2 x y) -> poke34 thePtr thePos theCol - >> pokeElemOff thePtr 7 x - >> pokeElemOff thePtr 8 y - where - thePtr = plusPtr (_vboPtr $ _psText vbos) ((_psText offsets + layOff) * 9 * floatSize) - ArcV (V3 x y z) -> poke34 thePtr thePos theCol - >> pokeElemOff thePtr 7 x - >> pokeElemOff thePtr 8 y - >> pokeElemOff thePtr 9 z - where - thePtr = plusPtr (_vboPtr $ _psArc vbos) ((_psArc offsets + layOff) * 10 * floatSize) - EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) ((_psEll offsets + layOff) * 7 * floatSize)) thePos theCol - where - layOff = theLay * numSubElements - offsets = getLay theLay imoffsets - -addLayCountVerx :: Layers (PicShads Int) -> Verx -> Layers (PicShads Int) +addLayCountVerx :: IM.IntMap (PicShads Int) -> Int -> VertexType -> IM.IntMap (PicShads Int) {-# INLINE addLayCountVerx #-} -addLayCountVerx !m@Layers - { _lay0 = a0 - , _lay1 = a1 - , _lay2 = a2 - , _lay3 = a3 - , _lay4 = a4 - , _lay5 = a5 - } - vx = case _vxLayer vx of - 0 -> m { _lay0 = f $! a0 } - 1 -> m { _lay1 = f $! a1 } - 2 -> m { _lay2 = f $! a2 } - 3 -> m { _lay3 = f $! a3 } - 4 -> m { _lay4 = f $! a4 } - 5 -> m { _lay5 = f $! a5 } - _ -> undefined - where - f = flip addCountVerx vx - - - -addLayCountVerx' :: Layers (PicShads Int) -> Int -> VertexType -> Layers (PicShads Int) -{-# INLINE addLayCountVerx' #-} -addLayCountVerx' m@Layers - { _lay0 = a0 - , _lay1 = a1 - , _lay2 = a2 - , _lay3 = a3 - , _lay4 = a4 - , _lay5 = a5 - } - lay vt = case lay of - 0 -> m { _lay0 = f a0 } - 1 -> m { _lay1 = f a1 } - 2 -> m { _lay2 = f a2 } - 3 -> m { _lay3 = f a3 } - 4 -> m { _lay4 = f a4 } - 5 -> m { _lay5 = f a5 } - _ -> undefined - where - f = addCountVerx' vt +addLayCountVerx m lay vt = case vt of + PolyV -> m & ix lay . psPoly +~ 1 + PolyzV _ -> m & ix lay . psPolyz +~ 1 + BezV _ -> m & ix lay . psBez +~ 1 + TextV _ -> m & ix lay . psText +~ 1 + ArcV _ -> m & ix lay . psArc +~ 1 + EllV -> m & ix lay . psEll +~ 1 + --PolyV -> IM.adjust (psPoly +~ 1) lay m + --PolyzV _ -> IM.adjust (psPolyz +~ 1) lay m + --BezV _ -> IM.adjust (psBez +~ 1) lay m + --TextV _ -> IM.adjust (psText +~ 1) lay m + --ArcV _ -> IM.adjust (psArc +~ 1) lay m + --EllV -> IM.adjust (psEll +~ 1) lay m poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int poke224s ptr vals0 = go vals0 0 @@ -295,4 +224,3 @@ poke224s ptr vals0 = go vals0 0 go vals (n+1) where off i = n*8 + i -