Add toggle for shadows on clouds

src/Dodge/Config/Data.hs

@@ -8,6 +8,7 @@ module Dodge.Config.Data (
     , volume_sound
     , volume_music
     , wall_textured
+    , cloud_shadows
     , resolution_factor
     , windowX
     , windowY
@@ -23,6 +24,7 @@ data Configuration = Configuration
     , _volume_sound         :: Float
     , _volume_music         :: Float
     , _wall_textured        :: Bool
+    , _cloud_shadows        :: Bool
     , _resolution_factor    :: Int -- ^ Higher values divide screen size, i.e. make the resolution worse
     , _windowX              :: Float
     , _windowY              :: Float
@@ -42,6 +44,7 @@ defaultConfig = Configuration
     , _volume_sound         = 1
     , _volume_music         = 1
     , _wall_textured        = False
+    , _cloud_shadows        = True
     , _resolution_factor    = 1
     , _windowX              = 800
     , _windowY              = 600

src/Dodge/Item/Weapon/Laser.hs

@@ -100,13 +100,12 @@ moveLaser phaseV pos dir w pt
       = case thHit of
           Just (p,E3x1 cr) 
               -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
---                  . over worldEvents ((.) $ flareAt yellow (flarePos p))
           Just (p,E3x2 wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p))
-                                                      (reflectDir wl) Nothing
+                                                      (reflectDir wl)
           _   -> id
     pic = setLayer 1 $ pictures
-        [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps)
+        [ setDepth 19   . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps)
-        , setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps)
+        , setDepth 19.5 . color (brightX 10 1 yellow)  $ lineOfThickness 3  (pos:ps)
         ]
         -- $ pictures 
         --[ fadeLine pos (head ps) 0.2 40 yellow

src/Dodge/Menu.hs

@@ -32,7 +32,6 @@ data MenuOption
         { _moKey    :: Scancode
         , _moEff    :: World -> Maybe World
         }
-
 optionsOptions :: [MenuOption]
 optionsOptions =
     [ Toggle ScancodeV (pushMenu SoundOptionMenu) (const "VOLUME")
@@ -73,11 +72,13 @@ graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
     [ Toggle ScancodeW (Just . (config . wall_textured %~ not))  wtextstring
     , Toggle ScancodeS upf resostring
+    , Toggle ScancodeD (Just . (config . cloud_shadows %~ not)) cshadstring
     ]
   where
     wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w)
     resostring w  = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w)
     upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution
+    cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w)
 
 cycleResolution :: (Eq a, Num a, Num p) => a -> p
 cycleResolution 1 = 2

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -26,7 +26,7 @@ import Control.Monad.State
 bulHitCr :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr bt p cr w 
     | crIsArmouredFrom p cr
-        = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w
+        = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w
     | otherwise = addDamage . makeHitSound . flashEff $ w
   where
     sp = head $ _btTrail' bt
@@ -135,7 +135,7 @@ bulConCr' bt p cr w
 {- | Hitting wall effects: create a spark, damage blocks.  -}
 bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
 bulHitWall' bt p x w = damageBlocksBy 5 x
-    $ createSparkCol 8 theCol pOut (reflectDir x) Nothing
+    $ createSparkCol 8 theCol pOut (reflectDir x)
     $ set randGen g
     w
   where 
@@ -202,7 +202,7 @@ hvBulHitWall' bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spar
     cs      = map (brightX 100 1.5 . numColor) cs'
     ds      = randomRs (-0.7,0.7) $ _randGen w
     ts      = randomRs (4,8) $ _randGen w
-    sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d) Nothing) ts cs ds
+    sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds
 
 bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
 bulHitFF' _ _ _ = id

src/Dodge/Render.hs

@@ -56,10 +56,8 @@ doDrawing pdata w = do
     -- poke wall points and colors
     nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
     nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
-                $ 
+        $ creatureSilhouettes w
-                --youSil w ++
+        ++ _foregroundEdgeVerx w
-                creatureSilhouettes w ++
-                _foregroundEdgeVerx w
     -- poke foreground geometry for caps
     nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
         $ concatMap polyToGeoRender (foregroundPics w)
@@ -132,30 +130,29 @@ doDrawing pdata w = do
     depthMask $= Disabled
     clearColor $= Color4 0.5 0.5 0.5 0
     --blendFunc $= (SrcAlphaSaturate,One)
-    blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha))
+    --blendColor $= Color4 0.5 0.5 0.5 0.5
+    blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
+    --blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha))
     drawBuffers $= [FBOColorAttachment 0,NoBuffers]
     clear [ColorBuffer]
     renderLayer 2 shadV layerCounts
     renderWindows pdata windowPoints
