From e98ecfffb345cee2ca6369f8d27ab0be93298f84 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 25 Mar 2022 14:04:42 +0000 Subject: [PATCH] Add file --- src/Dodge/Particle/Damage.hs | 68 +++++++++++++++++++ src/Dodge/Particle/HitEffect.hs | 24 +++++++ .../Particle/HitEffect/ExpireAndDamage.hs | 27 ++++++++ src/Dodge/Particle/HitEffect/Penetrate.hs | 23 +++++++ src/Dodge/Particle/Update.hs | 26 +++++++ 5 files changed, 168 insertions(+) create mode 100644 src/Dodge/Particle/Damage.hs create mode 100644 src/Dodge/Particle/HitEffect.hs create mode 100644 src/Dodge/Particle/HitEffect/ExpireAndDamage.hs create mode 100644 src/Dodge/Particle/HitEffect/Penetrate.hs create mode 100644 src/Dodge/Particle/Update.hs diff --git a/src/Dodge/Particle/Damage.hs b/src/Dodge/Particle/Damage.hs new file mode 100644 index 000000000..8ddf62c63 --- /dev/null +++ b/src/Dodge/Particle/Damage.hs @@ -0,0 +1,68 @@ +module Dodge.Particle.Damage where +import Dodge.Data +import Geometry +--import LensHelp + +import System.Random +import Control.Monad.State + +spawnAtBulDams :: (Point2 -> State StdGen Particle) + -> Particle -> Point2 -> [Damage] +spawnAtBulDams thespawn bt p = + [ Damage Piercing 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm)) + , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + ] + where + sp = head $ _ptTrail 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 = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel + +basicBulDams :: Particle -> Point2 -> [Damage] +basicBulDams bt p = + [ Damage Piercing 100 sp p ep NoDamageEffect + , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + ] + where + sp = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel + +basicSparkDams :: Particle -> Point2 -> [Damage] +basicSparkDams bt p = + [ Damage SparkDam 1 sp p ep NoDamageEffect + ] + where + sp = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel + +hvBulDams :: Particle -> Point2 -> [Damage] +hvBulDams bt p = + [ Damage Piercing 100 sp p ep NoDamageEffect + , Damage Blunt 50 sp p ep NoDamageEffect + , Damage TorqueDam 1 sp p ep $ TorqueDamage 0.7 + , Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp) + ] + where + sp = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel + +bounceBulDams :: Particle -> Point2 -> [Damage] +bounceBulDams bt p = + [ Damage Piercing 80 sp p ep (BounceBullet bt) + , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + ] + where + sp = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel diff --git a/src/Dodge/Particle/HitEffect.hs b/src/Dodge/Particle/HitEffect.hs new file mode 100644 index 000000000..8c600e02d --- /dev/null +++ b/src/Dodge/Particle/HitEffect.hs @@ -0,0 +1,24 @@ +module Dodge.Particle.HitEffect + ( penWalls + ) where +import Dodge.Data +import Dodge.Particle.Update +import Geometry + +import Data.Bifunctor +type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World +type HitWallEffect = Particle -> Point2 -> Wall -> World -> World + +penWalls + :: HitCreatureEffect + -> HitWallEffect + -> Particle + -> [(Point2, Either Creature Wall)] + -> World + -> (World, Maybe Particle) +penWalls crEff wlEff pt hitThings w = case hitThings of + [] -> ( w, mvPt pt) + ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) + ((p,Right wl):hs) | _wlFireThrough wl + -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w + ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) diff --git a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs new file mode 100644 index 000000000..0c4d2d547 --- /dev/null +++ b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs @@ -0,0 +1,27 @@ +module Dodge.Particle.HitEffect.ExpireAndDamage where +import Dodge.Data +import Dodge.Particle.Update +import Dodge.Wall.Damage +import Geometry +import LensHelp + +expireAndDamage :: (Particle -> Point2 -> [Damage]) + -> Particle + -> [(Point2, Either Creature Wall)] + -> World + -> (World, Maybe Particle) +expireAndDamage fdm bt hitThings w = case hitThings of + [] -> (w, mvPt bt) + (x:_) -> (doDamages fdm x bt w, destroyAt (fst x) bt) + +doDamages :: (Particle -> Point2 -> [Damage]) + -> (Point2, Either Creature Wall) + -> Particle + -> World + -> World +doDamages fdm (p,thhit) bt = case thhit of + Left cr -> creatures . ix (_crID cr) . crState . crDamage .++~ dams + Right wl -> flip (foldr (`damageWall` wl)) dams + where + dams = fdm bt p + diff --git a/src/Dodge/Particle/HitEffect/Penetrate.hs b/src/Dodge/Particle/HitEffect/Penetrate.hs new file mode 100644 index 000000000..d5d94c50c --- /dev/null +++ b/src/Dodge/Particle/HitEffect/Penetrate.hs @@ -0,0 +1,23 @@ +module Dodge.Particle.HitEffect.Penetrate where +import Dodge.Data +import Dodge.Particle.Update +import Dodge.Particle.HitEffect.ExpireAndDamage +import Geometry +--import LensHelp + +import Data.Bifunctor + +penetrate + :: ((Point2,Either Creature Wall) -> Particle -> Maybe Particle) + -- | penetration test, can update particle if it penetrates + -> (Particle -> Point2 -> [Damage]) -- | damages when penetrating + -> (Particle -> Point2 -> [Damage]) -- | damages when not penetrating + -> Particle + -> [(Point2, Either Creature Wall)] + -> World + -> (World, Maybe Particle) +penetrate t pendam stopdam pt hitThings w = case hitThings of + [] -> (w, mvPt pt) + (x:xs) -> case t x pt of + Nothing -> expireAndDamage stopdam pt hitThings w + Just pt' -> first (doDamages pendam x pt) $ penetrate t pendam stopdam pt' xs w diff --git a/src/Dodge/Particle/Update.hs b/src/Dodge/Particle/Update.hs new file mode 100644 index 000000000..b7b89c128 --- /dev/null +++ b/src/Dodge/Particle/Update.hs @@ -0,0 +1,26 @@ +module Dodge.Particle.Update where +import Dodge.Data +import LensHelp +import Geometry + +mvPt :: Particle -> Maybe Particle +mvPt pt = Just $ pt + & ptTrail %~ f + & ptTimer -~ 1 + & ptCrIgnore .~ Nothing + where + f trl = head trl +.+ _ptVel pt : trl + +destroyAt :: Point2 -> Particle -> Maybe Particle +destroyAt hitp pt = Just $ pt + & ptUpdate .~ killBulletUpdate + & ptTrail .:~ hitp + & ptTimer %~ (min 3 . subtract 1) + +killBulletUpdate :: World -> Particle -> (World,Maybe Particle) +killBulletUpdate w pt + | _ptTimer pt <= 0 = (w,Nothing) + | otherwise = (w + , Just $ pt & ptTimer -~ 1 + & ptTrail %~ (\(x:xs) -> x:x:xs) + )