Use mutable vectors to for layer vertex offset positions

src/Shader/Poke.hs

@@ -45,8 +45,7 @@ pokeVerxs vbos = F.foldM $ F.FoldM
     vToPicShad
 
 vToPicShad :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
-vToPicShad mv = do
+vToPicShad mv = mapM (MV.read mv) $ PicShads 0 1 2 3 4 5
-    mapM (MV.read mv) $ PicShads 0 1 2 3 4 5
 
 --pokeVerxs vbos vxs0 = go vxs0 (pure 0)
 --  where
@@ -205,6 +204,28 @@ comLayVerx vbos counts vx = do
     thePtr = plusPtr basePtr ((intFromType layCounts theType + layOff) * theStride * floatSize)
     theStride = pokeStride theType
 
+comLayVerx' :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO (MV.MVector (PrimState IO) Int)
+--{-# INLINE comLayVerx #-}
+comLayVerx' vbos counts vx = do
+    theOff <- MV.read counts vecPos
+    let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
+    poke34 thePtr thePos theCol
+    pokeVerxType thePtr theType
+    MV.unsafeModify counts (+ 1) vecPos
+    --return $ addLayCountVerx counts theLayer theType
+    return counts
+  where
+    vecPos = theLayer * 6 + typeInt theType
+    theLayer = _vxLayer vx
+    --layCounts = counts IM.! theLayer
+    theType = _vxType vx
+    thePos = _vxPos vx
+    theCol = _vxCol vx
+    basePtr = _vboPtr $ vboFromType vbos theType
+    layOff = theLayer * numSubElements
+    --thePtr = plusPtr basePtr ((intFromType layCounts theType + layOff) * theStride * floatSize)
+    theStride = pokeStride theType
+
 pokeVerxType :: Ptr Float -> VertexType -> IO ()
 {-# INLINE pokeVerxType #-}
 pokeVerxType thePtr vt = case vt of
@@ -216,6 +237,15 @@ pokeVerxType thePtr vt = case vt of
                             >> pokeElemOff thePtr 9 z
     _ -> return ()
 
+typeInt :: VertexType -> Int
+typeInt vt = case vt of
+    PolyV       -> 0
+    PolyzV{}    -> 1
+    BezV{}      -> 2
+    TextV{}     -> 3
+    ArcV{}      -> 4
+    EllV        -> 5
+
 intFromType :: PicShads Int -> VertexType -> Int
 {-# INLINE intFromType #-}
 intFromType ps vt = case vt of
@@ -236,12 +266,28 @@ vboFromType ps vt = case vt of
     ArcV{}      -> _psArc ps
     EllV        -> _psEll ps
 
-pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
+pokeLayVerxsFold'' :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
-pokeLayVerxsFold vbos = F.foldM $ F.FoldM
+pokeLayVerxsFold'' vbos = F.foldM $ F.FoldM
     (comLayVerx vbos)
     (return $ imLayers 0)
     return
 
+pokeLayVerxsFold' :: PicShads VBO -> [Verx] -> IO (MV.MVector (PrimState IO) Int)
+pokeLayVerxsFold' vbos = F.foldM $ F.FoldM
+    (comLayVerx' vbos)
+    (MV.replicate (6*6) 0)
+    return
+
+pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
+pokeLayVerxsFold vbos = F.foldM $ F.FoldM
+    (comLayVerx' vbos)
+    (MV.replicate (6*6) 0)
+    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)
+
 imLayers :: a -> IM.IntMap (PicShads a)
 {-# INLINE imLayers #-}
 imLayers x = IM.fromList $ zip [0..5] $ repeat ps