Refactor loading of background shader

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 x = winSize.x / (500*zoom) ;
-  float y = vWinSize[0].y / (500*zoom) ;
+  float y = winSize.y / (500*zoom) ;
   gTexPos = cPos + rotBy(-rot , vec2(x,y));
   gl_Position = vec4 (1,1,0.9,1);
   EmitVertex();

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

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]

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
+    nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
-    bindShaderBuffers [_wlShadShader pdata] [nWalls]
+    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)
+        currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
-        uniform (head $ fromJust $ _shaderCustomUnis $ _wlShadShader 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)
+    currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
-    bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
+    bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
-    let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
+    let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
-        backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
+        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