104 lines
3.6 KiB
Haskell
104 lines
3.6 KiB
Haskell
module Shader
|
|
( bindShaderLayer
|
|
, bindShaderLay
|
|
, bindShaderBuffers
|
|
, bindShader
|
|
, bindArrayBuffers
|
|
, drawShader
|
|
, freeShaderPointers
|
|
, drawShaderLay
|
|
) where
|
|
--import Geometry.Data
|
|
import Shader.Data
|
|
import Shader.Parameters
|
|
import Shader.ExtraPrimitive
|
|
--import MatrixHelper
|
|
|
|
import Foreign
|
|
import Control.Monad
|
|
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
|
import Graphics.GL.Core43
|
|
import qualified Data.IntMap.Strict as IM
|
|
--import Data.Bifunctor
|
|
--import Text.RawString.QQ
|
|
--import Linear.Matrix
|
|
--import Linear.V4
|
|
|
|
bindArrayBuffers :: Int -> VBO -> IO ()
|
|
bindArrayBuffers numVs theVBO = do
|
|
bindBuffer ArrayBuffer $= Just (_vbo theVBO)
|
|
bufferSubData
|
|
ArrayBuffer
|
|
WriteToBuffer
|
|
0
|
|
(fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO))
|
|
(_vboPointer theVBO)
|
|
|
|
bindArrayBuffersLayer' :: Int -> Int -> VBO -> IO ()
|
|
bindArrayBuffersLayer' lay numVs theVBO = do
|
|
bindBuffer ArrayBuffer $= Just (_vbo theVBO)
|
|
bufferSubData
|
|
ArrayBuffer
|
|
WriteToBuffer
|
|
(fromIntegral $ floatSize * stride * numSubElements * lay)
|
|
(fromIntegral $ floatSize * numVs * stride)
|
|
(_vboPointer theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
|
|
where
|
|
stride = sum $ _vboAttribSizes theVBO
|
|
|
|
bindArrayBuffersLayer :: Int -> Int -> VBO -> IO ()
|
|
bindArrayBuffersLayer numVs lay theVBO = do
|
|
bindBuffer ArrayBuffer $= Just (_vbo theVBO)
|
|
bufferSubData
|
|
ArrayBuffer
|
|
WriteToBuffer
|
|
(fromIntegral $ floatSize * stride * numSubElements * lay)
|
|
(fromIntegral $ floatSize * numVs * stride)
|
|
(_vboPointer theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
|
|
where
|
|
stride = sum $ _vboAttribSizes theVBO
|
|
|
|
bindShaderLay :: PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
|
|
bindShaderLay shads = mapM_ f . IM.toList
|
|
where
|
|
f (lay,counts) = sequence_ $ bindArrayBuffersLayer' lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
|
|
|
|
bindShader :: PicShads VShader -> PicShads Int -> IO ()
|
|
bindShader shads counts = sequence_ $ bindArrayBuffers <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
|
|
--bindShader = mapM_ (uncurry (flip bindArrayBuffers) . first (_vaoVBO . _vshaderVAO))
|
|
|
|
bindShaderLayer :: [(Int,VShader)] -> [Int] -> IO ()
|
|
bindShaderLayer = zipWithM_ f
|
|
where
|
|
f (l,fs) i = bindArrayBuffersLayer i l $ _vaoVBO $ _vshaderVAO fs
|
|
|
|
bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
|
|
bindShaderBuffers = zipWithM_ f
|
|
where
|
|
f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs
|
|
|
|
drawShaderLay :: Int -> VShader -> Int -> IO ()
|
|
{-# INLINE drawShaderLay #-}
|
|
drawShaderLay l fs i = do
|
|
currentProgram $= Just (_vshaderProgram fs)
|
|
bindVertexArrayObject $= Just (_vao $ _vshaderVAO fs)
|
|
case _vshaderTexture fs of
|
|
Just ShaderTexture{_textureObject = txo}
|
|
-> textureBinding Texture2D $= Just txo
|
|
_ -> return ()
|
|
glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i)
|
|
|
|
drawShader :: FullShader -> Int -> IO ()
|
|
{-# INLINE drawShader #-}
|
|
drawShader fs i = do
|
|
currentProgram $= Just (_shaderProgram fs)
|
|
bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
|
|
case _shaderTexture fs of
|
|
Just ShaderTexture{_textureObject = txo}
|
|
-> textureBinding Texture2D $= Just txo
|
|
_ -> return ()
|
|
glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) 0 (fromIntegral i)
|
|
|
|
freeShaderPointers :: FullShader -> IO ()
|
|
freeShaderPointers fs = free $ _vboPointer $ _vaoVBO $ _shaderVAO fs
|