Cleanup

src/Dodge/Item/Weapon/Launcher.hs

@@ -1,5 +1,4 @@
 module Dodge.Item.Weapon.Launcher (
-    fireTrackingShell,
     explodeRemoteRocket,
 ) where
 
@@ -7,7 +6,6 @@ import Control.Lens
 import Dodge.Data.World
 import Dodge.Item.Location
 import Dodge.Payload
-import Dodge.Projectile.Create
 import qualified IntMapHelp as IM
 
 explodeRemoteRocket ::

src/Dodge/Projectile/Create.hs

@@ -54,144 +54,6 @@ makeShell it cr theupdate w =
     pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
     am = _heldConsumption $ _itUse it
 
---fireShell :: Item -> Creature -> World -> World
---fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj
---    . pjThrust thrustdelay pj
---    . reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj
---    . decTimMvVel pj
---    . moveShell pj
---  where
---    params = _itParams it
---    spindrag = _shellSpinDrag params
---    spinamount = _shellSpinAmount params
---    thrustdelay = _shellThrustDelay params
---
---makeShell :: Item -> Creature -> (Proj -> World -> World) -> World -> World
---makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell
---    { _prjPos = pos
---    , _prjZ   = 20
---    , _prjStartPos = pos
---    , _prjVel = rotateV dir (V2 1 0)
---    , _prjID = i
---    , _prjUpdate = theupdate
---    , _prjAcc = rotateV dir (V2 3 0)
---    , _prjDir = dir
---    , _prjDraw = DrawShell
---    , _prjSpin = 0
---    , _prjPayload = _amPayload $ _laAmmoType am
---    , _prjTimer = 50
---    }
---  where
---    i = IM.newKey $ _props w
---    dir = _crDir cr
---    pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
---    am = _itConsumption it
---
---moveShell :: Proj
---    -> World
---    -> World
---moveShell pj w
---    | time > 40 = if circOnSomeWall oldPos 4 w
---        then doExplode
---        else w
---    | anythingHitCirc 2 oldPos newPos w = doExplode
---    | time > -300 = w
---    | otherwise = doExplode
---  where
---    time = _prjTimer pj
---    doExplode = w
---        & usePayload (_prjPayload pj) oldPos
---        & stopSoundFrom (ShellSound i)
---        & props %~ IM.delete i
---    i = _prjID pj
---    oldPos   = _prjPos pj
---    vel      = _prjVel pj
---    newPos   = oldPos +.+ vel
---
---usePjCreation :: Item -> Creature -> World -> World
---usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it
---
---usePjCreationX :: Int -> Item -> Creature -> World -> World
---usePjCreationX i it cr = foldr f
---    (createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr)
---    [1..i-1]
---  where
---    f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
---
---pjEffAtTime
---    :: Int
---    -> (Proj -> World -> World)
---    -> Proj
---    -> World
---    -> World
---pjEffAtTime t f pj
---    | _prjTimer pj == t = f pj
---    | otherwise = id
---
---trySpinByCID
---    :: Int -- ^ creature id
---    -> Int -- ^ Spin amount
---    -> Proj
---    -> World
---    -> World
---trySpinByCID cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin
---  where
---    pjid = _prjID pj
---    dir      = argV $ _prjVel pj
---    newSpin   = case w ^? creatures . ix cid of
---        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
---        _ -> 0
---    spinFactor = 5 * (6 - fromIntegral i)
---pjThrust :: Int -> Proj -> World -> World
---pjThrust i = pjEffTimeRange (st,et) doThrust
---  where
---    et | i == 0 = 36
---       | otherwise = 40 - (i * 20)
---    st = et - 100
---
---pjTrack :: Int -> Int -> Proj -> World -> World
---pjTrack itid i pj w = pjEffTimeRange (st,et) rotateToTarget pj w
---  where
---    et | i == 0 = 36
---       | otherwise = 40 - (i * 20)
---    st = et - 100
---    rotateToTarget _ = fromMaybe id $ do
---        tpos <- w ^? itPoint . itTargeting . tgPos . _Just
---        return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
---            (argV $ _prjAcc pj)
---    itPoint = pointToItem $ _itemPositions w IM.! itid
---
---doThrust :: Proj -> World -> World
---doThrust pj w = w
---    & randGen .~ g
---    & projectiles . ix i . prjVel    %~ (\v -> accel +.+ frict *.* v)
---    & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
---    & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) 3 10
---    & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
---  where
---    accel   = _prjAcc pj
---    i       = _prjID pj
---    oldPos  = _prjPos pj
---    vel     = _prjVel pj
---    newPos  = oldPos +.+ vel
---    (frict,g)  = randomR (0.6,0.9) $ _randGen w
---    (sparkD,_) = randomR (-0.2,0.2) $ _randGen w
---    r1 = randInCirc 10 & evalState $ _randGen w
---
---reduceSpinBy :: Float -> Proj -> World -> World
---reduceSpinBy x pj = projectiles . ix (_prjID pj) .  prjSpin *~ x
---
---pjEffTimeRange
---    :: (Int,Int)
---    -> (Proj -> World -> World)
---    -> Proj
---    -> World
---    -> World
---pjEffTimeRange (st,et) f pj
---    | t <= et && t >= st = f pj
---    | otherwise = id
---  where
---    t = _prjTimer pj
 fireTrackingShell :: Item -> Creature -> World -> World
 fireTrackingShell it cr w = addTrackRocket w'
   where

