Fix some menu bugs

2021-05-01 19:31:10 +02:00
parent 6eb6221a84
commit 9cdd3a9629
4 changed files with 61 additions and 48 deletions
@@ -65,11 +65,10 @@ handlePressedKeyInMenu mState scode w = case mState of
    pushMenu ml w   = Just $ w & menuLayers %~ (ml :)
    popMenu w       = Just $ w & menuLayers %~ tail
    sw = w & sideEffects %~ (setVol (_config w) : )
-    startNewGame = Just $ generateFromList levx 
+    startNewGame = Just $ updateFramebufferSize $ generateFromList levx 
        $ initialWorld 
            & randGen .~ _randGen w
-            & config . windowX .~ getWindowX w
-            & config . windowY .~ getWindowY w
+            & config .~ _config w

 updateFramebufferSize :: World -> World
 updateFramebufferSize w = w & sideEffects 
@@ -1,3 +1,5 @@
+{- |
+Contains the central drawing functions for the dodge loop. -}
 module Dodge.Render 
    ( module Dodge.Render.Picture
    , doDrawing
@@ -31,8 +33,10 @@ import qualified Data.Set as S
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL

-halfwindow = over (config . windowX) ( / 2) . over (config . windowY) ( / 2)
-
+{- |
+Central drawing function.
+Returns a 'Word32' that should give the number of ticks it took to evaluate.
+ -}
 doDrawing :: RenderData -> World -> IO (Word32)
 doDrawing pdata w = do
    sTicks <- SDL.ticks
@@ -47,62 +51,78 @@ 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)
+        :: 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))
--    clear [DepthBuffer]
--    depthFunc $= Just Always
    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
+
+    -- 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
--    depthFunc $= Just Lequal
+
+    -- 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
--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+
+    -- reset blend so that light map doesn't apply
+    -- useful for drawing vivid projectiles
    blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    depthFunc $= Just Lequal
    renderFoldable pdata $ picToLTree (Just 1) pic
-- set drawing for on top
+
+    -- 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 lightmap to the screen
+    -- draw the fbo to the screen
+    -- allows for post-processing
+    -- first, bind the screen fbo
    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    -- we probably do not want to blend during this step
    blend $= Disabled
-    clear [ColorBuffer,DepthBuffer]
    depthFunc $= Just Always
    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
-    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    generateMipmap' Texture2D
-    bindShaderBuffers [_grayscaleShader pdata] [4]
-    drawShader (_grayscaleShader pdata) 4
--    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
--    clear [ColorBuffer,DepthBuffer]
--    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
--    clear [ColorBuffer,DepthBuffer]
--    bindFramebuffer Framebuffer $= defaultFramebufferObject
+--    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+--    generateMipmap' Texture2D
+    bindShaderBuffers [_fullscreenShader pdata] [4]
+    drawShader (_fullscreenShader 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 
    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
@@ -113,7 +133,7 @@ renderBlankWalls pdata wps pmat = do
    bindShaderBuffers [_wallBlankShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
    uniform (head (fromJust $ _shaderCustomUnis $ _wallBlankShader pdata) )
-            $= pmat
+        $= pmat
    cullFace $= Just Back
    drawShader (_wallBlankShader pdata) n
    cullFace $= Nothing
@@ -128,7 +148,7 @@ renderTextureWalls pdata wps pmat = do
    bindShaderBuffers [_wallTextureShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
    uniform (head (fromJust $ _shaderCustomUnis $ _wallTextureShader pdata) )
-            $= pmat
+        $= pmat
    cullFace $= Just Back
    drawShader (_wallTextureShader pdata) n
    cullFace $= Nothing
@@ -28,11 +28,12 @@ worldPictures w = pictures $ concat
    ]

 fixedCoordPictures :: World -> Picture
-fixedCoordPictures w = pictures
-    [ hudDrawings w
-    , scaler . onLayer MenuDepth $ menuScreen (_config w) (halfWidth w) (halfHeight w) (_menuLayers w)
-    , customMouseCursor w
-    ]
+fixedCoordPictures w = case _menuLayers w of 
+    [] -> pictures
+        [ hudDrawings w
+        , customMouseCursor w
+        ]
+    lays -> scaler . onLayer MenuDepth $ menuScreen (_config w) (halfWidth w) (halfHeight w) lays
  where 
    scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w)

@@ -53,6 +53,10 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)

+{- | 
+Determine where light is shining in the world.
+Note that this currently (1/5/2021) sets the bound framebuffer to fbo2.
+The lightmap itself is rendered into this buffer.  -}
 createLightMap 
    :: RenderData 
    -> Int                  -- Resolution division
@@ -138,13 +142,10 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat =

 -- set the viewport size to that of the window
    viewport $= (vppos, vpsize)
-- always want to draw lightmap
+-- disable depth testing for blurring
    depthFunc $= Just Always
 -- draw the lightmap on a full size fbo
--    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
--    clear [ColorBuffer,DepthBuffer]
    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
--    clear [ColorBuffer,DepthBuffer]
    colorMask $= Color4 Disabled Disabled Disabled Enabled
    bindShaderBuffers [_boxBlurShader pdata] [4]
    textureBinding Texture2D $= Just (_fboTexture pdata)
@@ -154,18 +155,10 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat =
    generateMipmap' Texture2D
    drawShader (_boxBlurShader pdata) 4

-- ping pong blur between the two buffers as many times as desired
+-- ping pong blur between '_fbo2' and '_fbo3' as many times as desired
    replicateM_ 3 $ pingPongBlur pdata

---- draw the lightmap to the screen
--    bindFramebuffer Framebuffer $= defaultFramebufferObject
--    clear [DepthBuffer]
--    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
--    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
--    generateMipmap' Texture2D
--    bindShaderBuffers [_fullscreenShader pdata] [4]
--    drawShader (_fullscreenShader pdata) 4
-
+-- reset drawing parameters ready for drawing on top of the light map
    colorMask $= Color4 Enabled Enabled Enabled Enabled
    depthMask $= Enabled
    blend $= Enabled