Move toward shell storing update as list

src/Dodge/Base/Collide.hs

@@ -35,6 +35,8 @@ module Dodge.Base.Collide
     , canSee
     , canSeeIndirect
     , isWalkable
+
+    , anythingHitCirc
     ) where
 import Dodge.Data
 import Dodge.Zone
@@ -212,3 +214,10 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
   where 
     ipos = _crPos (_creatures w IM.! i)
     jpos = _crPos (_creatures w IM.! j)
+
+anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
+anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
+  where
+    hitCr    = runIdentity $ S.any_ (const True) $ overlap1SegCrs sp ep $ crsNearSeg sp ep w
+    hitWl    = collideCircWallsStream sp ep rad $ wlsNearPoint ep w
+                                                    -- this should probably be wallsOnLine or something

src/Dodge/Data.hs

@@ -742,16 +742,9 @@ data Proj
         , _prjPayload :: Payload
         , _prjTimer :: Int
         , _prjZ :: Float
+        , _prjUpdates :: [ProjectileUpdate]
         }
 data Prop 
---    = Projectile    
---        { _prPos :: Point2
---        , _pjStartPos :: Point2
---        , _pjVel :: Point2
---        , _prDraw :: Prop -> SPic
---        , _pjID :: Int
---        , _pjUpdate :: Prop -> World -> World
---        }
     = PropZ
         { _prPos :: Point2
         , _pjStartPos :: Point2

src/Dodge/Data/Ammo.hs

@@ -9,6 +9,6 @@ data ProjectileUpdate
     | PJSpin   {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
     | PJTrack  {_pjuStart :: Int, _pjuEnd :: Int, _pjuITID :: Int}
     | PJReduceSpin {_pjuReduceSpin :: Float}
-    | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int}
+    | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int}
-    | PJPayload {_pjuTime :: Int}
+    | PJSetScope {_pjuITID :: Int}
 

src/Dodge/Default/Shell.hs

@@ -17,4 +17,5 @@ defaultShell = Shell
     , _prjTimer = 0
     , _prjUpdate = const id
     , _prjPayload = ExplosionPayload
+    , _prjUpdates = []
     }

src/Dodge/Item/Weapon/Launcher.hs

@@ -6,6 +6,7 @@ module Dodge.Item.Weapon.Launcher
     ) where
 import Dodge.Data
 import Dodge.Payload
+import Dodge.Base.Collide
 import Dodge.Reloading.Action
 import Dodge.EnergyBall
 import Dodge.Default.Weapon
@@ -16,6 +17,7 @@ import Dodge.Item.Weapon.Remote
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Movement.Turn
 import Dodge.Base
+import Dodge.Base.Collide
 import Dodge.Zone
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Cloud
@@ -84,7 +86,6 @@ launcherX i = launcher
         , useTimeCheck
         , withSoundStart tap4S
         , useAmmoAmount i
-        ]
 
 usePjCreation :: Item -> Creature -> World -> World
 usePjCreation it = _amPjCreation (_laAmmoType (_itConsumption it)) it
@@ -291,12 +292,6 @@ moveRemoteShell cid itid pj w
     smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
     doExplosion = explodeRemoteRocket itid i $ stopSoundFrom (ShellSound i) w
 
-anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
-anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
-  where
-    hitCr    = runIdentity $ S.any_ (const True) $ overlap1SegCrs sp ep $ crsNearSeg sp ep w
-    hitWl    = collideCircWallsStream sp ep rad $ wlsNearPoint ep w
-                                                    -- this should probably be wallsOnLine or something
 explodeRemoteRocket 
     :: Int  -- ^ Item id
     -> Int  -- ^ Projectile id
@@ -341,6 +336,7 @@ makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell
     , _prjSpin = 0
     , _prjPayload = _amPayload $ _laAmmoType am
     , _prjTimer = 50
+    , _prjUpdates = []
     }
   where
     i = IM.newKey $ _props w

src/Dodge/Projectile/Create.hs

@@ -1,20 +1,20 @@
 module Dodge.Projectile.Create where
 import Dodge.Data
