64 lines
2.2 KiB
Haskell
64 lines
2.2 KiB
Haskell
module Shader.Bind
|
|
( bindShaderLayers
|
|
, bindShaderBuffers
|
|
, 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 qualified Data.Vector.Fusion.Stream.Monadic as VFSM
|
|
import Control.Monad.Primitive
|
|
import Control.Monad
|
|
import Graphics.GL.Core45
|
|
|
|
bindArrayBuffers :: Int -> VBO -> IO ()
|
|
{-# INLINABLE bindArrayBuffers #-}
|
|
bindArrayBuffers numVs theVBO = do
|
|
glBindBuffer GL_ARRAY_BUFFER (_vboName 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
|
|
glBindBuffer GL_ARRAY_BUFFER (_vboName $ theVBO)
|
|
VFSM.mapM_ (g stride theVBO) $ VFSM.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
|
|
|
|
bindShaderBuffers' :: [FullShader'] -> [Int] -> IO ()
|
|
bindShaderBuffers' = zipWithM_ f
|
|
where
|
|
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs
|