diff --git a/shader/background.geom b/shader/background.geom index adee13cd6..280eae591 100644 --- a/shader/background.geom +++ b/shader/background.geom @@ -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(); diff --git a/src/Loop.hs b/src/Loop.hs index cd296d6f4..5f7d9e604 100644 --- a/src/Loop.hs +++ b/src/Loop.hs @@ -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 diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index c81ff6cc3..3509ac55f 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -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] diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index f613f178c..b3a29c545 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -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