From 9cdd3a9629cc6127a7530bd6dce9984ad9317b26 Mon Sep 17 00:00:00 2001 From: jgk Date: Sat, 1 May 2021 19:31:10 +0200 Subject: [PATCH] Fix some menu bugs --- src/Dodge/Event/Menu.hs | 5 ++- src/Dodge/Render.hs | 72 +++++++++++++++++++++++-------------- src/Dodge/Render/Picture.hs | 11 +++--- src/Picture/Render.hs | 21 ++++------- 4 files changed, 61 insertions(+), 48 deletions(-) diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 9744b65b7..7b5015acb 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 8823a6cce..2556ceb22 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 1ca0fbfbd..3c379e1cc 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -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) diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 092dd8068..311e930c2 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -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