Refactor differing resolutions somewhat

src/Dodge/Config/Update.hs

@@ -48,8 +48,8 @@ applyWorldConfig ::
     IO PreloadData
 applyWorldConfig cfig pdata = do
     setVol cfig
-    pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y pdata
+    pdataResizeUpdate cfig (x `div` divRes) (y `div` divRes) x y pdata
   where
     x = round $ _windowX cfig
     y = round $ _windowY cfig
-    divRes = resFactorNum $ _graphics_resolution_factor cfig
+    divRes = resFactorNum $ _graphics_world_resolution cfig

src/Dodge/Data/Config.hs

@@ -42,7 +42,9 @@ data Configuration = Configuration
     , _graphics_distortions :: Bool
     , _graphics_bloom :: Bool
     , _graphics_object_shadows :: ShadowRendering
-    , _graphics_resolution_factor :: ResFactor
+    , _graphics_downsize_resolution :: ResFactor
+    , _graphics_world_resolution :: ResFactor
+    , _graphics_overlay_resolution :: ResFactor
     , _graphics_num_shadow_casters :: NumShadowCasters
     , _windowX :: Float
     , _windowY :: Float
@@ -83,7 +85,7 @@ data DebugBool
     | Show_path_between
     deriving (Eq, Ord, Bounded, Enum, Show)
 
-data ResFactor = FullRes | HalfRes | QuarterRes
+data ResFactor = FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes
     deriving (Show, Eq, Ord, Enum, Bounded)
 
 data ShadowRendering 
@@ -102,6 +104,8 @@ resFactorNum rf = case rf of
     FullRes -> 1
     HalfRes -> 2
     QuarterRes -> 4
+    EighthRes -> 8
+    SixteenthRes -> 16
 
 defaultConfig :: Configuration
 defaultConfig =
@@ -113,7 +117,9 @@ defaultConfig =
         , _graphics_bloom = True
         , _graphics_object_shadows = GeoObjShads
         , _graphics_distortions = True
-        , _graphics_resolution_factor = QuarterRes
+        , _graphics_downsize_resolution = SixteenthRes
+        , _graphics_world_resolution = QuarterRes
+        , _graphics_overlay_resolution = FullRes
         , _graphics_num_shadow_casters = toEnum 10
         , _windowX = 800
         , _windowY = 600

src/Dodge/DownscaleSize.hs

@@ -1,5 +0,0 @@
-module Dodge.DownscaleSize where
-
-downSize :: Int
-{-# INLINE downSize #-}
-downSize = 8

src/Dodge/Event.hs

@@ -61,4 +61,4 @@ handleResizeEvent sev u =
     x = fromIntegral x'
     y = fromIntegral y'
     V2 x' y' = windowSizeChangedEventSize sev
-    divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor
+    divRes = resFactorNum $ u ^. uvConfig . graphics_world_resolution

src/Dodge/Menu.hs

@@ -182,7 +182,11 @@ graphicsMenu = titleOptionsMenu "OPTIONS:GRAPHICS" graphicsMenuOptions
 
 graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
-    [ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
+    [ makeEnumOption graphics_world_resolution "World resolution" (uvIOEffects .~ updateFramebufferSize)
+    , makeEnumOption graphics_downsize_resolution "Downsize resolution" 
+        (uvIOEffects .~ updateFramebufferSize)
+    , makeEnumOption graphics_overlay_resolution "Overlay resolution" 
+        (uvIOEffects .~ updateFramebufferSize)
     , makeEnumOption graphics_object_shadows "SHADOW DETAIL" id
     , makeEnumOption graphics_distortions "ENABLE DISTORTIONS" id
     , makeEnumOption graphics_bloom "ENABLE BLOOM" id

src/Dodge/PreloadData.hs

@@ -7,12 +7,12 @@ import Preload.Update
 sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Universe -> IO Universe
 sideEffectUpdatePreload divRes x y f u = do
     --    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral x) (fromIntegral y))
-    pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u)
+    pdata <- pdataResizeUpdate (u ^. uvConfig) (x `div` divRes) (y `div` divRes) x y (_preloadData u)
     f $ u & preloadData .~ pdata
 
 updatePreload :: Int -> Int -> Int -> Universe -> IO Universe
 updatePreload divRes x y u = do
-    pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u)
+    pdata <- pdataResizeUpdate (u ^. uvConfig) (x `div` divRes) (y `div` divRes) x y (_preloadData u)
     return $ u & preloadData .~ pdata
 
 updateFramebufferSize :: Universe -> IO Universe