-    ----render transparency depths
+    if (_cloud_shadows $ _config w)
-    depthMask $= Enabled
+        then do
-    blend $= Disabled
+            ----render transparency depths
-    drawBuffers $= [NoBuffers,FBOColorAttachment 1]
+            depthMask $= Enabled
-    renderLayer 2 shadV layerCounts
+            blend $= Disabled
-    renderWindows pdata windowPoints
+            drawBuffers $= [NoBuffers,FBOColorAttachment 1]
-   -- --downscale transparency depths
+            renderLayer 2 shadV layerCounts
-   -- bindFramebuffer Framebuffer $= fst (_fboHalf3 pdata)
+            renderWindows pdata windowPoints
-   -- bindTO (snd $ snd $ _fboCloud pdata)
+            ----draw lightmap for cloud buffer
-   -- depthFunc $= Just Always
+            depthMask $= Disabled
-   -- drawShader (_fullscreenShader pdata) 4
+            blend $= Enabled
-    ----draw lightmap for cloud buffer
+            bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-    depthMask $= Disabled
+            createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata)
-    blend $= Enabled
+            colorMask $= Color4 Enabled Enabled Enabled Enabled
-    bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
+            clearColor $= Color4 0 0 0 0
-    createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata)
+        else return ()
-   -- createLightMap pdata lightPoints nWalls nSils nCaps (snd $ _fboHalf3 pdata)
-    colorMask $= Color4 Enabled Enabled Enabled Enabled
-    clearColor $= Color4 0 0 0 0
     --apply lightmap to cloud buffer
     clearColor $= Color4 0 0 0 0
     bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
@@ -192,12 +189,11 @@ doDrawing pdata w = do
         rds -> do
             let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO ()
                 bindDrawDist ( V2 a b , V2 c d , V2 e f , g) = do
-                    pokeArray (shadVBOptr $ _barrelShader pdata)
+                    pokeArray (shadVBOptr $ _barrelShader pdata) [a,b,c,d,e,f,g]
-                        [a,b,c,d,e,f,g]
                     bindShaderBuffers [_barrelShader pdata] [1]
                     drawShader (_barrelShader pdata) 1
                 fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata,fst $ _fbo3 pdata]))
-                        ++ [defaultFramebufferObject]
+                    ++ [defaultFramebufferObject]
                 toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata,snd $ _fbo3 pdata])
                 bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
             activeTexture $= TextureUnit 1
@@ -209,13 +205,10 @@ doDrawing pdata w = do
     depthMask $= Disabled
     blend $= Enabled
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
-
     renderFoldable shadV $ fixedCoordPictures w
     depthMask $= Enabled
-
     eTicks <- SDL.ticks
     return (eTicks - sTicks)
-
 --------------------------------------------------------------------------------
 -- note: currently assume there is only one UBO, we only bind it once at setup
 bufferUBO :: [Float] -> IO ()

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -34,7 +34,6 @@ import Data.Function (on)
 import Data.List
 import Data.Maybe
 import Data.Tuple
-
 aFlameParticle 
     :: Int      -- ^ Timer
     -> Point2   -- ^ Position
@@ -330,7 +329,7 @@ moveTeslaArc
 moveTeslaArc p d w pt
     | t == 2 = 
         (foldr damCrs w hitCrs & randGen .~ g
-            & createSparkCol 8 nc q2 (argV sv + d1) Nothing
+            & createSparkCol 8 nc q2 (argV sv + d1)
         , Just $ pt 
             & ptTimer -~ 1
             & ptPoints .~ ps'
@@ -453,8 +452,8 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
 -- | Create a spark. 
 -- If the spark is created by another Particle, it cannot be directly added to
 -- the list, hence the redirect through worldEvents.
-createSparkCol :: Int -> Color -> Point2 -> Float -> Maybe Int -> World -> World
+createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World
-createSparkCol time col pos dir maycid w 
+createSparkCol time col pos dir w 
     = w & worldEvents %~ ( over particles (spark :) . )
   where 
     spark = BulletPt
@@ -463,7 +462,7 @@ createSparkCol time col pos dir maycid w
         , _btVel' = rotateV dir (V2 5 0)
         , _btColor' = col
         , _btTrail' = [pos]
-        , _btPassThrough' = maycid
+        , _btPassThrough' = Nothing
         , _btWidth' = 1
         , _btTimer' = time
         , _btHitEffect' = destroyOnImpact sparkEff noEff noEff