justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove streaming

Browse Source
This commit is contained in:
justin
2022-08-22 11:50:41 +01:00
parent 6a46173fb4
commit b7a77cdbd9
2 changed files with 17 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Poke.hs
+17 -13
View File
@@ -21,18 +21,18 @@ import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
--import Data.Vector.Fusion.Util
import Control.Monad.Primitive
--import qualified Control.Monad.Parallel as MP
import qualified Streaming.Prelude as S
import Streaming
pokeVerxs
:: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each
--pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList
pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
@@ -54,9 +54,12 @@ pokeWallsWindowsFloor
-> [ ( Point3 , Point3 ) ]
-> IO (Int,Int,Int)
pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do
wlcounts1 <- S.foldM_ (pokeW wlptr) (return 0) return (S.each wls)
wlcounts2 <- S.foldM_ (pokeW wiptr) (return 0) return (S.each wis)
flcounts <- S.foldM_ (pokeF flptr) (return 0) return (S.each fls)
--wlcounts1 <- S.foldM_ (pokeW wlptr) (return 0) return (S.each wls)
wlcounts1 <- VFSM.foldlM' (pokeW wlptr) 0 (VFSM.fromList wls)
--wlcounts2 <- S.foldM_ (pokeW wiptr) (return 0) return (S.each wis)
wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis)
--flcounts <- S.foldM_ (pokeF flptr) (return 0) return (S.each fls)
flcounts <- VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)
return (wlcounts1,wlcounts2,flcounts)
pokeF :: Ptr Float -> Int -> (Point3,Point3) -> IO Int
@@ -95,9 +98,9 @@ pokeW ptr i' ((V2 a b,V2 c d),V4 e f g h) = do
pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort
-> Stream (Of ShapeObj) IO ()
-> VFSM.Stream IO ShapeObj
-> IO (Int,Int,Int)
pokeShape ptr iptr ieptr = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return (0,0,0)) return
pokeShape ptr iptr ieptr = VFSM.foldlM' (pokeShapeObj ptr iptr ieptr) (0,0,0)
--pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort
-- -> (Int,Int,Int)
@@ -109,7 +112,7 @@ pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort
-> (Int,Int,Int)
-> [ShapeObj]
-> IO (Int,Int,Int)
pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return . S.each
pokeShape' ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj ptr iptr ieptr) is . VFSM.fromList
pokeShapeObj
:: Ptr Float
@@ -120,16 +123,16 @@ pokeShapeObj
-> IO (Int,Int,Int)
{-# INLINE pokeShapeObj #-}
pokeShapeObj ptr iptr ieptr counts (ShapeObj shtype shVerts) = case shtype of
TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts (S.each shVerts)
TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts (VFSM.fromList shVerts)
pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
-> Ptr GLushort
-> (Int,Int,Int)
-> Stream (Of ShapeV) IO ()
-> VFSM.Stream IO ShapeV
-> IO (Int,Int,Int)
{-# INLINE pokeTopPrism #-}
pokeTopPrism size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
nv' <- S.foldM_ (pokeJustV ptr) (return nv) return svs
nv' <- VFSM.foldlM' (pokeJustV ptr) nv svs
nshapeindices' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices
(memoTopPrismIndices V.! size)
nedgeindices' <- UV.foldM' (pokeTopPrismEdgeIndex nv ieptr) nedgeindices
@@ -211,7 +214,8 @@ pokeLayVerxs
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each
--pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList
pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-}