@@ -20,4 +20,4 @@ updateFramebufferSize u = updatePreload divRes x y u
   where
     (x, y) = (round $ _windowX cfig, round $ _windowY cfig)
     cfig = _uvConfig u
-    divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor
+    divRes = resFactorNum $ u ^. uvConfig . graphics_world_resolution

src/Dodge/Render.hs

@@ -1,6 +1,7 @@
 -- | Contains the central drawing functions for the dodge loop.
 module Dodge.Render (
     doDrawing,
+    getWindowSize
 ) where
 
 --import qualified Data.Vector as V
@@ -13,7 +14,6 @@ import qualified Data.Map.Strict as M
 import Data.Preload.Render
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import Dodge.Data.Universe
-import Dodge.DownscaleSize
 import Dodge.Render.Lights
 import Dodge.Render.ShapePicture
 import Dodge.Render.Walls
@@ -49,7 +49,9 @@ doDrawing' win pdata u = do
         camzoom = w ^. cWorld . camPos . camZoom
         trans = w ^. cWorld . camPos . camCenter
         wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
-        resFact = resFactorNum $ cfig ^. graphics_resolution_factor
+        worldres = resFactorNum $ cfig ^. graphics_world_resolution
+        downres = resFactorNum $ cfig ^. graphics_downsize_resolution
+        overlayres = resFactorNum $ cfig ^. graphics_overlay_resolution
         (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
         lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
         viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
@@ -105,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` resFact) (round winy `div` resFact)
+    setViewportSize (round winx `div` worldres) (round winy `div` worldres)
     glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase ._1 . unFBO)
     glDepthMask GL_TRUE
     glDisable GL_BLEND
@@ -216,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` downSize) (round winy `div` downSize)
+    setViewportSize (round winx `div` downres) (round winy `div` downres)
     glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
     glDepthFunc GL_ALWAYS
     glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO)
