Separate out ammo data

src/Dodge/Combine/Module.hs

@@ -2,7 +2,6 @@ module Dodge.Combine.Module where
 import Dodge.Data
 import Dodge.Tesla
 import Dodge.Item.Weapon.ExtraEffect
-import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.TriggerType
 import LensHelp
 import Geometry
@@ -34,7 +33,7 @@ moduleModification imt = case imt of
     STATICLAS   -> (itParams . lasBeam .~ BeamCombine teslaBeamCombine)
         . (itParams . subParams ?~ teslaParams)
     WEPTELE     -> makeDirectedTele
-    LAUNCHHOME  -> itConsumption . laAmmoType . amPjCreation .~ fireTrackingShell
+    LAUNCHHOME  -> itConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
     EXTRABATTERY -> itConsumption . laMax +~ 1000
     ATTACHTORCH  -> id
   where

src/Dodge/Data.hs

@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.Gas
     , module Dodge.Data.Ammo
     , module Dodge.Data.Payload
     , module Dodge.Data.RadarSweep
@@ -55,6 +56,7 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.Gas
 import Dodge.Data.Ammo
 import Dodge.Data.Payload
 import Dodge.Data.RadarSweep
@@ -591,27 +593,6 @@ type HitEffect' = Flame
     -> World 
     -> (World,Maybe Flame)
 
-data AmmoType
-    = ProjectileAmmo
-        { _amPayload :: Payload
-        , _amString :: String
-        , _amPjDraw :: ProjectileDraw
-        , _amPjCreation :: Item -> Creature -> World -> World
-        }
-    | BulletAmmo
-        { _amString :: String 
-        , _amBullet :: Bullet
-        }
-    | DroneAmmo
-        { _amString :: String }
-    | GasAmmo
-        { _amString    :: String
-        , _amCreateGas :: Float -> Point2 -> Float -> Creature -> World -> World
-        }
-    | ForceFieldAmmo
-        { _amForceFieldType :: Wall
-        }
-    | GenericAmmo
 data ItemTweaks
     = NoTweaks
     | Tweakable
@@ -726,8 +707,8 @@ data Proj
         , _prjVel :: Point2
         , _prjDraw :: ProjectileDraw
         , _prjID :: Int
-        , _prjUpdate :: Proj -> World -> World
         , _prjPayload :: Payload
+        , _prjMITID :: Maybe Int
         }
     | Shell 
         { _prjPos :: Point2
@@ -738,11 +719,11 @@ data Proj
         , _prjSpin :: Float
         , _prjDraw :: ProjectileDraw
         , _prjID :: Int
-        , _prjUpdate :: Proj -> World -> World
         , _prjPayload :: Payload
         , _prjTimer :: Int
         , _prjZ :: Float
         , _prjUpdates :: [ProjectileUpdate]
+        , _prjMITID :: Maybe Int
         }
 data Prop 
     = PropZ
@@ -1299,7 +1280,6 @@ makeLenses ''ItemUse
 makeLenses ''ItEffect
 makeLenses ''FloorItem
 makeLenses ''ItemConsumption
-makeLenses ''AmmoType
 makeLenses ''TweakParam
 makeLenses ''Prop
 makeLenses ''Proj

src/Dodge/Data/Ammo.hs

