Separate out ammo data

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 itid time pID w 
-    | time < -4 = updatePicture
-                $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
-                    w
-    | time < 2 = case hitWl of
-            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
-            _      -> halfV updatedWorld
-    | otherwise = case hitWl of
-            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
-            _      -> updatedWorld
-  where 
-    updatedWorld = w
-        & updateV 
-        & props . ix pID . prPos .~ finalPos
-        & updatePicture
-        & props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
-    pj     = _props w IM.! pID
-    oldPos = _prPos pj
-    newPos = _pjVel pj +.+ oldPos
-    -- this is hacky, should use a version of collidePointWalls' that collides
-    -- circles and walls
-    invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
-    hitWl  = bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w
-    finalPos = maybe newPos (invShift . fst) hitWl
-    setV v = set (props . ix pID . pjVel) v
-    updateV = maybe id (setV . snd) hitWl
-    halfV = props . ix pID . pjVel %~ (0.5 *.*)
-    f x | x < -369 = -10
-        | otherwise = x - 1
-    updatePicture = 
-        set (props . ix pID . prDraw)
-            (\_ -> (,) mempty $ setDepth 20 $ uncurryV translate newPos $ remoteBombPic time)
+--moveRemoteBomb :: Int -> Int -> Int -> World -> World
+--moveRemoteBomb itid time pID w 
+--    | time < -4 = updatePicture
+--                $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
+--                    w
+--    | time < 2 = case hitWl of
+--            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
+--            _      -> halfV updatedWorld
+--    | otherwise = case hitWl of
+--            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
+--            _      -> updatedWorld
+--  where 
+--    updatedWorld = w
+--        & updateV 
+--        & props . ix pID . prPos .~ finalPos
+--        & updatePicture
+--        & props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
+--    pj     = _props w IM.! pID
+--    oldPos = _prPos pj
+--    newPos = _pjVel pj +.+ oldPos
+--    -- this is hacky, should use a version of collidePointWalls' that collides
+--    -- circles and walls
+--    invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
+--    hitWl  = bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w
+--    finalPos = maybe newPos (invShift . fst) hitWl
+--    setV v = set (props . ix pID . pjVel) v
+--    updateV = maybe id (setV . snd) hitWl
+--    halfV = props . ix pID . pjVel %~ (0.5 *.*)
+--    f x | x < -369 = -10
+--        | otherwise = x - 1
+--    updatePicture = 
+--        set (props . ix pID . prDraw)
+--            (\_ -> (,) 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 itid pjid cr w
-    = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
---        $ set (props . ix pjid . pjDraw) (\_ -> blank)
-        $ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id)
---        $ resetName
-        $ resetPict
---        $ resetScope
-        $ makeExplosionAt (_prPos (_props w IM.! pjid)) w
-        -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
-  where 
-    cid = _crID cr
---    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
-    resetPict = id --set (creatures . ix cid . crInv . ix j . itEquipPict ) 
-                   -- (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
---    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
-    j = crSel $ _creatures w IM.! cid
-remoteBombPic 
-    :: Int -- ^ time
-    -> Picture
-remoteBombPic _ = pictures 
-    [ color (dark $ dark orange) $ circleSolid 5
-    ]
+--explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
+--explodeRemoteBomb itid pjid cr w
+--    = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
+----        $ set (props . ix pjid . pjDraw) (\_ -> blank)
+--        $ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id)
+----        $ resetName
+--        $ resetPict
+----        $ resetScope
+--        $ makeExplosionAt (_prPos (_props w IM.! pjid)) w
+--        -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
+--  where 
+--    cid = _crID cr
+----    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
+--    resetPict = id --set (creatures . ix cid . crInv . ix j . itEquipPict ) 
+--                   -- (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
+----    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
+--    j = crSel $ _creatures w IM.! cid
+--remoteBombPic 
+--    :: Int -- ^ time
+--    -> Picture
+--remoteBombPic _ = pictures 
+--    [ color (dark $ dark orange) $ circleSolid 5
+--    ]
 
 remoteBombUnarmedPic :: Picture
 remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
 
-retireRemoteBomb :: Int -> Int -> Int -> World -> World
-retireRemoteBomb = retireRemoteProj $ const throwRemoteBomb
+--retireRemoteBomb :: Int -> Int -> Int -> World -> World
+--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