diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index 969c86392..6efa7b1c4 100644 --- a/src/Dodge/Config/Data.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs index 79ac2db7b..b96f1d947 100644 --- a/src/Dodge/Item/Weapon/Laser.hs +++ b/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.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (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) ] -- $ pictures --[ fadeLine pos (head ps) 0.2 40 yellow diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 692ea14c2..f7c7e9a49 100644 --- a/src/Dodge/Menu.hs +++ b/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 diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 0563e2331..d7b907434 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 2524af08a..5914ebe6a 100644 --- a/src/Dodge/Render.hs +++ b/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) - $ - --youSil w ++ - creatureSilhouettes 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 - depthMask $= Enabled - blend $= Disabled - drawBuffers $= [NoBuffers,FBOColorAttachment 1] - renderLayer 2 shadV layerCounts - renderWindows pdata windowPoints - -- --downscale transparency depths - -- bindFramebuffer Framebuffer $= fst (_fboHalf3 pdata) - -- bindTO (snd $ snd $ _fboCloud pdata) - -- depthFunc $= Just Always - -- drawShader (_fullscreenShader pdata) 4 - ----draw lightmap for cloud buffer - depthMask $= Disabled - blend $= Enabled - bindFramebuffer Framebuffer $= fst (_fboLighting pdata) - createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata) - -- createLightMap pdata lightPoints nWalls nSils nCaps (snd $ _fboHalf3 pdata) - colorMask $= Color4 Enabled Enabled Enabled Enabled - clearColor $= Color4 0 0 0 0 + if (_cloud_shadows $ _config w) + then do + ----render transparency depths + depthMask $= Enabled + blend $= Disabled + drawBuffers $= [NoBuffers,FBOColorAttachment 1] + renderLayer 2 shadV layerCounts + renderWindows pdata windowPoints + ----draw lightmap for cloud buffer + depthMask $= Disabled + blend $= Enabled + bindFramebuffer Framebuffer $= fst (_fboLighting pdata) + createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata) + colorMask $= Color4 Enabled Enabled Enabled Enabled + clearColor $= Color4 0 0 0 0 + else return () --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) - [a,b,c,d,e,f,g] + pokeArray (shadVBOptr $ _barrelShader pdata) [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 () diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 7f39cb2e4..5aaadab12 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/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 time col pos dir maycid w +createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World +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