Cleanup
This commit is contained in:
+2
-2
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
+36
-33
@@ -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]
|
||||
|
||||
+41
-26
@@ -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})
|
||||
|
||||
+4
-4
@@ -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
|
||||
|
||||
+2
-2
@@ -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 }
|
||||
|
||||
+19
-21
@@ -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])
|
||||
|
||||
|
||||
|
||||
+175
-315
@@ -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)
|
||||
|
||||
|
||||
+3
-3
@@ -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
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user