Refactor lighting shaders

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.9) $ color blue $ p
+    , setDepth (negate 0.4) $ color red $ 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)
-
-    -- draw the background. Assumes that depth testing is not enabled or that
-    -- the depth buffer is ready to be drawn on
+    clear [DepthBuffer]
+    depthFunc $= Just Less
+    -- 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' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
-    where getLS ls  = ( fst $ _lsPos ls, snd $ _lsPos ls,  _lsRad ls , _lsIntensity ls)
-          getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
-
+lightsForGloom :: World -> [Point4]
+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)
+    getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)