Work on cloud/window transparency

src/Framebuffer/Update.hs

@@ -3,15 +3,13 @@
 {- | Concerns resizing framebuffers on the fly.
  - Seems to need to be called at least once.
 -}
-module Framebuffer.Update (
-    sizeFBOs,
-) where
+module Framebuffer.Update (sizeFBOs) where
 
-import Dodge.WindowSize
 import Control.Lens
 import Control.Monad
 import Data.Preload.Render
 import Dodge.Data.Config
+import Dodge.WindowSize
 import Foreign.Marshal.Array
 import Framebuffer.Check
 import GLHelp
@@ -19,16 +17,13 @@ import Graphics.GL.Core45
 import Shader.Data
 import Unsafe.Coerce
 
-sizeFBOs ::
-    Config ->
-    RenderData ->
-    IO RenderData
+sizeFBOs :: Config -> RenderData -> IO RenderData
 sizeFBOs cfig rdata =
-    uncurry (resizeRBO (_rboBaseBloom rdata)) (getWindowSize _graphics_world_resolution cfig)
+    uncurry (resizeRBO (_rboBaseBloom rdata)) (getWindowSize _gr_world_res cfig)
         >> foldM
             ( uncurry
                 updateFBOTO3
-                (getWindowSize _graphics_world_resolution cfig)
+                (getWindowSize _gr_world_res cfig)
                 GL_NEAREST
                 GL_NEAREST
                 GL_RGBA8
@@ -38,43 +33,40 @@ sizeFBOs cfig rdata =
             rdata
             [fboBase, fboCloud]
             >>= foldUpdateFBOTO
-                _graphics_world_resolution
+                _gr_world_res
                 GL_NEAREST
                 GL_NEAREST
                 GL_RGBA8
                 [fboLighting]
             >>= foldUpdateFBOTO
-                _graphics_world_resolution
+                _gr_world_res
                 GL_LINEAR_MIPMAP_LINEAR
                 GL_LINEAR
                 GL_RGBA16F
                 [fboBloom, fboPos]
             >>= foldUpdateFBOTO
-                _graphics_distortion_resolution
+                _gr_distortion_res
                 GL_LINEAR
                 GL_NEAREST
                 GL_RGBA8
                 [fbo2, fbo3]
             >>= foldUpdateFBOTO
-                _graphics_downsize_resolution
+                _gr_downsize_res
                 GL_LINEAR_MIPMAP_LINEAR
                 GL_LINEAR
                 GL_RGBA16F
                 [fboHalf1, fboHalf2]
+            >>= uncurry updateFBOTO2
+                (getWindowSize _gr_world_res cfig)
+                GL_NEAREST
+                GL_NEAREST
+                GL_RGBA8
+                GL_RGBA16F
+                fboWindow
   where
-    updateFBOTO' f =
-        uncurry
-            updateFBOTO
-            (getWindowSize f cfig)
-    foldUpdateFBOTO f minfilt magfilt format l =
-        ffoldM
-            ( updateFBOTO'
-                f
-                minfilt
-                magfilt
-                format
-            )
-            l
+    updateFBOTO' f = uncurry updateFBOTO (getWindowSize f cfig)
+    foldUpdateFBOTO f minfilt magfilt format =
+        ffoldM ( updateFBOTO' f minfilt magfilt format)
 
 ffoldM :: (Foldable t, Monad m) => (a1 -> a2 -> m a1) -> t a2 -> a1 -> m a1
 ffoldM f = flip $ foldM f
@@ -98,23 +90,25 @@ updateFBOTO xsize ysize minfilt magfilt inFormat pdata target = do
     newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize minfilt magfilt inFormat
     return $ storing target newfbo2 pdata
 
---updateFBOTO2 ::
---    Int ->
---    Int ->
---    -- | minification filter
---    GLenum ->
---    -- | magnification filter
---    GLenum ->
---    -- | internal color format texture1
---    GLenum ->
---    -- | internal color format texture2
---    GLenum ->
---    RenderData ->
---    ALens' RenderData (FBO, (TO, TO)) ->
---    IO RenderData
---updateFBOTO2 xsize ysize minfilt magfilt inFormat1 inFormat2 pdata target = do
---    newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2
---    return $ storing target newfbo2 pdata
+-- note that the ordering of arguments is different to the other update
+-- functions... this all needs rethinking
+updateFBOTO2 ::
+    Int ->
+    Int ->
+    -- | minification filter
+    GLenum ->
+    -- | magnification filter
+    GLenum ->
+    -- | internal color format texture1
+    GLenum ->
+    -- | internal color format texture2
+    GLenum ->
+    ALens' RenderData (FBO, (TO, TO)) ->
+    RenderData ->
+    IO RenderData
+updateFBOTO2 xsize ysize minfilt magfilt inFormat1 inFormat2 target pdata = do
+    newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2
+    return $ storing target newfbo2 pdata
 
 updateFBOTO3 ::
     Int ->
@@ -136,29 +130,29 @@ 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
 
---resizeFBOTO2 ::
---    (FBO, (TO, TO)) ->
---    Int ->
---    Int ->
---    -- | minification filter
---    GLenum ->
---    -- | magnification filter
---    GLenum ->
---    -- | internal color format1
---    GLenum ->
---    -- | internal color format2
---    GLenum ->
---    IO (FBO, (TO, TO))
---resizeFBOTO2 (fbo, (toOld1, toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do
---    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
---    mglDelete glDeleteTextures $ _unTO toOld1
---    mglDelete glDeleteTextures $ _unTO toOld2
---    to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 xsize ysize minfilt magfilt inFormat1
---    to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 xsize ysize minfilt magfilt inFormat2
---    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $ \ptr ->
---        glNamedFramebufferDrawBuffers (_unFBO fbo) 2 ptr
---    checkFBO fbo
---    return (fbo, (TO to1, TO to2))
+resizeFBOTO2 ::
+    (FBO, (TO, TO)) ->
+    Int ->
+    Int ->
+    -- | minification filter
+    GLenum ->
+    -- | magnification filter
+    GLenum ->
+    -- | internal color format1
+    GLenum ->
+    -- | internal color format2
+    GLenum ->
+    IO (FBO, (TO, TO))
+resizeFBOTO2 (fbo, (toOld1, toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do
+    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
+    mglDelete glDeleteTextures $ _unTO toOld1
+    mglDelete glDeleteTextures $ _unTO toOld2
+    to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 xsize ysize minfilt magfilt inFormat1
+    to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 xsize ysize minfilt magfilt inFormat2
+    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $ \ptr ->
+        glNamedFramebufferDrawBuffers (_unFBO fbo) 2 ptr
+    checkFBO fbo
+    return (fbo, (TO to1, TO to2))
 
 resizeFBOTO3 ::
     (FBO, (TO, TO, TO)) ->
@@ -219,5 +213,5 @@ initializeTexture2D fbo attachpoint x y minfilt magfilt informat = do
 
 --getWindowSize :: Integral a => (Config -> ResFactor) -> Config -> (a, a)
 --getWindowSize f cfig = (g _windowX, g _windowY)
- -- where
-  --  g h = fromIntegral $ h cfig `div` resFactorNum (f cfig)
+-- where
+--  g h = fromIntegral $ h cfig `div` resFactorNum (f cfig)