Refactor lighting shaders

app/Main.hs

@@ -41,7 +41,7 @@ main = do
         (sizex,sizey)
         (SDL.cursorVisible $= False >> doPreload >>= applyWorldConfig dodgeConfig)
         (\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x)
-        (fmap (setWindowSize sizex sizey theKeyConfig . (config .~ dodgeConfig)) firstWorld)
+        (fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ dodgeConfig)) firstWorld)
         doSideEffects
         handleEvent
         (Just . update)
@@ -84,8 +84,7 @@ checkForGlErrors = do
     errs <- errors
     unless (null errs) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
 
-setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World
+setWindowSize :: Int -> Int -> World -> World
-setWindowSize x y z w = w 
+setWindowSize x y w = w 
     & config . windowX .~ fromIntegral x
     & config . windowY .~ fromIntegral y
-    & keyConfig .~ z

shader/lighting/floor.geom

@@ -7,20 +7,20 @@ out vec2 dField;
 void main()
 {
   lum = gl_in[0].gl_Position.w;
-  vec4 cenPos = vec4( gl_in[0].gl_Position.xy, 0 , 1);
+  vec4 cenPos = vec4( gl_in[0].gl_Position.xy, 0.1 , 1);
   float gRad = gl_in[0].gl_Position.z;
 
   dField = vec2 ( 1, 1);
-  gl_Position = theMat * vec4 (cenPos.x + gRad, cenPos.y + gRad, -0 , 1);
+  gl_Position = theMat * vec4 (cenPos.x + gRad, cenPos.y + gRad, 0.1 , 1);
   EmitVertex();
   dField = vec2 (-1, 1);
-  gl_Position = theMat * vec4 (cenPos.x - gRad, cenPos.y + gRad, -0 , 1);
+  gl_Position = theMat * vec4 (cenPos.x - gRad, cenPos.y + gRad, 0.1 , 1);
   EmitVertex();
   dField = vec2 ( 1,-1);
-  gl_Position = theMat * vec4 (cenPos.x + gRad, cenPos.y - gRad, -0 , 1);
+  gl_Position = theMat * vec4 (cenPos.x + gRad, cenPos.y - gRad, 0.1 , 1);
   EmitVertex();
   dField = vec2 (-1,-1);
-  gl_Position = theMat * vec4 (cenPos.x - gRad, cenPos.y - gRad, -0 , 1);
+  gl_Position = theMat * vec4 (cenPos.x - gRad, cenPos.y - gRad, 0.1 , 1);
   EmitVertex();
 
   EndPrimitive();

shader/lighting/occlude.geom

@@ -3,10 +3,10 @@ layout (points) in;
 layout (triangle_strip, max_vertices = 11) out;
 layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
 uniform vec2 lightPos;
-vec2 lightPosa = ( theMat * vec4(lightPos,0,1) ).xy;
+vec2 lightPosa = ( theMat * vec4(lightPos,0.1,1) ).xy;
 
 vec4 shift (vec4 p)
-{ return vec4 (p.xy + (200 * (p.xy-lightPos)), 0 , 1);
+{ return vec4 (p.xy + (200 * (p.xy-lightPos)), 0.1 , 1);
 }
 float isLHS (vec2 startV, vec2 testV)
 {
@@ -15,8 +15,8 @@ float isLHS (vec2 startV, vec2 testV)
 // construct a box with openings on bottom face and face away from wall
 void main()
 {
-vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0,1);
+vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0.1,1);
-vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1);
+vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0.1,1);
 if (isLHS (p1.xy - lightPos, p2.xy - lightPos) < 0)
 {
 vec4 p3 = vec4 (p1.xy,-0.5,1);

shader/lighting/wall.frag

@@ -1,5 +1,4 @@
 #version 430 core
-in vec2 cenPosT;
 in float lum;
 in vec3 dField;
 out vec4 fColor;

shader/lighting/wall.geom

@@ -15,15 +15,15 @@ vec4 shiftCloser (vec4 v)
 
 void main()
 {
-vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0,1);
+vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0.1,1);
-vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1);
+vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0.1,1);
 if (isLHS (p1.xy - lightPos, p2.xy - lightPos) < 0)
 {
     lum = radLum.y;
     float rad = radLum.x;
 
-    vec4 p3 = vec4 (p1.xy,-0.2,1);
+    vec4 p3 = vec4 (p1.xy,-0.3,1);
-    vec4 p4 = vec4 (p2.xy,-0.2,1);
+    vec4 p4 = vec4 (p2.xy,-0.3,1);
 
     vec2 d1 = p1.xy - lightPos;
     vec2 d2 = p2.xy - lightPos;
@@ -33,16 +33,16 @@ if (isLHS (p1.xy - lightPos, p2.xy - lightPos) < 0)
     vec4 a3 = shiftCloser( theMat * p3 );
     vec4 a4 = shiftCloser( theMat * p4 );
     
-    dField = vec3( d1.x/rad, d1.y/rad, 0);
+    dField = vec3( d1.x/rad, d1.y/rad, 100.0/rad);
     gl_Position = a1; 
     EmitVertex();
-    dField = vec3( d1.x/rad, d1.y/rad, 0);
+    dField = vec3( d1.x/rad, d1.y/rad, -300.0/rad);
     gl_Position = a3; 
     EmitVertex();
-    dField = vec3( d2.x/rad, d2.y/rad, 0);
+    dField = vec3( d2.x/rad, d2.y/rad, 100.0/rad);
     gl_Position = a2; 
     EmitVertex();
-    dField = vec3( d2.x/rad, d2.y/rad, 0);
+    dField = vec3( d2.x/rad, d2.y/rad, -300.0/rad);
     gl_Position = a4; 
     EmitVertex();
     

shader/wall/texture.geom

@@ -15,10 +15,10 @@ void main()
 {
     gColor = vColor[0];
 
-vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0,1);
+vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0.1,1);
-vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1);
+vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0.1,1);
-vec4 p3 = vec4 (p1.xy,-0.3,1);
+vec4 p3 = vec4 (p1.xy,-0.5,1);
-vec4 p4 = vec4 (p2.xy,-0.3,1);
+vec4 p4 = vec4 (p2.xy,-0.5,1);
 
 vec4 a1 = theMat * p1;
 vec4 a2 = theMat * p2;

