Refactor shell movement, modularised in a tweakable way

src/Dodge/Creature.hs

@@ -30,6 +30,7 @@ import Dodge.Data
 import Dodge.Default
 import Dodge.Item.Weapon
 import Dodge.Item.Weapon.Launcher
+import Dodge.Item.Weapon.Bezier
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
 import Dodge.WorldEvent.Cloud

src/Dodge/Data.hs

@@ -390,6 +390,8 @@ data Ammo
     = ShellAmmo
         { _amPayload :: Point2 -> World -> World
         , _amString :: String
+        , _amPjMove :: Item -> Creature -> [Projectile -> World -> World]
+        , _amPjDraw :: Projectile -> Picture
         }
     | BulletAmmo
         { _amString :: String 
@@ -408,12 +410,14 @@ data Projectile
         { _pjPos :: Point2
         , _pjStartPos :: Point2
         , _pjVel :: Point2
+        , _pjAcc :: Point2
         , _pjDir :: Float
         , _pjSpin :: Float
         , _pjDraw :: Projectile -> Picture
         , _pjID :: Int
         , _pjUpdate :: Projectile -> World -> World
         , _pjPayload :: Point2 -> World -> World
+        , _pjTimer :: Int
         }
     | LinearShockwave 
         { _pjDraw :: Projectile -> Picture

src/Dodge/Default/Shell.hs

@@ -8,10 +8,12 @@ defaultShell = Shell
     { _pjPos = (0,0)
     , _pjStartPos = (0,0)
     , _pjVel = (0,0)
+    , _pjAcc = (0,0)
     , _pjDir = 0
     , _pjSpin = 0
     , _pjDraw = \_ -> blank
     , _pjID = 0
+    , _pjTimer = 0
     , _pjUpdate = \_ -> id
     , _pjPayload = \_ -> id
     }

src/Dodge/Default/Weapon.hs

@@ -37,3 +37,9 @@ defaultGun = Weapon
     , _itTargeting = Nothing
     , _itWorldTrigger = Nothing
     }
+defaultAutoGun :: Item
+defaultAutoGun = defaultGun 
+    { _itScrollUp   = const id
+    , _itScrollDown = const id
+    , _itInvDisplay = basicWeaponDisplay
+    }

src/Dodge/Item/Weapon.hs

@@ -13,8 +13,6 @@ import Dodge.Default
 --import Dodge.Default.Shell
 import Dodge.Item.Draw
 import Dodge.Particle.Bullet.HitEffect
-import Dodge.Particle.Bullet.Spawn
---import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
@@ -83,12 +81,6 @@ pistol = Weapon
     , _itTargeting = Nothing
     , _itWorldTrigger = Nothing
     }
-defaultAutoGun :: Item
-defaultAutoGun = autoGun 
-    { _itScrollUp   = const id
-    , _itScrollDown = const id
-    , _itInvDisplay = basicWeaponDisplay
-    }
 effectGun :: String -> (Creature -> World -> World) -> Item
 effectGun name eff = defaultGun
     { _itName = name ++ "Gun"
@@ -161,7 +153,7 @@ rezGun = defaultGun
         ]
     }
 teslaGun :: Item
-teslaGun = defaultAutoGun 
+teslaGun = defaultGun 
     { _itName = "TESLA"
     , _itIdentity = TeslaGun
     , _wpMaxAmmo = 200
@@ -261,52 +253,7 @@ tractorGun = defaultAutoGun
     , _itAimingRange = 0.5
     , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
     }
-useTargetPos 
-    :: (Maybe Point2 -> Creature -> World -> World)
-    -> Creature
-    -> World
-    -> World
-useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of
-    Nothing -> w
-    Just (g,_) -> f (g w) cr w
 
