diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index a553754d4..8224fb37e 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -52,7 +52,7 @@ useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet) mvBullet x w bt' | t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing) - | otherwise = bimap id (fmap dodrag) $ + | otherwise = second (fmap dodrag) $ hiteff bt hitstream w where endspawn w' = fromMaybe w' $ do @@ -94,15 +94,15 @@ hitEffFromBul x bu hitstream w = case _buEffect bu of PenetrateBullet -> movePenBullet x bu hitstream w BounceBullet -> case runIdentity (S.head_ hitstream) of Nothing -> (w, moveBullet x bu) - Just (hp,crwl) -> fromMaybe (expireAndDamage' x bu hitstream w) $ do + Just (hp,crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do dir <- bounceDir (hp,crwl) - return $ (w,Just $ bu + return (w,Just $ bu & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp) & buVel %~ reflectIn dir & buTrajectory .~ BasicBulletTrajectory & buTimer -~ 1 ) - DestroyBullet -> expireAndDamage' x bu hitstream w + DestroyBullet -> expireAndDamage x bu hitstream w setFromToDams :: Bullet -> Point2 -> [Damage] setFromToDams bu p = map f (_buDamages bu) @@ -117,14 +117,14 @@ damageThingHit bu (p,crwl) = case crwl of dams = setFromToDams bu p -expireAndDamage' :: Float +expireAndDamage :: Float -> Bullet -> Stream (Of (Point2, Either Creature Wall)) Identity () -> World -> (World, Maybe Bullet) -expireAndDamage' y bt things w = case runIdentity $ S.head_ things of +expireAndDamage y bt things w = case runIdentity $ S.head_ things of Nothing -> (w, moveBullet y bt) - Just x -> (damageThingHit bt x w, destroyAt' (fst x) bt) + Just x -> (damageThingHit bt x w, destroyAt (fst x) bt) moveBullet :: Float -> Bullet -> Maybe Bullet moveBullet x pt = Just $ pt @@ -132,8 +132,8 @@ moveBullet x pt = Just $ pt & buOldPos .~ _buPos pt & buTimer -~ 1 -destroyAt' :: Point2 -> Bullet -> Maybe Bullet -destroyAt' hitp pt = Just $ pt +destroyAt :: Point2 -> Bullet -> Maybe Bullet +destroyAt hitp pt = Just $ pt & buPos .~ hitp +.+ normalizeV (p -.- hitp) & buOldPos .~ p & buVel .~ 0 @@ -146,7 +146,7 @@ movePenBullet x bu hitstream w = case runIdentity (S.next hitstream) of Left _ -> (w,moveBullet x bu) Right ((p,crwl),strm) -> if penThing crwl then first (damageThingHit bu (p,crwl)) $ movePenBullet x bu strm w - else expireAndDamage' x bu hitstream w + else expireAndDamage x bu hitstream w penThing :: Either Creature Wall -> Bool penThing (Left _) = True diff --git a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs deleted file mode 100644 index b7db21dd9..000000000 --- a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Dodge.Particle.HitEffect.ExpireAndDamage where -import Dodge.Data -import Dodge.Particle.Update ---import Dodge.Wall.Damage -import Geometry -import LensHelp -import qualified Data.IntMap.Strict as IM -import Streaming -import qualified Streaming.Prelude as S - -expireAndDamage :: (Particle -> Point2 -> [Damage]) - -> Particle - -> Stream (Of (Point2, Either Creature Wall)) Identity () - -> World - -> (World, Maybe Particle) -expireAndDamage fdm bt things w = case runIdentity $ S.head_ things of - Nothing -> (w, mvPt' bt) - Just x -> (doDamages fdm x bt w, destroyAt 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 . csDamage .++~ dams - Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams - where - dams = fdm bt p diff --git a/src/Dodge/Particle/Update.hs b/src/Dodge/Particle/Update.hs index 6ef388c80..805378f53 100644 --- a/src/Dodge/Particle/Update.hs +++ b/src/Dodge/Particle/Update.hs @@ -6,11 +6,6 @@ mvPt' :: Particle -> Maybe Particle mvPt' pt = Just $ pt & ptTimer -~ 1 -destroyAt :: Particle -> Maybe Particle -destroyAt pt = Just $ pt - & ptUpdate .~ killParticleUpdate - & ptTimer %~ (min 3 . subtract 1) - killParticleUpdate :: World -> Particle -> (World,Maybe Particle) killParticleUpdate w pt | _ptTimer pt <= 0 = (w,Nothing)