Add airlocks

src/Dodge/Render.hs

@@ -51,53 +51,43 @@ doDrawing pdata w = do
         viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
         pic = worldPictures w
         wallPoints = map fst wallPointsCol
-
     -- set the coordinate uniforms ready for drawing elements with using world coordinates
     setCommonUniforms pdata rot zoom trans wins
     depthFunc $= Just Less
     pmat <- (newMatrix RowMajor $ perspectiveMatrix rot zoom trans wins viewFroms) 
         :: IO (GLmatrix GLfloat)
-
     -- draw the lightmap. Probably changes the bound framebufferObject
     createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms pmat
-
     -- draw the background. Assumes that depth testing is not enabled or that
     -- the depth buffer is ready to be drawn on
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
     renderBackground pdata rot zoom trans wins
-
     -- draw the walls
     depthFunc $= Just Less
     if w ^. config . wall_textured
         then renderTextureWalls pdata wallPointsCol pmat
         else renderBlankWalls pdata wallPointsCol pmat
-
     -- I believe a more apt name would be setCeilingDepth: stops drawing of objects
     -- at points that are behind the extension of walls to the screen edge
     setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
-
     -- draw the first layer of pictures
     -- these will probably all be opaque
     renderFoldable pdata $ picToLTree (Just 0) pic
-
     -- reset blend so that light map doesn't apply
     -- useful for drawing vivid projectiles
     blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
     depthFunc $= Just Lequal
     renderFoldable pdata $ picToLTree (Just 1) pic
-
     -- reset blend so that light map applies again
     -- allows us to be certain these elements are drawn on top of those before,
     -- in case we want transparency effects
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
     renderFoldable pdata $ picToLTree (Just 2) pic
     depthMask $= Disabled
-
     -- render transparent walls
     -- the ordering between these and transparent clouds perhaps presents a challenge
     renderBlankWalls pdata windowPoints pmat
     depthMask $= Enabled
-
     -- draw the fbo to the screen
     -- allows for post-processing
     -- first, bind the screen fbo
@@ -108,20 +98,23 @@ doDrawing pdata w = do
     textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
 --    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
 --    generateMipmap' Texture2D
-    bindShaderBuffers [_fullscreenShader pdata] [4]
-    drawShader (_fullscreenShader pdata) 4
+    if _crHP (you w) > 0 
+        then do
+            bindShaderBuffers [_fullscreenShader pdata] [4]
+            drawShader (_fullscreenShader pdata) 4
+        else do
+            bindShaderBuffers [_grayscaleShader pdata] [4]
+            drawShader (_grayscaleShader pdata) 4
     blend $= Enabled
-
     -- reset the coordinate uniforms for pictures that are drawn wrt to window
     -- coordinates
     resetShaderUniforms (map extractProgAndUnis $ _pictureShaders pdata)
-
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
     eTicks <- SDL.ticks
     return (eTicks - sTicks)
 
-----------------------
+--------------------------------------------------------------------------------
 
 renderBlankWalls 
     :: RenderData