Unify curve bullets with straight

src/Dodge/Item/Weapon.hs

@@ -374,7 +374,7 @@ mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
 mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
     where 
         bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos')
-                                (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 5
+                                (passThroughAll bulHitCr' bulHitWall' bulHitFF') 5
         (randPos,randPos') = flip evalState (_randGen w) 
                                     $ do a <- randInCirc 10
                                          b <- randInCirc 20

src/Dodge/Item/Weapon/Bullet.hs

@@ -237,7 +237,7 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
 aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle'
 aCurveBulAt maycid col pos control targ hiteff width = Bul'
     { _ptDraw = drawBul
-    , _ptUpdate' = mvBulletTrajectory f
+    , _ptUpdate' = \w -> mvGenBullet' w . setVel
     , _btVel' = (0,0)
     , _btColor' = col
     , _btTrail' = [pos]
@@ -246,7 +246,6 @@ aCurveBulAt maycid col pos control targ hiteff width = Bul'
     , _btTimer' = 100
     , _btHitEffect' = hiteff
     }
-    where f i = g $ (100 - fromIntegral i) / den
+  where 
-          g x = map (bf . (+ x)) [0,1 / (den * 10)..9 / (den * 10)]
+    setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt)
-          bf = bQuadToF (pos,control,targ)
+    bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05
-          den = 20

src/Dodge/WorldEvent.hs

@@ -4,12 +4,10 @@ module Dodge.WorldEvent
     , module Dodge.WorldEvent.Flash
     , module Dodge.WorldEvent.ThingsHit
     , module Dodge.WorldEvent.HelperParticle
-    , module Dodge.WorldEvent.Projectile
     , module Dodge.WorldEvent.Cloud
     )
     where
 
-import Dodge.WorldEvent.Projectile
 import Dodge.WorldEvent.Bullet
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit

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
+  where 
-          crNotCid _ = True
+    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
+  where 
-        col     = _btColor' bt
+    mcr     = _btPassThrough' bt
-        (p:ps)  = _btTrail' bt
+    col     = _btColor' bt
-        vel     = _btVel' bt
+    (p:ps)  = _btTrail' bt
-        hiteff  = _btHitEffect' bt
+    vel     = _btVel' bt
-        wth     = _btWidth' bt
+    hiteff  = _btHitEffect' bt
-        t       = _btTimer' 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