From 48e6779503088f004b0943a7cda83641df6278fe Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 24 Mar 2021 03:02:39 +0100 Subject: [PATCH] Gunsmoke as clouds --- src/Dodge/Data.hs | 17 ++++---- src/Dodge/Item/Weapon.hs | 63 ---------------------------- src/Dodge/Item/Weapon/TriggerType.hs | 18 ++++++++ src/Dodge/WorldEvent/Cloud.hs | 27 ++++++++++++ 4 files changed, 53 insertions(+), 72 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ad36ecbde..fa59e5374 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -81,7 +81,7 @@ data World = World , _tempLightSources :: ![TempLightSource] , _closeActiveObjects :: [Either FloorItem Button] , _remap :: Keycode -> Keycode - } --deriving (Show) + } data Corpse = Corpse { _cpPos :: Point2 @@ -468,14 +468,13 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> -> (World,Maybe Particle') -data Projectile = - Projectile { _ptPos :: Point2 - , _ptStartPos :: Point2 - , _ptVel :: Point2 - , _ptPict :: Picture - , _ptID :: Int - , _ptUpdate :: World -> World - } +data Projectile = Projectile { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + } data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } | Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 8449521fc..fa020505c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1131,69 +1131,6 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cid w reloadCondition = _wpLoadedAmmo item == 0 -withThinSmoke :: (Int -> World -> World) -> Int -> World -> World -withThinSmoke eff cid w = eff cid $ foldr ($) w smokeGen - where - cr = _creatures w IM.! cid - dir = _crDir cr - pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir) - (vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w - (sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w - ts = randomRs (250,1000) $ _randGen w - ss = take 3 $ randomRs (10,20) $ _randGen w - smokeGen = zipWith4 (\ v s t sp -> makeThinSmokeAt (greyN 0.1) v s t (pos +.+ sp)) - vs ss ts sps - -withThickSmoke :: (Int -> World -> World) -> Int -> World -> World -withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen - where - cr = _creatures w IM.! cid - dir = _crDir cr - pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir) - (vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w - (sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w - ts = randomRs (18,20) $ _randGen w - ss = take 20 $ randomRs (0.1,1) $ _randGen w - smokeGen = zipWith4 (\ v s t sp -> makeColorSmokeAt (greyN 0.1) v s t (pos +.+ sp)) - vs ss ts sps - - -makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World -makeThinSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w - where n = newProjectileKey w - smP = Projectile - { _ptPos = p - , _ptStartPos = p - , _ptVel = vel - , _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 1 - , _ptID = n - , _ptUpdate = moveThinSmoke col scal time n - } - -moveThinSmoke :: Color -> Float -> Int -> Int -> World -> World -moveThinSmoke col scal time i w - | time > 0 - = set (projectiles . ix i . ptPict) pic - . set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) - . set (projectiles . ix i . ptPos) newPos - . setVel - $ w - | time > -10 - = set (projectiles . ix i . ptPict) pi1 - . set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) - . set (projectiles . ix i . ptPos) newPos - . setVel - $ w - | otherwise - = over projectiles (IM.delete i) w - where oldPos = _ptPos $ _projectiles w IM.! i - newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i) - setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99 - pic = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha 0.1 col) $ circleSolid scal - pi1 = onLayer PtLayer $ uncurry translate newPos - $ color (withAlpha (0.1 + fromIntegral time /100) col) - $ circleSolid $ scal - makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle' makeLaserAt phaseV pos dir mcid = Particle' { _ptPict' = blank diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index ec9199383..1919d43ed 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -4,6 +4,7 @@ import Dodge.Data import Dodge.SoundLogic import Dodge.CreatureAction (reloadWeapon) import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt) +import Dodge.WorldEvent.Cloud import Dodge.RandomHelp import Dodge.Item.Weapon.Bullet @@ -18,6 +19,23 @@ import Control.Monad.State import Data.Maybe import qualified Data.IntMap.Strict as IM +withThinSmoke :: (Int -> World -> World) -> Int -> World -> World +withThinSmoke eff cid w = eff cid . foldr makeThinSmokeAt w $ map (+.+ pos) ps + where + cr = _creatures w IM.! cid + dir = _crDir cr + pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir) + ps = (sequence . replicate 5 . randInCirc) 8 & evalState $ _randGen w + +withThickSmoke :: (Int -> World -> World) -> Int -> World -> World +withThickSmoke eff cid w = eff cid . foldr makeThickSmokeAt w $ map (+.+ pos) ps + where + cr = _creatures w IM.! cid + dir = _crDir cr + pos = _crPos cr +.+ ((_crRad cr +15) *.* unitVectorAtAngle dir) + ps = (sequence . replicate 20 . randInCirc) 8 & evalState $ _randGen w + + withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World withWarmUp t f cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index aa2b2001f..1beb1953b 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -11,6 +11,33 @@ import Picture import Control.Lens import qualified Data.IntMap as IM +makeCloudAt :: Float -> Int -> (Cloud -> Picture) -> Point2 -> World -> World +makeCloudAt rad t drawFunc p w + = w & clouds %~ IM.insert i theCloud + where i = newKey $ _clouds w + theCloud = Cloud { _clID = i + , _clPos = p + , _clVel = (0,0) + , _clPict = drawFunc + , _clRad = rad + , _clTimer = t + , _clEffect = const id + } + +fadeOutTime :: Color -> Float -> Cloud -> Picture +fadeOutTime col fadet cl = setLayer 2 + . setDepth (-0.5) + . color (withAlpha a col) + $ circleSolid (4 * _clRad cl) + where a = min 1 $ fromIntegral (_clTimer cl) / fadet + + +makeThickSmokeAt :: Point2 -> World -> World +makeThickSmokeAt = makeCloudAt 2 50 (fadeOutTime black 50) + +makeThinSmokeAt :: Point2 -> World -> World +makeThinSmokeAt = makeSmokeCloud + makeSmokeCloud :: Point2 -> World -> World makeSmokeCloud pos w = w & clouds %~ IM.insert i theCloud where i = newKey $ _clouds w