Add new files

2021-08-13 12:28:17 +02:00
parent 53555865f6
commit 5829c66527
21 changed files with 377 additions and 318 deletions
@@ -0,0 +1,53 @@
+module Shader.Bind
+    ( bindShaderLayers
+    , bindShaderBuffers
+    , bindShader
+    ) where
+import Shader.Data
+import Shader.Parameters
+--import Shader.ExtraPrimitive
+
+import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
+import Foreign hiding (rotate)
+import qualified Data.Vector.Unboxed.Mutable as UMV
+import qualified Data.Vector.Mutable as MV
+import Control.Monad.Primitive
+import Control.Monad
+
+bindArrayBuffers :: Int -> VBO -> IO ()
+bindArrayBuffers numVs theVBO = do
+    bindBuffer ArrayBuffer $= Just (_vbo theVBO)
+    bufferSubData 
+        ArrayBuffer 
+        WriteToBuffer 
+        0 
+        (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) 
+        (_vboPtr theVBO)
+
+bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
+bindShaderLayers shads counts = MV.imapM_ f shads
+  where
+    f i shad = do
+        let theVBO = _vaoVBO $ _shaderVAO shad
+            stride = sum $ _vboAttribSizes theVBO
+        bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
+        mapM_ (g stride theVBO) [0..5]
+      where
+        g stride theVBO lay = do
+            numVs <- UMV.unsafeRead counts $ lay * 6 + i
+            bufferSubData
+                ArrayBuffer 
+                WriteToBuffer 
+                (fromIntegral $ floatSize * stride * numSubElements * lay)
+                (fromIntegral $ floatSize * numVs * stride)
+                (_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
+
+bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
+bindShader shads counts = MV.imapM_ f shads
+  where
+    f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shaderVAO $ shad)
+
+bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
+bindShaderBuffers = zipWithM_ f
+  where 
+    f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs
@@ -13,14 +13,7 @@ import Shader.Parameters
 import Picture.Data
 import Geometry.Data

--import qualified Streaming.Prelude as SP
--import Data.Maybe
--import Data.List
 import Foreign
--import Control.Monad
--import qualified Control.Foldl as F
--import qualified Data.IntMap.Strict as IM
--import Control.Lens
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
@@ -44,37 +37,40 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
  where
    sn = _unShadNum theShadNum

--vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
--{-# INLINE vToPicShad #-}
--vToPicShad mv = mapM (UMV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
--
--vToPicShadMV :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
--{-# INLINE vToPicShadMV #-}
--vToPicShadMV mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
--
--picShadToUMV :: PicShads Int -> IO (UMV.MVector (PrimState IO) Int)
--{-# INLINE picShadToUMV #-}
--picShadToUMV (PicShads a b c d e f) = do
--    theVec <- UMV.new 6
--    UMV.write theVec 0 a
--    UMV.write theVec 1 b
--    UMV.write theVec 2 c
--    UMV.write theVec 3 d
--    UMV.write theVec 4 e
--    UMV.write theVec 5 f
--    return theVec
--
--picShadToMV :: PicShads a -> IO (MV.MVector (PrimState IO) a)
--{-# INLINE picShadToMV #-}
--picShadToMV (PicShads a b c d e f) = do
--    theVec <- MV.new 6
--    MV.write theVec 0 a
--    MV.write theVec 1 b
--    MV.write theVec 2 c
--    MV.write theVec 3 d
--    MV.write theVec 4 e
--    MV.write theVec 5 f
--    return theVec
+pokeLayVerxs 
+    :: MV.MVector (PrimState IO) FullShader 
+    -> UMV.MVector (PrimState IO) Int
+    -> [Verx] 
+    -> IO ()
+pokeLayVerxs vbos counts vxs = VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
+
+pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
+--{-# INLINE pokeLayVerx #-}
+pokeLayVerx vbos counts vx = do
+    theOff <- UMV.unsafeRead counts vecPos
+    basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.unsafeRead vbos sn
+    let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
+    poke34 thePtr thePos theCol
+    pokeArrayOff thePtr 7 (_vxExt vx)
+    UMV.unsafeModify counts (+ 1) vecPos
+  where
+    sn = _unShadNum (_vxShadNum vx)
+    vecPos = theLayer * 6 + sn
+    theLayer = _vxLayer vx
+    thePos = _vxPos vx
+    theCol = _vxCol vx
+    layOff = theLayer * numSubElements
+    theStride = pokeStride sn
+
+pokeStride :: Int -> Int
+{-# INLINE pokeStride #-}
+pokeStride 0 = 7
+pokeStride 1 = 8
+pokeStride 2 = 11
+pokeStride 3 = 9
+pokeStride 4 = 10
+pokeStride 5 = 7
+pokeStride _ = undefined


 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
@@ -119,41 +115,6 @@ pokePoint3s ptr vals0 = go vals0 0
      where
        off i = n*3 + i

-pokeLayVerxs 
-    :: MV.MVector (PrimState IO) FullShader 
-    -> UMV.MVector (PrimState IO) Int
-    -> [Verx] 
-    -> IO ()
-pokeLayVerxs vbos counts vxs = VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
-
-pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-}
-pokeLayVerx vbos counts vx = do
-    theOff <- UMV.unsafeRead counts vecPos
-    basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.unsafeRead vbos sn
-    let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
-    poke34 thePtr thePos theCol
-    pokeArrayOff thePtr 7 (_vxExt vx)
-    UMV.unsafeModify counts (+ 1) vecPos
-  where
-    sn = _unShadNum (_vxShadNum vx)
-    vecPos = theLayer * 6 + sn
-    theLayer = _vxLayer vx
-    thePos = _vxPos vx
-    theCol = _vxCol vx
-    layOff = theLayer * numSubElements
-    theStride = pokeStride sn
-
-pokeStride :: Int -> Int
-{-# INLINE pokeStride #-}
-pokeStride 0 = 7
-pokeStride 1 = 8
-pokeStride 2 = 11
-pokeStride 3 = 9
-pokeStride 4 = 10
-pokeStride 5 = 7
-pokeStride _ = undefined
-
 poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
 poke224s ptr vals0 = go vals0 0
  where