@@ -1,9 +1,13 @@
---{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell #-}
---{-# LANGUAGE StrictData #-}
+{-# LANGUAGE StrictData #-}
 module Dodge.Data.Ammo where
-
+import Dodge.Data.Payload
+import Dodge.Data.Bullet
+import Dodge.Data.Gas
+import Dodge.Data.Wall
+import Control.Lens
 data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile
-data ProjectileCreate = CreateShell
+data ProjectileCreate = CreateShell | CreateTrackingShell
 data ProjectileUpdate 
     = PJThrust {_pjuStart :: Int, _pjuEnd :: Int}
     | PJSpin   {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
@@ -11,3 +15,28 @@ data ProjectileUpdate
     | PJReduceSpin {_pjuReduceSpin :: Float}
     | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int}
     | PJSetScope {_pjuITID :: Int}
+    | PJRetireRemote {_pjuITID :: Int, _pjuTimer :: Int, _pjuPJID :: Int}
+
+data AmmoType
+    = ProjectileAmmo
+        { _amPayload :: Payload
+        , _amString :: String
+        , _amPjDraw :: ProjectileDraw
+        , _amPjCreation :: ProjectileCreate
+        }
+    | BulletAmmo
+        { _amString :: String 
+        , _amBullet :: Bullet
+        }
+    | DroneAmmo
+        { _amString :: String }
+    | GasAmmo
+        { _amString    :: String
+        , _amCreateGas :: GasCreate
+        }
+    | ForceFieldAmmo
+        { _amForceFieldType :: Wall
+        }
+    | GenericAmmo
+makeLenses ''ProjectileUpdate
+makeLenses ''AmmoType

src/Dodge/Data/Gas.hs

@@ -0,0 +1,4 @@
+--{-# LANGUAGE TemplateHaskell #-}
+--{-# LANGUAGE StrictData #-}
+module Dodge.Data.Gas where
+data GasCreate = CreatePoisonGas | CreateFlame

src/Dodge/Data/Item/Consumption.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Item.Consumption where
+import Control.Lens

src/Dodge/Default/Shell.hs

@@ -15,7 +15,7 @@ defaultShell = Shell
     , _prjDraw = DrawShell
     , _prjID = 0
     , _prjTimer = 0
-    , _prjUpdate = const id
     , _prjPayload = ExplosionPayload
     , _prjUpdates = []
+    , _prjMITID = Nothing
     }

src/Dodge/Gas.hs

@@ -0,0 +1,21 @@
+module Dodge.Gas where
+import Dodge.Data
+import Geometry
+import Dodge.Flame
+import Dodge.WorldEvent
+
+createGas :: GasCreate -> Float -> Point2 -> Float -> Creature -> World -> World
+createGas gc = case gc of
+    CreatePoisonGas -> aGasCloud
+    CreateFlame -> aFlame
+
+aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World
+aGasCloud pressure pos dir cr = makeGasCloud pos 
+    $ (_crPos cr -.- _crOldPos cr) +.+ pressure *.* unitVectorAtAngle dir
+
+aFlame :: Float -> Point2 -> Float -> Creature -> World -> World
+aFlame pressure pos dir cr = makeFlame pos vel
+    --w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr)
+  where 
+--    (t,_) = randomR (99,101) (_randGen w)
+    vel = (_crPos cr -.- _crOldPos cr) +.+ pressure *.* unitVectorAtAngle dir

src/Dodge/Item/Weapon/Grenade.hs

@@ -1,14 +1,8 @@
 module Dodge.Item.Weapon.Grenade where
 import Dodge.Data
-import Dodge.WorldEvent.Explosion
---import Dodge.Item.Weapon.TriggerType
-import Dodge.Item.Weapon.Remote
 import Dodge.Base
 import Dodge.Zone
 import Dodge.SoundLogic
---import Dodge.Item.Draw
---import Dodge.Item.Weapon.InventoryDisplay
---import Dodge.Item.Attachment
 import Picture
 import Geometry
 import ShapePicture
@@ -162,39 +156,39 @@ throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x }
 --    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
 
 -- TODO hive out movement and share with moveGrenade
-moveRemoteBomb :: Int -> Int -> Int -> World -> World
+--moveRemoteBomb :: Int -> Int -> Int -> World -> World
-moveRemoteBomb itid time pID w 
+--moveRemoteBomb itid time pID w 
-    | time < -4 = updatePicture
+--    | time < -4 = updatePicture
-                $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
+--                $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
-                    w
+--                    w
-    | time < 2 = case hitWl of
+--    | time < 2 = case hitWl of
-            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
+--            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
-            _      -> halfV updatedWorld
+--            _      -> halfV updatedWorld
-    | otherwise = case hitWl of
+--    | otherwise = case hitWl of
-            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
+--            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
-            _      -> updatedWorld
+--            _      -> updatedWorld
-  where 
+--  where 
-    updatedWorld = w
+--    updatedWorld = w
-        & updateV 
+--        & updateV 
-        & props . ix pID . prPos .~ finalPos
+--        & props . ix pID . prPos .~ finalPos
-        & updatePicture
+--        & updatePicture
-        & props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
+--        & props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
-    pj     = _props w IM.! pID
+--    pj     = _props w IM.! pID
-    oldPos = _prPos pj
+--    oldPos = _prPos pj
-    newPos = _pjVel pj +.+ oldPos
+--    newPos = _pjVel pj +.+ oldPos
-    -- this is hacky, should use a version of collidePointWalls' that collides
+--    -- this is hacky, should use a version of collidePointWalls' that collides
-    -- circles and walls
+--    -- circles and walls
-    invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
+--    invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
-    hitWl  = bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w
+--    hitWl  = bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w
-    finalPos = maybe newPos (invShift . fst) hitWl
+--    finalPos = maybe newPos (invShift . fst) hitWl
-    setV v = set (props . ix pID . pjVel) v
+--    setV v = set (props . ix pID . pjVel) v
-    updateV = maybe id (setV . snd) hitWl
+--    updateV = maybe id (setV . snd) hitWl
-    halfV = props . ix pID . pjVel %~ (0.5 *.*)
+--    halfV = props . ix pID . pjVel %~ (0.5 *.*)
-    f x | x < -369 = -10
+--    f x | x < -369 = -10
-        | otherwise = x - 1
+--        | otherwise = x - 1
-    updatePicture = 
+--    updatePicture = 
-        set (props . ix pID . prDraw)
+--        set (props . ix pID . prDraw)
-            (\_ -> (,) mempty $ setDepth 20 $ uncurryV translate newPos $ remoteBombPic time)
+--            (\_ -> (,) mempty $ setDepth 20 $ uncurryV translate newPos $ remoteBombPic time)
 
 
 
@@ -255,32 +249,32 @@ throwRemoteBomb = undefined
 --    newitid = IM.newKey $ _itemPositions w
 --    itid = fromMaybe newitid maybeitid
 
-explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
+--explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
-explodeRemoteBomb itid pjid cr w
+--explodeRemoteBomb itid pjid cr w
-    = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
+--    = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
---        $ set (props . ix pjid . pjDraw) (\_ -> blank)
+----        $ set (props . ix pjid . pjDraw) (\_ -> blank)
-        $ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id)
+--        $ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id)
---        $ resetName
+----        $ resetName
-        $ resetPict
+--        $ resetPict
---        $ resetScope
+----        $ resetScope
-        $ makeExplosionAt (_prPos (_props w IM.! pjid)) w
+--        $ makeExplosionAt (_prPos (_props w IM.! pjid)) w
-        -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
+--        -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
-  where 
+--  where 
-    cid = _crID cr
+--    cid = _crID cr
---    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
+----    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
-    resetPict = id --set (creatures . ix cid . crInv . ix j . itEquipPict ) 
+--    resetPict = id --set (creatures . ix cid . crInv . ix j . itEquipPict ) 
-                   -- (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
+--                   -- (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
---    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
+----    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
-    j = crSel $ _creatures w IM.! cid
+--    j = crSel $ _creatures w IM.! cid
-remoteBombPic 
+--remoteBombPic 
-    :: Int -- ^ time
+--    :: Int -- ^ time
-    -> Picture
+--    -> Picture
-remoteBombPic _ = pictures 
+--remoteBombPic _ = pictures 
-    [ color (dark $ dark orange) $ circleSolid 5
+--    [ color (dark $ dark orange) $ circleSolid 5
-    ]
+--    ]
 
 remoteBombUnarmedPic :: Picture
 remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
 
-retireRemoteBomb :: Int -> Int -> Int -> World -> World
+--retireRemoteBomb :: Int -> Int -> Int -> World -> World
-retireRemoteBomb = retireRemoteProj $ const throwRemoteBomb
+--retireRemoteBomb = retireRemoteProj $ const throwRemoteBomb

src/Dodge/Item/Weapon/Launcher.hs

@@ -3,14 +3,15 @@ module Dodge.Item.Weapon.Launcher
     , launcherX
     , remoteLauncher
     , fireTrackingShell
+    , fireRemoteShell
     ) where
 import Dodge.Data
+import Dodge.Projectile.Create
 import Dodge.Payload
 import Dodge.Reloading.Action
 import Dodge.Default.Weapon
 import Dodge.Item.Location
 import Dodge.SoundLogic.LoadSound
-import Dodge.Item.Weapon.Remote
 import Dodge.Item.Weapon.TriggerType
 import Geometry
 import qualified IntMapHelp as IM
@@ -24,7 +25,7 @@ launcher = defaultWeapon
             { _amPayload = ExplosionPayload
             , _amString = "EXPLOSIVE SHELL"
             , _amPjDraw = DrawShell
-            , _amPjCreation = fireShell
+            , _amPjCreation = CreateShell
             }
         & laMax .~ 1
         & laLoaded .~ 1
@@ -74,14 +75,14 @@ launcherX i = launcher
         ]
 
 usePjCreation :: Item -> Creature -> World -> World
