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

Cleanup

Browse Source
This commit is contained in:
justin
2023-03-08 18:31:32 +00:00
parent 2279af5510
commit 48966dde1a
9 changed files with 283 additions and 407 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/AuxAddition.hs
+19 -21
View File
@@ -1,8 +1,8 @@
module Shader.AuxAddition
( addTexture'
, vaddTextureNoFilter'
, addTextureArray'
, addUniforms'
( addTexture
, vaddTextureNoFilter
, addTextureArray
, addUniforms
, tilesToLine -- ^ kept in case it is needed in the future
) where
import Unsafe.Coerce
@@ -17,23 +17,23 @@ import Data.List.Extra
import Codec.Picture
import qualified Data.Vector.Storable as VS
import Control.Lens
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
--import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core45
-- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added...
addTexture' :: String -> FullShader' -> IO FullShader'
addTexture' = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
addTexture :: String -> FullShader' -> IO FullShader'
addTexture = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
vaddTextureNoFilter' :: String -> FullShader' -> IO FullShader'
vaddTextureNoFilter' = addTexture2D 1 GL_NEAREST GL_NEAREST
--vaddTextureNoFilter' = addTexture2D 3 ((Linear',Just Linear') , Linear')
vaddTextureNoFilter :: String -> FullShader' -> IO FullShader'
vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
addTexture2D :: GLint -- number mipmap levels
-- -> ((TextureFilter,Maybe TextureFilter),TextureFilter)
addTexture2D
:: GLint -- number of mipmap levels
-> GLenum -- minfilter
-> GLenum -- magfilter
-> String -> FullShader' -> IO FullShader'
-> String -- path to image
-> FullShader' -> IO FullShader'
addTexture2D nlev minfilt magfilt texpath shad = do
Right cmap <- readImage texpath
let texdata = convertRGBA8 cmap
@@ -54,8 +54,8 @@ addTexture2D nlev minfilt magfilt texpath shad = 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' -> IO FullShader'
addTextureArray' texturePath shad = do
addTextureArray :: String -> FullShader' -> IO FullShader'
addTextureArray texturePath shad = do
err <- glGetError
print err
Right cmap <- readImage texturePath
@@ -80,12 +80,10 @@ tilesToLine
-> [a]
tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
addUniforms' :: [String] -> FullShader' -> IO FullShader'
addUniforms' uniStrings shad = do foldM addUniform' shad uniStrings
addUniforms :: [String] -> FullShader' -> IO FullShader'
addUniforms uniStrings shad = do foldM addUniform shad uniStrings
addUniform' :: FullShader' -> String -> IO FullShader'
addUniform' shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
addUniform :: FullShader' -> String -> IO FullShader'
addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
loc <- glGetUniformLocation (_shadProg' shad) cstr
return $ shad & shadUnis' %~ (V.++ V.fromList [loc])
src/Shader/Compile.hs
+175 -315
View File
@@ -1,252 +1,127 @@
module Shader.Compile
( makeShader
, makeShader'
, makeByteStringShader
, makeByteStringShader'
, makeByteStringShaderUsingVAO
, makeByteStringShaderUsingVAO'
, makeShaderSized
, makeShaderSized'
, makeShaderUsingShaderVAO
, makeShaderUsingShaderVAO'
, makeShaderUsingVAO
, makeShaderUsingVAO'
, makeSourcedShader
, setupVAO
, setupVertexAttribPointer
) where
module Shader.Compile (
makeShader,
makeByteStringShaderUsingVAO,
makeShaderSized,
-- makeShaderUsingShaderVAO,
makeShaderUsingVAO,
setupVAO,
setupVertexAttribPointer,
) where
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU
import Foreign
import Foreign.C.String
--import Control.Lens
import Graphics.GL.Core45
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
import Shader.Data
import Shader.Parameters
import Foreign
import Foreign.C.String
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU
import Control.Monad
--import Control.Lens
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43
{- |
{- |
Compiles a full shader found within the shader directory.
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
-}
makeShader
:: String -- ^ First part of the name of the shader
-> [ShaderType] -- ^ Filetype extensions
-> [Int] -- ^ The input vertex sizes
-> EPrimitiveMode
-> IO FullShader
makeShader ::
-- | First part of the name of the shader
String ->
-- | shader types
[GLenum] ->
-- | The input vertex sizes
[Int] ->
EPrimitiveMode ->
IO FullShader'
makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist
vaob <- setupVAO sizes
return $ FullShader
{ _shadProg = prog
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = mempty
}
makeShader'
:: String -- ^ First part of the name of the shader
-> [GLenum] -- ^ shader types
-> [Int] -- ^ The input vertex sizes
-> EPrimitiveMode
-> IO FullShader'
makeShader' s shaderlist sizes pm = do
prog <- makeSourcedShader' s shaderlist
vaob <- setupVAO sizes
return $ FullShader'
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
return $
FullShader'
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
makeByteStringShader'
:: String -- ^ (Arbitrary) name of the shader
-> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data
-> [Int] -- ^ The input vertex sizes
-> EPrimitiveMode
-> IO FullShader'
makeByteStringShader' s shaderlist sizes pm = do
prog <- makeShaderProgram' s shaderlist
vaob <- setupVAO sizes
return $ FullShader'
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
makeByteStringShader
:: String -- ^ (Arbitrary) name of the shader
-> [(ShaderType,BS.ByteString)] -- ^ Filetype extensions and shader data
-> [Int] -- ^ The input vertex sizes
-> EPrimitiveMode
-> IO FullShader
makeByteStringShader s shaderlist sizes pm = do
makeByteStringShaderUsingVAO ::
-- | (Arbitrary) name of the shader
String ->
-- | Filetype extensions and shader data
[(GLenum, BS.ByteString)] ->
EPrimitiveMode ->
VAO ->
IO FullShader'
makeByteStringShaderUsingVAO s shaderlist pm vao = do
prog <- makeShaderProgram s shaderlist
vaob <- setupVAO sizes
return $ FullShader
{ _shadProg = prog
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = mempty
}
makeByteStringShaderUsingVAO
:: String -- ^ (Arbitrary) name of the shader
-> [(ShaderType,BS.ByteString)] -- ^ Filetype extensions and shader data
-> EPrimitiveMode
-> FullShader
-> IO FullShader
makeByteStringShaderUsingVAO s shaderlist pm fs = do
prog <- makeShaderProgram s shaderlist
return $ fs
{ _shadProg = prog
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = mempty
}
makeByteStringShaderUsingVAO'
:: String -- ^ (Arbitrary) name of the shader
-> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data
-> EPrimitiveMode
-> FullShader'
-> IO FullShader'
makeByteStringShaderUsingVAO' s shaderlist pm fs = do
prog <- makeShaderProgram' s shaderlist
return $ fs
{ _shadProg' = prog
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
return $
FullShader'
{ _shadProg' = prog
, _shadVAO' = vao
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
-- | Takes the VAO from elsewhere
makeShaderUsingVAO
:: String -- ^ First part of the name of the shader
-> [ShaderType] -- ^ Filetype extensions
-> EPrimitiveMode
-> VAO
-> IO FullShader
makeShaderUsingVAO ::
-- | First part of the name of the shader
String ->
-- | shader types
[GLenum] ->
EPrimitiveMode ->
VAO ->
IO FullShader'
makeShaderUsingVAO s shaderlist pm theVAO = do
prog <- makeSourcedShader s shaderlist
return $ FullShader
{ _shadProg = prog
, _shadVAO = theVAO
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = mempty
}
makeShaderUsingVAO'
:: String -- ^ First part of the name of the shader
-> [GLenum] -- ^ shader types
-> EPrimitiveMode
-> VAO
-> IO FullShader'
makeShaderUsingVAO' s shaderlist pm theVAO = do
prog <- makeSourcedShader' s shaderlist
return $ FullShader'
{ _shadProg' = prog
, _shadVAO' = theVAO
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
return $
FullShader'
{ _shadProg' = prog
, _shadVAO' = theVAO
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
-- | Takes the VAO from another shader
makeShaderUsingShaderVAO
:: String -- ^ First part of the name of the shader
-> [ShaderType] -- ^ Filetype extensions
-> EPrimitiveMode
-> FullShader
-> IO FullShader
makeShaderUsingShaderVAO s shaderlist pm fs = do
prog <- makeSourcedShader s shaderlist
return $ fs
{ _shadProg = prog
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = mempty
}
makeShaderUsingShaderVAO'
:: String -- ^ First part of the name of the shader
-> [GLenum] -- ^ shader types
-> EPrimitiveMode
-> FullShader'
-> IO FullShader'
makeShaderUsingShaderVAO' s shaderlist pm fs = do
prog <- makeSourcedShader' s shaderlist
return $ fs
{ _shadProg' = prog
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
{- |
{- |
Compiles a full shader found within the shader directory.
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
-}
makeShaderSized
:: String -- ^ First part of the name of the shader
-> [ShaderType] -- ^ Filetype extensions
-> [Int] -- ^ The input vertex sizes
-> Int -- ^ Number of vertexes that can be poked
-> EPrimitiveMode
-> IO FullShader
makeShaderSized ::
-- | First part of the name of the shader
String ->
-- | shader types
[GLenum] ->
-- | The input vertex sizes
[Int] ->
-- | Number of vertexes that can be poked
Int ->
EPrimitiveMode ->
IO FullShader'
makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist
vaob <- setupVAOSized sizes ndraw
return $ FullShader
{ _shadProg = prog
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = mempty
}
makeShaderSized'
:: String -- ^ First part of the name of the shader
-> [GLenum] -- ^ shader types
-> [Int] -- ^ The input vertex sizes
-> Int -- ^ Number of vertexes that can be poked
-> EPrimitiveMode
-> IO FullShader'
makeShaderSized' s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader' s shaderlist
vaob <- setupVAOSized sizes ndraw
return $ FullShader'
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
return $
FullShader'
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
-- | Compile shader and get its uniform locations.
-- supposes the shader code is in the shader folder, with the string names
-- followed by .vert/.geom/.frag.
makeSourcedShader :: String -> [ShaderType] -> IO Program
{- | Compile shader and get its uniform locations.
supposes the shader code is in the shader folder, with the string names
followed by .vert/.geom/.frag.
-}
makeSourcedShader :: String -> [GLenum] -> IO GLuint
makeSourcedShader s sts = do
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt' st)
makeShaderProgram s $ zip sts sources
makeSourcedShader' :: String -> [GLenum] -> IO GLuint
makeSourcedShader' s sts = do
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt' st)
makeShaderProgram' s $ zip sts sources
shaderTypeExt :: ShaderType -> String
shaderTypeExt VertexShader = ".vert"
shaderTypeExt GeometryShader = ".geom"
shaderTypeExt FragmentShader = ".frag"
shaderTypeExt _ = undefined
shaderTypeExt' :: GLenum -> String
shaderTypeExt' GL_VERTEX_SHADER = ".vert"
shaderTypeExt' GL_VERTEX_SHADER = ".vert"
shaderTypeExt' GL_GEOMETRY_SHADER = ".geom"
shaderTypeExt' GL_FRAGMENT_SHADER = ".frag"
shaderTypeExt' _ = undefined
@@ -257,39 +132,43 @@ setupVAO sizes = do
theVAO <- genObjectName
bindVertexArrayObject $= Just theVAO
theVBO <- setupVBO sizes
return $ VAO
{ _vao = theVAO
, _vaoVBO = theVBO
}
return $
VAO
{ _vaoName = theVAO
, _vaoVBO = theVBO
}
setupVAOSized :: [Int] -> Int -> IO VAO
setupVAOSized sizes ndraw = do
theVAO <- genObjectName
bindVertexArrayObject $= Just theVAO
theVBO <- setupVBOSized sizes ndraw
return $ VAO
{ _vao = theVAO
, _vaoVBO = theVBO
}
return $
VAO
{ _vaoName = theVAO
, _vaoVBO = theVBO
}
setupVBO :: [Int] -> IO VBO
setupVBO sizes = do
vboName <- genObjectName
bindBuffer ArrayBuffer $= Just vboName
forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer loc siz strd off
thePtr <- mallocArray (strd * numDrawableElements)
-- Allocate space
bufferData ArrayBuffer $=
(fromIntegral $ floatSize * numDrawableElements * strd
, nullPtr
, StreamDraw
)
return $ VBO
{ _vbo = vboName
, _vboPtr = thePtr
, _vboAttribSizes = sizes
, _vboStride = sum sizes
}
bufferData ArrayBuffer
$= ( fromIntegral $ floatSize * numDrawableElements * strd
, nullPtr
, StreamDraw
)
return $
VBO
{ _vbo = vboName
, _vboPtr = thePtr
, _vboAttribSizes = sizes
, _vboStride = sum sizes
}
where
strd = sum sizes
offs = scanl (+) 0 sizes
@@ -298,108 +177,89 @@ setupVBOSized :: [Int] -> Int -> IO VBO
setupVBOSized sizes ndraw = do
vboName <- genObjectName
bindBuffer ArrayBuffer $= Just vboName
forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer loc siz strd off
thePtr <- mallocArray (strd * ndraw)
-- Allocate space
bufferData ArrayBuffer $=
(fromIntegral $ floatSize * ndraw * strd
, nullPtr
, StreamDraw
)
return $ VBO
{ _vbo = vboName
, _vboPtr = thePtr
, _vboAttribSizes = sizes
, _vboStride = sum sizes
}
bufferData ArrayBuffer
$= ( fromIntegral $ floatSize * ndraw * strd
, nullPtr
, StreamDraw
)
return $
VBO
{ _vbo = vboName
, _vboPtr = thePtr
, _vboAttribSizes = sizes
, _vboStride = sum sizes
}
where
strd = sum sizes
offs = scanl (+) 0 sizes
{- | Assumes the correct VBO is bound -}
setupVertexAttribPointer
:: Int -- ^ Atrib location
-> Int -- ^ Size
-> Int -- ^ Stride
-> Int -- ^ Offset
-> IO ()
-- | Assumes the correct VBO is bound
setupVertexAttribPointer ::
-- | Atrib location
Int ->
-- | Size
Int ->
-- | Stride
Int ->
-- | Offset
Int ->
IO ()
setupVertexAttribPointer loc siz strd off = do
vertexAttribPointer (AttribLocation (fi loc)) $=
(ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
vertexAttribPointer (AttribLocation (fi loc))
$= (ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
vertexAttribArray (AttribLocation (fi loc)) $= Enabled
where
fi = fromIntegral
fi' = fromIntegral
fi'' = fromIntegral
makeShaderProgram' :: String
-> [(GLenum,BS.ByteString)] -- list of shaders
-> IO GLuint
makeShaderProgram' str srcs = do
makeShaderProgram ::
String ->
[(GLenum, BS.ByteString)] -> -- list of shaders
IO GLuint
makeShaderProgram str srcs = do
theprog <- glCreateProgram
shaders <- mapM (compileAndCheckShader' str) srcs
shaders <- mapM (compileAndCheckShader str) srcs
mapM_ (glAttachShader theprog) shaders
glLinkProgram theprog
glCheckError (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
mapM_ (glDetachShader theprog) shaders
mapM_ glDeleteShader shaders
return theprog
glCheckError :: (Storable t1) =>
[Char]
-> (t2 -> GLenum -> Ptr t1 -> IO ())
-> (t2 -> t1 -> Ptr a3 -> CString -> IO ())
-> t2
-> GLenum
-> IO ()
glCheckError ::
(Storable t1) =>
[Char] ->
(t2 -> GLenum -> Ptr t1 -> IO ()) ->
(t2 -> t1 -> Ptr a3 -> CString -> IO ()) ->
t2 ->
GLenum ->
IO ()
glCheckError str f g x statustype =
alloca $ \statusPtr -> do
f x statustype statusPtr
status <- peek $ castPtr statusPtr
if status == GL_FALSE
then do
alloca $ \ptr -> do
f x GL_INFO_LOG_LENGTH ptr
len <- peek ptr -- we may have to use this length more intelligently
alloca $ \charPtr -> do
g x len nullPtr charPtr
char <- peekCString charPtr
error $ str ++ show char
else return ()
when (status == GL_FALSE) $
alloca $ \ptr -> do
f x GL_INFO_LOG_LENGTH ptr
len <- peek ptr -- we may have to use this length more intelligently
alloca $ \charPtr -> do
g x len nullPtr charPtr
char <- peekCString charPtr
error $ str ++ show char
makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program
makeShaderProgram str sources = do
theShaderProgram <- createProgram
shaders <- mapM (compileAndCheckShader str) sources
mapM_ (attachShader theShaderProgram) shaders
linkProgram theShaderProgram
linkingSuccess <- linkStatus theShaderProgram
unless linkingSuccess $ do
infoLog <- get (programInfoLog theShaderProgram)
putStrLn $ str ++ ": Program Linking" ++ infoLog
return theShaderProgram
compileAndCheckShader :: String -> (ShaderType,BS.ByteString) -> IO Shader
compileAndCheckShader str (theShaderType,sourceCode) = do
theShader <- createShader theShaderType
shaderSourceBS theShader $= sourceCode
compileShader theShader
success <- compileStatus theShader
unless success $ do
infoLog <- get (shaderInfoLog theShader)
putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " :\n" ++ infoLog
return theShader
compileAndCheckShader' :: String -> (GLenum,BS.ByteString) -> IO GLuint
compileAndCheckShader' str (theShaderType,sourceCode) = do
compileAndCheckShader :: String -> (GLenum, BS.ByteString) -> IO GLuint
compileAndCheckShader str (theShaderType, sourceCode) = do
theShader <- glCreateShader theShaderType
setShaderSource theShader sourceCode
glCompileShader theShader
glCheckError (str ++ shaderTypeExt' theShaderType) glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS
return theShader
setShaderSource :: GLuint -> BS.ByteString -> IO ()
setShaderSource si src =
withByteString src $ \srcPtr srcLength ->
@@ -409,7 +269,7 @@ setShaderSource si src =
-- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP
withByteString :: Num t => BS.ByteString -> (Ptr b -> t -> IO a) -> IO a
withByteString bs act =
withByteString bs act =
BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->
act (castPtr ptr) (fromIntegral size)
src/Shader/Data.hs
+3 -3
View File
@@ -10,7 +10,7 @@ module Shader.Data
, ShaderTexture (..)
, EPrimitiveMode (..)
-- | Lens functions
, vao
, vaoName
, vaoVBO
, shadProg
, shadVAO
@@ -60,7 +60,7 @@ data FullShader' = FullShader'
{- | Vertex array object: contains the reference to the object,
and its buffer targets. -}
data VAO = VAO
{ _vao :: VertexArrayObject
{ _vaoName :: VertexArrayObject
, _vaoVBO :: VBO
}
{- | Vertex buffer object: contains the reference to the object,
@@ -78,7 +78,7 @@ data EBO = EBO
, _eboPtr :: Ptr GLushort
}
{- | Datatype containing the reference to a texture object. -}
data ShaderTexture = ShaderTexture
newtype ShaderTexture = ShaderTexture
{ _textureObject :: GLuint -- DSA style texture, 450
-- , _textureTarget :: GLenum
}