Refactor bezgun

src/Dodge/Item/Weapon.hs

@@ -180,7 +180,6 @@ rezGun = defaultGun
     , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures [polygon $ rectNESW 7    3 1    (-3)
                                             ,polygon $ rectNESW (-1) 3 (-7) (-3)
                                             ]
-
     , _itAmount = 1
     , _itMaxStack = 1
     , _itAimingSpeed = 0.4
@@ -204,7 +203,6 @@ teslaGun = defaultAutoGun
     , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 7    3 1    (-3)
                                             ,polygon $ rectNESW (-1) 3 (-7) (-3)
                                             ]
-
     , _itAmount = 1
     , _itMaxStack = 1
     , _itAimingSpeed = 0.4
@@ -337,7 +335,11 @@ launcher = defaultGun
     }
 bezierGun = defaultAutoGun
     { _itName = "B-GUN"
-    , _wpFire = maybeSetTarget shootBezier
+    , _wpFire = maybeSetTarget $ \p ->  shootWithSound 0 
+                                        . withMuzFlare 
+                                        . withRecoil 40
+                                        . torqueBefore 0.05 -- I believe that this doesn't affect
+                                        $ shootBezier p     -- <- the start point
     , _itAttachment = Nothing
     , _itScrollUp   = removeItAttachment 0
     , _itScrollDown = removeItAttachment 0
@@ -349,36 +351,33 @@ bezierGun = defaultAutoGun
 
 maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World
 maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of
-        Just (ItTargetPos targetp) -> f targetp cid w
+    Just (ItTargetPos targetp) 
-        _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp)
+        -> f targetp cid w
-    where 
+    _   -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp)
-        mp = mouseWorldPos w
+  where 
-        cr = _creatures w IM.! cid
+    mp = mouseWorldPos w
-        itRef = _crInvSel cr
+    cr = _creatures w IM.! cid
+    itRef = _crInvSel cr
 
 shootBezier :: Point2 -> Int -> World -> World
-shootBezier targetp cid w = (shootWithSound 0 
+shootBezier targetp cid w = over particles' (theBullet :) w
-                            . withMuzFlare 
+  where
-                            . withRecoil 40 
+    theBullet = aCurveBulAt 
-                            . torqueBefore 0.05 
+                    (Just cid) 
-                            ) bezBul cid w
+                    white 
-    where
+                    startp 
--- note that torqueBefore will not affect the startp here
+                    (controlp +.+ randPos) 
-        bezBul = mkBezierBul startp controlp targetp
+                    (targetp +.+ randPos')
-        controlp = mouseWorldPos w
+                    (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 
-        cr = _creatures w IM.! cid
+                    5
-        dir = _crDir cr
+    controlp = mouseWorldPos w
-        startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
+    cr = _creatures w IM.! cid
-          
+    dir = _crDir cr
-mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
+    startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
-mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
+    (randPos,randPos') = flip evalState (_randGen w) 
-    where 
+                                $ do a <- randInCirc 10
-        bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos')
+                                     b <- randInCirc 20
-                                (passThroughAll bulHitCr' bulHitWall' bulHitFF') 5
+                                     return (a,b)
-        (randPos,randPos') = flip evalState (_randGen w) 
-                                    $ do a <- randInCirc 10
-                                         b <- randInCirc 20
-                                         return (a,b)
           
 removeItAttachment :: Int -> Int -> World -> World
 removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing

src/Dodge/WorldEvent.hs

@@ -5,6 +5,7 @@ module Dodge.WorldEvent
     , module Dodge.WorldEvent.ThingsHit
     , module Dodge.WorldEvent.HelperParticle
     , module Dodge.WorldEvent.Cloud
+    , module Dodge.WorldEvent.HitEffect
     )
     where
 
@@ -13,6 +14,7 @@ import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
 import Dodge.WorldEvent.Cloud
+import Dodge.WorldEvent.HitEffect
 import Dodge.LightSources
 
 import Dodge.Data

src/Dodge/WorldEvent/Bullet.hs

@@ -16,14 +16,6 @@ import Data.Function (on)
 import Data.Bifunctor
 import qualified Data.IntMap.Strict as IM
 
-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
-
 mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
 mvGenBullet' w bt 
     | t <= 0 = (w, Nothing)
@@ -40,51 +32,3 @@ mvGenBullet' w 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/ThingsHit.hs

@@ -10,6 +10,35 @@ import Data.List
 import Data.Maybe
 import Data.Function (on)
 
+thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
+thingsHit sp ep w 
+        | sp == ep  = []
+        | otherwise = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
+    where 
+          hitCrs   = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
+                                            $ _creatures w
+          crPs     = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
+          crs   = zip crPs (map E3x1 hitCrs)
+
+          hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
+                                                                            , b<-[y-1,y,y+1]])
+          (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
+          f i m = case IM.lookup i m of Just val -> val
+                                        _        -> IM.empty
+          walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
+          hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
+          hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
+          ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
+
+
+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
+
 thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World 
                         -> [(Point2, (Either3 Creature Wall ForceField))]
 thingsHitExceptCrLongLine Nothing    sp ep = thingsHitLongLine sp ep
@@ -35,26 +64,6 @@ thingsHitLongLine sp ep w
           hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
           ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
 
-thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
-thingsHit sp ep w 
-        | sp == ep  = []
-        | otherwise = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
-    where 
-          hitCrs   = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
-                                            $ _creatures w
-          crPs     = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
-          crs   = zip crPs (map E3x1 hitCrs)
-
-          hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
-                                                                            , b<-[y-1,y,y+1]])
-          (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
-          f i m = case IM.lookup i m of Just val -> val
-                                        _        -> IM.empty
-          walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
-          hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
-          hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
-          ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
-
 thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, (Either3 Creature Wall ForceField) ) ] ]
 thingsHitOnPath [] _ = error "tried to find thingsHitOnPath containing no points"
 thingsHitOnPath ps w = map (flip (uncurry thingsHit) w) . zip ps $ tail ps