src/Dodge/Projectile/Update.hs

@@ -31,64 +31,26 @@ updateProjectile :: Proj -> World -> World
 updateProjectile pj = case pj of
     Shell{} -> upsProjectile pj
 
---explodeRemoteRocket' ::
---    -- | Item id
-----    Maybe Int ->
---    Proj ->
---    World ->
---    World
---explodeRemoteRocket' thepj w =
---    w
---        & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
---        & usePayload (_prjPayload thepj) (_prjPos thepj)
---        & updateitem
---  where
---    mitid = _prjMITID thepj
---    updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
---        itid <- mitid
---        itpos <- w ^? cWorld . itemLocations . ix itid
---        return $
---            (pointerToItemLocation itpos . itUse . heldUse .~ HeldDoNothing)
---                . (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
---    pjid = _prjID thepj
+shellCollisionCheck :: (Proj -> World -> World) -> Proj -> World -> World
+shellCollisionCheck doExplode pj w
+    | time > 340 && circOnSomeWall oldPos 4 w = doExplode pj w
+    | time <= 340 && anythingHitCirc 2 oldPos newPos w = doExplode pj w
+    | time <= 0 = doExplode pj w
+    | otherwise = w
+  where
+    time = _prjTimer pj
+    oldPos = _prjPos pj
+    vel = _prjVel pj
+    newPos = oldPos +.+ vel
 
 remoteShellCollisionCheck :: Proj -> World -> World
-remoteShellCollisionCheck pj w
-    | time > 340 =
-        if circOnSomeWall oldPos 4 w
-            then doExplode
-            else w
-    | anythingHitCirc 2 oldPos newPos w = doExplode
-    | time > 0 = w
-    | otherwise = doExplode
-  where
-    time = _prjTimer pj
-    doExplode = explodeRemoteRocket (fromJust (_prjMITID pj)) (_prjID pj) w
-    i = _prjID pj
-    oldPos = _prjPos pj
-    vel = _prjVel pj
-    newPos = oldPos +.+ vel
+remoteShellCollisionCheck = shellCollisionCheck $ \pj -> explodeRemoteRocket (fromJust (_prjMITID pj)) (_prjID pj)
 
-updateShell :: Proj -> World -> World
-updateShell pj w
-    | time > 340 =
-        if circOnSomeWall oldPos 4 w
-            then doExplode
-            else w
-    | anythingHitCirc 2 oldPos newPos w = doExplode
-    | time > 0 = w
-    | otherwise = doExplode
-  where
-    time = _prjTimer pj
-    doExplode =
-        w
-            & usePayload (_prjPayload pj) oldPos
-            & stopSoundFrom (ShellSound i)
-            & cWorld . projectiles %~ IM.delete i
-    i = _prjID pj
-    oldPos = _prjPos pj
-    vel = _prjVel pj
-    newPos = oldPos +.+ vel
+plainShellCollisionCheck :: Proj -> World -> World
+plainShellCollisionCheck = shellCollisionCheck $ \pj ->
+             (usePayload (_prjPayload pj) (_prjPos pj))
+            . (stopSoundFrom (ShellSound (_prjID pj)))
+            . (cWorld . projectiles %~ IM.delete (_prjID pj))
 
 upsProjectile :: Proj -> World -> World
 upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
@@ -96,31 +58,31 @@ upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
 upProjectile :: ProjectileUpdate -> Proj -> World -> World
 upProjectile pu pj = case pu of
     PJRemoteShellCollisionCheck -> remoteShellCollisionCheck pj
-    PJShellCollisionCheck -> updateShell pj
+    PJShellCollisionCheck -> plainShellCollisionCheck pj
     PJDecTimMvVel -> decTimMvVel pj
     PJThrust st et
         | act st et -> doThrust pj
         | otherwise -> id
     PJSpin t cid spinamount
-        | ain t -> trySpinByCID' cid spinamount pj
+        | ain t -> trySpinByCID cid spinamount pj
         | otherwise -> id
     PJTrack st et itid
-        | act st et -> pjTrack' itid pj
+        | act st et -> pjTrack itid pj
         | otherwise -> id
-    PJReduceSpin x -> reduceSpinBy' x pj
+    PJReduceSpin x -> reduceSpinBy x pj
     PJRemoteDirection st et cid itid
         | act st et -> setRemoteDir cid itid pj
         | otherwise -> id
     PJSetScope itid -> setRemoteScope itid (_prjPos pj)
-    PJRetireRemote itid 0 pjid -> retireRemoteProj'' itid pjid
+    PJRetireRemote itid 0 pjid -> retireRemoteProj itid pjid
     PJRetireRemote _ _ pjid -> cWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1
   where
     time = _prjTimer pj
     act st et = time <= st && time >= et
     ain t = time == t
 
-retireRemoteProj'' :: Int -> Int -> World -> World
-retireRemoteProj'' itid pjid w =
+retireRemoteProj :: Int -> Int -> World -> World
+retireRemoteProj itid pjid w =
     w
         & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid)
             %~ ( (itScope . scopePos .~ V2 0 0)
@@ -135,8 +97,8 @@ setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjAcc
     --i = _prjID pj
     newdir
         | SDL.ButtonRight `M.member` _mouseButtons w
---            && w ^? cWorld . creatures . ix cid . crInvSel . iselPos
---                == w ^? cWorld . itemLocations . ix itid . ipInvID
+            && w ^? cWorld . creatures . ix cid . crInvSel . iselPos
+                == w ^? cWorld . itemLocations . ix itid . ipInvID
             = _cameraRot (_cWorld w) + argV (_mousePos w)
         | otherwise = _prjDir pj
 
@@ -158,7 +120,7 @@ doThrust pj w =
     (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
     r1 = randInCirc 10 & evalState $ _randGen w
 
-trySpinByCID' ::
+trySpinByCID ::
     -- | creature id
     Int ->
     -- | Spin amount
@@ -166,7 +128,7 @@ trySpinByCID' ::
     Proj ->
     World ->
     World
-trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
+trySpinByCID cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
   where
     pjid = _prjID pj
     dir = argV $ _prjVel pj
@@ -175,8 +137,8 @@ trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSp
         _ -> 0
     spinFactor = 5 * (6 - fromIntegral i)
 
-pjTrack' :: Int -> Proj -> World -> World
-pjTrack' itid pj w = rotateToTarget pj w
+pjTrack :: Int -> Proj -> World -> World
+pjTrack itid pj w = rotateToTarget pj w
   where
     rotateToTarget _ = fromMaybe id $ do
         tpos <- w ^? itPoint . itTargeting . tgPos . _Just
@@ -189,5 +151,5 @@ pjTrack' itid pj w = rotateToTarget pj w
                     (argV $ _prjAcc pj)
     itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid
 
-reduceSpinBy' :: Float -> Proj -> World -> World
-reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
+reduceSpinBy :: Float -> Proj -> World -> World
+reduceSpinBy x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x