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