Refactor loading of background shader

This commit is contained in:
2021-03-11 19:18:52 +01:00
parent 6c378659b2
commit 33017a599b
4 changed files with 31 additions and 65 deletions
+15 -44
View File
@@ -76,59 +76,29 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
-- of wall shadows when creating the light map
depthFunc $= Just Less
-- calculate world transformation matrix
let scalMat = Linear.Matrix.transpose $
V4 (V4 (2*zoom/winx) 0 0 (0::GLfloat))
(V4 0 (2*zoom/winy) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
let rotMat = Linear.Matrix.transpose $
V4 (V4 (cos rot) (sin (-rot)) 0 0)
(V4 (sin rot) (cos rot) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
let tranMat = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-tranx) (-trany) 0 1)
let wmat = scalMat !*! rotMat !*! tranMat
vToL (V4 a b c d) = [a,b,c,d]
wmata <- (newMatrix RowMajor $ concatMap vToL $ vToL wmat) :: IO (GLmatrix GLfloat)
-- set common uniforms
setShaderUniforms rot zoom (tranx,trany) (winx,winy)
( (extractProgAndUnis $ _lightSourceShader pdata)
: (extractProgAndUnis $ _wlShadShader pdata)
: (extractProgAndUnis $ _wallShadowShader pdata)
: (extractProgAndUnis $ _backgroundShader pdata)
: (map extractProgAndUnis $ _listShaders pdata)
)
forM_ [--lightmapCircleShader pdata
_backShader pdata
,_wallShadowShader pdata
] $ \shad -> do
currentProgram $= Just (fst shad)
uniform (snd shad !! 0) $= Vector2 winx winy
uniform (snd shad !! 1) $= zoom
uniform (snd shad !! 2) $= rot
uniform (snd shad !! 3) $= Vector2 tranx trany
uniform (snd shad !! 4) $= wmata
-- draw lightmap
nWalls <- F.foldM (pokeShader (_wlShadShader pdata)) wallPoints
bindShaderBuffers [_wlShadShader pdata] [nWalls]
nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
bindShaderBuffers [_wallShadowShader pdata] [nWalls]
forM_ lightPoints $ \(x,y,r,lum) -> do
cullFace $= Just Front
clear [DepthBuffer]
-- currentProgram does get called twice: here and inside drawShader below
currentProgram $= Just (_shaderProgram $ _wlShadShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _wlShadShader pdata)
currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
$= Vector2 (x) (y)
blendFunc $= (Zero,One)
drawShader (_wlShadShader pdata) nWalls
drawShader (_wallShadowShader pdata) nWalls
cullFace $= Nothing
@@ -144,21 +114,22 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
wallPokeEnd <- SDL.ticks
ticksS <- SDL.ticks
ticksAfterL <- SDL.ticks
-- draw picture
-- draw picture on top of light/shadow map
-- set drawing for on top
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
clear [DepthBuffer]
-- draw background
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
depthFunc $= Just Less
currentProgram $= Just (fst $ _backShader pdata)
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata) !! 1
pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
pokeTwoOff backPtr2 0 (winx,winy)
textureBinding Texture2D $= Just (_textures pdata !! 1)
textureBinding Texture2D $= (fmap _textureObject $ _shaderTexture $ _backgroundShader pdata)
drawArrays Points (fromIntegral 0) (fromIntegral 1)
depthFunc $= Just Lequal