justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start to move damage effects of bullets into a more sensible place

Browse Source
This commit is contained in:
justin
2022-03-25 09:45:11 +00:00
parent 41ad289de2
commit af6cdfd048
7 changed files with 102 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Damage.hs
+30 -12
View File
@@ -1,12 +1,12 @@
module Dodge.Creature.Damage where
import Dodge.Data
import Dodge.SoundLogic
import Dodge.Creature.Property
import Dodge.Particle.Spark
import Dodge.Particle.Bullet.Spawn
import Color
import Geometry
import LensHelp
import Control.Lens
import Data.List
defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
@@ -18,34 +18,52 @@ defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (i
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
doPoisonDam = crHP -~ poisonDam
applyDamageEffect :: Damage -> DamageEffect -> Creature -> Creature
applyDamageEffect dm de cr = case de of
NoDamageEffect -> cr
PushDamage push pushexp pushRad -> cr
& crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)))
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))) )
where
pushAmount
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
PushBackDamage pback -> cr
PushBackDamage pback -> (f, cr
& crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
TorqueDamage rot -> cr & crDir +~ rot
)
TorqueDamage rot -> (f, cr & crDir +~ rot)
BounceBullet bt | crIsArmouredFrom p cr -> (f . (instantParticles .:~ bouncer), cr) -- TODO
where
bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
(_ptHitEff bt) (_ptWidth bt)
) {_ptTimer = _ptTimer bt - 1}
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
newDir = squashNormalizeV (p -.- _crPos cr)
bulVel = _ptVel bt
SparkBullet _ -> (f, cr) -- TODO
_ -> (f,cr)
where
fromDir = _dmFrom dm
p = _dmAt dm
applyIndividualDamage :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
applyIndividualDamage (f,cr) dm = case _dmType dm of
applyIndividualDamage (f,cr) dm = applyDamageEffect dm (_dmEffect dm) (f . f', cr')
where
(f',cr') = applyIndividualDamage' (f,cr) 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
& applyDamageEffect dm (_dmEffect dm)
applyPiercingDamage :: Creature -> Damage -> (World -> World, Creature)
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = (colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) , cr)
| otherwise = (id,cr & crHP -~ _dmAmount dm & applyDamageEffect dm (_dmEffect dm))
| otherwise = (id, cr & crHP -~ _dmAmount dm)
where
p = _dmAt dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
src/Dodge/Creature/State/Data.hs
-9
View File
@@ -4,18 +4,10 @@ module Dodge.Creature.State.Data
where
--import Geometry
import Geometry.Data
import Dodge.Data.DamageType
import Color
import Control.Lens
import qualified Data.IntSet as IS
import qualified Data.Vector as V
data CreatureState = CrSt
{ _crDamage :: [Damage]
, _crPastDamage :: V.Vector [Damage]
, _crSpState :: CrSpState
, _crDropsOnDeath :: CreatureDropType
}
data CreatureDropType
= DropAll
| DropAmount Int
@@ -43,5 +35,4 @@ data CrGroup
| CrGroupID { _crGroupID :: Int }
| ShieldGroup
deriving (Eq, Show)
makeLenses ''CreatureState
makeLenses ''CrSpState
src/Dodge/Data.hs
+42
View File
@@ -44,6 +44,7 @@ import Dodge.GameRoom
import Color
import Shape
import qualified Data.Vector as V
import GHC.Generics
import Control.Lens
import Control.Monad.State
@@ -1002,6 +1003,47 @@ data Goal
newtype Zone a = Zone
{ _znObjects :: IM.IntMap (IM.IntMap a)
}
data DamageEffect
= PushDamage
{ _dePush :: Float
, _dePushExp :: Float
, _dePushRadius :: Float
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Point2 }
| BounceBullet {_bulToBounce :: Particle}
| SparkBullet {_bulToSpark :: Particle}
| NoDamageEffect
-- deriving (Eq,Ord,Show)
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _dmEffect :: DamageEffect
}
-- deriving (Eq,Ord,Show)
isElectrical :: Damage -> Bool
isElectrical dm = case _dmType dm of
Electrical{} -> True
_ -> False
isMovementDam :: Damage -> Bool
isMovementDam dm = case _dmType dm of
TorqueDam{} -> True
PushDam{} -> True
_ -> False
data CreatureState = CrSt
{ _crDamage :: [Damage]
, _crPastDamage :: V.Vector [Damage]
, _crSpState :: CrSpState
, _crDropsOnDeath :: CreatureDropType
}
makeLenses ''CreatureState
makeLenses ''Damage
makeLenses ''DamageEffect
makeLenses ''World
makeLenses ''Cloud
makeLenses ''Creature
src/Dodge/Data/DamageType.hs
+3 -42
View File
@@ -1,17 +1,11 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-
Datatypes describing the type of damage effects that are to be applied to
creatures.
-}
module Dodge.Data.DamageType
where
--import Geometry
import Geometry.Data
import Control.Lens
data DamageType = Piercing
module Dodge.Data.DamageType where
data DamageType
= Piercing
| Blunt
| Cutting
| SparkDam
@@ -24,36 +18,3 @@ data DamageType = Piercing
| PushDam
| PoisonDam
deriving (Eq,Ord,Show)
-- this should possibly be pushed into the damage type
data DamageEffect
= PushDamage
{ _dePush :: Float
, _dePushExp :: Float
, _dePushRadius :: Float
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Point2 }
| NoDamageEffect
-- deriving (Eq,Ord,Show)
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _dmEffect :: DamageEffect
}
-- deriving (Eq,Ord,Show)
isElectrical :: Damage -> Bool
isElectrical dm = case _dmType dm of
Electrical{} -> True
_ -> False
isMovementDam :: Damage -> Bool
isMovementDam dm = case _dmType dm of
TorqueDam{} -> True
PushDam{} -> True
_ -> False
makeLenses ''Damage
makeLenses ''DamageEffect
src/Dodge/Particle/Bullet/DestroyDamage.hs
-1
View File
@@ -4,7 +4,6 @@ module Dodge.Particle.Bullet.DestroyDamage
import Dodge.Data
import Dodge.WorldEvent.HitEffect
import Dodge.Wall.Damage
import Dodge.SoundLogic
import Geometry
import LensHelp
src/Dodge/Particle/Bullet/HitEffect.hs
+12 -34
View File
@@ -31,28 +31,6 @@ crArmourSplit normalf armourf bt p cr
| crIsArmouredFrom p cr = armourf bt p cr
| otherwise = normalf bt p cr
basicHitCr :: Particle -> Point2 -> Creature -> World -> World
basicHitCr bt p cr = addDamage
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage .++~
(Damage Piercing 100 sp p ep NoDamageEffect : mvDams)
cid = _crID cr
-- | Basic bullet hit creature effect.
basicHitArmour :: Particle -> Point2 -> Creature -> World -> World
basicHitArmour bt p cr w = colSpark 8 (_ptColor bt) p1 (argV (p1 -.- p)) $ addDamageArmoured w
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
cid = _crID cr
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
bounceArmour :: Particle -> Point2 -> Creature -> World -> World
bounceArmour bt p cr = addBouncer . addDamageArmoured
@@ -73,12 +51,20 @@ bounceArmour bt p cr = addBouncer . addDamageArmoured
-- | Basic bullet hit creature effect.
bulHitCr :: Particle -> Point2 -> Creature -> World -> World
bulHitCr = basicHitCr
--bulHitCr = crArmourSplit basicHitCr basicHitArmour
bulHitCr bt p cr = addDamage
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage .++~
(Damage Piercing 100 sp p ep NoDamageEffect : mvDams)
cid = _crID cr
{- | Bounce off armoured creatures, otherwise do damage. -}
bulBounceArmCr :: Particle -> Point2 -> Creature -> World -> World
bulBounceArmCr = crArmourSplit basicHitCr bounceArmour
bulBounceArmCr = crArmourSplit bulHitCr bounceArmour
{- | Heavy bullet effects when hitting creature:
piercing, blunt, twisting and pushback damage all applied. -}
hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
@@ -145,18 +131,10 @@ bulHitWall bt p = damageWall (Damage Piercing 100 sp p ep NoDamageEffect)
sp = head $ _ptTrail bt
{- | Bounce off walls, do damage to blocks. -}
bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
bulBounceWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl
. over instantParticles (bouncer :)
bulBounceWall bt p = damageWall (Damage Blunt 50 sp p ep (BounceBullet bt))
where
ep = sp +.+ _ptVel bt
sp = head $ _ptTrail bt
pOut = p +.+ squashNormalizeV (sp -.- p)
bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
) {_ptTimer = _ptTimer bt - 1}
reflectVel = reflVelWall wl (_ptVel bt)
-- the hack is to get around the fact that the particles list gets reset after
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
-- this list
hvBulHitWall
:: Particle
src/Dodge/Wall/DamageEffect.hs
+15 -1
View File
@@ -1,13 +1,15 @@
module Dodge.Wall.DamageEffect where
import Dodge.Data
import Dodge.Particle.Spark
import Dodge.Particle.Bullet.Spawn
import Dodge.Wall.Reflect
import Dodge.Wall.Dust
import Geometry
import Color
import LensHelp
defaultWallDamage :: Damage -> Wall -> World -> World
defaultWallDamage dm wl = case _dmType dm of
defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
Lasering -> colSpark 8 lSparkCol outTo (reflDirWall sp p wl)
Piercing -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl)
. wlDustAt wl outTo
@@ -27,3 +29,15 @@ defaultWallDamage dm wl = case _dmType dm of
outTo = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = brightX 100 1.5 white
lSparkCol = V4 20 (-5) 0 1
wallDamageEffect :: Damage -> Wall -> World -> World
wallDamageEffect dm wl = case _dmEffect dm of
BounceBullet bt -> instantParticles .:~ thebouncer
where
reflectVel = reflVelWall wl (_ptVel bt)
thebouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
) {_ptTimer = _ptTimer bt - 1}
pOut = p +.+ squashNormalizeV (sp -.- p)
p = _dmAt dm
sp = _dmFrom dm
_ -> id