-usePjCreation it = _amPjCreation (_laAmmoType (_itConsumption it)) it
+usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it
 
 usePjCreationX :: Int -> Item -> Creature -> World -> World
 usePjCreationX i it cr = foldr f 
-    (_amPjCreation (_laAmmoType (_itConsumption it)) it cr)
+    (createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr)
     [1..i-1]
   where
-    f n = (. _amPjCreation (_laAmmoType (_itConsumption it)) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
+    f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
 
 basicAmPjMoves :: IM.IntMap TweakParam
 basicAmPjMoves = IM.fromList . zip [0..] $
@@ -114,17 +115,6 @@ thrustParam = TweakParam
     , _nameTweak = "THRUST DELAY"
     }
 
-fireShell :: Item -> Creature -> World -> World
-fireShell it cr = makeShell it cr 
-    [ PJSpin 335 (_crID cr) spinamount
-    , PJThrust (350 - thrustdelay) 0 
-    , PJReduceSpin (1-fromIntegral spindrag*2 / 200)
-    ]
-  where 
-    params = _itParams it
-    spindrag = _shellSpinDrag params
-    spinamount = _shellSpinAmount params
-    thrustdelay = _shellThrustDelay params
 
 remoteLauncher :: Item
 remoteLauncher = launcher 
@@ -155,48 +145,12 @@ explodeRemoteRocket
     -> World 
     -> World
 explodeRemoteRocket itid pjid w = w
