diff --git a/appDodge/Main.hs b/appDodge/Main.hs index d63743d65..8298f0b51 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -27,9 +27,10 @@ import Music import Preload import Preload.Render --import Render + +import SDL (($=)) import qualified SDL import qualified SDL.Mixer as Mix -import SDL (($=)) import Sound import System.Directory @@ -77,27 +78,25 @@ firstWorldLoad :: Configuration -> IO Universe firstWorldLoad theConfig = do SDL.cursorVisible $= False pdata <- doPreload >>= applyWorldConfig theConfig - --return $ startNewGame $ Universe cancontinue <- doesFileExist "saveSlot/0" mseed <- loadSeed - let u = Universe - { --{_uvWorld = initialWorld - _uvWorld = splashScreen - , _uvConfig = theConfig - , _preloadData = pdata - , _uvScreenLayers = [] - , _uvIOEffects = return - , _uvTestString = testStringInit - , _uvSideEffects = mempty - , _uvCanContinue = cancontinue - , _uvMSeed = mseed - , _uvLastFrameTicks = 0 - , _uvFrameTicks = 0 - } + let u = + Universe + { _uvWorld = splashScreen + , _uvConfig = theConfig + , _preloadData = pdata + , _uvScreenLayers = [] + , _uvIOEffects = return + , _uvTestString = testStringInit + , _uvSideEffects = mempty + , _uvCanContinue = cancontinue + , _uvMSeed = mseed + , _uvLastFrameTicks = 0 + , _uvFrameTicks = 0 + } return $ Universe - { --{_uvWorld = initialWorld - _uvWorld = splashScreen + { _uvWorld = splashScreen , _uvConfig = theConfig , _preloadData = pdata , _uvScreenLayers = [splashMenu u] @@ -115,8 +114,7 @@ theUpdateStep win = doSideEffects <=< updateRenderSplit win updateRenderSplit :: SDL.Window -> Universe -> IO Universe updateRenderSplit win u = do - let preData = _preloadData u - updateUniverse u `par` void (doDrawing win (_renderData preData) u) + updateUniverse u `par` void (doDrawing win u) return $! updateUniverse u playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound) diff --git a/data/texture/charMapVertBig.png b/data/texture/charMapVertBig.png index 948001ed1..c1f0cf27a 100644 Binary files a/data/texture/charMapVertBig.png and b/data/texture/charMapVertBig.png differ diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 755fd2c67..cc3199784 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -40,6 +40,7 @@ data RenderData = RenderData , _fboCloud :: (FBO, (TO, TO, TO)) , _fboBloom :: (FBO, TO) , _fboPos :: (FBO, TO) + , _fboOverlay :: (FBO, TO) , _fboLighting :: (FBO, TO) , _fboShadow :: (FBO, (TO, TO)) , _rboBaseBloom :: GLuint -- RenderbufferObject id diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index ba6a46732..0463b136b 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -3,7 +3,6 @@ IO actions that apply config side effects and save configuration settings to dis -} module Dodge.Config.Update ( saveConfig, - setVolThen, applyWorldConfig, setVol, ) where @@ -33,12 +32,6 @@ setVol cfig = do setSoundVolume (_volume_master cfig * _volume_sound cfig) setMusicVolume (_volume_master cfig * _volume_music cfig) --- what? -setVolThen :: Configuration -> (a -> IO a) -> a -> IO a -setVolThen cfig f a = do - setVol cfig - f a - {- | Apply /all/ of the values in the world configuration to the running game. -} diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 4141f1fef..d79da3598 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -31,10 +31,12 @@ import Shader.Data import Shader.Poke import Shader.Poke.Cloud -doDrawing :: SDL.Window -> RenderData -> Universe -> IO () -doDrawing window rdata u +doDrawing :: SDL.Window -> Universe -> IO () +doDrawing window u | SDL.ScancodeT `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u | otherwise = doDrawing' window rdata u + where + rdata = u ^. preloadData . renderData doTestDrawing :: RenderData -> Universe -> IO () doTestDrawing _ _ = do @@ -49,9 +51,7 @@ doDrawing' win pdata u = do rot = w ^. cWorld . camPos . camRot camzoom = w ^. cWorld . camPos . camZoom trans = w ^. cWorld . camPos . camCenter - wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) - worldres = resFactorNum $ cfig ^. graphics_world_resolution - downres = resFactorNum $ cfig ^. graphics_downsize_resolution + wins = V2 (_windowX cfig) (_windowY cfig) (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld) viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom @@ -107,7 +107,7 @@ doDrawing' win pdata u = do glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO) withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $ \ptr -> glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr - setViewportSize (round winx `div` worldres) (round winy `div` worldres) + setViewport _graphics_world_resolution cfig glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase ._1 . unFBO) glDepthMask GL_TRUE glDisable GL_BLEND @@ -218,7 +218,7 @@ doDrawing' win pdata u = do renderLayer BloomLayer shadV layerCounts --setup downscale viewport for blurring bloom --setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact)) - setViewportSize (round winx `div` downres) (round winy `div` downres) + setViewport _graphics_downsize_resolution cfig glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata))) glDepthFunc GL_ALWAYS glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO) @@ -226,7 +226,7 @@ doDrawing' win pdata u = do drawShader (_bloomBlurShader pdata) 4 replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) glEnable GL_BLEND - setViewportSize (round winx `div` worldres) (round winy `div` worldres) + setViewport _graphics_world_resolution cfig --draw clouds onto cloud buffer glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata))) glDepthFunc GL_LEQUAL @@ -335,7 +335,7 @@ doDrawing' win pdata u = do drawShader (_fullscreenShader pdata) 4 --set viewport for radial distortion --setViewportSize (round winx) (round winy) - setViewportType _graphics_overlay_resolution cfig + setViewport _graphics_overlay_resolution cfig glDepthFunc GL_ALWAYS glBlendFunc GL_ONE GL_ZERO -- perform any radial distortion @@ -372,8 +372,5 @@ getDistortions cfig w | cfig ^. graphics_distortions = w ^. cWorld . lWorld . distortions | otherwise = [] -setViewportSize :: Int -> Int -> IO () -setViewportSize x y = glViewport 0 0 (fromIntegral x) (fromIntegral y) - -setViewportType :: (Configuration -> ResFactor) -> Configuration -> IO () -setViewportType f = uncurry (glViewport 0 0) . getWindowSize f +setViewport :: (Configuration -> ResFactor) -> Configuration -> IO () +setViewport f = uncurry (glViewport 0 0) . getWindowSize f diff --git a/src/Framebuffer/Setup.hs b/src/Framebuffer/Setup.hs index 143882f21..182b64e31 100644 --- a/src/Framebuffer/Setup.hs +++ b/src/Framebuffer/Setup.hs @@ -1,6 +1,6 @@ -- | For initialising framebuffers. module Framebuffer.Setup ( - setupTextureFramebuffer, + newTextureFramebuffer, setupFramebufferGivenStencil, setupFramebuffer2GivenStencil, setupFramebuffer3GivenStencil, @@ -9,41 +9,23 @@ module Framebuffer.Setup ( import Shader.Data import Framebuffer.Check -import Unsafe.Coerce import GLHelp import Graphics.GL.Core45 -setupTextureFramebuffer :: - GLsizei -> - GLsizei -> - IO (FBO, TO) -{-# INLINE setupTextureFramebuffer #-} -setupTextureFramebuffer x y = do - --fboName <- genObjectName - --bindFramebuffer Framebuffer $= fboName +-- the framebuffer is not complete after this +newTextureFramebuffer :: IO (FBO, TO) +{-# INLINE newTextureFramebuffer #-} +newTextureFramebuffer = do fboName <- mglCreate glCreateFramebuffers - --fboTO <- genObjectName to <- mglCreate (glCreateTextures GL_TEXTURE_2D) - --textureBinding Texture2D $= Just fboTO - --glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y - glTextureStorage2D to 1 GL_RGBA8 x y - glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST) - glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST) - --textureFilter Texture2D $= minMagFilter - --framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 - glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 to 0 - checkFBO $ FBO fboName return (FBO fboName, TO to) +-- the framebuffer is not complete after this setupShadowFramebuffer :: IO (FBO, (TO, TO)) setupShadowFramebuffer = do - --fboName <- genObjectName - --bindFramebuffer Framebuffer $= fboName fboName <- mglCreate glCreateFramebuffers to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY) to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY) - --textureBinding Texture2DArray $= Just toName - --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName return (FBO fboName, (TO to1,TO to2)) setupFramebufferGivenStencil :: diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index 8a0f3f180..69d174cf6 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -46,9 +46,7 @@ sizeFBOs cfig rdata = do (uncurry updateFBOTO (getWindowSize _graphics_downsize_resolution cfig) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata''' [fboHalf1, fboHalf2, fboHalf3] - newShadowFBO <- uncurry (resizeShadowFBO (rdata ^. fboShadow)) - (getWindowSize _graphics_world_resolution cfig) - return $ rdata4 & fboShadow .~ newShadowFBO + resizeShadowFBO' cfig rdata4 resizeRBO :: GLuint -> -- RenderbufferObject @@ -113,13 +111,16 @@ updateFBOTO3 xsize ysize minfilt magfilt inFormat1 inFormat2 inFormat3 pdata tar newfbo2 <- resizeFBOTO3 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2 inFormat3 return $ storing target newfbo2 pdata +resizeShadowFBO' :: Configuration -> RenderData -> IO RenderData +resizeShadowFBO' cfig = fboShadow (uncurry resizeShadowFBO (getWindowSize _graphics_world_resolution cfig)) + -- note we only really "change" the texture objects resizeShadowFBO :: + Int -> + Int -> (FBO, (TO, TO)) -> - Int -> - Int -> IO (FBO, (TO, TO)) -resizeShadowFBO (fbo, (oldto1, oldto2)) x y = do +resizeShadowFBO x y (fbo, (oldto1, oldto2)) = do glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo) mglDelete glDeleteTextures $ _unTO oldto1 mglDelete glDeleteTextures $ _unTO oldto2 diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index b921a8296..9f7397d34 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -115,8 +115,8 @@ preloadRender = do cloudvbo <- setupVBO (sum cloudverxsizes) (cloudshader, cloudebo) <- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes pmTriangles cloudvbo - framebuf2 <- setupTextureFramebuffer 800 600 - framebuf3 <- setupTextureFramebuffer 800 600 + framebuf2 <- newTextureFramebuffer + framebuf3 <- newTextureFramebuffer rboBaseBloomName <- mglCreate glCreateRenderbuffers glNamedRenderbufferStorage @@ -133,9 +133,11 @@ preloadRender = do fboShadowName <- setupShadowFramebuffer - fboHalf1Name <- setupTextureFramebuffer 300 300 - fboHalf2Name <- setupTextureFramebuffer 300 300 - fboHalf3Name <- setupTextureFramebuffer 300 300 + fbooverlay <- newTextureFramebuffer + + fboHalf1Name <- newTextureFramebuffer + fboHalf2Name <- newTextureFramebuffer + fboHalf3Name <- newTextureFramebuffer -- reset to default framebuffer, ready for drawing direct to screen glBindFramebuffer GL_FRAMEBUFFER 0 @@ -183,6 +185,7 @@ preloadRender = do , _fboCloud = fboCloudName , _fboBloom = fboBloomName , _fboPos = fboPosName + , _fboOverlay = fbooverlay , _rboBaseBloom = rboBaseBloomName , _matUBO = theUBO , _orthonormalMatUBO = orthonormalUBO diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index 3c43709f1..53772beb1 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -5,12 +5,12 @@ module Preload.Update ( renderDataResizeUpdate, ) where -import Dodge.WindowSize -import Dodge.Data.Universe import Control.Lens import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Data.Preload.Render +import Dodge.Data.Universe +import Dodge.WindowSize import Framebuffer.Update import Shader.Compile import Shader.Data @@ -18,9 +18,10 @@ import Shader.Data -- i don't like this being here pulling in the dodge universe dependency, but -- splitting it out would be overkill updatePreload :: Universe -> IO Universe -updatePreload u = do - pdata <- renderDataResizeUpdate (u ^. uvConfig) (u ^. preloadData . renderData) - return $ u & preloadData . renderData .~ pdata +updatePreload u = + (preloadData . renderData) + (renderDataResizeUpdate (u ^. uvConfig)) + u renderDataResizeUpdate :: Configuration -> @@ -30,7 +31,7 @@ renderDataResizeUpdate cfig rdata = do rdata' <- sizeFBOs cfig rdata bbVert <- BS.readFile "shader/texture/bloomBlur.vert" bbFrag <- BS.readFile "shader/texture/bloomBlur.frag" - let (xsize,ysize) = getWindowSize _graphics_downsize_resolution cfig :: (Int,Int) + let (xsize, ysize) = getWindowSize _graphics_downsize_resolution cfig :: (Int, Int) (bh, bmid) = BS.breakSubstring "(" bbFrag (_, btt) = BS.breakSubstring ")" bmid bbFrag' = BS.append bh $ BS.append (BSC.pack $ '(' : show xsize ++ "," ++ show ysize) btt @@ -40,4 +41,4 @@ renderDataResizeUpdate cfig rdata = do [(vert, bbVert), (frag, bbFrag')] pmTriangleStrip (rdata ^. screenTextureVAO) - return (rdata'{_bloomBlurShader = bbShad}) + return rdata'{_bloomBlurShader = bbShad}