Add file

src/Dodge/Creature/Damage.hs

@@ -0,0 +1,51 @@
+module Dodge.Creature.Damage where
+import Dodge.Data
+import Dodge.SoundLogic
+import Dodge.Creature.Property
+import Dodge.Particle.Spark
+import Color
+import Geometry
+
+import Control.Lens
+import Data.List
+
+defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
+defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (id,cr) ds'
+  where 
+    (ps,ds') = partition isPoison ds
+    isPoison Damage{_dmType=PoisonDam} = True
+    isPoison _ = False
+    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))) 
+      where
+        pushAmount
+            | dist (_crPos cr) fromDir == 0 = 0
+            | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
+    PushBackDamage pback -> cr
+        & crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
+    TorqueDamage rot -> cr & crDir +~ rot
+  where
+    fromDir = _dmFrom 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))
+  where
+    p = _dmAt dm
+    p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)