Unify curve bullets with straight

src/Dodge/WorldEvent/Bullet.hs

@@ -16,65 +16,13 @@ import Data.Function (on)
 import Data.Bifunctor
 import qualified Data.IntMap.Strict as IM
 
-mvBulletTrajectory :: (Int -> [Point2]) -> World -> Particle' -> (World, Maybe Particle')
-mvBulletTrajectory velF w bt
-    | t <= 0 = (w, Nothing)
-    | t < 4  = (w, Just $ set btPassThrough' Nothing
-                        $ set btTrail' (replicate numPs p ++ (p:ps) )
-                        $ set btTimer' (t-1) 
-                        bt                      
-                )
-    | otherwise = (w, Just  $ set btPassThrough' Nothing
-                        $ set btVel' newVel -- this may be useful for hit effects
-                        $ set btTrail' (init (reverse newPs) ++ (p:ps))
-                        $ set btTimer' (t-1) bt                      
-                    )
---    | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
---        (_,Nothing)  -> (w, Just  $ set btPassThrough' Nothing
---                        $ set btVel' newVel -- this may be useful for hit effects
---                        $ set btTrail' (init (reverse newPs) ++ (p:ps))
---                        $ set btTimer' (t-1) bt                      
---                )
---        (mvPs,Just (hitp,thing)) 
---            -> let newMvPs = leftPad numPs hitp (init $ reverse mvPs)
---                   hitVel  = speed *.* normalizeV ( hitp -.- (head $ reverse mvPs) )
---               in  ( hiteff bt (hitp,thing) w
---               --in  ( w
---                   , Just  $ set btPassThrough' Nothing
---                           $ set btVel' hitVel -- this may be useful for hit effects
---                           $ set btTrail' (newMvPs ++ (p:ps))
---                           $ set btTimer' 3 bt                      
---                   )
-  where mcr     = _btPassThrough' bt
-        col     = _btColor' bt
-        (p:ps)  = _btTrail' bt
-        hiteff  = _btHitEffect' bt
-        wth     = _btWidth' bt
-        t       = _btTimer' bt
-        newPs   = velF t
-        numPs   = (length $ newPs) - 1
-        firstThingHit :: [[(Point2,(Either3 Creature Wall ForceField))]] 
-                            -> ([Point2], Maybe (Point2,Either3 Creature Wall ForceField))
-        firstThingHit hitList = second last $ unzip $ zip newPs 
-                                $ takeUntil isJust 
-                                $ map listToMaybe hitList
-        newVel  = speed *.* ( last newPs -.- (last $ init newPs) )
-        speed   = sum . map magV $ zipWith (-.-) (init newPs) (tail newPs)
-
-
-thingsHitExceptCrCurve :: Maybe Int -> [Point2] -> World 
-                        -> [ [(Point2, (Either3 Creature Wall ForceField))]
-                           ]
-thingsHitExceptCrCurve mcid ps@(a:b:_) w 
-                            = zipWith (\x y -> thingsHitExceptCr mcid x y w) ps $ tail ps
-thingsHitExceptCrLine _ _ _ = []
-
 thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World 
                         -> [(Point2, (Either3 Creature Wall ForceField))]
 thingsHitExceptCr Nothing    sp ep = thingsHit sp ep
 thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
-    where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
-          crNotCid _ = True
+  where 
+    crNotCid (_,(E3x1 cr)) = _crID cr /= cid
+    crNotCid _ = True
 
 mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
 mvGenBullet' w bt 
@@ -82,13 +30,61 @@ mvGenBullet' w bt
     | t < 4  = (w, Just $ set btPassThrough' Nothing
                         $ set btTrail' (p:p:ps)
                         $ set btTimer' (t-1) bt                      
-                )
+               )
     | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
