Refactor loading of background shader

This commit is contained in:
jgk
2021-03-11 19:18:52 +01:00
parent 6c378659b2
commit 33017a599b
4 changed files with 31 additions and 65 deletions
+3 -2
View File
@@ -5,6 +5,7 @@ in vec4 vParams [];
in vec2 vWinSize [];
out vec2 gTexPos;
uniform vec2 winSize;
uniform vec2 translation;
uniform float zoom;
uniform float rotation;
@@ -23,8 +24,8 @@ void main()
// float zoom = vParams[0].w;
float rot = 0 - rotation;
float x = vWinSize[0].x / (500*zoom) ;
float y = vWinSize[0].y / (500*zoom) ;
float x = winSize.x / (500*zoom) ;
float y = winSize.y / (500*zoom) ;
gTexPos = cPos + rotBy(-rot , vec2(x,y));
gl_Position = vec4 (1,1,0.9,1);
EmitVertex();
+3
View File
@@ -78,6 +78,9 @@ doLoop setup window startWorld
eventFn
worldUpdate
= do
errs <- GL.errors
if length errs > 0 then putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs)
else return ()
startLoopTicks <- ticks
GL.clear [GL.ColorBuffer,GL.DepthBuffer]
newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
+10 -19
View File
@@ -21,16 +21,11 @@ import Geometry (Point2)
data RenderData = RenderData
{ _textures :: [TextureObject]
, _backShader :: (Program, [UniformLocation])
, _wallShadowShader :: (Program, [UniformLocation])
-- , _lightmapCircleShader :: (Program, [UniformLocation])
, _lightSourceShader :: FullShader (Float,Float,Float,Float)
, _wlShadShader :: FullShader (Point2,Point2,Point2,Point2)
, _wallShadowShader :: FullShader (Point2,Point2,Point2,Point2)
, _backgroundShader :: FullShader (Point2,Point2,Point2,Point2)
, _listShaders :: [FullShader RenderType]
, _backVAO :: VAO
, _wallVAO :: VAO
, _fadeCircVAO :: VAO
, _wssLightPos :: UniformLocation
, _dummyVBO :: BufferObject
, _dummyPtr :: Ptr Float
}
@@ -62,19 +57,21 @@ frag = FragmentShader
pokeWPStrat :: (Point2,Point2,Point2,Point2) -> [[[Float]]]
pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w],[a,b,c,d]]]
pokeBGStrat :: a -> [[[Float]]]
pokeBGStrat = const []
preloadRender :: IO RenderData
preloadRender = do
-- compile shader programs
lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
-- fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
bgs <- makeSourcedShader "background" [VertexShader,GeometryShader,FragmentShader]
wss <- makeSourcedShader "wallShadow" [VertexShader,GeometryShader,FragmentShader]
bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
"data/texture/smudgedDirt.png"
wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat
["lightPos"]
wssLightPosUniLoc <- GL.uniformLocation (fst wss) "lightPos"
bslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
lslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
aslist <- makeShader "arc" [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeArcStrat
@@ -106,23 +103,17 @@ preloadRender = do
-- input a list of (attribute location, attrib length) pairs
-- these will have buffers and pointers created
backgroundvao <- setupVAO [(0,4),(1,2)]
wallvao <- setupVAO [(0,4),(1,4)]
fadevao <- setupVAO [(0,4)]
return $ RenderData
{ _textures = [dirttex,dirttex]
, _listShaders = [bslist,lslist,cslist,aslist,eslist]
-- , _lightmapCircleShader = fcs
, _backShader = bgs
, _wallShadowShader = wss
, _backVAO = backgroundvao
, _wallVAO = wallvao
, _fadeCircVAO = fadevao
, _dummyVBO = dummyvbo
, _dummyPtr = dummyptr
, _wssLightPos = wssLightPosUniLoc
, _lightSourceShader = lsShad
, _wlShadShader = wsShad
, _wallShadowShader = wsShad
, _backgroundShader = bgShad
}
vaoPointers :: VAO -> [Ptr Float]
+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