Refactor loading of background shader
This commit is contained in:
+15
-44
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user