diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 803189359..a553754d4 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -87,14 +87,14 @@ bulletSpawn bu = case _buSpawn bu of BulBall TeslaBall -> Just makeStaticBall hitEffFromBul :: Float -> Bullet - -> Stream (Of (Point2, Either Creature Wall)) Identity () + -> StreamOf (Point2, Either Creature Wall) -> World -> (World,Maybe Bullet) hitEffFromBul x bu hitstream w = case _buEffect bu of - PenetrateBullet -> undefined + PenetrateBullet -> movePenBullet x bu hitstream w BounceBullet -> case runIdentity (S.head_ hitstream) of Nothing -> (w, moveBullet x bu) - Just (hp,crwl) -> fromMaybe (expireAndDamage' x setfromtodams bu hitstream w) $ do + Just (hp,crwl) -> fromMaybe (expireAndDamage' x bu hitstream w) $ do dir <- bounceDir (hp,crwl) return $ (w,Just $ bu & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp) @@ -102,20 +102,29 @@ hitEffFromBul x bu hitstream w = case _buEffect bu of & buTrajectory .~ BasicBulletTrajectory & buTimer -~ 1 ) - DestroyBullet -> expireAndDamage' x setfromtodams bu hitstream w - where - setfromtodams bu' p = map f (_buDamages bu') - where - f = (dmFrom .~ _buPos bu') . (dmAt .~ p) . (dmTo .~ _buPos bu' +.+ _buVel bu') + DestroyBullet -> expireAndDamage' x bu hitstream w -expireAndDamage' :: Float -> (Bullet -> Point2 -> [Damage]) +setFromToDams :: Bullet -> Point2 -> [Damage] +setFromToDams bu p = map f (_buDamages bu) + where + f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu) + +damageThingHit :: Bullet -> (Point2,Either Creature Wall) -> World -> World +damageThingHit bu (p,crwl) = case crwl of + Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams + Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams + where + dams = setFromToDams bu p + + +expireAndDamage' :: Float -> Bullet -> Stream (Of (Point2, Either Creature Wall)) Identity () -> World -> (World, Maybe Bullet) -expireAndDamage' y fdm 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 -> (doDamages' fdm x bt 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 @@ -131,45 +140,14 @@ destroyAt' hitp pt = Just $ pt where p = _buPos pt ---penWalls --- :: HitCreatureEffect' --- -> HitWallEffect' --- -> Bullet --- -> [(Point2, Either Creature Wall)] --- -> World --- -> (World, Maybe Bullet) ---penWalls crEff wlEff pt hitThings w = case hitThings of --- [] -> ( w, moveBullet 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) +movePenBullet :: Float -> Bullet -> StreamOf (Point2, Either Creature Wall) + -> World -> (World, Maybe Bullet) +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 ---type HitCreatureEffect' = Bullet -> Point2 -> Creature -> World -> World ---type HitWallEffect' = Bullet -> Point2 -> Wall -> World -> World - -doDamages' :: (Bullet -> Point2 -> [Damage]) - -> (Point2, Either Creature Wall) - -> Bullet - -> 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 - ---penetrate --- :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) --- -- | penetration test, can update particle if it penetrates --- -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating --- -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating --- -> Bullet --- -> Stream (Of (Point2, Either Creature Wall)) Identity () --- -> World --- -> (World, Maybe Bullet) ---penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of --- Nothing -> (w, moveBullet pt) --- Just (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 +penThing :: Either Creature Wall -> Bool +penThing (Left _) = True +penThing (Right wl) = _wlPenetrable wl