justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor shader types

Browse Source
This commit is contained in:
justin
2023-03-22 14:08:07 +00:00
parent c0579fae00
commit 5769477ad4
20 changed files with 303 additions and 330 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/AuxAddition.hs
+8 -12
View File
@@ -4,24 +4,23 @@ module Shader.AuxAddition
, addTextureArray
, initTexture2D
, initTexture2DArray
, tilesToLine -- ^ kept in case it is needed in the future
, tilesToLine
) where
import Data.Preload.Render
import LensHelp
import Unsafe.Coerce
import Shader.Data
import Data.List.Extra
import Codec.Picture
import qualified Data.Vector.Storable as VS
import Control.Lens
import Graphics.GL.Core45
import GLHelp
-- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added...
addSamplerTexture2D :: String -> FullShader -> IO FullShader
addSamplerTexture2D :: String -> Shader -> IO Shader
addSamplerTexture2D = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
vaddTextureNoFilter :: String -> FullShader -> IO FullShader
vaddTextureNoFilter :: String -> Shader -> IO Shader
vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
addTexture2D
@@ -29,7 +28,7 @@ addTexture2D
-> GLenum -- minfilter
-> GLenum -- magfilter
-> String -- path to image
-> FullShader -> IO FullShader
-> Shader -> IO Shader
addTexture2D nlev minfilt magfilt texpath shad = do
Right cmap <- readImage texpath
let texdata = convertRGBA8 cmap
@@ -42,8 +41,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do
glGenerateTextureMipmap texname
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
return $ shad & shadTex' ?~ ShaderTexture
{_textureObject = texname }
return $ shad & shaderTextures .:~ TO texname
-- alloca $ \nameptr -> do
-- glCreateTextures GL_TEXTURE_2D 1 nameptr
-- texname <- peek nameptr
@@ -113,7 +111,7 @@ initTexture2DArray nlev minfilt magfilt fp = do
-- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the
-- transformation tilesToLine 8 128 on the underlying pixels.
addTextureArray :: String -> (FullShader,VBO) -> IO (FullShader,VBO)
addTextureArray :: String -> (Shader,VBO) -> IO (Shader,VBO)
addTextureArray texturePath (shad,vbo) = do
err <- glGetError
print err
@@ -126,11 +124,9 @@ addTextureArray texturePath (shad,vbo) = do
glGenerateTextureMipmap texname
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR)
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR)
return (shad & shadTex' ?~ ShaderTexture
{ _textureObject = texname}
return (shad & shaderTextures .:~ TO texname
, vbo)
-- I am completely unclear on why this works with its current parameters
tilesToLine
:: Int -- ^ Parameter a
-> Int -- ^ Parameter b
src/Shader/Bind.hs
+2 -2
View File
@@ -24,7 +24,7 @@ bufferPokedVBO theVBO numVs =
(fromIntegral $ floatSize * numVs * _vboVertexSize theVBO)
(_vboPtr theVBO)
bindShaderLayers :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bindShaderLayers :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bindShaderLayers shads counts = MV.imapM_ f shads
where
f i shad = do
@@ -43,7 +43,7 @@ bindShaderLayers shads counts = MV.imapM_ f shads
glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()
glNamedBufferSubDataH = glNamedBufferSubData
bufferShaderVector :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bufferShaderVector :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bufferShaderVector shads counts = MV.imapM_ f shads
where
f i shad = UMV.read counts i >>= bufferPokedVBO (snd shad)
src/Shader/Compile.hs
+39 -38
View File
@@ -38,16 +38,16 @@ makeShader ::
[GLenum] ->
-- | The input vertex sizes
[Int] ->
EPrimitiveMode ->
IO (FullShader,VBO)
PrimitiveMode ->
IO (Shader,VBO)
makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist
(vao,vbo) <- setupVAO sizes
return ( FullShader
{ _shadName = prog
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
return ( Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
, vbo)
@@ -60,7 +60,7 @@ makeShaderEBO ::
[Int] ->
-- | The stride
Int ->
GLenum ->
PrimitiveMode ->
VBO ->
IO (Shader, EBO)
makeShaderEBO s shaderlist sizes strd pm vbo = do
@@ -68,7 +68,7 @@ makeShaderEBO s shaderlist sizes strd pm vbo = do
vao <- setupVAOvbo sizes strd vbo
ebo <- setupEBO vao
return
( Shader prog pm vao
( Shader prog pm vao []
, ebo
)
@@ -81,17 +81,17 @@ makeShader4 ::
[Int] ->
-- | The stride
Int ->
EPrimitiveMode ->
PrimitiveMode ->
VBO ->
IO FullShader
IO Shader
makeShader4 s shaderlist sizes strd pm vbo = do
prog <- makeSourcedShader s shaderlist
vao <- setupVAOvbo sizes strd vbo
return $ FullShader
{ _shadName = prog
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
return $ Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
makeShader4UsingVAO ::
@@ -99,7 +99,7 @@ makeShader4UsingVAO ::
String ->
-- | shader types
[GLenum] ->
GLenum ->
PrimitiveMode ->
VAO ->
IO Shader
makeShader4UsingVAO s shaderlist pm vao = do
@@ -108,6 +108,7 @@ makeShader4UsingVAO s shaderlist pm vao = do
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = []
}
setupVBO :: Int -> IO VBO
@@ -137,17 +138,17 @@ makeByteStringShaderUsingVAO ::
String ->
-- | Filetype extensions and shader data
[(GLenum, BS.ByteString)] ->
EPrimitiveMode ->
PrimitiveMode ->
VAO ->
IO FullShader
IO Shader
makeByteStringShaderUsingVAO s shaderlist pm vao = do
prog <- makeShaderProgram s shaderlist
return $
FullShader
{ _shadName = prog
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
-- | Takes the VAO from elsewhere
@@ -156,17 +157,17 @@ makeShaderUsingVAO ::
String ->
-- | shader types
[GLenum] ->
EPrimitiveMode ->
PrimitiveMode ->
VAO ->
IO FullShader
IO Shader
makeShaderUsingVAO s shaderlist pm theVAO = do
prog <- makeSourcedShader s shaderlist
return $
FullShader
{ _shadName = prog
, _shadVAO = theVAO
, _shadPrim' = pm
, _shadTex' = Nothing
Shader
{ _shaderUINT = prog
, _shaderVAO = theVAO
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
{- |
@@ -182,16 +183,16 @@ makeShaderSized ::
[Int] ->
-- | Number of vertexes that can be poked
Int ->
EPrimitiveMode ->
IO (FullShader,VBO)
PrimitiveMode ->
IO (Shader,VBO)
makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist
(vao,vbo) <- setupVAOSized ndraw sizes
return ( FullShader
{ _shadName = prog
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
return ( Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
, vbo)
src/Shader/Data.hs
+87 -67
View File
@@ -1,98 +1,118 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{- | Datatypes used to setup and pass data to shaders. -}
module Shader.Data
( VAO (..)
, VBO (..)
, EBO (..)
, Shader (..)
, FullShader (..)
, ShaderTexture (..)
, EPrimitiveMode (..)
-- | Lens functions
, vaoName
, shaderUINT
, shaderPrimitive
, shaderVAO
{-# LANGUAGE TemplateHaskell #-}
, textureObject
-- | Datatypes used to setup and pass data to shaders.
module Shader.Data (
VAO (..),
VBO (..),
EBO (..),
TO (..),
FBO (..),
Shader (..),
PrimitiveMode (..),
-- | Lens functions
vaoName,
shaderUINT,
shaderPrimitive,
shaderVAO,
shaderTextures,
textureObject,
vboName,
vboPtr,
vboVertexSize,
unFBO,
unTO,
unPrimitiveMode,
eboName,
eboPtr,
-- | Synonyms
vert,
geom,
frag,
pmPoints,
pmLines,
pmLinesAdjacency,
pmLineLoop,
pmLineStrip,
pmTriangles,
pmTriangleStrip,
pmTriangleFan,
pmQuads,
pmPatches,
) where
, vboName
, vboPtr
, vboVertexSize
, eboName
, eboPtr
, shadName
, shadVAO
, shadPrim'
, shadTex'
-- | Synonyms
, vert
, geom
, frag
) where
import Graphics.GL.Core45
import Foreign
import Control.Lens
{- | Datatype containing the necessary information for a single shader. -}
data FullShader = FullShader
{ _shadName :: GLuint -- should be shaderID
, _shadVAO :: VAO
, _shadPrim' :: EPrimitiveMode
, _shadTex' :: Maybe ShaderTexture
}
import Foreign
import Graphics.GL.Core45
-- | Datatype containing the necessary information for a single shader.
data Shader = Shader
{ _shaderUINT :: GLuint -- should be shaderID
, _shaderPrimitive :: GLenum
, _shaderPrimitive :: PrimitiveMode
, _shaderVAO :: VAO
, _shaderTextures :: [TO]
}
newtype FBO = FBO {_unFBO :: GLuint}
newtype TO = TO {_unTO :: GLuint}
{- | Vertex array object: contains the reference to the object,
and its buffer targets. -}
and its buffer targets.
-}
newtype VAO = VAO
{ _vaoName :: GLuint
{ _vaoName :: GLuint
}
{- | 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. -}
Vertex attributes are interleaved within the vbo.
-}
data VBO = VBO
{ _vboName :: GLuint
, _vboPtr :: Ptr Float
, _vboVertexSize :: Int
{ _vboName :: GLuint
, _vboPtr :: Ptr Float
, _vboVertexSize :: Int
-- add int for AMOUNT of data poked!
}
data EBO = EBO
{ _eboName :: GLuint
, _eboPtr :: Ptr GLushort
{ _eboName :: GLuint
, _eboPtr :: Ptr GLushort
}
{- | Datatype containing the reference to a texture object. -}
-- | Datatype containing the reference to a texture object.
newtype ShaderTexture = ShaderTexture
{ _textureObject :: GLuint -- DSA style texture, 450
-- , _textureTarget :: GLenum
{ _textureObject :: GLuint -- DSA style texture, 450
-- , _textureTarget :: GLenum
}
data EPrimitiveMode
= EPoints
| ELines
| ELinesAdjacency
| ELineLoop
| ELineStrip
| ETriangles
| ETriangleStrip
| ETriangleFan
| EQuads
| EQuadStrip
| EPolygon
| EPatches
newtype PrimitiveMode = PrimitiveMode {_unPrimitiveMode :: GLenum}
-- | Short synonyms for shader types
vert, geom, frag :: GLenum
vert = GL_VERTEX_SHADER
geom = GL_GEOMETRY_SHADER
frag = GL_FRAGMENT_SHADER
pmPoints, pmLines, pmLinesAdjacency, pmLineLoop, pmLineStrip, pmTriangles, pmTriangleStrip, pmTriangleFan, pmQuads, pmPatches :: PrimitiveMode
pmPoints = PrimitiveMode GL_POINTS
pmLines = PrimitiveMode GL_LINES
pmLinesAdjacency = PrimitiveMode GL_LINES_ADJACENCY
pmLineLoop = PrimitiveMode GL_LINE_LOOP
pmLineStrip = PrimitiveMode GL_LINE_STRIP
pmTriangles = PrimitiveMode GL_TRIANGLES
pmTriangleStrip = PrimitiveMode GL_TRIANGLE_STRIP
pmTriangleFan = PrimitiveMode GL_TRIANGLE_FAN
pmQuads = PrimitiveMode GL_QUADS
pmPatches = PrimitiveMode GL_PATCHES
makeLenses ''VAO
makeLenses ''VBO
makeLenses ''FullShader
makeLenses ''EBO
makeLenses ''ShaderTexture
makeLenses ''Shader
makeLenses ''FBO
makeLenses ''TO
makeLenses ''PrimitiveMode
src/Shader/ExtraPrimitive.hs
-22
View File
@@ -1,22 +0,0 @@
module Shader.ExtraPrimitive
where
import Shader.Data
import Graphics.GL.Types
import Graphics.GL.Tokens
marshalEPrimitiveMode :: EPrimitiveMode -> GLenum
{-# INLINABLE marshalEPrimitiveMode #-}
marshalEPrimitiveMode x = case x of
EPoints -> GL_POINTS
ELines -> GL_LINES
ELinesAdjacency -> GL_LINES_ADJACENCY
ELineLoop -> GL_LINE_LOOP
ELineStrip -> GL_LINE_STRIP
ETriangles -> GL_TRIANGLES
ETriangleStrip -> GL_TRIANGLE_STRIP
ETriangleFan -> GL_TRIANGLE_FAN
EQuads -> GL_QUADS
EQuadStrip -> GL_QUAD_STRIP
EPolygon -> GL_POLYGON
EPatches -> GL_PATCHES
src/Shader/Poke.hs
+4 -4
View File
@@ -27,13 +27,13 @@ import Shader.Parameters
import Shape.Data
pokeVerxs ::
MV.MVector (PrimState IO) (FullShader, VBO) ->
MV.MVector (PrimState IO) (Shader, VBO) ->
UMV.MVector (PrimState IO) Int ->
Picture ->
IO ()
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList
pokeVerx :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = theShadNum} = do
typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
@@ -400,13 +400,13 @@ pokeFlatV norm col ptr nv sh = do
V3 nx ny nz = sh - norm
pokeLayVerxs ::
MV.MVector (PrimState IO) (FullShader, VBO) ->
MV.MVector (PrimState IO) (Shader, VBO) ->
UMV.MVector (PrimState IO) Int ->
Picture ->
IO ()
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList
pokeLayVerx :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeLayVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do
theOff <- UMV.unsafeRead counts vecPos