diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 923e9378e..7bdf5912a 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -181,7 +181,7 @@ data TempLightSource = TLS { _tlsPos :: !Point3 , _tlsRad :: !Float , _tlsIntensity :: !Point3 - , _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource) + , _tlsUpdate :: World -> TempLightSource -> Maybe TempLightSource , _tlsTime :: !Int } data Creature = Creature diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index e86e20b94..5fa4b3920 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -247,7 +247,7 @@ defaultTLS = TLS , _tlsTime = 1 } where - f w t + f _ t | _tlsTime t <= 0 - = (w, Nothing) - | otherwise = (w, Just $ t & tlsTime -~ 1) + = Nothing + | otherwise = Just $ t & tlsTime -~ 1 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 342d1f047..e9d2d4069 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -98,7 +98,7 @@ youLight = ,_tlsRad = 300 ,_tlsIntensity = 0.1 --,_tlsUpdate = \w _ -> (w, Nothing) - ,_tlsUpdate = \w _ -> (w, Just (youLight {_tlsPos = f $ _crPos (you w)})) + ,_tlsUpdate = \w _ -> Just (youLight {_tlsPos = f $ _crPos (you w)}) ,_tlsTime = 0 } where diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index e9274c4f6..5d10dd807 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -328,7 +328,7 @@ ltAutoGun = defaultAutoGun , withRandomDirI 0.1 , torqueAfterI 0.2 , withSidePushI 50 - , withMuzFlareI + , modClock 2 withMuzFlareI ] , _wpSpread = 0.5 , _wpRange = 20 @@ -388,6 +388,7 @@ miniGun = defaultAutoGun , withRandomOffsetI 9 , withMuzFlareI , withOldDir od3 + , withSmoke 1 black 20 200 5 ] , _wpRange = 20 , _itFloorPict = onLayer FlItLayer miniGunPict @@ -948,7 +949,7 @@ moveRemoteShell cid itid pj w hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl r1 = _randGen w & evalState (randInCirc 10) - smokeGen = makeSmokeCloudAt $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos) + smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos) doExplosion = explodeRemoteRocket itid i explodeRemoteRocket diff --git a/src/Dodge/Item/Weapon/AutoGun.hs b/src/Dodge/Item/Weapon/AutoGun.hs index 6a0f24c5c..dd7b87574 100644 --- a/src/Dodge/Item/Weapon/AutoGun.hs +++ b/src/Dodge/Item/Weapon/AutoGun.hs @@ -44,6 +44,7 @@ autoGun = defaultAutoGun , useAmmo 1 , withRandomDirI (autogunSpread/2) , withMuzFlareI + , withSmoke 1 black 20 200 5 ] , _wpSpread = autogunSpread , _wpRange = 20 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index bc5fdbb5d..b2c0bc3c9 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -119,7 +119,7 @@ doThrust pj w = w (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.2,0.2) $ _randGen w r1 = randInCirc 10 & evalState $ _randGen w - smokeGen = makeSmokeCloudAt $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) + smokeGen = shellTrailCloud $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) flameLauncher :: Item flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index c59434653..69e337ddf 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -15,6 +15,7 @@ module Dodge.Item.Weapon.TriggerType , withSoundStart , withSoundContinue , withSoundForI + , withSmoke , withThickSmokeI , withThinSmokeI , withRandomOffsetI @@ -33,14 +34,15 @@ module Dodge.Item.Weapon.TriggerType , useTimeCheckI , ammoCheckI , randSpreadDir + , modClock ) where import Dodge.Data import Dodge.Data.SoundOrigin import Dodge.SoundLogic import Dodge.Creature.Action (startReloadingWeapon) -import Dodge.WorldEvent (tempLightForAt) -import Dodge.WorldEvent.Cloud +import Dodge.WorldEvent +--import Dodge.WorldEvent.Cloud import Dodge.RandomHelp import Dodge.Item.Attachment.Data import Dodge.Item.Data @@ -69,6 +71,15 @@ trigDoAlso -> ChainEffect trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr +withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect +withSmoke num col rad t alt eff item cr w + = eff item cr + $ foldl' (flip $ smokeCloudAt col rad t alt . (+.+.+ pos) . (*8)) w ps + where + dir = _crDir cr + pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir + ps = replicateM num randOnUnitSphere & evalState $ _randGen w + withThinSmokeI :: ChainEffect withThinSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps where @@ -295,8 +306,14 @@ withTempLight time rad col eff item cr = eff item cr } V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) +modClock :: Int -> ChainEffect -> ChainEffect +modClock n chainEff eff it cr w + | _frameClock w `mod` n == 0 = (chainEff eff) it cr w + | otherwise = eff it cr w + withMuzFlareI :: ChainEffect -withMuzFlareI f it cr w = tempLightForAt 3 pos2 -- . muzzleFlashAt pos2 +withMuzFlareI f it cr w = + makeTLight 3 100 (V3 1 1 0.5) pos2 -- . muzzleFlashAt pos2 $ f it cr w where --pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs index 47a2589c9..c2788ee4d 100644 --- a/src/Dodge/LightSources.hs +++ b/src/Dodge/LightSources.hs @@ -1,12 +1,15 @@ -module Dodge.LightSources where +module Dodge.LightSources + ( tLightTimedIntensity + , tLight + , lightAt + , colorLightAt + ) + where import Dodge.Data ---import Dodge.Base ---import Dodge.Picture.Layer ---import Dodge.LevelGen.Data ---import Geometry ---import Picture import Geometry.Data +import Control.Lens + colorLightAt :: Point3 -> Point3 -> Int -> LightSource colorLightAt col pos i = LS {_lsID = i @@ -19,46 +22,38 @@ colorLightAt col pos i = lightAt :: Point3 -> Int -> LightSource lightAt = colorLightAt 0.75 -tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource -tLightFade 0 rmax intensityF (V2 x y) = TLS +tLightTimedIntensity :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource +tLightTimedIntensity t rmax intensityF (V2 x y) = TLS { _tlsPos = V3 x y 0 , _tlsRad = rmax - , _tlsIntensity = f $ intensityF 0 - , _tlsUpdate = \w _ -> (w, Nothing) - , _tlsTime = 0 - } - where - f x' = V3 x' x' x' -tLightFade i rmax intensityF p@(V2 x y) = TLS - { _tlsPos = V3 x y 0 - , _tlsRad = rmax - , _tlsIntensity = f $ intensityF i - , _tlsUpdate = \w _ -> (w, Just $ tLightFade (i-1) rmax intensityF p) - , _tlsTime = 0 + , _tlsIntensity = f $ intensityF t + , _tlsUpdate = upF + , _tlsTime = t } where + upF _ tls + | _tlsTime tls <= 0 = Nothing + | otherwise = Just $ tls + & tlsTime -~ 1 + & tlsIntensity .~ f (intensityF (_tlsTime tls) ) f x' = V3 x' x' x' -tLightRad +tLight :: Int -> Float -- ^ maximal radius - -> Float -- ^ minimal radius (unused) + -> Point3 -> Point2 -> TempLightSource -tLightRad 0 rmax _ (V2 x y) = TLS +tLight t rmax col (V2 x y) = TLS { _tlsPos = V3 x y 1 , _tlsRad = rmax - , _tlsIntensity = 0.5 - , _tlsUpdate = \w _ -> (w, Nothing) - , _tlsTime = 0 - } -tLightRad i rmax rmin p@(V2 x y) = TLS - { _tlsPos = V3 x y 0 - , _tlsRad = rmax - , _tlsIntensity = V3 0.5 0.5 0 - , _tlsUpdate = \w _ -> (w, Just $ tLightRad (i-1) rmax rmin p) - , _tlsTime = 0 + , _tlsIntensity = col + , _tlsUpdate = upF + , _tlsTime = t } + where + upF _ tls + | _tlsTime tls <= 0 = Nothing + | otherwise = Just $ tls + & tlsTime -~ 1 -tLightAt :: Int -> Point2 -> TempLightSource -tLightAt i = tLightRad i 100 0 diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index e17859f7c..7d4e367e7 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -17,6 +17,7 @@ import Dodge.WorldEvent.Shockwave import Dodge.Creature.State.Data import Dodge.Creature.Property import Geometry +import Geometry.Vector3D import Picture import System.Random @@ -137,11 +138,13 @@ bulConCr' bt p cr w mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) {- | 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) +bulHitWall' bt p wl w = damageBlocksBy 5 wl + . smokeCloudAt dustcol 20 200 1 (addZ 20 pOut) + $ createSparkCol 8 theCol pOut (reflectDir wl) $ set randGen g w where + dustcol = _wlColor wl & _4 .~ 1 theCol = brightX 100 1.5 white sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index edc2ef8e4..b79637ddf 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -131,8 +131,8 @@ doDrawing pdata w = do clearColor $= Color4 0.5 0.5 0.5 0 --blendFunc $= (SrcAlphaSaturate,One) --blendColor $= Color4 0.5 0.5 0.5 0.5 - blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha)) - --blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha)) + --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha)) + blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha)) drawBuffers $= [FBOColorAttachment 0,NoBuffers] clear [ColorBuffer] renderLayer 2 shadV layerCounts diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 22085a1fd..c8def0c5f 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -6,8 +6,6 @@ module Dodge.Render.MenuScreen ) where import Dodge.Data ---import Dodge.Config.Update ---import Dodge.Config.Data import Dodge.Base.Window import Picture import Dodge.Menu diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1c467e939..aaf9a5fa9 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -124,9 +124,9 @@ updateSoundQueue :: World -> World updateSoundQueue = set sounds M.empty updateLightSources :: World -> World -updateLightSources w = set tempLightSources (catMaybes tlss) w' +updateLightSources w = set tempLightSources tlss w where - (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w + tlss = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w updateProjectiles :: World -> World updateProjectiles w = IM.foldl' (flip $ dbArg _pjUpdate) w $ _projectiles w diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 8ac3fc412..b766a6786 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -58,5 +58,5 @@ damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine) = over crHP (\hp -> hp - dam) cr | otherwise = cr -tempLightForAt :: Int -> Point2 -> World -> World -tempLightForAt i p w = w & tempLightSources %~ (tLightAt i p :) +makeTLight :: Int -> Float -> Point3 -> Point2 -> World -> World +makeTLight i rad col p = tempLightSources %~ (tLight i rad col p :) diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 4662f54ca..646618cb4 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -10,14 +10,14 @@ import Picture import Control.Lens makeCloudAt - :: Float -- ^ radius + :: (Cloud -> Picture) -- ^ draw function + -> Float -- ^ radius -> Int -- ^ timer -> Float -- ^ resting altitude - -> (Cloud -> Picture) -- ^ draw function -> Point3 -- start position -> World -> World -makeCloudAt rad t alt drawFunc p w = w & clouds %~ (theCloud :) +makeCloudAt drawFunc rad t alt p w = w & clouds %~ (theCloud :) where theCloud = Cloud { _clPos = p @@ -30,6 +30,16 @@ makeCloudAt rad t alt drawFunc p w = w & clouds %~ (theCloud :) , _clEffect = const id } +smokeCloudAt + :: Color + -> Float -- ^ radius + -> Int -- ^ timer + -> Float -- ^ resting altitude + -> Point3 -- start position + -> World + -> World +smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col) + drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture drawCloudWith radMult fadet col cl = setLayer 2 @@ -39,23 +49,23 @@ drawCloudWith radMult fadet col cl a = min 1 $ fromIntegral (_clTimer cl) / fadet makeThickSmokeAt :: Point3 -> World -> World -makeThickSmokeAt = makeCloudAt 3 50 30 (drawCloudWith 4 50 black) +makeThickSmokeAt = makeCloudAt (drawCloudWith 4 50 black) 3 50 30 makeThinSmokeAt :: Point3 -> World -> World -makeThinSmokeAt = makeCloudAt 5 400 50 (drawCloudWith 4 400 (withAlpha 0.05 black)) +makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50 makeStartCloudAt :: Point3 -> World -> World --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5)) -makeStartCloudAt = makeCloudAt 10 400 5 (drawCloudWith 2 800 white) +makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5 -makeSmokeCloudAt :: Point3 -> World -> World ---makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5)) -makeSmokeCloudAt = makeCloudAt 15 400 40 (drawCloudWith (4/3) 800 (greyN 0.5)) +shellTrailCloud :: Point3 -> World -> World +----makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5)) +shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40 makeFlamerSmokeAt :: Float -> Point3 -> World -> World -makeFlamerSmokeAt x = makeCloudAt 6 200 40 (drawCloudWith 4 300 (greyN x)) +makeFlamerSmokeAt x = makeCloudAt (drawCloudWith 4 300 (greyN x)) 6 200 40 spawnSmokeAtCursor :: World -> World -spawnSmokeAtCursor w = makeSmokeCloudAt (V3 x y 20) w +spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w where V2 x y = mouseWorldPos w diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 69cf5be96..00b82f78a 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -85,7 +85,7 @@ flashFlareAt col alphax (V2 x y) = Particle } explosionFlashAt :: Point2 -> World -> World -explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p) +explosionFlashAt p = over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p) where intensityFunc x | x < 10 = 1 / (10 - fromIntegral x)