70 lines
2.2 KiB
Haskell
70 lines
2.2 KiB
Haskell
module Shader
|
|
( freeShaderPointers
|
|
, drawShaderLay
|
|
, shadVBOptr
|
|
, drawShader
|
|
, pokeBindFoldable
|
|
, pokeBindFoldableLayer
|
|
) where
|
|
import Shader.Data
|
|
import Shader.Parameters
|
|
import Shader.ExtraPrimitive
|
|
import Shader.Poke
|
|
import Shader.Bind
|
|
import Picture.Data
|
|
|
|
import qualified Data.Vector.Unboxed.Mutable as UMV
|
|
import qualified Data.Vector.Mutable as MV
|
|
import Control.Monad.Primitive
|
|
import Foreign
|
|
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
|
import Graphics.GL.Core43
|
|
|
|
drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO ()
|
|
{-# INLINE drawShaderLay #-}
|
|
drawShaderLay l countsVector shadIn fs = do
|
|
i <- UMV.read countsVector shadIn
|
|
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) (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 $ _vboPtr $ _vaoVBO $ _shaderVAO fs
|
|
|
|
pokeBindFoldable
|
|
:: MV.MVector (PrimState IO) FullShader
|
|
-> UMV.MVector (PrimState IO) Int
|
|
-> Picture
|
|
-> IO ()
|
|
pokeBindFoldable shadV counts m = do
|
|
pokeVerxs shadV counts m
|
|
bindShader shadV counts
|
|
|
|
pokeBindFoldableLayer
|
|
:: MV.MVector (PrimState IO) FullShader
|
|
-> UMV.MVector (PrimState IO) Int
|
|
-> Picture
|
|
-> IO ()
|
|
pokeBindFoldableLayer shadV counts m = do
|
|
pokeLayVerxs shadV counts m
|
|
bindShaderLayers shadV counts
|
|
|
|
shadVBOptr :: FullShader -> Ptr Float
|
|
{-# INLINE shadVBOptr #-}
|
|
shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO
|