-    & projectiles . ix pjid . prjUpdate .~ (\_ -> retireRemoteProj fireRemoteShell itid 30 pjid)
+    & projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
     & projectiles . ix pjid . prjDraw   .~ DrawBlankProjectile
     & itPoint . itUse . rUse     .~ (\_ _ -> id)
---    & itPoint . itName           .~ "REMOTELAUNCHER"
     & usePayload (_prjPayload thepj) (_prjPos thepj)
   where 
     itPoint = pointToItem $ _itemPositions w IM.! itid
     thepj = _projectiles w IM.! pjid
 
-fireTrackingShell :: Item -> Creature -> World -> World
-fireTrackingShell it cr w = addTrackRocket w'
-  where
-    (w',itid) = getHeldItemLoc cr w
-    addTrackRocket = makeShell it cr
-        [ PJSpin 335 (_crID cr) spinamount
-        , PJTrack (350 - thrustdelay) 0 itid
-        , PJThrust (350 - thrustdelay) 0 
-        , PJReduceSpin (1-fromIntegral spindrag*2 / 200)
-        ]
-    spinamount = _shellSpinAmount params
-    thrustdelay = _shellThrustDelay params
-    spindrag = _shellSpinDrag params
-    params = _itParams it
 
-makeShell :: Item -> Creature -> [ProjectileUpdate] -> 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)
-    , _prjDraw = DrawShell
-    , _prjID = i
-    , _prjUpdate = const id
-    , _prjAcc = rotateV dir (V2 3 0)
-    , _prjDir = dir
-    , _prjSpin = 0
-    , _prjPayload = _amPayload $ _laAmmoType am
-    , _prjTimer = 350
-    , _prjUpdates = theupdate
-    }
-  where
-    i = IM.newKey $ _props w
-    dir = _crDir cr
-    pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
-    am = _itConsumption it

