Refactor shell movement, modularised in a tweakable way

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
-    cid = _crID cr
+    am = _wpAmmo it
     i = IM.newKey $ _projectiles w
     pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
     dir = _crDir cr
-    theShell = makeShellAt pl i cid pos dir
-    
-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
-    , _pjID = i
-    , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
-    , _pjPayload = pl
-    }
+    ammoMvs pj w' = foldr ($ pj) w' (_amPjMove am it cr)
+    theShell = defaultShell
+        { _pjPos = pos
+        , _pjStartPos = pos
+        , _pjVel = rotateV dir (1,0)
+        , _pjAcc = rotateV dir (3,0)
+        , _pjDraw = _amPjDraw am
+        , _pjID = i
+        , _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj
+        , _pjPayload = _amPayload am
+        , _pjTimer = 50
+        }
 
 moveShell 
-    :: Int      -- ^ Timer (frames)
-    -> Int      -- ^ Projectile id
-    -> Int      -- ^ Creature id
-    -> Float    -- ^ Rotation
-    -> Point2   -- ^ Acceleration
-    -> World -> World
-moveShell time i cid rot accel w 
+    :: Projectile   -- ^ Projectile id
+    -> World 
+    -> World
+moveShell pj 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
-shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
+reduceSpinBy :: Float -> Projectile -> World -> World
+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