Make clouds use specific upscale filter, break cloud render over walls

src/Data/Preload/Render.hs

@@ -22,6 +22,7 @@ data RenderData = RenderData
     , _pullWallShader :: GLuint
     , _fullscreenShader :: GLuint
     , _textureAntiaShader :: GLuint
+    , _upscaleCloudShader :: GLuint
     , _bloomBlurShader :: GLuint
     , _barrelShader :: (GLuint,VBO)
     , _shapeShader :: GLuint

src/Dodge/Render.hs

@@ -251,7 +251,7 @@ doDrawing' win pdata u = do
     when (_gr_cloud_shadows cfig) $ do
         ----render transparency depths
         --        glDepthMask GL_TRUE
---        glDepthMask GL_TRUE
+        glDepthMask GL_TRUE
         glDepthFunc GL_ALWAYS
         withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
             glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 3
@@ -305,7 +305,7 @@ doDrawing' win pdata u = do
         glClearNamedFramebufferfv (pdata ^. fboWindow . _1 . unFBO) GL_COLOR 0
     withArray [0, 0, 0, 0] $
         glClearNamedFramebufferfv (pdata ^. fboWindow . _1 . unFBO) GL_COLOR 1
---    glEnable GL_CULL_FACE
+    glEnable GL_CULL_FACE
     glEnable GL_DEPTH_CLAMP
     glDepthFunc GL_LEQUAL
     glDepthMask GL_FALSE
@@ -335,19 +335,26 @@ doDrawing' win pdata u = do
     glDrawArrays GL_TRIANGLES 0 3
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     -- bind base buffer for drawing clouds and bloom
-    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
+    --glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
+    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboFullscreen . _1 . unFBO)
+    setViewport (const FullRes) cfig
     glUseProgram (pdata ^. fullscreenShader)
+    glBindTextureUnit 0 (pdata ^. fboBase . _2 . _1 . unTO)
+    glDisable GL_BLEND
+    glDrawArrays GL_TRIANGLES 0 3
+    glEnable GL_BLEND
     glBindTextureUnit 0 (pdata ^. fboWindow . _2 . _2 . unTO)
     glBlendFunc GL_DST_COLOR GL_ONE_MINUS_SRC_ALPHA
     --glDrawArrays GL_TRIANGLES 0 6
     glDrawArrays GL_TRIANGLES 0 3
     glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
+    glUseProgram (pdata ^. upscaleCloudShader)
+    glUniform2f 0 (windowXFloat cfig) (windowYFloat cfig)
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-    --glDrawArrays GL_TRIANGLES 0 6
     glDrawArrays GL_TRIANGLES 0 3
+    glUseProgram (pdata ^. fullscreenShader)
     glBindTextureUnit 0 (pdata ^. fboWindow . _2 . _1 . unTO)
     glBlendFunc GL_DST_COLOR GL_ONE_MINUS_SRC_ALPHA
-    --glDrawArrays GL_TRIANGLES 0 6
     glDrawArrays GL_TRIANGLES 0 3
 
     --Draw blurred bloom onto base buffer
@@ -367,7 +374,8 @@ doDrawing' win pdata u = do
     -- perform distortions
     case getDistortions cfig w of
         [] -> do
-            glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
+--            glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
+            glBindTextureUnit 0 $ pdata ^. fboFullscreen . _2 . unTO
             glBindFramebuffer GL_FRAMEBUFFER 0
             if (cfig ^. gr_upscale_filter) then do
                 glUseProgram (pdata ^. textureAntiaShader)
@@ -382,7 +390,8 @@ doDrawing' win pdata u = do
             withArray (concatMap rdToVec2s rs) $ 
                 glNamedBufferSubData (pdata ^. barrelShader . _2 . vboName) 0 
                     (24 * fromIntegral (length rs * sizeOf (0 :: Float)))
-            glBindTextureUnit 1 $ pdata ^. fboBase . _2 . _1 . unTO
+--            glBindTextureUnit 1 $ pdata ^. fboBase . _2 . _1 . unTO
+            glBindTextureUnit 1 $ pdata ^. fboFullscreen . _2 . unTO
             glUseProgram (pdata ^. barrelShader . _1)
             glUniform1i 0 (fromIntegral (length rs))
             --glDrawArrays GL_TRIANGLES 0 6

src/Dodge/Wall/Damage.hs

@@ -7,6 +7,7 @@ module Dodge.Wall.Damage (
     damageWall,
 ) where
 
+import Control.Monad
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
@@ -48,6 +49,7 @@ damageBlock = \case
 
 damageGlassBlock :: Int -> Int -> World -> (S.Set Int2, World)
 damageGlassBlock x i w = fromMaybe (mempty,w) $ do
+    guard $ x > 0
     bl <- w ^? cWorld . lWorld . blocks . ix i
     return $ case bl ^. blHP - x of
         y | y > 0 -> (mempty, w

src/Preload/Render.hs

@@ -134,6 +134,7 @@ preloadRender = do
     alphadivideshader <- makeSourcedShader "texture2D/alphaDivide" [vert, frag]
     fsShad <- makeSourcedShader "texture/simple" [vert, frag]
     textureantiashad <- makeSourcedShader "texture/antia" [vert,frag]
+    upscalecloud <- makeSourcedShader "upscale/cloud" [vert, frag]
     bloomBlurShad <- makeSourcedShader "texture/bloomBlur" [vert, frag]
     lightingTextureShad <- makeSourcedShader "lighting/texture" [vert, frag]
     lightingCloudShad <- makeSourcedShader "lighting/cloud" [vert, frag]
@@ -201,6 +202,7 @@ preloadRender = do
             , _pullWallShader = wallpull
             , _textureAntiaShader = textureantiashad
             , _fullscreenShader = fsShad
+            , _upscaleCloudShader = upscalecloud
             , _alphaDivideShader = alphadivideshader
             , _lightingTextureShader = lightingTextureShad
             , _lightingCloudShader = lightingCloudShad