-  where mcr     = _btPassThrough' bt
-        col     = _btColor' bt
-        (p:ps)  = _btTrail' bt
-        vel     = _btVel' bt
-        hiteff  = _btHitEffect' bt
-        wth     = _btWidth' bt
-        t       = _btTimer' bt
+  where 
+    mcr     = _btPassThrough' bt
+    col     = _btColor' bt
+    (p:ps)  = _btTrail' bt
+    vel     = _btVel' bt
+    hiteff  = _btHitEffect' bt
+    wth     = _btWidth' bt
+    t       = _btTimer' bt
 
+type HitCreatureEffect   = Particle' -> Point2 -> Creature   -> World -> World
+type HitWallEffect       = Particle' -> Point2 -> Wall       -> World -> World
+type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
+
+passThroughAll :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
+     Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
+passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt)
+  where 
+    mvPt = Just $ pt & btTrail' .~ (newP : trl)
+                     & btTimer' %~ (\t -> t - 1)
+                     & btPassThrough' .~ Nothing
+    trl = _btTrail' pt
+    newP = head trl +.+ _btVel' pt
+
+destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
+     Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
+destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
+        []              -> (              w, mvPt)
+        ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
+        ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
+        ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
+    where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
+                                     & btTimer' .~ 3
+          mvPt = Just $ pt & btTrail' .~ (newP : trl)
+                           & btTimer' %~ (\t -> t - 1)
+                           & btPassThrough' .~ Nothing
+          trl = _btTrail' pt
+          wth = _btWidth' pt
+          newP = head trl +.+ _btVel' pt
+
+penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
+     Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
+penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
+        []              -> (              w, mvPt)
+        ((p,E3x1 cr):_)  -> (crEff pt p cr w, destroyAt p)
+        ((p,E3x3 ff):_)  -> (ffEff pt p ff w, destroyAt p)
+        ((p,E3x2 wl):hs) | isJust (wl ^? blHP) 
+                                     -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
+        ((p,E3x2 wl):_)  | otherwise -> (wlEff pt p wl w, destroyAt p)
+    where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
+                                     & btTimer' .~ 3
+          mvPt = Just $ pt & btTrail' .~ (newP : trl)
+                           & btTimer' %~ (\t -> t - 1)
+                           & btPassThrough' .~ Nothing
+          trl = _btTrail' pt
+          wth = _btWidth' pt
+          newP = head trl +.+ _btVel' pt

src/Dodge/WorldEvent/Projectile.hs

@@ -1,48 +0,0 @@
-module Dodge.WorldEvent.Projectile
-    where
-import Dodge.Data
-import Control.Lens
-
-import Data.Bifunctor
-import Data.Maybe
-
-import Picture
-
-import Geometry
-
-type HitCreatureEffect   = Particle' -> Point2 -> Creature   -> World -> World
-type HitWallEffect       = Particle' -> Point2 -> Wall       -> World -> World
-type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
-
-destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
-     Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
-destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt)
-        ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
-        ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
-        ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
-    where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
-                                     & btTimer' .~ 3
-          mvPt = Just $ pt & btTrail' .~ (newP : trl)
-                           & btTimer' %~ (\t -> t - 1)
-                           & btPassThrough' .~ Nothing
-          trl = _btTrail' pt
-          wth = _btWidth' pt
-          newP = head trl +.+ _btVel' pt
-penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
-     Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
-penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt)
-        ((p,E3x1 cr):_)  -> (crEff pt p cr w, destroyAt p)
-        ((p,E3x3 ff):_)  -> (ffEff pt p ff w, destroyAt p)
-        ((p,E3x2 wl):hs) | isJust (wl ^? blHP) 
-                                     -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
-        ((p,E3x2 wl):_)  | otherwise -> (wlEff pt p wl w, destroyAt p)
-    where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
-                                     & btTimer' .~ 3
-          mvPt = Just $ pt & btTrail' .~ (newP : trl)
-                           & btTimer' %~ (\t -> t - 1)
-                           & btPassThrough' .~ Nothing
-          trl = _btTrail' pt
-          wth = _btWidth' pt
-          newP = head trl +.+ _btVel' pt