This commit is contained in:
2022-03-25 12:00:35 +00:00
parent cb9bdf9c55
commit a07647d89d
5 changed files with 44 additions and 46 deletions
+29 -31
View File
@@ -8,31 +8,31 @@ import Geometry
import LensHelp
import Control.Monad.State
import System.Random
--import System.Random
import Data.List
defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (id,cr) ds'
defaultApplyDamage :: [Damage] -> Creature -> World -> World
defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
where
(ps,ds') = partition isPoison ds
(_,ds') = partition isPoison ds
isPoison Damage{_dmType=PoisonDam} = True
isPoison _ = False
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
doPoisonDam = crHP -~ poisonDam
-- poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
-- doPoisonDam = crHP -~ poisonDam
applyDamageEffect :: Damage -> DamageEffect -> (World->World,Creature) -> (World -> World, Creature)
applyDamageEffect dm de (f,cr) = case de of
PushDamage push pushexp pushRad -> (f, cr
& crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) )
applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
applyDamageEffect dm de cr w = case de of
PushDamage push pushexp pushRad -> w
& creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
where
pushAmount
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
PushBackDamage pback -> (f, cr
& crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
)
TorqueDamage rot -> (f, cr & crDir +~ rot)
BounceBullet bt | crIsArmouredFrom p cr -> (f . (instantParticles .:~ bouncer), cr) -- TODO
PushBackDamage pback -> w
& creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
TorqueDamage rot -> w
& creatures . ix (_crID cr) . crDir +~ rot
BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer
where
bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
(_ptHitEff bt) (_ptWidth bt)
@@ -41,32 +41,30 @@ applyDamageEffect dm de (f,cr) = case de of
reflectVel = magV bulVel *.* newDir
newDir = squashNormalizeV (p -.- _crPos cr)
bulVel = _ptVel bt
DamageSpawn f -> (instantParticles .:~ thepart, cr)
BounceBullet _ -> w
DamageSpawn f -> w & instantParticles .:~ thepart
& randGen .~ g
where
thepart = evalState (f (Left cr) dm) $ mkStdGen 0
(thepart,g) = runState (f (Left cr) dm) $ _randGen w
NoDamageEffect -> w
where
fromDir = _dmFrom dm
p = _dmAt dm
applyIndividualDamage :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
applyIndividualDamage (f,cr) dm = applyDamageEffect dm (_dmEffect dm) (f . f', cr')
where
(f',cr') = applyIndividualDamage' (f,cr) dm
applyIndividualDamage :: Creature -> World -> Damage -> World
applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm
-- & applyDamageEffect dm (_dmEffect dm)
applyIndividualDamage' :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
applyIndividualDamage' (f,cr) dm = case _dmType dm of
Piercing -> applyPiercingDamage cr dm & _1 %~ (. f)
_ -> (f , newcr )
where
newcr = cr
& crHP -~ _dmAmount dm
applyIndividualDamage' :: Creature -> World -> Damage -> World
applyIndividualDamage' cr w dm = case _dmType dm of
Piercing -> applyPiercingDamage cr dm w
_ -> w & creatures . ix (_crID cr) . crHP -~ _dmAmount dm
applyPiercingDamage :: Creature -> Damage -> (World -> World, Creature)
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = (colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) , cr)
| otherwise = (id, cr & crHP -~ _dmAmount dm)
| crIsArmouredFrom p cr = colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p))
| otherwise = creatures . ix (_crID cr) . crHP -~ _dmAmount dm
where
p = _dmAt dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)