Move towards replacing F.foldM with streaming, using mutable accumulator

src/Shader/Poke.hs

@@ -27,7 +27,17 @@ import qualified Data.Vector.Unboxed.Mutable as MV
 import Control.Monad.Primitive
 
 pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
-pokeVerxs vbos = F.foldM $ F.FoldM 
+pokeVerxs vbos vxs = do
+    count <- (MV.replicate 6 0 :: IO (MV.MVector (PrimState IO) Int))
+    F.foldM (F.FoldM 
+        (\_ vx -> pokeVerx vbos count vx >> addCountVerx count vx)
+        (return ())
+        (const (vToPicShad count))
+        )
+        vxs
+
+pokeVerxs' :: PicShads VBO -> [Verx] -> IO (PicShads Int)
+pokeVerxs' vbos = F.foldM $ F.FoldM 
     (\count vx -> pokeVerx vbos count vx >> addCountVerx count vx >> return count)
     (MV.replicate 6 0)
     vToPicShad
@@ -84,17 +94,10 @@ poke34 ptr (V3 a b c) (V4 d e f g) = do
 
 addCountVerx :: MV.MVector (PrimState IO) Int -> Verx -> IO ()
 {-# INLINE addCountVerx #-}
-addCountVerx v !Verx{_vxType=theType} = case theType of
-    PolyV       -> MV.unsafeModify v (+ 1) 0
-    PolyzV _    -> MV.unsafeModify v (+ 1) 1 
-    BezV _      -> MV.unsafeModify v (+ 1) 2
-    TextV _     -> MV.unsafeModify v (+ 1) 3
-    ArcV _      -> MV.unsafeModify v (+ 1) 4
-    EllV        -> MV.unsafeModify v (+ 1) 5
+addCountVerx vec vx = MV.unsafeModify vec (+1) (_unShadNum $ _vxShadNum vx)
 
 pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
 --{-# INLINE pokeArrayOff #-}
---pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]
 pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))
 
 pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
@@ -134,7 +137,7 @@ comLayVerx vbos counts vx = do
     MV.unsafeModify counts (+ 1) vecPos
     return counts
   where
-    vecPos = theLayer * 6 + typeInt theType
+    vecPos = theLayer * 6 + _unShadNum (_vxShadNum vx)
     theLayer = _vxLayer vx
     theType = _vxType vx
     thePos = _vxPos vx
@@ -154,25 +157,6 @@ 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
---    PolyV       -> _psPoly ps
---    PolyzV{}    -> _psPolyz ps
---    BezV{}      -> _psBez ps
---    TextV{}     -> _psText ps
---    ArcV{}      -> _psArc ps
---    EllV        -> _psEll ps
-
 vboFromType :: PicShads VBO -> VertexType -> VBO
 {-# INLINE vboFromType #-}
 vboFromType ps vt = case vt of