Merge branch 'master' into testing

app/Main.hs

@@ -10,7 +10,7 @@ import Dodge.Layout
 import Dodge.LoadSound
 import Dodge.Update
 import Dodge.Event
-import Dodge.Rendering
+import Dodge.Render
 import Dodge.Menu
 import Dodge.Floor
 import Dodge.LoadConfig
@@ -24,6 +24,7 @@ import Sound.Preload
 
 import Control.Concurrent
 import Control.Lens
+import Foreign (Word32)
 
 import Control.Monad (when)
  
@@ -52,18 +53,7 @@ main = do
         (fmap (setWindowSize sizex sizey keyConfig) firstWorld)
         ( \preData w -> do
             startTicks <- SDL.ticks
-            clear [ColorBuffer,DepthBuffer]
+            doDrawing (_renderData preData) w
-            (lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData) 
-                (_cameraRot w) (_cameraZoom w) 
-                (_cameraCenter w)
-                (_windowX w,_windowY w) 
-                (wallsPointsAndCols w)
-                (wallsWindows w)
-                (lightsForGloom' w)
-                (_cameraViewFrom w)
-                (worldPictures w)
-            blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
-            renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
             playSoundQueue (_soundData preData) (_soundQueue w)
             newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
 

bench/Bench.hs

@@ -0,0 +1,4 @@
+import Criterion.Main
+
+main :: IO ()
+main = putStrLn "h"

package.yaml

@@ -79,3 +79,23 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - loop
+
+benchmarks:
+    loop-benchmarks:
+        dependencies:
+        - criterion
+        ghc-options:
+        - -threaded
+        - -O2
+        - -rtsopts
+        - -with-rtsopts=-N
+        - -flate-dmd-anal
+        - -fno-liberate-case 
+        - -fno-state-hack
+        - -funfolding-use-threshold1000 
+        - -funfolding-keeness-factor1000 
+        - -fllvm 
+        - -optlo-O3
+        main:         Bench.hs
+        source-dirs:  bench
+

src/Dodge/Base.hs

@@ -280,6 +280,12 @@ zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
 zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f 
                                  $ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
     where f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
+
+zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
+{-# INLINE zoneOfLine' #-}
+zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
+    where (x,y) = zoneOfPoint a
+          (x',y') = zoneOfPoint b
 --zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f 
 --                                 $ digitalLine (zoneOfPoint (aa-n,ab-n)) (zoneOfPoint (ba-n,bb-n))
 --    where f (x,y) = [(p,r) | p <-[x,x+1] , r<-[y,y+1]]
@@ -294,11 +300,6 @@ expandLine xs = IM.map expandSet
           --expandSet s = s
                 where mk = IS.findMax s
 
-zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
-{-# INLINE zoneOfLine' #-}
-zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
-    where (x,y) = zoneOfPoint a
-          (x',y') = zoneOfPoint b
                         
 --zoneOfLine a b = concatMap zoneNearPoint $ divideLine (2 * zoneSize) a b
 --zoneOfLine a b = concatMap zoneNearPoint $ divideLine zoneSize a b

src/Dodge/Creature.hs

@@ -254,6 +254,7 @@ startCr = defaultCreature
         (
         [pistol
         ,blinkGun
+        ,spawnGun lamp
         ,flameGrenade
         ,teslaGrenade
         ,autoGun

src/Dodge/Creature/Inanimate.hs

@@ -5,6 +5,7 @@ import Dodge.Base
 import Dodge.Default
 import Dodge.CreatureState
 import Dodge.LightSources
+import Dodge.WorldEvent.Flash
 
 import Dodge.WorldEvent.Sound
 
@@ -34,7 +35,7 @@ updateLamp :: Int -> CRUpdate
 updateLamp i = unrandUpdate handleLS internalUpdate
   where
     handleLS cr w 
-        | _crHP cr < 0 = mkSoundBreakGlass w & lightSources %~ IM.delete i
+        | _crHP cr < 0 = explosionFlashAt (_crPos cr) $ mkSoundBreakGlass w & lightSources %~ IM.delete i
         | otherwise    = w & lightSources . ix i . lsPos .~ _crPos cr
     internalUpdate cr 
         | _crHP cr < 0 = Nothing

src/Dodge/Item/Weapon.hs

@@ -82,6 +82,7 @@ pistol = Weapon
     , _itInvColor = white
     }
 defaultGun = pistol
+
 defaultAutoGun = autoGun {_itScrollUp = const id
                          , _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay}
 effectGun :: String -> (Int -> World -> World) -> Item
@@ -900,13 +901,14 @@ aFlame a cid w
             w
         where 
             (a2,g) = randomR (-0.1,0.1) (_randGen w)
+            (t,_) = randomR (99,101) (_randGen w)
             angle = min flamerAngle $ max (-flamerAngle) (a + a2)
             cr = (_creatures w IM.! cid)
             dir = _crDir cr + angle
             pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
             w1 = set randGen g w
             vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
-            insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
+            insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
             resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
                                               (shoot $ aFlame angle)
 
@@ -1942,4 +1944,23 @@ makeLaserScope p ep d relFrac = Particle'
 
 
 
+spawnGun :: Creature -> Item
+spawnGun cr = defaultGun
+    { _itName       = "SPAWNER"
+    , _wpMaxAmmo    = 1
+    , _wpLoadedAmmo = 1
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _wpFireRate   = 100
+    , _wpFire       = spawnCrNextTo cr
+    }
 
+spawnCrNextTo :: Creature -> Int -> World -> World
+spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
+  where
+    k = newKey $ _creatures w
+    sCr = _creatures w IM.! i
+    newCr = cr
+        & crID  .~ k
+        & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
+        & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)

src/Dodge/Render.hs

@@ -0,0 +1,122 @@
+module Dodge.Render 
+    ( module Dodge.Render.Picture
+    , doDrawing
+    , doDrawing'
+    )
+  where
+import Dodge.Data
+import Dodge.Base
+
+import Dodge.Render.HUD
+import Dodge.Render.MenuScreen
+import Dodge.Render.Picture
+import Dodge.Render.PerspectiveMatrix
+
+import Geometry
+import Picture
+import Shader
+
+import Picture.Render
+import Picture.Preload
+
+import Data.Graph.Inductive.Query.DFS
+import Data.Graph.Inductive.Graph
+
+import Control.Monad.State
+import Data.List
+import Data.Bifunctor
+
+import Foreign (Word32)
+import Data.Function
+import Control.Applicative
+import Control.Lens
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
+
+import qualified SDL
+
+doDrawing :: RenderData -> World -> IO (Word32)
+doDrawing pdata w = do
+    sTicks <- SDL.ticks
+    clear [ColorBuffer,DepthBuffer]
+    let rot     = _cameraRot w
+        zoom    = _cameraZoom w
+        trans@(tranx,trany) = _cameraCenter w
+        wins@(winx,winy)    = (_windowX w,_windowY w)
+        wallPointsCol   = wallsPointsAndCols w
+        windowPoints    = wallsWindows w
+        lightPoints     = lightsForGloom' w
+        viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
+        pic = worldPictures w
+        wallPoints = map fst wallPointsCol
+    setCommonUniforms pdata rot zoom trans wins
+    depthFunc $= Just Less
+    pmat <- (newMatrix RowMajor $ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
+    createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
+    blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
+--    clear [DepthBuffer]
+    depthFunc $= Just Always
+    renderBackground pdata rot zoom trans wins
+    depthFunc $= Just Lequal
+    renderWalls pdata wallPointsCol pmat
+    setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
+--    depthFunc $= Just Lequal
+    renderFoldable pdata $ picToLTree (Just 0) pic
+-- reset blend so that light map doesn't apply
+--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
+--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    renderFoldable pdata $ picToLTree (Just 1) pic
+
+-- set drawing for on top
+    blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
+
+    renderFoldable pdata $ picToLTree (Just 2) pic
+
+    depthMask $= Disabled
+    renderWalls pdata windowPoints pmat
+    depthMask $= Enabled
+
+    resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
+----------------------
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
+    eTicks <- SDL.ticks
+    return (eTicks - sTicks)
+doDrawing' :: RenderData -> World -> IO (Word32)
+doDrawing' pdata w = do
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    sTicks <- SDL.ticks
+    clear [ColorBuffer,DepthBuffer]
+    let rot     = _cameraRot w
+        zoom    = _cameraZoom w
+        trans@(tranx,trany) = _cameraCenter w
+        wins@(winx,winy)    = (_windowX w,_windowY w)
+        wallPointsCol   = wallsPointsAndCols w
+        windowPoints    = wallsWindows w
+        lightPoints     = lightsForGloom' w
+        viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
+        pic = worldPictures w
+        wallPoints = map fst wallPointsCol
+    pmat <- (newMatrix RowMajor 
+                $ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
+    setCommonUniforms pdata rot zoom trans wins
+
+    depthMask $= Disabled
+    renderBackground pdata rot zoom trans wins
+    depthMask $= Enabled
+    blend $= Enabled
+    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
+    -- not sure why renderWalls and setWallDepth aren't combined
+    renderWalls pdata wallPointsCol pmat
+    setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
+    depthFunc $= Just Lequal
+    renderFoldable pdata $ picToLTree (Just 0) pic
+    renderFoldable pdata $ picToLTree (Just 1) pic
+    renderFoldable pdata $ picToLTree (Just 2) pic
+    eTicks <- SDL.ticks
+    return (eTicks - sTicks)
+

src/Dodge/Render/HUD.hs

@@ -1,4 +1,4 @@
-module Dodge.Rendering.HUD
+module Dodge.Render.HUD
     where
 
 import Dodge.Data

src/Dodge/Render/MenuScreen.hs

@@ -1,4 +1,4 @@
-module Dodge.Rendering.MenuScreen
+module Dodge.Render.MenuScreen
     ( menuScreen
     )
     where

src/Dodge/Render/PerspectiveMatrix.hs

@@ -0,0 +1,50 @@
+module Dodge.Render.PerspectiveMatrix
+    where
+import Dodge.Data
+
+import Geometry
+
+import Linear.Matrix
+import Linear.V4
+import Graphics.Rendering.OpenGL (GLfloat)
+
+perspectiveMatrix :: World -> [GLfloat]
+perspectiveMatrix w =
+    let rot     = _cameraRot w
+        zoom    = _cameraZoom w
+        (tranx,trany)   = _cameraCenter w
+        (winx,winy)     = (_windowX w,_windowY w)
+        (viewFromx,viewFromy)   = _cameraViewFrom w
+        scalMat = Linear.Matrix.transpose $ V4 
+            (V4 (2*zoom/winx) 0             0   (0::GLfloat))
+            (V4 0             (2*zoom/winy) 0   0)
+            (V4 0             0             0.5 0) --scaled to make walls shorter
+            (V4 0             0             0   1)
+        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)
+        tranMat3 = Linear.Matrix.transpose $
+            V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (-tranx) (-trany) 0 1)
+        tranMat2 = Linear.Matrix.transpose $
+            V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
+        perMat = Linear.Matrix.transpose $
+             V4 (V4 1 0 0 0)
+                (V4 0 1 0 0)
+                (V4 0 0 1 1)
+                (V4 0 0 0 1)
+        tranMat1 = Linear.Matrix.transpose $
+             V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (-viewFromx) (-viewFromy) 0 1)
+        wmat = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
+        vToL (V4 a b c d) = [a,b,c,d]
+    in concatMap vToL $ vToL wmat

src/Dodge/Render/Picture.hs

@@ -1,29 +1,17 @@
-module Dodge.Rendering where
+module Dodge.Render.Picture
--- imports {{{
+  where
 import Dodge.Data
 import Dodge.Base
---import Dodge.Inventory
 
-import Dodge.Rendering.HUD
+import Dodge.Render.HUD
-import Dodge.Rendering.MenuScreen
+import Dodge.Render.MenuScreen
 
 import Geometry
 import Picture
 
-import Data.Graph.Inductive.Query.DFS
-import Data.Graph.Inductive.Graph
-
-import Control.Monad.State
-import Data.List
-import Data.Bifunctor
-
-import Data.Function
-import Control.Applicative
 import Control.Lens
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
-import qualified Data.Map as M
-import qualified Data.Set as S
 
 worldPictures :: World -> Picture
 worldPictures w = pictures $ concat 

src/Dodge/Update.hs

@@ -71,8 +71,11 @@ updateLightSources w = set tempLightSources (catMaybes tlss) w'
 updateProjectiles w = IM.foldr' _pjUpdate w $ _projectiles w
 
 updateParticles' :: World -> World
-updateParticles' w = set particles' (catMaybes ps) w'
+updateParticles' w = 
-    where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
+    --set particles' [] w
+    set particles' (catMaybes ps) w'
+  where 
+    (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
 
 updateCreatures :: World -> World
 updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w

src/Dodge/WallCreatureCollisions.hs

@@ -40,18 +40,17 @@ wallBuffer = 3
 
 -- the following tests whether or not a point is on a wall, and if so pushes it
 -- out from the wall
--- If the resultant push out is itself on another wall, the original point is
+-- this is then repeated if the point ends up on a new wall
--- returned
 collideWalls :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2
 collideWalls rad cp1 walls cp2
     = case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of
             Nothing -> cp2
             Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of
                                          Nothing -> cp3
-                                         Just cp4 -> cp1
+                                         Just cp4 -> cp4
 
 -- pushes a point out from a list of walls
--- if multiple new points occur, chooses the one closest to the orignal pointjk
+-- if multiple new points occur, chooses the one closest to the orignal point
 pushOutFromWalls :: Float -> [[Point2]] -> Point2 -> Point2
 pushOutFromWalls rad walls p = 
     fromMaybe p

src/Dodge/WorldEvent/Flash.hs

@@ -59,7 +59,7 @@ glareBetween t len wdth col a b w
 
 lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
 lowLightPic len wdth col (a,b) w
-    = case thingsHitLongLine a b w of
+    = case thingsHit a b w of
         ((p, E3x2 wall):_) 
             -> setCol . lineOfThickness wdth $ [alongLineBy len p wa, alongLineBy len p wb]
                 where x = len *.* (normalizeV $ wa -.- wb)

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -37,8 +37,8 @@ aFlameParticle t pos vel maycid = Pt'
     , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
     }
 
-makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
+makeFlame :: Int -> Point2 -> Point2 -> Maybe Int -> World -> World
-makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : )
+makeFlame t pos vel maycid = over particles' (aFlameParticle t pos vel maycid : )
 
 drawFlame :: Point2 -> Particle' -> Picture
 drawFlame rotd pt = thePic
@@ -167,6 +167,7 @@ moveFlamelet w pt
                      & btPassThrough' .~ Nothing
                      & btVel'         .~ 0.8 *.* vel
     damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
+--    damcrs = w
     closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
     dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
                     ((:) $ Flaming 3 sp ep ep)

src/Dodge/WorldEvent/ThingsHit.hs

@@ -17,6 +17,7 @@ thingsHit sp ep w
     where 
           hitCrs   = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
                                             $ _creatures w
+--                                            $ creaturesAlongLine sp ep w
           crPs     = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
           crs   = zip crPs (map E3x1 hitCrs)
 

src/Geometry.hs

@@ -152,6 +152,7 @@ circOnLine' !p1 !p2 !c !rad = isJustTrue (fmap (\p -> magV (p -.- c) < rad) y)
 
 -- this should probably be circOnSeg
 circOnLine :: Point2 -> Point2 -> Point2 -> Float -> Bool
+{-# INLINE circOnLine #-}
 circOnLine !p1 !p2 !c !rad = magV (p1 -.- c) <= rad || magV (p2 -.- c) <= rad
                              || isJustTrue (fmap (\p -> magV (p -.- c) < rad) y)
   where 

src/MatrixHelper.hs

@@ -11,7 +11,7 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
     let scalMat = Linear.Matrix.transpose $ V4 
             (V4 (2*zoom/winx) 0             0   (0::GLfloat))
             (V4 0             (2*zoom/winy) 0   0)
-            (V4 0             0             0.5 0) --scale to make walls shorter
+            (V4 0             0             0.5 0) --scaled to make walls shorter
             (V4 0             0             0   1)
         rotMat = Linear.Matrix.transpose $
             V4 (V4 (cos rot) (sin (-rot)) 0 0)

src/Picture/Render.hs

@@ -1,9 +1,9 @@
 --{-# LANGUAGE Strict #-}
 {-# LANGUAGE DeriveFoldable, StandaloneDeriving #-}
 module Picture.Render
-    ( renderPicture'
+    ( module Picture.Render
-    , renderFoldable
     , picToLTree
+--    , perspectiveMatrix 
     )
     where
 
@@ -33,25 +33,22 @@ import qualified SDL as SDL
 
 renderPicture' :: RenderData -> Float -> Float -> Point2 -> Point2 ->
                     [((Point2,Point2),Point4)] -> [((Point2,Point2),Point4)] -> [Point4] ->
-                    (Float,Float) -> Picture -> IO (Word32,Word32)
+                    (Float,Float) -> Picture -> IO (Word32)
 renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
                     viewFroms@(viewFromx,viewFromy) pic = do
-    let wallPoints = map fst wallPointsCol
     startTicks <- SDL.ticks
+    let wallPoints = map fst wallPointsCol
 
     setCommonUniforms pdata rot zoom trans wins
 
     depthFunc $= Just Less
 
--- calculate perspective matrix
     pmat <- (newMatrix RowMajor 
                 $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
             ) :: IO (GLmatrix GLfloat)
 
     createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
 
-    ticksAfterLighting <- SDL.ticks
-
     renderBackground pdata rot zoom trans wins
 
     renderWalls pdata wallPointsCol pmat
@@ -65,6 +62,7 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 -- reset blend so that light map doesn't apply
 --    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
+--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     renderFoldable pdata $ picToLTree (Just 1) pic
 
 -- set drawing for on top
@@ -78,7 +76,7 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
     endTicks <- SDL.ticks
-    return (ticksAfterLighting, endTicks - startTicks)
+    return (endTicks - startTicks)
 
 renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO ()
 renderWalls pdata wps pmat = do
@@ -116,22 +114,23 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
                     (viewFromx,viewFromy) pmat = do
 
     bindFramebuffer Framebuffer $= (_spareFBO pdata)
-    clearColor $= Color4 0 0.5 0 1
+-- clear buffer to full alpha and furthest depth
-    depthFunc $= Just Less
+    clearColor $= Color4 0 0 0 1
     clearDepth $= 1
     clear [ColorBuffer,DepthBuffer]
-
+    depthFunc $= Just Less
+-- store wall and light positions into buffer
     nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints
     bindShaderBuffers [_wallLightShader pdata] [nWallLights]
+    nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints
+    bindShaderBuffers [_wallShadowShader pdata] [nWalls]
+-- set uniforms for shader that draws lights
     currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
     uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 1)
             $= pmat
-
+-- draw walls from your point of view in order to set z buffer
-    nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints
+    colorMask $= (Color4 Disabled Disabled Disabled Disabled)
-    bindShaderBuffers [_wallShadowShader pdata] [nWalls]
-
     let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
-
     currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
     uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
             $= Vector2 viewFromx viewFromy  
@@ -141,81 +140,65 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
             $= (0 :: Float)
     cullFace $= Just Back
     drawShader (_wallShadowShader pdata) nWalls
-
+-- for each of the lights: 
+-- stencil out the walls from this light's point of view
+-- draw fading lightmap circles on the floor
+-- draw fading lightmaps on the walls
     depthMask $= Disabled
     blendFunc $= (Zero, OneMinusSrcAlpha)
---    blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
     stencilTest $= Enabled
     forM_ lightPoints $ \(x,y,r,lum) -> do
---        depthFunc $= Just Less
+-- bind buffer for floor light circle
-        colorMask $= (Color4 Disabled Disabled Disabled Disabled)
-        clear [StencilBuffer]
-        cullFace $= Just Back
---        stencilOp $= (OpKeep,OpKeep,OpReplace)
-        stencilOp $= (OpKeep,OpKeep,OpIncr)
-        stencilFunc $= (Always, 0, 255)
--- currentProgram does get called twice: here and inside drawShader below
-        currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
-        uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
-            $= Vector2 x y
---        blendFunc $= (Zero,One)
-        drawShader (_wallShadowShader pdata) nWalls
-
-        cullFace $= Just Front
-        stencilOp $= (OpKeep,OpKeep,OpDecr)
-        drawShader (_wallShadowShader pdata) nWalls
-
-        cullFace $= Nothing
-        
-        colorMask $= (Color4 Enabled Enabled Enabled Enabled)
         let lightPtr = (\(_,ptr,_) -> ptr) $ head 
                             $ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata
             (x',y') = zTran $ rotateV (0 - rot) $ (x,y) -.- (tranx,trany)
             zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy)
         pokeFourOff lightPtr 0 (x',y',r,lum)
+-- stencil out walls
+        colorMask $= (Color4 Disabled Disabled Disabled Disabled)
+        clear [StencilBuffer]
+        cullFace $= Just Back
+        stencilOp $= (OpKeep,OpKeep,OpIncr)
+        stencilFunc $= (Always, 0, 255)
+        currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
+        uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
+            $= Vector2 x y
+        drawShader (_wallShadowShader pdata) nWalls
+        cullFace $= Just Front
+        stencilOp $= (OpKeep,OpKeep,OpDecr)
+        drawShader (_wallShadowShader pdata) nWalls
+-- draw floor light circles
+        cullFace $= Nothing
+        colorMask $= (Color4 Disabled Disabled Disabled Enabled)
         bindShaderBuffers [_lightSourceShader pdata] [1]
         stencilFunc $= (Equal, 0, 255)
         drawShader (_lightSourceShader pdata) 1
-
+-- draw wall light "circles"
         currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
         uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata)
                 $= Vector2 x y  
         uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 2)
                 $= Vector2 r lum
         drawShader (_wallLightShader pdata) nWallLights
-        
     depthMask $= Enabled
     cullFace $= Nothing
     stencilTest $= Disabled
-
     blend $= Disabled
-
---    blendFunc $= (Zero,One)
     bindFramebuffer Framebuffer $= defaultFramebufferObject
-
     colorMask $= (Color4 Disabled Disabled Disabled Enabled)
---
---    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
     bindShaderBuffers [_fullscreenShader pdata] [4]
     textureBinding Texture2D $= Just (_fboTexture pdata)
---    blendFunc $= (One, Zero)
     drawShader (_fullscreenShader pdata) 4
-
     colorMask $= (Color4 Enabled Enabled Enabled Enabled)
-
     blend $= Enabled
 
 renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
 renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
-    depthFunc $= Just Less
+--    depthFunc $= Just Less
-
 -- set drawing for on top
-    blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
+    --blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-    clear [DepthBuffer]
-
 -- draw background
     bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
-
     currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
     bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
     let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata