diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 7ea322c49..b52d8d691 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -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) diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 77f25238d..a96c434ff 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f39255568..f09cb8e69 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 8e3906448..8d0624ab6 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/src/Dodge/Data/DamageType.hs @@ -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 diff --git a/src/Dodge/Particle/Bullet/DestroyDamage.hs b/src/Dodge/Particle/Bullet/DestroyDamage.hs index 4aa989a43..927b8bcda 100644 --- a/src/Dodge/Particle/Bullet/DestroyDamage.hs +++ b/src/Dodge/Particle/Bullet/DestroyDamage.hs @@ -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 diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 9555e6ce0..92eab9b3a 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -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 diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 9f359d826..2a9282bd2 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -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