From 79eb031637cc47790025beed9982078e1c7d7186 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Tue, 10 Aug 2021 01:55:42 +0200
Subject: [PATCH] Stream vertex poking

---
 package.yaml       |  2 +-
 src/Render.hs      |  2 +-
 src/Shader/Poke.hs | 62 ++++++++++++++++++++++------------------------
 3 files changed, 32 insertions(+), 34 deletions(-)

diff --git a/package.yaml b/package.yaml
index 4a6c710a7..9b3e67f1c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -49,7 +49,7 @@ dependencies:
 - QuickCheck
 - extra
 - primitive
-  #- streaming
+- streaming
 
 library:
   source-dirs: src
diff --git a/src/Render.hs b/src/Render.hs
index 66007529e..4a9ff5e34 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -161,7 +161,7 @@ pokeBindFoldableLayer
     -> IO (IM.IntMap (PicShads Int))
 pokeBindFoldableLayer pdata m = do
     let shads = _pictureShaders pdata
-    slist'' <- pokeLayVerxsFold (fmap (_vaoVBO . _vshaderVAO) shads) m
+    slist'' <- pokeLayVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m
     bindShaderLay shads slist''
     return slist''
 
diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs
index ae5ebe0e9..d5df16aeb 100644
--- a/src/Shader/Poke.hs
+++ b/src/Shader/Poke.hs
@@ -6,7 +6,7 @@ module Shader.Poke
     , pokePoint3s
     , pokePoint33s
     , pokeVerxs
-    , pokeLayVerxsFold
+    , pokeLayVerxs
     , poke224s
     ) where
 import Shader.Data
@@ -24,23 +24,20 @@ import qualified Control.Foldl as F
 import qualified Data.IntMap.Strict as IM
 --import Control.Lens
 import qualified Data.Vector.Unboxed.Mutable as MV
+import qualified Streaming.Prelude as SP
 import Control.Monad.Primitive
 
 pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
 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
+    count <- MV.replicate 6 0
+    SP.mapM_ (\vx -> pokeVerx vbos count vx >> addCountVerx count vx) $ SP.each vxs
+    vToPicShad count
+   -- F.foldM (F.FoldM 
+   --     (\_ vx -> pokeVerx vbos count vx >> addCountVerx count vx)
+   --     (return ())
+   --     (const (vToPicShad count))
+   --     )
+   --     vxs
 
 vToPicShad :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
 vToPicShad mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
@@ -96,7 +93,7 @@ addCountVerx :: MV.MVector (PrimState IO) Int -> Verx -> IO ()
 {-# INLINE addCountVerx #-}
 addCountVerx vec vx = MV.unsafeModify vec (+1) (_unShadNum $ _vxShadNum vx)
 
-pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
+pokeArrayOff :: Ptr Float -> Int -> [Float] -> IO ()
 --{-# INLINE pokeArrayOff #-}
 pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))
 
@@ -127,7 +124,8 @@ pokePoint3s ptr vals0 = go vals0 0
       where
         off i = n*3 + i
 
-comLayVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO (MV.MVector (PrimState IO) Int)
+--comLayVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> () -> Verx -> IO (MV.MVector (PrimState IO) Int)
+comLayVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO ()
 --{-# INLINE comLayVerx #-}
 comLayVerx vbos counts vx = do
     theOff <- MV.unsafeRead counts vecPos
@@ -135,14 +133,14 @@ comLayVerx vbos counts vx = do
     poke34 thePtr thePos theCol
     pokeVerxType thePtr theType
     MV.unsafeModify counts (+ 1) vecPos
-    return counts
   where
-    vecPos = theLayer * 6 + _unShadNum (_vxShadNum vx)
+    sn = _unShadNum (_vxShadNum vx)
+    vecPos = theLayer * 6 + sn
     theLayer = _vxLayer vx
     theType = _vxType vx
     thePos = _vxPos vx
     theCol = _vxCol vx
-    basePtr = _vboPtr $ vboFromType vbos theType
+    basePtr = _vboPtr $ vboFromType vbos sn
     layOff = theLayer * numSubElements
     theStride = pokeStride theType
 
@@ -157,22 +155,22 @@ pokeVerxType thePtr vt = case vt of
                             >> pokeElemOff thePtr 9 z
     _ -> return ()
 
-vboFromType :: PicShads VBO -> VertexType -> VBO
+vboFromType :: PicShads VBO -> Int -> VBO
 {-# INLINE vboFromType #-}
-vboFromType ps vt = case vt of
-    PolyV       -> _psPoly ps
-    PolyzV{}    -> _psPolyz ps
-    BezV{}      -> _psBez ps
-    TextV{}     -> _psText ps
-    ArcV{}      -> _psArc ps
-    EllV        -> _psEll ps
+vboFromType ps sn = case sn of
+    0 -> _psPoly ps
+    1 -> _psPolyz ps
+    2 -> _psBez ps
+    3 -> _psText ps
+    4 -> _psArc ps
+    5 -> _psEll ps
 
 
-pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
-pokeLayVerxsFold vbos = F.foldM $ F.FoldM
-    (comLayVerx vbos)
-    (MV.replicate (6*6) 0)
-    vToLayPicShad
+pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
+pokeLayVerxs vbos vxs = do
+    counts <- MV.replicate (6*6) 0
+    SP.mapM_ (comLayVerx vbos counts) $ SP.each vxs
+    vToLayPicShad counts
 
 vToLayPicShad :: MV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int))
 vToLayPicShad mv = foldM f IM.empty [0..5]