@@ -224,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` resFact) (round winy `div` resFact)
+    setViewportSize (round winx `div` worldres) (round winy `div` worldres)
     --draw clouds onto cloud buffer
     glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
     glDepthFunc GL_LEQUAL
@@ -332,7 +334,8 @@ doDrawing' win pdata u = do
     glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
     drawShader (_fullscreenShader pdata) 4
     --set viewport for radial distortion
-    setViewportSize (round winx) (round winy)
+    --setViewportSize (round winx) (round winy)
+    setViewportType _graphics_overlay_resolution cfig
     glDepthFunc GL_ALWAYS
     glBlendFunc GL_ONE GL_ZERO
     -- perform any radial distortion
@@ -371,3 +374,11 @@ getDistortions cfig w
 
 setViewportSize :: Int -> Int -> IO ()
 setViewportSize x y = glViewport 0 0 (fromIntegral x) (fromIntegral y)
+
+getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a,a)
+getWindowSize f cfig = (g _windowX,g _windowY)
+  where
+    g h = fromIntegral $ round (h cfig) `div` resFactorNum (f cfig)
+
+setViewportType :: (Configuration -> ResFactor) -> Configuration -> IO ()
+setViewportType f = uncurry (glViewport 0 0) . getWindowSize f

src/Dodge/WindowSize.hs

@@ -7,4 +7,4 @@ getWindowSize cfig = (x `div` divRes,y `div` divRes)
   where
     x = round $ _windowX cfig
     y = round $ _windowY cfig
-    divRes = resFactorNum $ _graphics_resolution_factor cfig
+    divRes = resFactorNum $ _graphics_world_resolution cfig

src/Framebuffer/Update.hs

@@ -7,7 +7,7 @@ module Framebuffer.Update (
     sizeFBOs,
 ) where
 
-import Dodge.DownscaleSize
+import Dodge.Data.Config
 import Shader.Data
 import Framebuffer.Check
 import Control.Lens
@@ -19,52 +19,45 @@ import Graphics.GL.Core45
 import Unsafe.Coerce
 
 sizeFBOs ::
-    -- | Scaled width
+    Configuration ->
-    Int ->
-    -- | Scaled height
-    Int ->
-    -- | Full width
-    Int ->
-    -- | Full height
-    Int ->
     RenderData ->
     IO RenderData
-sizeFBOs xsize ysize xfull yfull rdata = do
+sizeFBOs cfig rdata = do
-    resizeRBO (_rboBaseBloom rdata) xsize ysize
+    uncurry (resizeRBO (_rboBaseBloom rdata)) (getWindowSize _graphics_world_resolution cfig)
-    rdata1 <- updateFBOTO3 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F GL_RGBA16F rdata fboBase
+    rdata1 <- uncurry updateFBOTO3 (getWindowSize _graphics_world_resolution cfig)
-    rdata2 <- updateFBOTO3 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F GL_RGBA16F rdata1 fboCloud
+        GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F GL_RGBA16F rdata fboBase
-    rdata' <- updateFBOTO xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 rdata2 fboLighting
+    rdata2 <- uncurry updateFBOTO3 (getWindowSize _graphics_world_resolution cfig)
+         GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F GL_RGBA16F rdata1 fboCloud
+    rdata' <- uncurry updateFBOTO (getWindowSize _graphics_world_resolution cfig)
+         GL_NEAREST GL_NEAREST GL_RGBA8 rdata2 fboLighting
     rdata'' <-
         foldM
-            (updateFBOTO xsize ysize GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F)
+            (uncurry updateFBOTO (getWindowSize _graphics_world_resolution cfig) 
+                GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F)
             rdata'
             [fboBloom, fboPos]
     rdata''' <-
         foldM
-            (updateFBOTO xfull yfull GL_NEAREST GL_NEAREST GL_RGBA8)
+            (uncurry updateFBOTO (getWindowSize _graphics_overlay_resolution cfig) GL_NEAREST GL_NEAREST GL_RGBA8)
             rdata''
             [fbo2, fbo3]
     rdata4 <-
         foldM
-            (updateFBOTO (xfull `div` downSize) (yfull `div` downSize) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F)
+            (uncurry updateFBOTO (getWindowSize _graphics_downsize_resolution cfig) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F)
             rdata'''
             [fboHalf1, fboHalf2, fboHalf3]
-    newShadowFBO <- resizeShadowFBO (rdata ^. fboShadow) xsize ysize
+    newShadowFBO <- uncurry (resizeShadowFBO (rdata ^. fboShadow)) 
+        (getWindowSize _graphics_world_resolution cfig)
     return $ rdata4 & fboShadow .~ newShadowFBO
 
 resizeRBO ::
     GLuint -> -- RenderbufferObject
-    Int ->
+    GLsizei ->
-    Int ->
+    GLsizei ->
     IO ()
-resizeRBO rboName xsize ysize = do
+resizeRBO rboName = glNamedRenderbufferStorage
-    let xsize' = fromIntegral xsize
-        ysize' = fromIntegral ysize
-    glNamedRenderbufferStorage
         rboName
         GL_DEPTH24_STENCIL8
-        xsize'
-        ysize'
 
 updateFBOTO ::
     Int ->
@@ -228,3 +221,8 @@ initializeTexture2DArray fbo attachpoint x y z minfilt magfilt informat = do
     glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
     glNamedFramebufferTexture (_unFBO fbo) attachpoint to1 0
     return to1
+
+getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a,a)
+getWindowSize f cfig = (g _windowX,g _windowY)
+  where
+    g h = fromIntegral $ round (h cfig) `div` resFactorNum (f cfig)

src/Preload/Update.hs

@@ -4,6 +4,7 @@ module Preload.Update (
     pdataResizeUpdate,
 ) where
 
+import Dodge.Data.Config
 import Control.Lens
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
@@ -14,6 +15,7 @@ import Shader.Compile
 import Shader.Data
 
 pdataResizeUpdate ::
+    Configuration ->
     -- | Scaled width
     Int ->
     -- | Scaled height
@@ -24,11 +26,12 @@ pdataResizeUpdate ::
     Int ->
     PreloadData ->
     IO PreloadData
-pdataResizeUpdate xsize ysize xfull yfull pdata = do
+pdataResizeUpdate cfig xsize ysize xfull yfull pdata = do
-    rd <- renderDataResizeUpdate xsize ysize xfull yfull (_renderData pdata)
+    rd <- renderDataResizeUpdate cfig xsize ysize xfull yfull (_renderData pdata)
     return (pdata{_renderData = rd})
 
 renderDataResizeUpdate ::
+    Configuration ->
     -- | Scaled width
     Int ->
     -- | Scaled height
@@ -39,8 +42,8 @@ renderDataResizeUpdate ::
     Int ->
     RenderData ->
     IO RenderData
-renderDataResizeUpdate xsize ysize xfull yfull rdata = do
+renderDataResizeUpdate cfig xsize ysize xfull yfull rdata = do
-    rdata' <- sizeFBOs xsize ysize xfull yfull rdata
+    rdata' <- sizeFBOs cfig rdata
     bbVert <- BS.readFile "shader/texture/bloomBlur.vert"
     bbFrag <- BS.readFile "shader/texture/bloomBlur.frag"
     let (bh, bmid) = BS.breakSubstring "(" bbFrag