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
data/normalMaps/diffuseArray.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 90 KiB

After

Width:  |  Height:  |  Size: 141 KiB

data/normalMaps/normalArray.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 36 KiB

After

Width:  |  Height:  |  Size: 82 KiB

src/Data/Preload/Render.hs
+21 -27
View File
@@ -10,34 +10,30 @@ import qualified Data.Vector.Mutable as MV
import Graphics.GL.Core45 import Graphics.GL.Core45
import Shader.Data import Shader.Data
newtype FBO = FBO {_unFBO :: GLuint}
newtype TO = TO {_unTO :: GLuint}
data RenderData = RenderData data RenderData = RenderData
{ _lightingWallShadShader :: FullShader { _lightingWallShadShader :: Shader
, _lightingLineShadowShader :: FullShader , _lightingLineShadowShader :: Shader
, _lightingCapShader :: FullShader , _lightingCapShader :: Shader
, _lightingTextureShader :: FullShader , _lightingTextureShader :: Shader
, _alphaDivideShader :: Shader , _alphaDivideShader :: Shader
, _shadowEdgeShader :: FullShader , _shadowEdgeShader :: Shader
, _shadowCapShader :: FullShader , _shadowCapShader :: Shader
, _shadowWallShader :: FullShader , _shadowWallShader :: Shader
, _shadowLightShader :: (FullShader,VBO) , _shadowLightShader :: (Shader,VBO)
, _shadowCombineShader :: (FullShader,VBO) , _shadowCombineShader :: (Shader,VBO)
, _positionalBlankShader :: (FullShader,VBO) , _positionalBlankShader :: (Shader,VBO)
, _wallBlankShader :: FullShader , _wallBlankShader :: Shader
, _windowShader :: FullShader , _windowShader :: Shader
, _wallTextureShader :: FullShader , _wallTextureShader :: Shader
, _fullscreenShader :: Shader , _fullscreenShader :: Shader
, _bloomBlurShader :: FullShader , _bloomBlurShader :: Shader
, _colorBlurShader :: FullShader , _colorBlurShader :: Shader
, _barrelShader :: (FullShader,VBO) , _barrelShader :: (Shader,VBO)
, _grayscaleShader :: FullShader , _grayscaleShader :: Shader
, _shapeShader :: FullShader , _shapeShader :: Shader
, _shapeEBO :: EBO , _shapeEBO :: EBO
, _silhouetteEBO :: EBO , _silhouetteEBO :: EBO
, _pictureShaders :: MV.MVector (PrimState IO) (FullShader,VBO) , _pictureShaders :: MV.MVector (PrimState IO) (Shader,VBO)
, _fbo2 :: (FBO, TO) , _fbo2 :: (FBO, TO)
, _fbo3 :: (FBO, TO) , _fbo3 :: (FBO, TO)
, _fboHalf1 :: (FBO, TO) , _fboHalf1 :: (FBO, TO)
@@ -57,11 +53,11 @@ data RenderData = RenderData
, _vboWindows :: VBO , _vboWindows :: VBO
, _vboShapes :: VBO , _vboShapes :: VBO
, _floorVBO :: VBO , _floorVBO :: VBO
, _floorShader :: FullShader , _floorShader :: Shader
, _toNormalMaps :: TO , _toNormalMaps :: TO
, _toDiffuse :: TO , _toDiffuse :: TO
, _wallVBO :: VBO , _wallVBO :: VBO
, _wallShader :: FullShader , _wallShader :: Shader
, _cloudVBO :: VBO , _cloudVBO :: VBO
, _cloudShader :: Shader , _cloudShader :: Shader
, _cloudEBO :: EBO , _cloudEBO :: EBO
@@ -69,5 +65,3 @@ data RenderData = RenderData
} }
makeLenses ''RenderData makeLenses ''RenderData
makeLenses ''FBO
makeLenses ''TO
src/Dodge/Placement/Instance/Wall.hs
+3 -2
View File
@@ -89,8 +89,9 @@ baseBlockPane =
{ _wlLine = (V2 0 0, V2 50 0) { _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0 , _wlID = 0
--, _wlColor = greyN 0.5 --, _wlColor = greyN 0.5
, _wlColor = orange , _wlColor = dark $ dark orange
, _wlOpacity = Opaque 10 --, _wlOpacity = Opaque 10
, _wlOpacity = Opaque 14
, _wlUnshadowed = True , _wlUnshadowed = True
, _wlFireThrough = True , _wlFireThrough = True
, _wlPenetrable = True , _wlPenetrable = True
src/Dodge/Render.hs
+21 -23
View File
@@ -30,7 +30,6 @@ import qualified SDL
import Shader import Shader
import Shader.Bind import Shader.Bind
import Shader.Data import Shader.Data
import Shader.ExtraPrimitive
import Shader.Parameters import Shader.Parameters
import Shader.Poke import Shader.Poke
@@ -134,15 +133,15 @@ doDrawing' win pdata u = do
ptr ptr
glDepthFunc GL_LESS glDepthFunc GL_LESS
-- draw wall occlusions from the camera's point of view -- draw wall occlusions from the camera's point of view
glUseProgram (pdata ^. lightingWallShadShader . shadName) glUseProgram (pdata ^. lightingWallShadShader . shaderUINT)
glProgramUniform3f (pdata ^. lightingWallShadShader . shadName) glProgramUniform3f (pdata ^. lightingWallShadShader . shaderUINT)
0 vfx vfy 20 0 vfx vfy 20
glProgramUniform1f (pdata ^. lightingWallShadShader . shadName) glProgramUniform1f (pdata ^. lightingWallShadShader . shaderUINT)
1 1000 1 1000
glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO . vaoName glBindVertexArray $ pdata ^. lightingWallShadShader . shaderVAO . vaoName
unless (debugOn Remove_LOS cfig) $ unless (debugOn Remove_LOS cfig) $
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim') (_unPrimitiveMode $ pdata ^. lightingWallShadShader . shaderPrimitive)
0 0
(fromIntegral nWalls) (fromIntegral nWalls)
-- clear normals -- clear normals
@@ -153,15 +152,13 @@ doDrawing' win pdata u = do
ptr ptr
--draw walls onto base buffer --draw walls onto base buffer
glDisable GL_BLEND glDisable GL_BLEND
glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
-- maybe cull faces? maybe do this before? -- maybe cull faces? maybe do this before?
--glEnable GL_CULL_FACE --glEnable GL_CULL_FACE
--glCullFace GL_BACK --glCullFace GL_BACK
glUseProgram (pdata ^. wallShader . shadName) glUseProgram (pdata ^. wallShader . shaderUINT)
glBindVertexArray $ pdata ^. wallShader . shadVAO . vaoName glBindVertexArray $ pdata ^. wallShader . shaderVAO . vaoName
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ pdata ^. wallShader . shadPrim') (_unPrimitiveMode $ pdata ^. wallShader . shaderPrimitive)
0 0
(fromIntegral trueNWalls) (fromIntegral trueNWalls)
--glDisable GL_CULL_FACE --glDisable GL_CULL_FACE
@@ -172,23 +169,24 @@ doDrawing' win pdata u = do
renderLayer BottomLayer shadV layerCounts renderLayer BottomLayer shadV layerCounts
--draw object shapes onto base buffer --draw object shapes onto base buffer
let fs = _shapeShader pdata let fs = _shapeShader pdata
glUseProgram (_shadName fs) glUseProgram (_shaderUINT fs)
glBindVertexArray $ fs ^. shadVAO . vaoName glBindVertexArray $ fs ^. shaderVAO . vaoName
-- glEnable GL_CULL_FACE -- glEnable GL_CULL_FACE
-- glCullFace GL_BACK -- glCullFace GL_BACK
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim' fs) (_unPrimitiveMode $ _shaderPrimitive fs)
(fromIntegral nIndices) (fromIntegral nIndices)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
glDisable GL_CULL_FACE glDisable GL_CULL_FACE
--draw floor onto base buffer --draw floor onto base buffer
glUseProgram (pdata ^. floorShader . shadName) glUseProgram (pdata ^. floorShader . shaderUINT)
glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO) glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
--glTextureParameteri (pdata ^. toNormalMaps . unTO) GL_TEXTURE_BASE_LEVEL 3
glBindTextureUnit 2 (pdata ^. toDiffuse . unTO) glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ pdata ^. floorShader . shadPrim' ) (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive )
0 0
(fromIntegral nFls) (fromIntegral nFls)
glEnable GL_BLEND glEnable GL_BLEND
@@ -234,7 +232,7 @@ doDrawing' win pdata u = do
glDepthFunc GL_ALWAYS glDepthFunc GL_ALWAYS
glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO)
glDisable GL_BLEND glDisable GL_BLEND
drawFullShader (_bloomBlurShader pdata) 4 drawShader (_bloomBlurShader pdata) 4
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
glEnable GL_BLEND glEnable GL_BLEND
setViewportSize (round winx `div` resFact) (round winy `div` resFact) setViewportSize (round winx `div` resFact) (round winy `div` resFact)
@@ -260,11 +258,11 @@ doDrawing' win pdata u = do
glUseProgram (pdata ^. cloudShader . shaderUINT) glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements glDrawElements
(pdata ^. cloudShader . shaderPrimitive) (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs) (fromIntegral nCloudIs)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
drawFullShader (_windowShader pdata) nWins drawShader (_windowShader pdata) nWins
when (_graphics_cloud_shadows cfig) $ do when (_graphics_cloud_shadows cfig) $ do
----render transparency depths ----render transparency depths
glDepthMask GL_TRUE glDepthMask GL_TRUE
@@ -290,11 +288,11 @@ doDrawing' win pdata u = do
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDepthMask GL_TRUE glDepthMask GL_TRUE
glDrawElements glDrawElements
(pdata ^. cloudShader . shaderPrimitive) (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs) (fromIntegral nCloudIs)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
drawFullShader (_windowShader pdata) nWins drawShader (_windowShader pdata) nWins
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO) glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
(pdata ^. fboPos . _1 . unFBO) (pdata ^. fboPos . _1 . unFBO)
@@ -355,7 +353,7 @@ doDrawing' win pdata u = do
bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g] pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g]
bufferPokedVBO (snd $ _barrelShader pdata) 1 bufferPokedVBO (snd $ _barrelShader pdata) 1
drawFullShader (fst $ _barrelShader pdata) 1 drawShader (fst $ _barrelShader pdata) 1
fboList = fboList =
take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
++ [FBO 0] ++ [FBO 0]
src/Dodge/Room/Procedural.hs
+2 -1
View File
@@ -63,7 +63,8 @@ roomRect x y xn yn =
{ _tilePoly = rectNSWE y 0 0 x { _tilePoly = rectNSWE y 0 0 x
, _tileZero = V2 0 0 , _tileZero = V2 0 0
, _tileTangentPos = V2 baseFloorTileSize 0 , _tileTangentPos = V2 baseFloorTileSize 0
, _tileArrayZ = 5 --, _tileArrayZ = 5
, _tileArrayZ = 16
} }
] ]
, _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)] , _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)]
src/Dodge/WorldEvent/Cloud.hs
+2 -2
View File
@@ -60,10 +60,10 @@ makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50
makeStartCloudAt :: Point3 -> World -> World makeStartCloudAt :: Point3 -> World -> World
--makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5 --makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
--makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50 --makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 200 makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
shellTrailCloud :: Int -> Float -> Point3 -> World -> World shellTrailCloud :: Int -> Float -> Point3 -> World -> World
shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 200 shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 30
makeFlamerSmokeAt :: Point3 -> World -> World makeFlamerSmokeAt :: Point3 -> World -> World
makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
src/Framebuffer/Check.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Framebuffer.Check where module Framebuffer.Check where
import Data.Preload.Render import Shader.Data
import Graphics.GL.Core45 import Graphics.GL.Core45
checkFBO :: FBO -> IO () checkFBO :: FBO -> IO ()
src/Framebuffer/Setup.hs
+1 -1
View File
@@ -7,9 +7,9 @@ module Framebuffer.Setup (
setupShadowFramebuffer, setupShadowFramebuffer,
) where ) where
import Shader.Data
import Framebuffer.Check import Framebuffer.Check
import Unsafe.Coerce import Unsafe.Coerce
import Data.Preload.Render
import GLHelp import GLHelp
import Graphics.GL.Core45 import Graphics.GL.Core45
src/Framebuffer/Update.hs
+1
View File
@@ -7,6 +7,7 @@ module Framebuffer.Update (
sizeFBOs, sizeFBOs,
) where ) where
import Shader.Data
import Framebuffer.Check import Framebuffer.Check
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
src/Preload/Render.hs
+32 -32
View File
@@ -101,39 +101,39 @@ preloadRender = do
-- shEdgeVAO is unecessary? -- shEdgeVAO is unecessary?
-- lighting shaders -- lighting shaders
lightingWallShadShad <- lightingWallShadShad <-
makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] EPoints wpVAO makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] pmPoints wpVAO
lightingCapShad <- lightingCapShad <-
makeShaderUsingVAO "lighting/cap" [vert, geom] ETriangles shPosVAO makeShaderUsingVAO "lighting/cap" [vert, geom] pmTriangles shPosVAO
lightingLineShadowShad <- lightingLineShadowShad <-
makeShaderUsingVAO "lighting/lineShadow" [vert, geom] ELinesAdjacency shEdgeVAO makeShaderUsingVAO "lighting/lineShadow" [vert, geom] pmLinesAdjacency shEdgeVAO
shadowedgeshader <- shadowedgeshader <-
makeShaderUsingVAO "shadow/edge" [vert, geom] ELinesAdjacency shEdgeVAO makeShaderUsingVAO "shadow/edge" [vert, geom] pmLinesAdjacency shEdgeVAO
shadowcapshader <- shadowcapshader <-
makeShaderUsingVAO "shadow/cap" [vert, geom] ETriangles shPosVAO makeShaderUsingVAO "shadow/cap" [vert, geom] pmTriangles shPosVAO
shadowwallshader <- shadowwallshader <-
makeShaderUsingVAO "shadow/wallShadow" [vert, geom] EPoints wpVAO makeShaderUsingVAO "shadow/wallShadow" [vert, geom] pmPoints wpVAO
shadowlightshader <- makeShaderSized "shadow/light" [vert, geom, frag] shadowlightshader <- makeShaderSized "shadow/light" [vert, geom, frag]
[1] 1 [1] 1
EPoints pmPoints
shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 EPoints shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 pmPoints
poke (shadVBOptr shadowlightshader) 1 poke (shadVBOptr shadowlightshader) 1
-- positional shader -- positional shader
positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] pmTriangles
-- 2D draw shaders -- 2D draw shaders
bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] pmTriangles
bslista <- makeShader4 "shape/basic" [vert, frag] shapeVerxSizes nShapeVerxComp ETriangles shVBO bslista <- makeShader4 "shape/basic" [vert, frag] shapeVerxSizes nShapeVerxComp pmTriangles shVBO
glVertexArrayElementBuffer (bslista ^. shadVAO . vaoName) (shEBO' ^. eboName) glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) (shEBO' ^. eboName)
--glVertexArrayElementBuffer (bslista ^. shadVAO . vaoName) shEBOname --glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) shEBOname
aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] ETriangles aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles
eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] ETriangles eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] pmTriangleStrip
cslist <- cslist <-
makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] pmTriangles
>>= _1 (vaddTextureNoFilter "data/texture/charMap.png") >>= _1 (vaddTextureNoFilter "data/texture/charMap.png")
-- this should really be a 2d texture array -- 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] pmTriangles
-- texture shaders, no textures attached -- texture shaders, no textures attached
screentexturevbo <- mglCreate glCreateBuffers screentexturevbo <- mglCreate glCreateBuffers
@@ -144,25 +144,25 @@ preloadRender = do
ptr ptr
0 0
screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo
alphadivideshader <- makeShader4UsingVAO "texture2D/alphaDivide" [vert,frag] GL_TRIANGLE_STRIP screentexturevao alphadivideshader <- makeShader4UsingVAO "texture2D/alphaDivide" [vert,frag] pmTriangleStrip screentexturevao
fsShad <- makeShader4UsingVAO "texture/simple" [vert, frag] GL_TRIANGLE_STRIP screentexturevao fsShad <- makeShader4UsingVAO "texture/simple" [vert, frag] pmTriangleStrip screentexturevao
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip screentexturevao bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] pmTriangleStrip screentexturevao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip screentexturevao colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] pmTriangleStrip screentexturevao
grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] ETriangleStrip screentexturevao grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] pmTriangleStrip screentexturevao
lightingTextureShad <- lightingTextureShad <-
makeShaderUsingVAO "lighting/texture" [vert, frag] ETriangleStrip screentexturevao makeShaderUsingVAO "lighting/texture" [vert, frag] pmTriangleStrip screentexturevao
barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] EPoints barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] pmPoints
-- blank wallShader -- blank wallShader
wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] EPoints wpColVAO wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] pmPoints wpColVAO
-- textured wallShader -- textured wallShader
wallTextureShad <- wallTextureShad <-
makeShaderUsingVAO "wall/texture" [vert, geom, frag] EPoints wpColVAO makeShaderUsingVAO "wall/texture" [vert, geom, frag] pmPoints wpColVAO
let wallverxstrd = 8 let wallverxstrd = 8
wallvbo <- setupVBO wallverxstrd wallvbo <- setupVBO wallverxstrd
wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd EPoints wallvbo wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd pmPoints wallvbo
let floorverxstrd = 8 let floorverxstrd = 8
floorvbo <- setupVBOStatic floorverxstrd floorvbo <- setupVBOStatic floorverxstrd
floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles floorvbo floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd pmTriangles floorvbo
tonormalmap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png" tonormalmap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"
todiffusemap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png" todiffusemap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
@@ -170,7 +170,7 @@ preloadRender = do
cloudvbo <- setupVBO (sum cloudverxsizes) cloudvbo <- setupVBO (sum cloudverxsizes)
(cloudshader, cloudebo) (cloudshader, cloudebo)
<- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes (sum cloudverxsizes) <- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes (sum cloudverxsizes)
GL_TRIANGLES cloudvbo pmTriangles cloudvbo
framebuf2 <- setupTextureFramebuffer 800 600 framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600
@@ -211,7 +211,7 @@ preloadRender = do
return $ return $
RenderData RenderData
{ _pictureShaders = shadV { _pictureShaders = shadV
, _shapeShader = bslista -- & shadVAO' .~ shPosColVAO , _shapeShader = bslista -- & shaderVAO' .~ shPosColVAO
, _shapeEBO = shEBO' , _shapeEBO = shEBO'
, _silhouetteEBO = silEBO , _silhouetteEBO = silEBO
, _lightingCapShader = lightingCapShad , _lightingCapShader = lightingCapShad
@@ -225,7 +225,7 @@ preloadRender = do
, _positionalBlankShader = positionalBlankShad , _positionalBlankShader = positionalBlankShad
, _wallBlankShader = wallBlankShad , _wallBlankShader = wallBlankShad
, _wallTextureShader = wallTextureShad , _wallTextureShader = wallTextureShad
, _windowShader = wallBlankShad{_shadVAO = winColVAO} , _windowShader = wallBlankShad{_shaderVAO = winColVAO}
-- , _textureArrayShader = textArrayShad -- , _textureArrayShader = textArrayShad
, _fullscreenShader = fsShad , _fullscreenShader = fsShad
, _alphaDivideShader = alphadivideshader , _alphaDivideShader = alphadivideshader
src/Preload/Update.hs
+1 -1
View File
@@ -51,6 +51,6 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do
makeByteStringShaderUsingVAO makeByteStringShaderUsingVAO
"bloomBlur" "bloomBlur"
[(vert, bbVert), (frag, bbFrag')] [(vert, bbVert), (frag, bbFrag')]
ETriangleStrip pmTriangleStrip
(rdata ^. screenTextureVAO) (rdata ^. screenTextureVAO)
return (rdata'{_bloomBlurShader = bbShad}) return (rdata'{_bloomBlurShader = bbShad})
src/Render.hs
+34 -35
View File
@@ -22,7 +22,6 @@ import Graphics.GL.Core45
import Picture.Data import Picture.Data
import Shader import Shader
import Shader.Data import Shader.Data
import Shader.ExtraPrimitive
{- | Determine where light is shining in the world. {- | Determine where light is shining in the world.
think of the produced texture as showing what RGB values should be "taken think of the produced texture as showing what RGB values should be "taken
@@ -89,12 +88,12 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype
glBindTextureUnit 0 (positiontexture ^. unTO) glBindTextureUnit 0 (positiontexture ^. unTO)
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
glStencilFunc GL_EQUAL 0 255 glStencilFunc GL_EQUAL 0 255
glUseProgram (ltextShad ^. shadName) glUseProgram (ltextShad ^. shaderUINT)
glUniform3f 0 x y z glUniform3f 0 x y z
glUniform4f 1 r g b rad glUniform4f 1 r g b rad
glBindVertexArray $ ltextShad ^. shadVAO . vaoName glBindVertexArray $ ltextShad ^. shaderVAO . vaoName
glDrawArrays glDrawArrays
(marshalEPrimitiveMode (_shadPrim' ltextShad)) (_unPrimitiveMode (_shaderPrimitive ltextShad))
0 0
(fromIntegral (4 :: Int)) (fromIntegral (4 :: Int))
--cleanup: may not be necessary, depending on what comes after... --cleanup: may not be necessary, depending on what comes after...
@@ -153,24 +152,24 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype
glDisable GL_CULL_FACE glDisable GL_CULL_FACE
glStencilFunc GL_ALWAYS 0 255 glStencilFunc GL_ALWAYS 0 255
--draw wall shadows --draw wall shadows
glUseProgram (_shadName lwallShad) glUseProgram (_shaderUINT lwallShad)
glUniform3f 0 x y z glUniform3f 0 x y z
glUniform1f 1 rad glUniform1f 1 rad
glBindVertexArray $ lwallShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO lwallShad) glBindVertexArray $ lwallShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO lwallShad)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ _shadPrim' lwallShad) (_unPrimitiveMode $ _shaderPrimitive lwallShad)
0 0
(fromIntegral nWalls) (fromIntegral nWalls)
case shadsdrawtype of case shadsdrawtype of
GeoObjShads -> do GeoObjShads -> do
--draw silhouette shadows --draw silhouette shadows
glEnable GL_DEPTH_CLAMP glEnable GL_DEPTH_CLAMP
glUseProgram (_shadName llinesShad) glUseProgram (_shaderUINT llinesShad)
glUniform3f 0 x y z glUniform3f 0 x y z
glUniform1f 1 rad glUniform1f 1 rad
glBindVertexArray (_vaoName $ _shadVAO llinesShad) glBindVertexArray (_vaoName $ _shaderVAO llinesShad)
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim' llinesShad) (_unPrimitiveMode $ _shaderPrimitive llinesShad)
(fromIntegral nSils) (fromIntegral nSils)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
@@ -178,11 +177,11 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype
glEnable GL_CULL_FACE glEnable GL_CULL_FACE
glCullFace GL_BACK glCullFace GL_BACK
glCullFace GL_FRONT glCullFace GL_FRONT
glUseProgram (_shadName lcapShad) glUseProgram (_shaderUINT lcapShad)
glUniform3f 0 x y z glUniform3f 0 x y z
glBindVertexArray $ lcapShad ^. shadVAO . vaoName --Just (_vao $ _shadVAO lcapShad) glBindVertexArray $ lcapShad ^. shaderVAO . vaoName --Just (_vao $ _shadVAO lcapShad)
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim' lcapShad) (_unPrimitiveMode $ _shaderPrimitive lcapShad)
(fromIntegral nCaps) (fromIntegral nCaps)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
@@ -196,12 +195,12 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype
glBindTextureUnit 1 (normaltexture ^. unTO) glBindTextureUnit 1 (normaltexture ^. unTO)
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
glStencilFunc GL_EQUAL 0 255 glStencilFunc GL_EQUAL 0 255
glUseProgram (ltextShad ^. shadName) --Just (_shadProg ltextShad) glUseProgram (ltextShad ^. shaderUINT) --Just (_shadProg ltextShad)
glUniform3f 0 x y z glUniform3f 0 x y z
glUniform4f 1 r g b rad glUniform4f 1 r g b rad
glBindVertexArray $ ltextShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO ltextShad) glBindVertexArray $ ltextShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO ltextShad)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode (_shadPrim' ltextShad)) (_unPrimitiveMode (_shaderPrimitive ltextShad))
0 0
(fromIntegral (4 :: Int)) (fromIntegral (4 :: Int))
--cleanup: may not be necessary, depending on what comes after... --cleanup: may not be necessary, depending on what comes after...
@@ -274,17 +273,17 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
glDisable GL_CULL_FACE glDisable GL_CULL_FACE
glStencilFunc GL_ALWAYS 0 255 glStencilFunc GL_ALWAYS 0 255
--draw wall shadows --draw wall shadows
glUseProgram $ pdata ^. shadowWallShader . shadName glUseProgram $ pdata ^. shadowWallShader . shaderUINT
glBindVertexArray $ pdata ^. shadowWallShader . shadVAO . vaoName glBindVertexArray $ pdata ^. shadowWallShader . shaderVAO . vaoName
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ pdata ^. shadowWallShader . shadPrim') (_unPrimitiveMode $ pdata ^. shadowWallShader . shaderPrimitive)
0 0
(fromIntegral nWalls) (fromIntegral nWalls)
--draw silhouette shadows --draw silhouette shadows
glUseProgram $ pdata ^. shadowEdgeShader . shadName glUseProgram $ pdata ^. shadowEdgeShader . shaderUINT
glBindVertexArray $ pdata ^. shadowEdgeShader . shadVAO . vaoName glBindVertexArray $ pdata ^. shadowEdgeShader . shaderVAO . vaoName
glDrawElements glDrawElements
(marshalEPrimitiveMode $ pdata ^. shadowEdgeShader . shadPrim') (_unPrimitiveMode $ pdata ^. shadowEdgeShader . shaderPrimitive)
(fromIntegral nSils) (fromIntegral nSils)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
@@ -292,10 +291,10 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
glEnable GL_CULL_FACE glEnable GL_CULL_FACE
glCullFace GL_BACK glCullFace GL_BACK
--glCullFace GL_FRONT --glCullFace GL_FRONT
glUseProgram (_shadName lcapShad) glUseProgram (_shaderUINT lcapShad)
glBindVertexArray $ lcapShad ^. shadVAO . vaoName glBindVertexArray $ lcapShad ^. shaderVAO . vaoName
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim' lcapShad) (_unPrimitiveMode $ _shaderPrimitive lcapShad)
(fromIntegral nCaps) (fromIntegral nCaps)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
@@ -303,12 +302,12 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
glDepthFunc GL_ALWAYS glDepthFunc GL_ALWAYS
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
glStencilFunc GL_EQUAL 0 255 glStencilFunc GL_EQUAL 0 255
glUseProgram (pdata ^. shadowLightShader . _1 . shadName) glUseProgram (pdata ^. shadowLightShader . _1 . shaderUINT)
-- bind world position texture -- bind world position texture
bindTO toPos bindTO toPos
-- glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName -- glBindVertexArray $ pdata ^. shadowLightShader . shaderVAO' . vaoName
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ pdata ^. shadowLightShader . _1 . shadPrim') (_unPrimitiveMode $ pdata ^. shadowLightShader . _1 . shaderPrimitive)
0 0
1 1
glDisable GL_CULL_FACE glDisable GL_CULL_FACE
@@ -323,9 +322,9 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO) glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO)
glEnable GL_BLEND glEnable GL_BLEND
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
glUseProgram (pdata ^. shadowCombineShader . _1 . shadName) glUseProgram (pdata ^. shadowCombineShader . _1 . shaderUINT)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode EPoints) GL_POINTS
0 0
1 1
withArray [GL_COLOR_ATTACHMENT0, GL_DEPTH_STENCIL_ATTACHMENT] $ \ptr -> withArray [GL_COLOR_ATTACHMENT0, GL_DEPTH_STENCIL_ATTACHMENT] $ \ptr ->
@@ -338,22 +337,22 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
pingPongBetween :: pingPongBetween ::
(FBO, TO) -> (FBO, TO) ->
(FBO, TO) -> (FBO, TO) ->
FullShader -> Shader ->
IO () IO ()
pingPongBetween (fb1, to1) (fb2, to2) fs = do pingPongBetween (fb1, to1) (fb2, to2) fs = do
--bindFramebuffer Framebuffer $= fb2 --bindFramebuffer Framebuffer $= fb2
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2) glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2)
--textureBinding Texture2D $= Just to1 --textureBinding Texture2D $= Just to1
glBindTexture GL_TEXTURE_2D (_unTO to1) glBindTexture GL_TEXTURE_2D (_unTO to1)
drawFullShader fs 4 drawShader fs 4
--bindFramebuffer Framebuffer $= fb1 --bindFramebuffer Framebuffer $= fb1
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1) glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1)
--textureBinding Texture2D $= Just to2 --textureBinding Texture2D $= Just to2
glBindTexture GL_TEXTURE_2D (_unTO to2) glBindTexture GL_TEXTURE_2D (_unTO to2)
drawFullShader fs 4 drawShader fs 4
renderFoldable :: renderFoldable ::
MV.MVector (PrimState IO) (FullShader,VBO) -> MV.MVector (PrimState IO) (Shader,VBO) ->
Picture -> Picture ->
IO () IO ()
renderFoldable shadV struct = do renderFoldable shadV struct = do
@@ -364,7 +363,7 @@ renderFoldable shadV struct = do
------------------------------end renderFoldable ------------------------------end renderFoldable
renderLayer :: renderLayer ::
Layer -> Layer ->
MV.MVector (PrimState IO) (FullShader,VBO) -> MV.MVector (PrimState IO) (Shader,VBO) ->
UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int ->
IO () IO ()
renderLayer layer shads counts = do renderLayer layer shads counts = do
src/Shader.hs
+39 -55
View File
@@ -1,54 +1,37 @@
module Shader module Shader (
( freeShaderPointers' freeShaderPointers',
, drawShaderLay drawShaderLay,
, shadVBOptr shadVBOptr,
, drawFullShader drawShader,
, drawShader pokeBindFoldable,
, pokeBindFoldable pokeBindFoldableLayer,
, pokeBindFoldableLayer ) where
) where
import Control.Lens
import Shader.Data
import Shader.Parameters
import Shader.ExtraPrimitive
import Shader.Poke
import Shader.Bind
import Picture.Data
import qualified Data.Vector.Unboxed.Mutable as UMV import Control.Lens
import qualified Data.Vector.Mutable as MV import Control.Monad
import Control.Monad.Primitive import Control.Monad.Primitive
--import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
--import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Foreign import Foreign
import Graphics.GL.Core45 import Graphics.GL.Core45
import Picture.Data
import Shader.Bind
import Shader.Data
import Shader.Parameters
import Shader.Poke
drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (FullShader,VBO) -> IO () drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (Shader, VBO) -> IO ()
{-# INLINE drawShaderLay #-} {-# INLINE drawShaderLay #-}
drawShaderLay l countsVector shadIn fs = do drawShaderLay l countsVector shadIn fs = do
i <- UMV.read countsVector shadIn i <- UMV.read countsVector shadIn
glUseProgram (_shadName $ fst fs) glUseProgram (_shaderUINT $ fst fs)
glBindVertexArray $ fs ^. _1 . shadVAO . vaoName glBindVertexArray $ fs ^. _1 . shaderVAO . vaoName
case _shadTex' $ fst fs of zipWithM_ (\ti -> glBindTextureUnit ti . _unTO) [0 ..] (fs ^. _1 . shaderTextures)
Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt}
-> glBindTextureUnit 0 txo
_ -> return ()
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ _shadPrim' $ fst fs) (_unPrimitiveMode $ _shaderPrimitive $ fst fs)
(fromIntegral $ l*numSubElements) (fromIntegral $ l * numSubElements)
(fromIntegral i)
drawFullShader :: FullShader -> Int -> IO ()
{-# INLINE drawFullShader #-}
drawFullShader fs i = do
glUseProgram (_shadName fs)
glBindVertexArray $ fs ^. shadVAO . vaoName
case _shadTex' fs of
Just ShaderTexture{_textureObject = txo
}
-> glBindTextureUnit 0 txo
_ -> return ()
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim' fs)
0
(fromIntegral i) (fromIntegral i)
drawShader :: Shader -> Int -> IO () drawShader :: Shader -> Int -> IO ()
@@ -56,32 +39,33 @@ drawShader :: Shader -> Int -> IO ()
drawShader fs i = do drawShader fs i = do
glUseProgram (_shaderUINT fs) glUseProgram (_shaderUINT fs)
glBindVertexArray $ fs ^. shaderVAO . vaoName glBindVertexArray $ fs ^. shaderVAO . vaoName
zipWithM_ (\ti -> glBindTextureUnit ti . _unTO) [0..] (fs ^. shaderTextures)
glDrawArrays glDrawArrays
(_shaderPrimitive fs) (_unPrimitiveMode $ _shaderPrimitive fs)
0 0
(fromIntegral i) (fromIntegral i)
freeShaderPointers' :: (FullShader,VBO) -> IO () freeShaderPointers' :: (Shader, VBO) -> IO ()
freeShaderPointers' = free . _vboPtr . snd freeShaderPointers' = free . _vboPtr . snd
pokeBindFoldable pokeBindFoldable ::
:: MV.MVector (PrimState IO) (FullShader,VBO) MV.MVector (PrimState IO) (Shader, VBO) ->
-> UMV.MVector (PrimState IO) Int UMV.MVector (PrimState IO) Int ->
-> Picture Picture ->
-> IO () IO ()
pokeBindFoldable shadV counts m = do pokeBindFoldable shadV counts m = do
pokeVerxs shadV counts m pokeVerxs shadV counts m
bufferShaderVector shadV counts bufferShaderVector shadV counts
pokeBindFoldableLayer pokeBindFoldableLayer ::
:: MV.MVector (PrimState IO) (FullShader,VBO) MV.MVector (PrimState IO) (Shader, VBO) ->
-> UMV.MVector (PrimState IO) Int UMV.MVector (PrimState IO) Int ->
-> Picture Picture ->
-> IO () IO ()
pokeBindFoldableLayer shadV counts m = do pokeBindFoldableLayer shadV counts m = do
pokeLayVerxs shadV counts m pokeLayVerxs shadV counts m
bindShaderLayers shadV counts bindShaderLayers shadV counts
shadVBOptr :: (FullShader,VBO) -> Ptr Float shadVBOptr :: (Shader, VBO) -> Ptr Float
{-# INLINE shadVBOptr #-} {-# INLINE shadVBOptr #-}
shadVBOptr = _vboPtr . snd shadVBOptr = _vboPtr . snd
src/Shader/AuxAddition.hs
+8 -12
View File
@@ -4,24 +4,23 @@ module Shader.AuxAddition
, addTextureArray , addTextureArray
, initTexture2D , initTexture2D
, initTexture2DArray , initTexture2DArray
, tilesToLine -- ^ kept in case it is needed in the future , tilesToLine
) where ) where
import Data.Preload.Render import LensHelp
import Unsafe.Coerce import Unsafe.Coerce
import Shader.Data import Shader.Data
import Data.List.Extra import Data.List.Extra
import Codec.Picture import Codec.Picture
import qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable as VS
import Control.Lens
import Graphics.GL.Core45 import Graphics.GL.Core45
import GLHelp import GLHelp
-- I am not sure if this assumes that the shader is constructed directly before -- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added... -- the texture is added...
addSamplerTexture2D :: String -> FullShader -> IO FullShader addSamplerTexture2D :: String -> Shader -> IO Shader
addSamplerTexture2D = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR 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 vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
addTexture2D addTexture2D
@@ -29,7 +28,7 @@ addTexture2D
-> GLenum -- minfilter -> GLenum -- minfilter
-> GLenum -- magfilter -> GLenum -- magfilter
-> String -- path to image -> String -- path to image
-> FullShader -> IO FullShader -> Shader -> IO Shader
addTexture2D nlev minfilt magfilt texpath shad = do addTexture2D nlev minfilt magfilt texpath shad = do
Right cmap <- readImage texpath Right cmap <- readImage texpath
let texdata = convertRGBA8 cmap let texdata = convertRGBA8 cmap
@@ -42,8 +41,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do
glGenerateTextureMipmap texname glGenerateTextureMipmap texname
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt) glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
return $ shad & shadTex' ?~ ShaderTexture return $ shad & shaderTextures .:~ TO texname
{_textureObject = texname }
-- alloca $ \nameptr -> do -- alloca $ \nameptr -> do
-- glCreateTextures GL_TEXTURE_2D 1 nameptr -- glCreateTextures GL_TEXTURE_2D 1 nameptr
-- texname <- peek 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 -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the -- an image that was directly readable by glTexSubImage3D, used the
-- transformation tilesToLine 8 128 on the underlying pixels. -- 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 addTextureArray texturePath (shad,vbo) = do
err <- glGetError err <- glGetError
print err print err
@@ -126,11 +124,9 @@ addTextureArray texturePath (shad,vbo) = do
glGenerateTextureMipmap texname glGenerateTextureMipmap texname
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR) glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR)
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR)
return (shad & shadTex' ?~ ShaderTexture return (shad & shaderTextures .:~ TO texname
{ _textureObject = texname}
, vbo) , vbo)
-- I am completely unclear on why this works with its current parameters
tilesToLine tilesToLine
:: Int -- ^ Parameter a :: Int -- ^ Parameter a
-> Int -- ^ Parameter b -> Int -- ^ Parameter b
src/Shader/Bind.hs
+2 -2
View File
@@ -24,7 +24,7 @@ bufferPokedVBO theVBO numVs =
(fromIntegral $ floatSize * numVs * _vboVertexSize theVBO) (fromIntegral $ floatSize * numVs * _vboVertexSize theVBO)
(_vboPtr 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 bindShaderLayers shads counts = MV.imapM_ f shads
where where
f i shad = do f i shad = do
@@ -43,7 +43,7 @@ bindShaderLayers shads counts = MV.imapM_ f shads
glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO () glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()
glNamedBufferSubDataH = glNamedBufferSubData 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 bufferShaderVector shads counts = MV.imapM_ f shads
where where
f i shad = UMV.read counts i >>= bufferPokedVBO (snd shad) f i shad = UMV.read counts i >>= bufferPokedVBO (snd shad)
src/Shader/Compile.hs
+39 -38
View File
@@ -38,16 +38,16 @@ makeShader ::
[GLenum] -> [GLenum] ->
-- | The input vertex sizes -- | The input vertex sizes
[Int] -> [Int] ->
EPrimitiveMode -> PrimitiveMode ->
IO (FullShader,VBO) IO (Shader,VBO)
makeShader s shaderlist sizes pm = do makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
(vao,vbo) <- setupVAO sizes (vao,vbo) <- setupVAO sizes
return ( FullShader return ( Shader
{ _shadName = prog { _shaderUINT = prog
, _shadVAO = vao , _shaderVAO = vao
, _shadPrim' = pm , _shaderPrimitive = pm
, _shadTex' = Nothing , _shaderTextures = mempty
} }
, vbo) , vbo)
@@ -60,7 +60,7 @@ makeShaderEBO ::
[Int] -> [Int] ->
-- | The stride -- | The stride
Int -> Int ->
GLenum -> PrimitiveMode ->
VBO -> VBO ->
IO (Shader, EBO) IO (Shader, EBO)
makeShaderEBO s shaderlist sizes strd pm vbo = do 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 vao <- setupVAOvbo sizes strd vbo
ebo <- setupEBO vao ebo <- setupEBO vao
return return
( Shader prog pm vao ( Shader prog pm vao []
, ebo , ebo
) )
@@ -81,17 +81,17 @@ makeShader4 ::
[Int] -> [Int] ->
-- | The stride -- | The stride
Int -> Int ->
EPrimitiveMode -> PrimitiveMode ->
VBO -> VBO ->
IO FullShader IO Shader
makeShader4 s shaderlist sizes strd pm vbo = do makeShader4 s shaderlist sizes strd pm vbo = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vao <- setupVAOvbo sizes strd vbo vao <- setupVAOvbo sizes strd vbo
return $ FullShader return $ Shader
{ _shadName = prog { _shaderUINT = prog
, _shadVAO = vao , _shaderVAO = vao
, _shadPrim' = pm , _shaderPrimitive = pm
, _shadTex' = Nothing , _shaderTextures = mempty
} }
makeShader4UsingVAO :: makeShader4UsingVAO ::
@@ -99,7 +99,7 @@ makeShader4UsingVAO ::
String -> String ->
-- | shader types -- | shader types
[GLenum] -> [GLenum] ->
GLenum -> PrimitiveMode ->
VAO -> VAO ->
IO Shader IO Shader
makeShader4UsingVAO s shaderlist pm vao = do makeShader4UsingVAO s shaderlist pm vao = do
@@ -108,6 +108,7 @@ makeShader4UsingVAO s shaderlist pm vao = do
{ _shaderUINT = prog { _shaderUINT = prog
, _shaderVAO = vao , _shaderVAO = vao
, _shaderPrimitive = pm , _shaderPrimitive = pm
, _shaderTextures = []
} }
setupVBO :: Int -> IO VBO setupVBO :: Int -> IO VBO
@@ -137,17 +138,17 @@ makeByteStringShaderUsingVAO ::
String -> String ->
-- | Filetype extensions and shader data -- | Filetype extensions and shader data
[(GLenum, BS.ByteString)] -> [(GLenum, BS.ByteString)] ->
EPrimitiveMode -> PrimitiveMode ->
VAO -> VAO ->
IO FullShader IO Shader
makeByteStringShaderUsingVAO s shaderlist pm vao = do makeByteStringShaderUsingVAO s shaderlist pm vao = do
prog <- makeShaderProgram s shaderlist prog <- makeShaderProgram s shaderlist
return $ return $
FullShader Shader
{ _shadName = prog { _shaderUINT = prog
, _shadVAO = vao , _shaderVAO = vao
, _shadPrim' = pm , _shaderPrimitive = pm
, _shadTex' = Nothing , _shaderTextures = mempty
} }
-- | Takes the VAO from elsewhere -- | Takes the VAO from elsewhere
@@ -156,17 +157,17 @@ makeShaderUsingVAO ::
String -> String ->
-- | shader types -- | shader types
[GLenum] -> [GLenum] ->
EPrimitiveMode -> PrimitiveMode ->
VAO -> VAO ->
IO FullShader IO Shader
makeShaderUsingVAO s shaderlist pm theVAO = do makeShaderUsingVAO s shaderlist pm theVAO = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
return $ return $
FullShader Shader
{ _shadName = prog { _shaderUINT = prog
, _shadVAO = theVAO , _shaderVAO = theVAO
, _shadPrim' = pm , _shaderPrimitive = pm
, _shadTex' = Nothing , _shaderTextures = mempty
} }
{- | {- |
@@ -182,16 +183,16 @@ makeShaderSized ::
[Int] -> [Int] ->
-- | Number of vertexes that can be poked -- | Number of vertexes that can be poked
Int -> Int ->
EPrimitiveMode -> PrimitiveMode ->
IO (FullShader,VBO) IO (Shader,VBO)
makeShaderSized s shaderlist sizes ndraw pm = do makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
(vao,vbo) <- setupVAOSized ndraw sizes (vao,vbo) <- setupVAOSized ndraw sizes
return ( FullShader return ( Shader
{ _shadName = prog { _shaderUINT = prog
, _shadVAO = vao , _shaderVAO = vao
, _shadPrim' = pm , _shaderPrimitive = pm
, _shadTex' = Nothing , _shaderTextures = mempty
} }
, vbo) , vbo)
src/Shader/Data.hs
+86 -66
View File
@@ -1,98 +1,118 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{- | Datatypes used to setup and pass data to shaders. -} {-# LANGUAGE TemplateHaskell #-}
module Shader.Data
( VAO (..)
, VBO (..)
, EBO (..)
, Shader (..)
, FullShader (..)
, ShaderTexture (..)
, EPrimitiveMode (..)
-- | Lens functions
, vaoName
, shaderUINT
, shaderPrimitive
, shaderVAO
, 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 import Control.Lens
{- | Datatype containing the necessary information for a single shader. -} import Foreign
data FullShader = FullShader import Graphics.GL.Core45
{ _shadName :: GLuint -- should be shaderID
, _shadVAO :: VAO -- | Datatype containing the necessary information for a single shader.
, _shadPrim' :: EPrimitiveMode
, _shadTex' :: Maybe ShaderTexture
}
data Shader = Shader data Shader = Shader
{ _shaderUINT :: GLuint -- should be shaderID { _shaderUINT :: GLuint -- should be shaderID
, _shaderPrimitive :: GLenum , _shaderPrimitive :: PrimitiveMode
, _shaderVAO :: VAO , _shaderVAO :: VAO
, _shaderTextures :: [TO]
} }
newtype FBO = FBO {_unFBO :: GLuint}
newtype TO = TO {_unTO :: GLuint}
{- | Vertex array object: contains the reference to the object, {- | Vertex array object: contains the reference to the object,
and its buffer targets. -} and its buffer targets.
-}
newtype VAO = VAO newtype VAO = VAO
{ _vaoName :: GLuint { _vaoName :: GLuint
} }
{- | Vertex buffer object: contains the reference to the object, {- | Vertex buffer object: contains the reference to the object,
a pointer to a location with space that can be written to the buffer, a pointer to a location with space that can be written to the buffer,
and a list of attribute pointer sizes. and a list of attribute pointer sizes.
Vertex attributes are interleaved within the vbo. -} Vertex attributes are interleaved within the vbo.
-}
data VBO = VBO data VBO = VBO
{ _vboName :: GLuint { _vboName :: GLuint
, _vboPtr :: Ptr Float , _vboPtr :: Ptr Float
, _vboVertexSize :: Int , _vboVertexSize :: Int
-- add int for AMOUNT of data poked! -- add int for AMOUNT of data poked!
} }
data EBO = EBO data EBO = EBO
{ _eboName :: GLuint { _eboName :: GLuint
, _eboPtr :: Ptr GLushort , _eboPtr :: Ptr GLushort
} }
{- | Datatype containing the reference to a texture object. -}
-- | Datatype containing the reference to a texture object.
newtype ShaderTexture = ShaderTexture newtype ShaderTexture = ShaderTexture
{ _textureObject :: GLuint -- DSA style texture, 450 { _textureObject :: GLuint -- DSA style texture, 450
-- , _textureTarget :: GLenum -- , _textureTarget :: GLenum
} }
data EPrimitiveMode
= EPoints newtype PrimitiveMode = PrimitiveMode {_unPrimitiveMode :: GLenum}
| ELines
| ELinesAdjacency
| ELineLoop
| ELineStrip
| ETriangles
| ETriangleStrip
| ETriangleFan
| EQuads
| EQuadStrip
| EPolygon
| EPatches
-- | Short synonyms for shader types -- | Short synonyms for shader types
vert, geom, frag :: GLenum vert, geom, frag :: GLenum
vert = GL_VERTEX_SHADER vert = GL_VERTEX_SHADER
geom = GL_GEOMETRY_SHADER geom = GL_GEOMETRY_SHADER
frag = GL_FRAGMENT_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 ''VAO
makeLenses ''VBO makeLenses ''VBO
makeLenses ''FullShader
makeLenses ''EBO makeLenses ''EBO
makeLenses ''ShaderTexture makeLenses ''ShaderTexture
makeLenses ''Shader 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 import Shape.Data
pokeVerxs :: pokeVerxs ::
MV.MVector (PrimState IO) (FullShader, VBO) -> MV.MVector (PrimState IO) (Shader, VBO) ->
UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int ->
Picture -> Picture ->
IO () IO ()
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList 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 pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = theShadNum} = do
typeOff <- UMV.unsafeRead offsets sn typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos 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 V3 nx ny nz = sh - norm
pokeLayVerxs :: pokeLayVerxs ::
MV.MVector (PrimState IO) (FullShader, VBO) -> MV.MVector (PrimState IO) (Shader, VBO) ->
UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int ->
Picture -> Picture ->
IO () IO ()
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList 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 #-} {-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do pokeLayVerx vbos counts vx = do
theOff <- UMV.unsafeRead counts vecPos theOff <- UMV.unsafeRead counts vecPos