57 lines
2.0 KiB
Haskell
57 lines
2.0 KiB
Haskell
module Shader.Bind
|
|
( bindShaderLayers
|
|
, bindShaderBuffers
|
|
, bindShader
|
|
) where
|
|
import Shader.Data
|
|
import Shader.Parameters
|
|
|
|
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
|
|
import qualified Streaming.Prelude as S
|
|
|
|
bindArrayBuffers :: Int -> VBO -> IO ()
|
|
{-# INLINABLE bindArrayBuffers #-}
|
|
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 $ _shadVAO shad
|
|
stride = sum $ _vboAttribSizes theVBO
|
|
bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
|
|
--VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5]
|
|
S.mapM_ (g stride theVBO) $ S.each [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 . _shadVAO $ shad)
|
|
|
|
bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
|
|
bindShaderBuffers = zipWithM_ f
|
|
where
|
|
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO fs
|