(Re)Implement penetrating bullets

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