src/Data/Preload/Render.hs

@@ -12,7 +12,6 @@ data RenderData = RenderData
     , _lightingWallShader       :: FullShader
     , _wallBlankShader          :: FullShader
     , _wallTextureShader        :: FullShader
-    , _backgroundShader         :: FullShader
     , _textureShader            :: FullShader
     , _textureArrayShader       :: FullShader
     , _fullscreenShader         :: FullShader

src/Dodge/Creature/Inanimate.hs

@@ -36,8 +36,8 @@ lampPic = pictures
     [ setDepth 0 $ color white $ p
     , setDepth (negate 0.1) $ color yellow $ p
     , setDepth (negate 0.5) $ color green $ p
-    , setDepth (negate 0.7) $ color red $ p
+    , setDepth (negate 0.4) $ color red $ p
-    , setDepth (negate 0.9) $ color blue $ p
+    , setDepth (negate 0.2) $ color blue $ p
     , setDepth (negate 1) $ color white $ p
     ]
   where

src/Dodge/Render.hs

@@ -51,7 +51,7 @@ doDrawing pdata w = do
         wins    = (getWindowX w,getWindowY w)
         wallPointsCol   = wallsPointsAndCols w
         windowPoints    = wallsWindows w
-        lightPoints     = lightsForGloom' w
+        lightPoints     = lightsForGloom w
         viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
         pic = worldPictures w
         wallPoints = map fst wallPointsCol
@@ -63,16 +63,13 @@ doDrawing pdata w = do
     -- draw the lightmap. Probably changes the bound framebufferObject
     createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms
         (foregroundPics w)
-
+    clear [DepthBuffer]
-    -- draw the background. Assumes that depth testing is not enabled or that
+    depthFunc $= Just Less
-    -- the depth buffer is ready to be drawn on
+    -- set blending to depend upon the alpha level already present
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-    renderBackground pdata rot camzoom trans wins
-
     _ <- renderShader (_textureArrayShader pdata) (_floorTiles w)
 
     -- draw the walls
-    depthFunc $= Just Less
     if w ^. config . wall_textured
         then renderTextureWalls pdata wallPointsCol
         else renderBlankWalls pdata wallPointsCol

src/Dodge/Render/Picture.hs

@@ -217,8 +217,8 @@ wallsForShadows w = map _wlLine
                         . filter (not . _wlIsSeeThrough)
                         . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
 
-lightsForGloom' :: World -> [Point4]
+lightsForGloom :: World -> [Point4]
-lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
+lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
-    where getLS ls  = ( fst $ _lsPos ls, snd $ _lsPos ls,  _lsRad ls , _lsIntensity ls)
+  where 
-          getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
+    getLS ls  = ( fst $ _lsPos ls, snd $ _lsPos ls,  _lsRad ls , _lsIntensity ls)
-
+    getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)

src/Loop.hs

@@ -48,7 +48,6 @@ setupLoop
                     initParams 
                     paramCleanup 
                     $ doLoop window startWorld sideEffects eventFn worldFn
