diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 0f67771d5..8d000049b 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -110,7 +110,7 @@ doDrawing win pdata u = do -- uniform (_shadUnis lwShad V.! 0) $= viewFrom3d glUseProgram (lwShad ^. shadProg') glUniform3f (_shadUnis' lwShad V.! 0) vfx vfy 20 - bindVertexArrayObject $= lwShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO lwShad) + bindVertexArrayObject $= lwShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwShad) unless (debugOn Remove_LOS cfig) $ glDrawArrays (marshalEPrimitiveMode $ _shadPrim' lwShad) @@ -126,7 +126,7 @@ doDrawing win pdata u = do let fs = _shapeShader pdata --currentProgram $= Just (_shadProg fs) glUseProgram (_shadProg' fs) - bindVertexArrayObject $= fs ^? shadVAO' . vao -- Just (_vao $ _shadVAO fs) + bindVertexArrayObject $= fs ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO fs) glDrawElements (marshalEPrimitiveMode $ _shadPrim' fs) (fromIntegral nIndices) diff --git a/src/Dodge/Render/Shadow.hs b/src/Dodge/Render/Shadow.hs index 7939d68f4..67848b2cb 100644 --- a/src/Dodge/Render/Shadow.hs +++ b/src/Dodge/Render/Shadow.hs @@ -32,7 +32,7 @@ drawCPUShadows pdata s pos rad = do (theshad ^. shadVAO' . vaoVBO . vboPtr) --currentProgram $= theshad ^? shadProg glUseProgram (theshad ^. shadProg') - bindVertexArrayObject $= Just (_vao $ _shadVAO' theshad) + bindVertexArrayObject $= Just (_vaoName $ _shadVAO' theshad) glDrawArrays (marshalEPrimitiveMode $ _shadPrim' theshad) 0 diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 9479e471d..483f7e923 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -5,6 +5,7 @@ module Preload.Render ( cleanUpRenderPreload, ) where +import Control.Lens import Control.Monad import Data.Preload.Render import qualified Data.Vector.Mutable as MV @@ -46,8 +47,8 @@ preloadRender = do bindVertexArrayObject $= Just wpColVAOname setupVertexAttribPointer 0 4 8 0 setupVertexAttribPointer 1 4 8 4 - let wpVAO = VAO{_vao = wpVAOname, _vaoVBO = wpVBO} - wpColVAO = VAO{_vao = wpColVAOname, _vaoVBO = wpVBO} + let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO} + wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO} -- setup window points VBO, VAOs and shaders winVBOname <- genObjectName winVBOptr <- mallocArray (8 * numDrawableWalls) @@ -62,7 +63,7 @@ preloadRender = do bindVertexArrayObject $= Just winColVAOname setupVertexAttribPointer 0 4 8 0 setupVertexAttribPointer 1 4 8 4 - let winColVAO = VAO{_vao = winColVAOname, _vaoVBO = winVBO} + let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO} -- setup shape geometry/cap VBO and two VAOs shEBOname <- genObjectName shEBOptr <- mallocArray numDrawableElements @@ -93,8 +94,8 @@ preloadRender = do bindBuffer ArrayBuffer $= Just shVBOname setupVertexAttribPointer 0 3 7 0 bindBuffer ElementArrayBuffer $= Just shEBOname - let shPosColVAO = VAO{_vao = shPosColVAOname, _vaoVBO = shVBO} - shPosVAO = VAO{_vao = shPosVAOname, _vaoVBO = shVBO} + let shPosColVAO = VAO{_vaoName = shPosColVAOname, _vaoVBO = shVBO} + shPosVAO = VAO{_vaoName = shPosVAOname, _vaoVBO = shVBO} --setup silhouette edge VAO shEdgeVAOname <- genObjectName bindVertexArrayObject $= Just shEdgeVAOname @@ -111,56 +112,58 @@ preloadRender = do , StreamDraw ) let silEBO = EBO{_ebo = silEBOname, _eboPtr = silEBOptr} - shEdgeVAO = VAO{_vao = shEdgeVAOname, _vaoVBO = shVBO} + shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoVBO = shVBO} -- lighting shaders lightingWallShadShad <- - makeShaderUsingVAO' "lighting/wallShadow" [vert', geom', frag'] EPoints wpVAO - >>= addUniforms' ["lightPos"] + makeShaderUsingVAO "lighting/wallShadow" [vert', geom', frag'] EPoints wpVAO + >>= addUniforms ["lightPos"] lightingCapShad <- - makeShaderUsingVAO' "lighting/cap" [vert', geom', frag'] ETriangles shPosVAO - >>= addUniforms' ["lightPos"] + makeShaderUsingVAO "lighting/cap" [vert', geom', frag'] ETriangles shPosVAO + >>= addUniforms ["lightPos"] lightingLineShadowShad <- - makeShaderUsingVAO' "lighting/lineShadow" [vert', geom', frag'] ELinesAdjacency shEdgeVAO - >>= addUniforms' ["lightPos", "radiusUniform"] + makeShaderUsingVAO "lighting/lineShadow" [vert', geom', frag'] ELinesAdjacency shEdgeVAO + >>= addUniforms ["lightPos", "radiusUniform"] -- positional shader - positionalBlankShad <- makeShader' "positional/blank" [vert', frag'] [3] ETriangles + positionalBlankShad <- makeShader "positional/blank" [vert', frag'] [3] ETriangles -- 2D draw shaders - bslist <- makeShader' "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles - bslista <- makeShader' "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles - aslist <- makeShader' "dualTwoD/arc" [vert', frag'] [3, 4, 3] ETriangles - eslist <- makeShader' "dualTwoD/ellipse" [vert', geom', frag'] [3, 4] ETriangles - bezierQuadShader <- makeShader' "dualTwoD/bezierQuad" [vert', frag'] [3, 4, 4] ETriangleStrip + bslist <- makeShader "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles + bslista <- makeShader "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles + aslist <- makeShader "dualTwoD/arc" [vert', frag'] [3, 4, 3] ETriangles + eslist <- makeShader "dualTwoD/ellipse" [vert', geom', frag'] [3, 4] ETriangles + bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert', frag'] [3, 4, 4] ETriangleStrip cslist <- - makeShader' "dualTwoD/character" [vert', frag'] [3, 4, 2] ETriangles - >>= vaddTextureNoFilter' "data/texture/charMap.png" + makeShader "dualTwoD/character" [vert', frag'] [3, 4, 2] ETriangles + >>= vaddTextureNoFilter "data/texture/charMap.png" -- this should really be a 2d texture array - basicTweakZShad <- makeShader' "dualTwoD/basicTweakZ" [vert', frag'] [4, 4] ETriangles + basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert', frag'] [4, 4] ETriangles -- fullscreen shaders --fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip --pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord -- texture shaders, no textures attached - fsShad <- makeShaderSized' "texture/simple" [vert', frag'] [2, 2] 4 ETriangleStrip + fsShad <- makeShaderSized "texture/simple" [vert', frag'] [2, 2] 4 ETriangleStrip -- note we directly poke the shader vertex data here -- could possibly use an indirect draw call pokeArray (shadVBOptr' fsShad) $ concat cornerList - bloomBlurShad <- makeShaderUsingShaderVAO' "texture/bloomBlur" [vert', frag'] ETriangleStrip fsShad - colorBlurShad <- makeShaderUsingShaderVAO' "texture/colorBlur" [vert', frag'] ETriangleStrip fsShad - grayscaleShad <- makeShaderUsingShaderVAO' "texture/grayscale" [vert', frag'] ETriangleStrip fsShad + let fsshadvao = fsShad ^. shadVAO' + + bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert', frag'] ETriangleStrip fsshadvao + colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert', frag'] ETriangleStrip fsshadvao + grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert', frag'] ETriangleStrip fsshadvao lightingTextureShad <- - makeShaderUsingShaderVAO' "lighting/texture" [vert', frag'] ETriangleStrip fsShad - >>= addUniforms' ["lightPos", "lumRad"] - barrelShad <- makeShader' "texture/barrel" [vert', geom', frag'] [2, 2, 2, 1] EPoints + makeShaderUsingVAO "lighting/texture" [vert', frag'] ETriangleStrip fsshadvao + >>= addUniforms ["lightPos", "lumRad"] + barrelShad <- makeShader "texture/barrel" [vert', geom', frag'] [2, 2, 2, 1] EPoints -- blank wallShader - wallBlankShad <- makeShaderUsingVAO' "wall/blank" [vert', geom', frag'] EPoints wpColVAO + wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert', geom', frag'] EPoints wpColVAO -- textured wallShader wallTextureShad <- - makeShaderUsingVAO' "wall/texture" [vert', geom', frag'] EPoints wpColVAO - >>= addTexture' "data/texture/grayscaleDirt.png" + makeShaderUsingVAO "wall/texture" [vert', geom', frag'] EPoints wpColVAO + >>= addTexture "data/texture/grayscaleDirt.png" ---- texture array shader textArrayShad <- - makeShader' "texture/arrayPos" [vert', frag'] [3, 3] ETriangles - >>= addTextureArray' "data/texture/ayene_wooden_floor_transformed.png" + makeShader "texture/arrayPos" [vert', frag'] [3, 3] ETriangles + >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png" -- >>= addTextureArray "data/texture/ayene_wooden_floor.png" -- bind fixed vertex data bindShaderBuffers' [fsShad] [4, 4] diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index b27ef12f2..1e1777527 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -1,41 +1,56 @@ {-# LANGUAGE OverloadedStrings #-} -module Preload.Update - ( pdataResizeUpdate - ) where + +module Preload.Update ( + pdataResizeUpdate, +) where + +import Control.Lens +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC import Data.Preload +import Data.Preload.Render import Framebuffer.Update import Shader.Compile import Shader.Data -import Data.Preload.Render -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -pdataResizeUpdate - :: Int -- ^ Scaled width - -> Int -- ^ Scaled height - -> Int -- ^ Full width - -> Int -- ^ Full height - -> PreloadData - -> IO PreloadData +pdataResizeUpdate :: + -- | Scaled width + Int -> + -- | Scaled height + Int -> + -- | Full width + Int -> + -- | Full height + Int -> + PreloadData -> + IO PreloadData pdataResizeUpdate xsize ysize xfull yfull pdata = do rd <- renderDataResizeUpdate xsize ysize xfull yfull (_renderData pdata) - return (pdata {_renderData = rd}) + return (pdata{_renderData = rd}) -renderDataResizeUpdate - :: Int -- ^ Scaled width - -> Int -- ^ Scaled height - -> Int -- ^ Full width - -> Int -- ^ Full height - -> RenderData - -> IO RenderData +renderDataResizeUpdate :: + -- | Scaled width + Int -> + -- | Scaled height + Int -> + -- | Full width + Int -> + -- | Full height + Int -> + RenderData -> + IO RenderData renderDataResizeUpdate xsize ysize xfull yfull rdata = do rdata' <- sizeFBOs xsize ysize xfull yfull rdata bbVert <- BS.readFile "shader/texture/bloomBlur.vert" bbFrag <- BS.readFile "shader/texture/bloomBlur.frag" - let (bh,bmid) = BS.breakSubstring "(" bbFrag - (_,btt) = BS.breakSubstring ")" bmid + let (bh, bmid) = BS.breakSubstring "(" bbFrag + (_, btt) = BS.breakSubstring ")" bmid bbFrag' = BS.append bh $ BS.append (BSC.pack $ '(' : show xsize ++ "," ++ show ysize) btt --BSC.putStrLn bbFrag' - bbShad <- makeByteStringShaderUsingVAO' "bloomBlur" [(vert',bbVert),(frag',bbFrag')] ETriangleStrip - (_fullscreenShader rdata) - return (rdata' {_bloomBlurShader = bbShad}) + bbShad <- + makeByteStringShaderUsingVAO + "bloomBlur" + [(vert', bbVert), (frag', bbFrag')] + ETriangleStrip + (rdata ^. fullscreenShader . shadVAO') + return (rdata'{_bloomBlurShader = bbShad}) diff --git a/src/Render.hs b/src/Render.hs index a9ff8a8c1..d5ed4e0d7 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -81,7 +81,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh --uniform (_shadUnis lwallShad V.! 0) -- $= Vector3 x y z glUniform3f (_shadUnis' lwallShad V.! 0) x y z - bindVertexArrayObject $= lwallShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO lwallShad) + bindVertexArrayObject $= lwallShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad) glDrawArrays (marshalEPrimitiveMode $ _shadPrim' lwallShad) 0 @@ -95,7 +95,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh glUseProgram (_shadProg' llinesShad) glUniform3f (_shadUnis' llinesShad V.! 0) x y z glUniform1f (_shadUnis' llinesShad V.! 1) rad - bindVertexArrayObject $= Just (_vao $ _shadVAO' llinesShad) + bindVertexArrayObject $= Just (_vaoName $ _shadVAO' llinesShad) glDrawElements (marshalEPrimitiveMode $ _shadPrim' llinesShad) (fromIntegral nSils) @@ -107,7 +107,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh --uniform (_shadUnis lcapShad V.! 0) $= Vector3 x y z glUseProgram (_shadProg' lcapShad) glUniform3f (_shadUnis' lcapShad V.! 0) x y z - bindVertexArrayObject $= lcapShad ^? shadVAO' . vao --Just (_vao $ _shadVAO lcapShad) + bindVertexArrayObject $= lcapShad ^? shadVAO' . vaoName --Just (_vao $ _shadVAO lcapShad) glDrawElements (marshalEPrimitiveMode $ _shadPrim' lcapShad) (fromIntegral nCaps) @@ -128,7 +128,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh glUseProgram (ltextShad ^. shadProg') --Just (_shadProg ltextShad) glUniform3f (_shadUnis' ltextShad V.! 0) x y z glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad - bindVertexArrayObject $= ltextShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO ltextShad) + bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad) glDrawArrays (marshalEPrimitiveMode (_shadPrim' ltextShad)) 0 diff --git a/src/Shader.hs b/src/Shader.hs index 6681324e8..9c9446df6 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -28,7 +28,7 @@ drawShaderLay l countsVector shadIn fs = do i <- UMV.read countsVector shadIn --currentProgram $= Just (_shadProg' fs) glUseProgram (_shadProg' fs) - bindVertexArrayObject $= Just (_vao $ _shadVAO' fs) + bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs) case _shadTex' fs of Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt} -- -> textureBinding Texture2D $= Just txo @@ -45,7 +45,7 @@ drawShader :: FullShader' -> Int -> IO () drawShader fs i = do --currentProgram $= Just (_shadProg fs) glUseProgram (_shadProg' fs) - bindVertexArrayObject $= Just (_vao $ _shadVAO' fs) + bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs) case _shadTex' fs of Just ShaderTexture{_textureObject = txo } --, _textureTarget = tt } diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index c529b7a91..e611cb6af 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -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]) - - diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index a00e19d1f..6b3fdbd26 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -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) diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 912e699de..b6d845ad7 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -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 }