-bezierGun :: Item
-bezierGun = defaultAutoGun
-    { _itName = "B-GUN"
-    , _itUse = \_ ->  useTargetPos $ \p ->  
-        shootWithSound 0 
-        . withMuzFlare 
-        . withRecoil 40
-        . torqueBefore 0.05 -- I believe that this doesn't affect
-        $ shootBezier $ fromJust p    -- <- the start point
-    , _itAttachment = Nothing
-    , _itScrollUp   = removeItAttachment 0
-    , _itScrollDown = removeItAttachment 0
-    , _itHammer = HammerUp
-    , _itEffect = rbSetTarget
-    , _itZoom = defaultItZoom
-    , _itAimingRange = 0
-    }
-
-shootBezier :: Point2 -> Creature -> World -> World
-shootBezier targetp cr w = w & particles %~ (theBullet :)
-  where
-    theBullet = aCurveBulAt 
-        (Just cid) 
-        white 
-        startp 
-        (controlp +.+ randPos) 
-        (targetp +.+ randPos')
-        (destroyOnImpact bulHitCr bulHitWall' bulHitFF') 
-        5
-    controlp = mouseWorldPos w
-    cid = _crID cr
-    dir = _crDir cr
-    startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
-    (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/Item/Weapon/Bezier.hs

@@ -0,0 +1,57 @@
+module Dodge.Item.Weapon.Bezier
+    where
+import Dodge.Data
+import Dodge.Base
+import Dodge.Default.Weapon
+import Dodge.Item.Weapon.Targeting
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Default
+import Dodge.Particle.Bullet.Spawn
+import Dodge.Particle.Bullet.HitEffect
+import Dodge.WorldEvent.HitEffect
+import Dodge.RandomHelp
+import Picture
+import Geometry
+
+--import System.Random
+import Data.Maybe
+import Control.Lens
+import Control.Monad.State
+bezierGun :: Item
+bezierGun = defaultGun
+    { _itName = "B-GUN"
+    , _itUse = \_ ->  useTargetPos $ \p ->  
+        shootWithSound 0 
+        . withMuzFlare 
+        . withRecoil 40
+        . torqueBefore 0.05 -- I believe that this doesn't affect
+        $ shootBezier $ fromJust p    -- <- the start point
+    , _itAttachment = Nothing
+    , _itScrollUp   = removeItTarget 0
+    , _itScrollDown = removeItTarget 0
+    , _itHammer = HammerUp
+    , _itEffect = rbSetTarget
+    , _itZoom = defaultItZoom
+    , _itAimingRange = 0
+    }
+
+shootBezier :: Point2 -> Creature -> World -> World
+shootBezier targetp cr w = w & particles %~ (theBullet :)
+  where
+    theBullet = aCurveBulAt 
+        (Just cid) 
+        white 
+        startp 
+        (controlp +.+ randPos) 
+        (targetp +.+ randPos')
+        (destroyOnImpact bulHitCr bulHitWall' bulHitFF') 
+        5
+    controlp = mouseWorldPos w
+    cid = _crID cr
+    dir = _crDir cr
+    startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
+    (randPos,randPos') = flip evalState (_randGen w) $ do 
+        a <- randInCirc 10
+        b <- randInCirc 20
+        return (a,b)

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -111,13 +111,13 @@ rbSetTarget = ItInvEffect
         | _crInvSel cr /= invid = w
         | SDL.ButtonRight `S.member` _mouseButtons w = w 
             & creatures . ix (_crID cr) . crInv . ix invid . itTargeting 
-                %~ maybe (Just $ targetCurrentMousePos w) Just
+                %~ maybe (Just $ targetRBMousePos w) Just
         | otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ Nothing
 
-targetCurrentMousePos 
+targetRBMousePos 
     :: World 
     -> (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
-targetCurrentMousePos w = (f, \_ _ _ w' -> cursorPic w')
+targetRBMousePos w = (f, \_ _ _ w' -> cursorPic w')
   where
     f _ = Just mwp
     mwp = mouseWorldPos w

src/Dodge/Item/Weapon/Launcher.hs

@@ -45,8 +45,17 @@ launcher = defaultGun
     , _wpAmmo = ShellAmmo 
         { _amPayload = makeExplosionAt
         , _amString = ""
+        , _amPjMove = basicAmPjMoves
+        , _amPjDraw = shellPic
         }
     }
+
+basicAmPjMoves :: Item -> Creature -> [Projectile -> World -> World]
+basicAmPjMoves _ cr = 
+    [reduceSpinBy 0.995
+    ,pjEffAtTime 35 $ trySpinByCID (_crID cr)
+    ]
+
 flameLauncher :: Item
 flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
 poisonLauncher :: Item
@@ -61,93 +70,105 @@ aRocketWithItemParams
     -> World
 aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
   where 
-    pl = _amPayload $ _wpAmmo it
+    am = _wpAmmo it
-    cid = _crID cr
     i = IM.newKey $ _projectiles w
     pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
     dir = _crDir cr
-    theShell = makeShellAt pl i cid pos dir
+    ammoMvs pj w' = foldr ($ pj) w' (_amPjMove am it cr)
-    
+    theShell = defaultShell
-makeShellAt 
-    :: (Point2 -> World -> World) 
-                -- ^ Payload
-    -> Int      -- ^ Projectile id
-    -> Int      -- ^ Creature id
-    -> Point2   -- ^ Start position
-    -> Float    -- ^ Direction
-    -> Projectile
-makeShellAt pl i cid pos dir = defaultShell
         { _pjPos = pos
         , _pjStartPos = pos
         , _pjVel = rotateV dir (1,0)
-    , _pjDraw = \_ -> blank
+        , _pjAcc = rotateV dir (3,0)
+        , _pjDraw = _amPjDraw am
         , _pjID = i
-    , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
+        , _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj
-    , _pjPayload = pl
+        , _pjPayload = _amPayload am
+        , _pjTimer = 50
         }
 
 moveShell 
-    :: Int      -- ^ Timer (frames)
+    :: Projectile   -- ^ Projectile id
-    -> Int      -- ^ Projectile id
+    -> World 
-    -> Int      -- ^ Creature id
+    -> World
-    -> Float    -- ^ Rotation
+moveShell pj w 
-    -> Point2   -- ^ Acceleration
-    -> World -> World
-moveShell time i cid rot accel w 
     | time > 40 = if circOnSomeWall oldPos 4 w
         then doExplode
         else w
-            & projectiles . ix i . pjPos    %~ (+.+ vel)
-            & projectiles . ix i . pjDraw   .~ (\_ -> piclow)
-            & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel))
     | isJust thingHit = doExplode
-    | time == 35 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel
     | time >= 20 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
     | time > -99 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
         & randGen .~ g
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
         & projectiles . ix i . pjVel    %~ (\v -> accel +.+ frict *.* v)
         & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
         & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
         & smokeGen
     | time > -200 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
     | otherwise = doExplode
   where 
+    time = _pjTimer pj
+    accel = _pjAcc pj
     doExplode = w
         & projectileExplosion oldPos 
         & stopSoundFrom (ShellSound i)
         & projectiles %~ IM.delete i
-    pj = _projectiles w IM.! i
+    i = _pjID pj
     oldPos   = _pjPos pj
     vel      = _pjVel pj
     projectileExplosion = _pjPayload pj
     newPos   = oldPos +.+ vel
     (frict,g)  = randomR (0.6,0.9) $ _randGen w
     (sparkD,_) = randomR (-0.2,0.2) $ _randGen w
-    dir      = argV vel
-    pic      = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
-    piclow   = onLayerL [levLayer CrLayer - 2] 
-        $ uncurry translate newPos $ rotate (argV accel) shellPic
     hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
     hitWl    = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
-    spin   = case w ^? creatures . ix cid of
-        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
-        _ -> 0
     r1 = randInCirc 10 & evalState $ _randGen w
     smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
-    rot' = rot * 0.995
 
-shellPic :: Picture
+reduceSpinBy :: Float -> Projectile -> World -> World
-shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
+reduceSpinBy x pj = projectiles . ix (_pjID pj) .  pjSpin *~ x
+
+shellPic :: Projectile -> Picture
+shellPic pj
+    | t > 40    =  onLayerL [levLayer CrLayer - 2] 
+        $ uncurry translate pos $ rotate (argV accel) basePic 
+    | otherwise = onLayer PtLayer $ uncurry translate pos $ rotate (argV accel) basePic
+  where
+    basePic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
+    accel = _pjAcc pj
+    pos = _pjPos pj
+    t = _pjTimer pj
+
+decTimMvVel :: Projectile -> World -> World
+decTimMvVel pj = projectiles . ix pjid %~
+    ( (pjTimer -~ 1) 
+    . (pjPos   %~ (+.+ vel) )
+    . (pjAcc   %~ rotateV rot )
+    )
+  where
+    rot = _pjSpin pj
+    vel = _pjVel pj
+    pjid = _pjID pj
+
+pjEffAtTime 
+    :: Int
+    -> (Projectile -> World -> World)
+    -> Projectile
+    -> World
+    -> World
+pjEffAtTime t f pj
+    | _pjTimer pj == t = f pj
+    | otherwise = id
+
+trySpinByCID
+    :: Int -- ^ creature id
+    -> Projectile
+    -> World 
+    -> World
+trySpinByCID cid pj w = w & projectiles . ix pjid . pjSpin .~ newSpin
+  where
+    pjid = _pjID pj
+    dir      = argV $ _pjVel pj
+    newSpin   = case w ^? creatures . ix cid of
+        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
+        _ -> 0

src/Dodge/Item/Weapon/Targeting.hs

@@ -0,0 +1,20 @@
+module Dodge.Item.Weapon.Targeting
+    where
+import Dodge.Data
+
+import Control.Lens
+import qualified Data.IntMap.Strict as IM
+useTargetPos 
+    :: (Maybe Point2 -> Creature -> World -> World)
+    -> Creature
+    -> World
+    -> World
+useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of
+    Nothing -> w
+    Just (g,_) -> f (g w) cr w
+
+removeItTarget :: Int -> Int -> World -> World
+removeItTarget i _ w = w & creatures . ix i . crInv . ix itRef . itTargeting .~ Nothing
+  where 
+    cr = _creatures w IM.! i
+    itRef = _crInvSel cr