-
 -- | The internal loop.
 doLoop 
     :: Window   -- ^ The SDL window.
@@ -81,7 +80,6 @@ doLoop
 
             doLoop window updatedWorld worldSideEffects eventFn worldUpdate newParams
         Nothing -> return ()
-
 -- | Handle quit events in a manner to exit the loop. Other events handled as
 -- determined by the custom function, although resize events also change the viewport.
 applyEventIO :: (world -> Event -> Maybe world) -> Maybe world -> Event -> IO (Maybe world)
@@ -91,16 +89,13 @@ applyEventIO fn mw e = case eventPayload e of
     WindowSizeChangedEvent WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y}
                         -> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e)
     _                   -> return $ mw >>= flip fn e
-
 -- | Create an OpenGL SDL window configuration with a given x and y size.
 winConfig :: Int -> Int -> WindowConfig
 winConfig x y = defaultWindow 
-    { windowGraphicsContext
+    { windowGraphicsContext = OpenGLContext $ defaultOpenGL 
-        = OpenGLContext (defaultOpenGL { glProfile = Core Normal 4 3
+        { glProfile = Core Normal 4 3
-                                       , glColorPrecision = V4 8 8 8 8
+        , glColorPrecision = V4 8 8 8 8
-                                       } 
+        } 
-                        )
     , windowInitialSize = V2 (fromIntegral x) (fromIntegral y)
     , windowResizable =True
     }
-

src/Picture/Render.hs

@@ -73,10 +73,8 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 -- clear buffer to full alpha and furthest depth
-    clearColor $= Color4 0 0 0 1
+-- clearColor is specified in preloadRender
-    clearDepth $= 1
     clear [ColorBuffer,DepthBuffer]
-    depthFunc $= Just Less
 -- draw walls from your point of view in order to set z buffer
     colorMask $= Color4 Disabled Disabled Disabled Disabled
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
@@ -174,27 +172,6 @@ pingPongBlur pdata = do
     generateMipmap' Texture2D
     drawShader (_boxBlurShader pdata) 4
 
-renderBackground 
-    :: RenderData 
-    -> Float            -- Rotation
-    -> Float            -- Zoom
-    -> (Float,Float)    -- Translation
-    -> (Float,Float)    -- Window size
-    -> IO ()
-renderBackground pdata rot camZoom (tranx,trany) (winx,winy) = do
---    depthFunc $= Just Less
--- set drawing for on top
-    --blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
--- draw background
-    --bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
-    bindArrayBuffers 1 $ _vaoVBO $ _shaderVAO $ _backgroundShader pdata
-    currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
-    bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
-    let backPtr = _vboPointer $ _vaoVBO $ _shaderVAO $ _backgroundShader pdata
-    pokeArrayOff backPtr 0 [tranx,trany,rot,camZoom,winx,winy]
-    textureBinding Texture2D $= _textureObject <$> _shaderTexture (_backgroundShader pdata)
-    drawArrays Points 0 1
-
 renderShader
     :: Foldable f
     => FullShader

src/Preload/Render.hs

@@ -49,10 +49,6 @@ preloadRender = do
     pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO boxBlurShad) $ concat cornerList
     grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const cornerList
     pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList
--- background shader
-    bgShad <- makeShader "background" [vert,geom,frag] [4,2] Points pokeBGStrat
-                >>= addTexture "data/texture/marbleSlabs.png"
---                >>= addTexture "data/texture/smudgedDirt.png"
 -- blank wallShader
     wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] Points pokeWPColStrat
 -- textured wallShader
@@ -70,6 +66,10 @@ preloadRender = do
     framebuf3 <- setupFramebufferWithStencil
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
+
+-- set the clearColor to have 1 alpha
+    clearColor $= Color4 0 0 0 1
+
     return $ RenderData
         { _pictureShaders           = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
         , _lightingFloorShader      = lightingFloorShad
@@ -79,7 +79,6 @@ preloadRender = do
         , _wallTextureShader        = wlTexture
         , _textureShader            = textShad
         , _textureArrayShader       = textArrayShad
-        , _backgroundShader         = bgShad
         , _fullscreenShader         = fsShad
         , _boxBlurShader            = boxBlurShad
         , _grayscaleShader          = grayscaleShad
@@ -148,7 +147,6 @@ cleanUpRenderPreload pd = do
     mapM_ freeShaderPointers $ _pictureShaders pd
     freeShaderPointers $ _lightingFloorShader pd
     freeShaderPointers $ _lightingOccludeShader pd
-    freeShaderPointers $ _backgroundShader pd
     freeShaderPointers $ _fullscreenShader pd
 
 {-# INLINE pokeBezQStrat #-}