166 lines
4.1 KiB
Haskell
166 lines
4.1 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{- |
|
|
Datatypes used to setup and pass data to shaders.
|
|
-}
|
|
module Shader.Data
|
|
( VAO (..)
|
|
, VBO (..)
|
|
, FullShader (..)
|
|
, VShader (..)
|
|
, ShaderTexture (..)
|
|
, EPrimitiveMode (..)
|
|
, PicShads (..)
|
|
-- | Lens functions
|
|
, vao
|
|
, vaoVBO
|
|
|
|
, shaderProgram
|
|
, shaderVAO
|
|
, shaderPokeStrategy
|
|
, shaderDrawPrimitive
|
|
, shaderTexture
|
|
, shaderCustomUnis
|
|
|
|
, vshaderProgram
|
|
, vshaderVAO
|
|
, vshaderDrawPrimitive
|
|
, vshaderTexture
|
|
, vshaderCustomUnis
|
|
, vshaderPokeTest
|
|
|
|
, psPoly
|
|
, psPolyz
|
|
, psBez
|
|
, psText
|
|
, psArc
|
|
, psEll
|
|
|
|
-- TODO make lenses for VBO object
|
|
-- , textureObject
|
|
) where
|
|
import Picture.Data
|
|
|
|
import Graphics.Rendering.OpenGL
|
|
import Foreign
|
|
import Control.Lens
|
|
--import Graphics.GL.Types
|
|
{- | Vertex array object: contains the reference to the object,
|
|
and its buffer targets. -}
|
|
data VAO = VAO
|
|
{ _vao :: VertexArrayObject
|
|
, _vaoVBO :: VBO
|
|
}
|
|
{- | Vertex buffer object: contains the reference to the object,
|
|
a pointer to a location with space that can be written to the buffer,
|
|
and a list of attribute pointer sizes.
|
|
Vertex attributes are interleaved within the vbo. -}
|
|
data VBO = VBO
|
|
{ _vbo :: BufferObject
|
|
, _vboPointer :: Ptr Float
|
|
, _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not
|
|
, _vboStride :: Int
|
|
}
|
|
data VShader = VShader
|
|
{ _vshaderProgram :: Program
|
|
, _vshaderVAO :: VAO
|
|
, _vshaderDrawPrimitive :: EPrimitiveMode
|
|
, _vshaderTexture :: Maybe ShaderTexture
|
|
, _vshaderCustomUnis :: [UniformLocation]
|
|
, _vshaderPokeTest :: VertexType -> Bool
|
|
}
|
|
data PicShads a = PicShads
|
|
{ _psPoly :: a
|
|
, _psPolyz :: a
|
|
, _psBez :: a
|
|
, _psText :: a
|
|
, _psArc :: a
|
|
, _psEll :: a
|
|
}
|
|
-- boilerplate folows
|
|
instance Functor PicShads where
|
|
fmap f PicShads
|
|
{ _psPoly = thePoly
|
|
, _psPolyz = thePolyz
|
|
, _psBez = theBez
|
|
, _psText = theText
|
|
, _psArc = theArc
|
|
, _psEll = theEll
|
|
}
|
|
= PicShads
|
|
{ _psPoly = f thePoly
|
|
, _psPolyz = f thePolyz
|
|
, _psBez = f theBez
|
|
, _psText = f theText
|
|
, _psArc = f theArc
|
|
, _psEll = f theEll
|
|
}
|
|
instance Applicative PicShads where
|
|
pure a = PicShads a a a a a a
|
|
(<*>) PicShads
|
|
{ _psPoly = fPoly
|
|
, _psPolyz = fPolyz
|
|
, _psBez = fBez
|
|
, _psText = fText
|
|
, _psArc = fArc
|
|
, _psEll = fEll
|
|
}
|
|
PicShads
|
|
{ _psPoly = thePoly
|
|
, _psPolyz = thePolyz
|
|
, _psBez = theBez
|
|
, _psText = theText
|
|
, _psArc = theArc
|
|
, _psEll = theEll
|
|
}
|
|
= PicShads
|
|
{ _psPoly = fPoly thePoly
|
|
, _psPolyz = fPolyz thePolyz
|
|
, _psBez = fBez theBez
|
|
, _psText = fText theText
|
|
, _psArc = fArc theArc
|
|
, _psEll = fEll theEll
|
|
}
|
|
instance Foldable PicShads where
|
|
foldr f x PicShads
|
|
{ _psPoly = thePoly
|
|
, _psPolyz = thePolyz
|
|
, _psBez = theBez
|
|
, _psText = theText
|
|
, _psArc = theArc
|
|
, _psEll = theEll
|
|
}
|
|
= f thePoly . f thePolyz . f theBez . f theText . f theArc $ f theEll x
|
|
|
|
|
|
{- | Datatype containing the necessary information for a single shader. -}
|
|
data FullShader = FullShader
|
|
{ _shaderProgram :: Program
|
|
, _shaderVAO :: VAO
|
|
, _shaderPokeStrategy :: RenderType -> [[Float]]-- -> F.FoldM IO RenderType Int
|
|
, _shaderDrawPrimitive :: EPrimitiveMode
|
|
, _shaderTexture :: Maybe ShaderTexture
|
|
, _shaderCustomUnis :: [UniformLocation]
|
|
}
|
|
{- | Datatype containing the reference to a texture object. -}
|
|
newtype ShaderTexture = ShaderTexture
|
|
{ _textureObject :: TextureObject }
|
|
|
|
data EPrimitiveMode
|
|
= EPoints
|
|
| ELines
|
|
| ELinesAdjacency
|
|
| ELineLoop
|
|
| ELineStrip
|
|
| ETriangles
|
|
| ETriangleStrip
|
|
| ETriangleFan
|
|
| EQuads
|
|
| EQuadStrip
|
|
| EPolygon
|
|
| EPatches
|
|
|
|
makeLenses ''VAO
|
|
makeLenses ''FullShader
|
|
makeLenses ''VShader
|
|
makeLenses ''PicShads
|