src/Dodge/Item/Weapon/Remote.hs

@@ -1,6 +1,5 @@
 module Dodge.Item.Weapon.Remote
     ( pointToItem
-    , retireRemoteProj
     , setRemoteScope
     , setRemoteBombScope
     ) where
@@ -11,25 +10,6 @@ import Dodge.Item.Location
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
-import Data.Maybe
-
-retireRemoteProj :: (Item -> Creature -> World -> World) 
-    -> Int -> Int -> Int -> World -> World
-retireRemoteProj resetFire itid 0 pjid w = w
-    & pointToItem (_itemPositions w IM.! itid) %~ 
-        ( (itScope . scopePos .~ V2 0 0)
-        . (itUse . rUse .~ resetFire)
-        )
-    & props %~ IM.delete pjid
-retireRemoteProj resetFire itid t pjid w = setScope w 
-    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteProj resetFire itid (t-1) pjid)
-  where
-    setScope w' = case _itemPositions w' IM.! itid of
-        InInv cid invid -> w' 
-            & creatures . ix cid . crInv . ix invid . itScope 
-                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
-        _   -> w'
-    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . prPos
 
 setRemoteBombScope :: Int -> Prop -> World -> World
 setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -7,11 +7,9 @@ module Dodge.Item.Weapon.SprayGuns
     , flameWall
     ) where
 import Dodge.Data
+import Dodge.Gas
 import Dodge.Reloading.Action
-import Dodge.Flame
 import Dodge.SoundLogic.LoadSound
---import Dodge.Creature.Action
-import Dodge.WorldEvent
 import Dodge.Default
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.InventoryDisplay
@@ -30,7 +28,7 @@ poisonSprayer = flameThrower
     & itType . iyBase .~ HELD POISONSPRAYER
     & itConsumption . laAmmoType .~ GasAmmo
         { _amString = "POISONGAS"
-        , _amCreateGas = aGasCloud
+        , _amCreateGas = CreatePoisonGas --aGasCloud
         }
     & itUse . useMods .~
         [ ammoCheckI
@@ -95,7 +93,7 @@ flameThrower = defaultAutoGun
         & laMax .~ 250
         & laAmmoType .~ GasAmmo
             {_amString = "FLAME"
-            ,_amCreateGas = aFlame
+            ,_amCreateGas = CreateFlame --aFlame
             }
         & laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
     , _itParams = Sprayer
@@ -129,9 +127,6 @@ flameThrower = defaultAutoGun
     & itUse . useAim . aimMuzPos .~ 18
     & itType . iyBase .~ HELD FLAMETHROWER
 
-aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World
-aGasCloud pressure pos dir cr = makeGasCloud pos 
-    $ (_crPos cr -.- _crOldPos cr) +.+ pressure *.* unitVectorAtAngle dir
 
 overNozzles :: (Nozzle -> Item -> Creature -> World -> World)
     -> Item -> Creature -> World -> World
@@ -158,14 +153,9 @@ overNozzle eff it cr w nz =
     wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
 
 useGasParams :: Nozzle -> Item -> Creature -> World -> World
-useGasParams nz it cr = _amCreateGas (_laAmmoType (_itConsumption it)) (_nzPressure nz) pos dir cr
+useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it))) 
+    (_nzPressure nz) pos dir cr
   where 
     dir = _crDir cr
     pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
 
