From 8ee4d2e0f257aecf99a669bf666c09007d141d88 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 19 Jul 2022 14:26:10 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Data.hs | 10 --- src/Dodge/EnergyBall/Draw.hs | 17 ++++- src/Dodge/Particle/Damage.hs | 12 ++-- src/Dodge/Particle/Draw.hs | 10 --- src/Dodge/Spark.hs | 3 +- src/Dodge/WorldEvent/SpawnParticle.hs | 94 +++++++++++++-------------- 6 files changed, 68 insertions(+), 78 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f65df5aee..7d05e86a7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -562,16 +562,6 @@ data Particle , _ptPoints :: [Point2] , _ptColor :: Color } - | PtStaticBall - { _ptUpdate :: World -> Particle -> (World, Maybe Particle) - , _ptVel :: Point2 - , _ptColor :: Color - , _ptPos :: Point2 - , _ptWidth :: Float - , _ptTimer :: Int - , _ptHitEff :: HitEffect - , _ptZ :: Float - } | Shockwave { _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptColor :: Color diff --git a/src/Dodge/EnergyBall/Draw.hs b/src/Dodge/EnergyBall/Draw.hs index 276213741..17196f110 100644 --- a/src/Dodge/EnergyBall/Draw.hs +++ b/src/Dodge/EnergyBall/Draw.hs @@ -5,10 +5,21 @@ import Picture drawEnergyBall :: EnergyBall -> Picture -drawEnergyBall = drawFlameletEB +drawEnergyBall eb = case _ebEff eb of + (ELECTRICAL,_) -> drawStaticBall eb + (FLAMING,_) -> drawFlamelet eb + _ -> error "don't know how to draw an energy ball of this type" -drawFlameletEB :: EnergyBall -> Picture -drawFlameletEB pt = pictures +drawStaticBall + :: EnergyBall + -> Picture +drawStaticBall pt = setLayer BloomNoZWrite + . setDepth (_ebZ pt + 20) + . uncurryV translate (_ebPos pt) + $ circleSolidCol (_ebColor pt) (withAlpha 0.5 white) (_ebWidth pt+5) + +drawFlamelet :: EnergyBall -> Picture +drawFlamelet pt = pictures [ setLayer BloomLayer pic , setLayer BloomNoZWrite piu , setLayer BloomNoZWrite pi2 diff --git a/src/Dodge/Particle/Damage.hs b/src/Dodge/Particle/Damage.hs index 534fd1297..8ac9d56e6 100644 --- a/src/Dodge/Particle/Damage.hs +++ b/src/Dodge/Particle/Damage.hs @@ -2,12 +2,12 @@ module Dodge.Particle.Damage where import Dodge.Data import Geometry -simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage] -simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] - where - sp = _ptPos bt - bulVel = _ptVel bt - ep = sp +.+ bulVel +--simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage] +--simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] +-- where +-- sp = _ptPos bt +-- bulVel = _ptVel bt +-- ep = sp +.+ bulVel simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage] simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] where diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs index 71d4b92a7..18199edd9 100644 --- a/src/Dodge/Particle/Draw.hs +++ b/src/Dodge/Particle/Draw.hs @@ -6,7 +6,6 @@ import Picture drawParticle :: Particle -> Picture drawParticle pt = case pt of Shockwave {} -> drawShockwave pt - PtStaticBall {} -> drawStaticBall pt PtInvShockwave {} -> drawInverseShockwave pt PtTeslaArc {} -> drawTeslaArc pt PtTargetLaser {} -> drawTargetLaser pt @@ -27,15 +26,6 @@ drawShockwave pt = setDepth 20 rad = r - (3/4) * r * tFraction tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt) -drawStaticBall - :: Particle - -> Picture -drawStaticBall pt = setLayer BloomNoZWrite - . setDepth (_ptZ pt + 20) - . uncurryV translate (_ptPos pt) - $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5) - - drawInverseShockwave :: Particle -> Picture drawInverseShockwave pt = setLayer BloomLayer $ setDepth 20 $ uncurryV translate p diff --git a/src/Dodge/Spark.hs b/src/Dodge/Spark.hs index 7fe40dfa4..ec2a5a567 100644 --- a/src/Dodge/Spark.hs +++ b/src/Dodge/Spark.hs @@ -12,6 +12,7 @@ import Geometry import LensHelp import Color +import qualified Data.IntMap.Strict as IM import Control.Monad.State import System.Random @@ -35,7 +36,7 @@ sparkDam -> World sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of (hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp - (hitp,Right wl) -> wallDamages . ix (_wlID wl) .:~ thedam hitp + (hitp,Right wl) -> wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp] where thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 4c45adb00..04ff202f6 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -6,29 +6,27 @@ module Dodge.WorldEvent.SpawnParticle , randParticleAt ) where import Dodge.Data -import Dodge.Zone -import Dodge.Particle.HitEffect.ExpireAndDamage -import Dodge.Particle.Damage -import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Shockwave import RandomHelp import Picture import Geometry -import qualified IntMapHelp as IM import LensHelp -import Data.Foldable -import qualified Streaming.Prelude as S - randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World randParticleAt f p w = w & instantParticles .:~ thepart & randGen .~ g where (thepart,g) = runState (f p) (_randGen w) +randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World +randEnergyBallAt f p w = w + & energyBalls .:~ thepart + & randGen .~ g + where + (thepart,g) = runState (f p) (_randGen w) makeStaticBall :: Point2 -> World -> World -makeStaticBall p = randParticleAt aStaticBall p . (posEvents .:~ thesparker) +makeStaticBall p = randEnergyBallAt aStaticBall p . (posEvents .:~ thesparker) where thesparker = PosEvent SparkSpawner 10 p @@ -44,40 +42,40 @@ concBall p = return Shockwave , _ptTimer = 10 } -aStaticBall :: Point2 -> State g Particle -aStaticBall p = return PtStaticBall - { _ptUpdate = moveFlamelet - , _ptVel = 0 - , _ptColor = blue - , _ptPos = p - , _ptWidth = 3 - , _ptTimer = 20 - , _ptHitEff = expireAndDamage $ simpleDam ELECTRICAL 20 - , _ptZ = 20 +aStaticBall :: Point2 -> State g EnergyBall +aStaticBall p = return EnergyBall + { _ebVel = 0 + , _ebColor = blue + , _ebPos = p + , _ebWidth = 3 + , _ebTimer = 20 + , _ebEff = (ELECTRICAL,1) + , _ebZ = 20 + , _ebRot = 0 } -- | Note damgeInRadius by itself never destroys the particle -damageInRadius :: Float -> Particle -> World -> World -damageInRadius size pt = damageInArea isClose closeWls pt - where - p = _ptPos pt - closeWls wl = uncurry segOnCirc (_wlLine wl) p size - isClose cr = dist p (_crPos cr) < _crRad cr + size +--damageInRadius :: Float -> Particle -> World -> World +--damageInRadius size pt = damageInArea isClose closeWls pt +-- where +-- p = _ptPos pt +-- closeWls wl = uncurry segOnCirc (_wlLine wl) p size +-- isClose cr = dist p (_crPos cr) < _crRad cr + size -damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World -{-# INLINE damageInArea #-} -damageInArea crt wlt pt w = damwls damcrs - where - p = _ptPos pt - damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w - damwls w' = runIdentity - . S.fold_ - (flip $ \wl -> fst . hiteff (S.yield (p,Right wl))) - w' - id - . S.filter wlt - $ wlsNearPoint p w' - hiteff = _ptHitEff pt pt +--damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World +--{-# INLINE damageInArea #-} +--damageInArea crt wlt pt w = damwls damcrs +-- where +-- p = _ptPos pt +-- damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w +-- damwls w' = runIdentity +-- . S.fold_ +-- (flip $ \wl -> fst . hiteff (S.yield (p,Right wl))) +-- w' +-- id +-- . S.filter wlt +-- $ wlsNearPoint p w' +-- hiteff = _ptHitEff pt pt -- | At writing the radius is half the size of the effect area makeGasCloud @@ -107,12 +105,12 @@ makeGasCloud pos vel w = w {- Update of a flamelet. Applies movement and attaches damage to nearby creatures. -} -- This should be unified in many ways with moveFlame -moveFlamelet :: World -> Particle -> (World, Maybe Particle) -moveFlamelet w pt - | _ptTimer pt <= 0 = ( w, Nothing) - | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt') - where - mvPt' = pt - & ptTimer -~ 1 - & ptPos .~ _ptPos pt +.+ _ptVel pt - & ptVel .*.*~ 0.8 +--moveFlamelet :: World -> Particle -> (World, Maybe Particle) +--moveFlamelet w pt +-- | _ptTimer pt <= 0 = ( w, Nothing) +-- | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt') +-- where +-- mvPt' = pt +-- & ptTimer -~ 1 +-- & ptPos .~ _ptPos pt +.+ _ptVel pt +-- & ptVel .*.*~ 0.8