Store number of vertices in an intmap

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

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 :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
-renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> getLay i counts
+renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i
+  where
 
 pokeTwoOff 
     :: Ptr Float 

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 :: PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
-bindShaderLay shads = sequenceLayers_ f
+bindShaderLay shads = mapM_ (uncurry f) . IM.toList
   where
     f lay counts = sequence_ $ bindArrayBuffersLayer' lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
 

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 qualified Data.IntMap.Strict as IM
---import Control.Lens
+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))
+comLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO (IM.IntMap (PicShads Int))
-{-# INLINE comLayVerx #-}
+--{-# 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
@@ -169,8 +151,8 @@ pokeVerxType thePtr vt = case vt of
                             >> 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
+addLayCountVerx :: IM.IntMap (PicShads Int) -> Int -> VertexType -> IM.IntMap (PicShads Int)
-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)
 {-# INLINE addLayCountVerx #-}
-addLayCountVerx !m@Layers
+addLayCountVerx m lay vt = case vt of
-    { _lay0 = a0
+    PolyV       -> m & ix lay . psPoly  +~ 1
-    , _lay1 = a1
+    PolyzV _    -> m & ix lay . psPolyz +~ 1
-    , _lay2 = a2
+    BezV _      -> m & ix lay . psBez   +~ 1
-    , _lay3 = a3
+    TextV _     -> m & ix lay . psText  +~ 1
-    , _lay4 = a4
+    ArcV _      -> m & ix lay . psArc   +~ 1
-    , _lay5 = a5
+    EllV        -> m & ix lay . psEll   +~ 1
-    }
+    --PolyV       -> IM.adjust (psPoly  +~ 1) lay m 
-    vx = case _vxLayer vx of
+    --PolyzV _    -> IM.adjust (psPolyz +~ 1) lay m 
-    0 -> m { _lay0 = f $! a0 }
+    --BezV _      -> IM.adjust (psBez   +~ 1) lay m 
-    1 -> m { _lay1 = f $! a1 }
+    --TextV _     -> IM.adjust (psText  +~ 1) lay m 
-    2 -> m { _lay2 = f $! a2 }
+    --ArcV _      -> IM.adjust (psArc   +~ 1) lay m 
-    3 -> m { _lay3 = f $! a3 }
+    --EllV        -> IM.adjust (psEll   +~ 1) lay m 
-    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
 
 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
-