-aFlame :: Float -> Point2 -> Float -> Creature -> World -> World
-aFlame pressure pos dir cr = makeFlame pos vel
-    --w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr)
-  where 
---    (t,_) = randomR (99,101) (_randGen w)
-    vel = (_crPos cr -.- _crOldPos cr) +.+ pressure *.* unitVectorAtAngle dir

src/Dodge/Projectile.hs

@@ -1,69 +1,3 @@
 module Dodge.Projectile where
-import Dodge.Data
+--import Dodge.Data
 
-createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World 
-createProjectile pt = case pt of
-    CreateShell -> undefined
---
---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 -> (Projectile -> World -> World) -> World -> World
---makeShell it cr theupdate w = w & props %~ IM.insert i Shell 
---    { _prPos = pos
---    , _pjZ   = 20
---    , _pjStartPos = pos
---    , _pjVel = rotateV dir (V2 1 0)
---    , _pjID = i
---    , _pjUpdate = theupdate
---    , _pjAcc = rotateV dir (V2 3 0)
---    , _pjDir = dir
---    , _pjSpin = 0
---    , _pjPayload = _amPayload $ _laAmmoType am
---    , _pjTimer = 50
---    }
---  where
---    i = IM.newKey $ _props w
---    dir = _crDir cr
---    pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
---    am = _itConsumption it
---
---moveShell :: Prop   -- ^ Projectile id
---    -> 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 = _pjTimer pj
---    doExplode = w
---        & usePayload (_pjPayload pj) oldPos 
---        & stopSoundFrom (ShellSound i)
---        & props %~ IM.delete i
---    i = _pjID pj
---    oldPos   = _prPos pj
---    vel      = _pjVel 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 
---    (_amPjCreation (_laAmmoType (_itConsumption it)) it cr)
---    [1..i-1]
---  where
---    f n = (. _amPjCreation (_laAmmoType (_itConsumption it)) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))

src/Dodge/Projectile/Create.hs

@@ -1,25 +1,55 @@
 module Dodge.Projectile.Create where
 import Dodge.Data
---import Dodge.Item.Weapon.Shell
---import Dodge.Base.Collide
---import Dodge.Base
 --import Dodge.Payload
 --import Dodge.SoundLogic
 --import Dodge.Movement.Turn
---import Dodge.Item.Location
+import Dodge.Item.Location
 --import Dodge.EnergyBall
 --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 Data.Maybe
 
 createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World 
 createProjectile pt = case pt of
-    CreateShell -> undefined
+    CreateShell -> fireShell
-    --CreateRemoteShell -> undefined
+    CreateTrackingShell -> fireTrackingShell
+
+fireShell :: Item -> Creature -> World -> World
+fireShell it cr = makeShell it cr 
+    [ PJSpin 335 (_crID cr) spinamount
+    , PJThrust (350 - thrustdelay) 0 
+    , PJReduceSpin (1-fromIntegral spindrag*2 / 200)
+    ]
+  where 
+    params = _itParams it
+    spindrag = _shellSpinDrag params
+    spinamount = _shellSpinAmount params
+    thrustdelay = _shellThrustDelay params
+makeShell :: Item -> Creature -> [ProjectileUpdate] -> 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)
+    , _prjDraw = DrawShell
+    , _prjID = i
+    , _prjAcc = rotateV dir (V2 3 0)
+    , _prjDir = dir
+    , _prjSpin = 0
+    , _prjPayload = _amPayload $ _laAmmoType am
+    , _prjTimer = 350
+    , _prjUpdates = theupdate
+    , _prjMITID = _itID it
+    }
+  where
+    i = IM.newKey $ _props w
+    dir = _crDir cr
+    pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
+    am = _itConsumption it
 
 --fireShell :: Item -> Creature -> World -> World
 --fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj 