-import Dodge.Item.Weapon.Shell
+--import Dodge.Item.Weapon.Shell
-import Dodge.Base.Collide
+--import Dodge.Base.Collide
-import Dodge.Base
+--import Dodge.Base
-import Dodge.Payload
+--import Dodge.Payload
-import Dodge.SoundLogic
+--import Dodge.SoundLogic
-import Dodge.Movement.Turn
+--import Dodge.Movement.Turn
-import Dodge.Item.Location
+--import Dodge.Item.Location
-import Dodge.EnergyBall
+--import Dodge.EnergyBall
-import Dodge.WorldEvent.Cloud
+--import Dodge.WorldEvent.Cloud
-import LensHelp
+--import LensHelp
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
-import Geometry
+--import Geometry
-import RandomHelp
+--import RandomHelp
-
+--
-import Data.Maybe
+--import Data.Maybe
 
 createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World 
 createProjectile pt = case pt of

src/Dodge/Projectile/Update.hs

@@ -1,2 +1,130 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update where
---import Dodge.Data
+import Dodge.Data
+import Dodge.Payload
+import Dodge.Reloading.Action
+import Dodge.EnergyBall
+import Dodge.Default.Weapon
+import Dodge.Item.Location
+import Dodge.SoundLogic.LoadSound
+import Dodge.Item.Weapon.Shell
+import Dodge.Item.Weapon.Remote
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Movement.Turn
+import Dodge.Base
+import Dodge.Zone
+import Dodge.SoundLogic
+import Dodge.WorldEvent.Cloud
+import RandomHelp
+import Geometry
+import qualified IntMapHelp as IM
+
+import qualified Streaming.Prelude as S
+--import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+import qualified SDL
+import Data.Maybe
+import Control.Lens
+
+
+updateProjectile :: Proj -> World -> World
+updateProjectile pj = case pj of
+    Shell{} -> updateShell pj . decTimMvVel pj . upsProjectile pj
+    RemoteShell{} -> _prjUpdate pj 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)
+        & projectiles %~ IM.delete i
+    i = _prjID pj
+    oldPos   = _prjPos pj
+    vel      = _prjVel pj
+    newPos   = oldPos +.+ vel
+
+upsProjectile :: Proj -> World -> World
+upsProjectile pj w' = foldr (\pu -> upProjectile pu pj) w' (_prjUpdates pj)
+
+upProjectile :: ProjectileUpdate -> Proj -> World -> World
+upProjectile pu pj = case pu of
+    PJThrust st et 
+        | act st et -> doThrust' pj
+        | otherwise -> id
+    PJSpin t cid spinamount
+        | ain t -> trySpinByCID' cid spinamount pj
+        | otherwise -> id
+    PJTrack st et itid
+        | act st et -> pjTrack' itid pj
+        | otherwise -> id
+    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)
+  where
+    time = _prjTimer pj
+    act st et = time >= st && time <= et
+    ain t = time == t
+
+setRemoteDir :: Int -> Int -> Proj -> World -> World
+setRemoteDir cid itid pj w = w & projectiles . ix i . prjDir .~ newdir
+  where
+    i       = _prjID pj
+    newdir 
+        | SDL.ButtonRight `M.member` _mouseButtons w
+            && w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvID
+                  = _cameraRot w + argV (_mousePos w)
+        | otherwise = _prjDir pj
+
+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
+
+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)
+
+pjTrack' :: Int -> Proj -> World -> World
+pjTrack' itid pj w = rotateToTarget pj w
+  where
+    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
+
+reduceSpinBy' :: Float -> Proj -> World -> World
+reduceSpinBy' x pj = projectiles . ix (_prjID pj) .  prjSpin *~ x

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.Projectile.Update
 import Dodge.Creature.Update
 import Dodge.RadarSweep
 import Dodge.PosEvent
@@ -87,7 +88,7 @@ functionalUpdate cfig w = checkEndGame
     . updateFlares 
     . updateBeams
     . updateIMl _props _pjUpdate  
-    . updateIMl _projectiles _prjUpdate
+    . updateIMl' _projectiles updateProjectile
     . updateLightSources
     . updateClouds
     . updateGusts