Add file

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

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)

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
+

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

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)
+        )