@@ -159,3 +189,17 @@ createProjectile pt = case pt of
 --    | otherwise = id
 --  where
 --    t = _prjTimer pj
+fireTrackingShell :: Item -> Creature -> World -> World
+fireTrackingShell it cr w = addTrackRocket w'
+  where
+    (w',itid) = getHeldItemLoc cr w
+    addTrackRocket = makeShell it cr
+        [ PJSpin 335 (_crID cr) spinamount
+        , PJTrack (350 - thrustdelay) 0 itid
+        , PJThrust (350 - thrustdelay) 0 
+        , PJReduceSpin (1-fromIntegral spindrag*2 / 200)
+        ]
+    spinamount = _shellSpinAmount params
+    thrustdelay = _shellThrustDelay params
+    spindrag = _shellSpinDrag params
+    params = _itParams it

src/Dodge/Projectile/Update.hs

@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update where
+import Dodge.Item.Weapon.Launcher
 import Dodge.Data
 import Dodge.Payload
 import Dodge.Reloading.Action
@@ -30,7 +31,43 @@ import Control.Lens
 updateProjectile :: Proj -> World -> World
 updateProjectile pj = case pj of
     Shell{} -> updateShell pj . decTimMvVel pj . upsProjectile pj
-    RemoteShell{} -> updateShell pj . decTimMvVel pj . upsProjectile pj
+    RemoteShell{} -> updateRemoteShell pj . decTimMvVel pj . upsProjectile pj
+
+updateRemoteShell :: Proj -> World -> World
+updateRemoteShell 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
+
+explodeRemoteRocket' 
+    :: Maybe Int  -- ^ Item id
+    -> Proj
+    -> World 
+    -> World
+explodeRemoteRocket' mitid thepj w = w
+    & projectiles . ix pjid . prjDraw   .~ DrawBlankProjectile
+    & usePayload (_prjPayload thepj) (_prjPos thepj)
+    & updateitem
+  where 
+    updateitem = fromMaybe (projectiles . at pjid .~ Nothing) $ do
+        itid <- mitid
+        itpos <- w ^? itemPositions . ix itid
+        return $ (pointToItem itpos . itUse . rUse     .~ (\_ _ -> id))
+            . (projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
+    pjid = _prjID thepj
 
 updateShell :: Proj -> World -> World
 updateShell pj w
@@ -52,7 +89,7 @@ updateShell pj w
     newPos   = oldPos +.+ vel
 
 upsProjectile :: Proj -> World -> World
-upsProjectile pj w' = foldr (\pu -> upProjectile pu pj) w' (_prjUpdates pj)
+upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
 
 upProjectile :: ProjectileUpdate -> Proj -> World -> World
 upProjectile pu pj = case pu of
@@ -70,11 +107,21 @@ upProjectile pu pj = case pu of
         | act st et -> setRemoteDir cid itid pj
         | otherwise -> id
     PJSetScope itid -> setRemoteScope itid (_prjPos pj)
+    PJRetireRemote itid 0 pjid -> retireRemoteProj'' itid pjid
+    PJRetireRemote _ _ pjid -> 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 = w
+    & pointToItem (_itemPositions w IM.! itid) %~ 
+        ( (itScope . scopePos .~ V2 0 0)
+        . (itUse . rUse .~ fireRemoteShell)
+        )
+    & props %~ IM.delete pjid
+
 setRemoteDir :: Int -> Int -> Proj -> World -> World
 setRemoteDir cid itid pj w = w & projectiles . ix i . prjDir .~ newdir
   where