Refactor grenades and rockets to allow different explosions

src/Dodge/Critters.hs

@@ -350,7 +350,7 @@ startCr = defaultCreature
     , _crHP = 10000
     , _crMaxHP = 1500
     , _crInv = IM.fromList (zip [0..20] 
-                           ([pistol,autoGun,launcher,lasGun,grenade
+                           ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade
                             ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
                             ,longGun
                             ,hvAutoGun

src/Dodge/Data.hs

@@ -484,6 +484,14 @@ data Projectile = Projectile    { _ptPos :: Point2
                                 , _ptID :: Int
                                 , _ptUpdate :: World -> World
                                 }
+                | Shell { _ptPos :: Point2
+                                , _ptStartPos :: Point2
+                                , _ptVel :: Point2
+                                , _ptPict :: Picture
+                                , _ptID :: Int
+                                , _ptUpdate :: World -> World
+                                , _ptExplosion :: Point2-> World -> World
+                                }
 
 data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
                 | Blunt    {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } 

src/Dodge/Item/Weapon.hs

@@ -333,6 +333,21 @@ launcher = defaultGun
     , _itHammer = NoHammer
     , _itEffect = NoItEffect
     }
+flameLauncher = launcher
+    { _itName = "FLROCKO"
+    , _wpFire = shoot $ aRocket' makeFlameShellAt
+    }
+
+poisonLauncher = launcher 
+    { _itName = "POISROCK"
+    , _wpFire = shoot $ aRocket' makePoisonShellAt
+    }
+
+teslaLauncher = launcher 
+    { _itName = "TESLROCK"
+    , _wpFire = shoot $ aRocket' makeTeslaShellAt
+    }
+
 bezierGun = defaultAutoGun
     { _itName = "B-GUN"
     , _wpFire = maybeSetTarget $ \p ->  shootWithSound 0 
@@ -697,36 +712,80 @@ aTractorBeam col cid w
           dir = _crDir cr
           itRef = _crInvSel cr
 
-aRocket :: Int -> World -> World
+-- |The aRocket' function allows us to define the shell to be used
-aRocket cid w
+aRocket' :: (Int -> Int -> Point2 -> Float -> Projectile) -> Int -> World -> World
+aRocket' shell cid w
         = soundOnce (fromIntegral launcherSound)
-            $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w
+            $ over projectiles (IM.insert i (shell i cid pos dir)) w
     where i = newProjectileKey w
           cr  = (_creatures w IM.! cid)
           pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
           dir = _crDir cr
 
+aRocket :: Int -> World -> World
+aRocket = aRocket' makeShellAt
+--        = soundOnce (fromIntegral launcherSound)
+--            $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w
+--    where i = newProjectileKey w
+--          cr  = (_creatures w IM.! cid)
+--          pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+--          dir = _crDir cr
+
 makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile
-makeShellAt i cid pos dir = Projectile
+makeShellAt i cid pos dir = Shell
     { _ptPos = pos
     , _ptStartPos = pos
     , _ptVel = rotateV dir (1,0)
     , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
     , _ptID = i
     , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
+    , _ptExplosion = shellExplosionAt
+    }
+
+makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile
+makeFlameShellAt i cid pos dir = Shell
+    { _ptPos = pos
+    , _ptStartPos = pos
+    , _ptVel = rotateV dir (1,0)
+    , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
+    , _ptID = i
+    , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
+    , _ptExplosion = makeFlameExplosionAt
+    }
+
+makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile
+makePoisonShellAt i cid pos dir = Shell
+    { _ptPos = pos
+    , _ptStartPos = pos
+    , _ptVel = rotateV dir (1,0)
+    , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
+    , _ptID = i
+    , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
+    , _ptExplosion = makePoisonExplosionAt
+    }
+
+makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile
+makeTeslaShellAt i cid pos dir = Shell
+    { _ptPos = pos
+    , _ptStartPos = pos
+    , _ptVel = rotateV dir (1,0)
+    , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
+    , _ptID = i
+    , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
+    , _ptExplosion = makeTeslaExplosionAt
     }
 
 moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World
 moveShell time i cid rot accel w 
     | time > 40 = if circOnSomeWall oldPos 4 w
-                  then shellExplosionAt oldPos $ over projectiles (IM.delete i) w
+                  then projectileExplosion oldPos $ over projectiles (IM.delete i) w
                   else over (projectiles . ix i . ptPos) (+.+ vel)
                                   $ set (projectiles . ix i . ptPict) piclow
                                   $ set (projectiles . ix i . ptUpdate) 
                                             (moveShell (time-1) i cid rot (rotateV rot accel))
                                     w
     | time == 35 = case thingHit of
-                       Just p  -> shellExplosionAt oldPos
+                       Just p  -> projectileExplosion oldPos
                                     $ over projectiles (IM.delete i) w
                        Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
                                   $ set (projectiles . ix i . ptPict) pic
@@ -734,7 +793,7 @@ moveShell time i cid rot accel w
                                             (moveShell (time-1) i cid spin accel)
                                     w
     | time >= 20 = case thingHit of
-                       Just p  -> shellExplosionAt oldPos
+                       Just p  -> projectileExplosion oldPos
                                     $ over projectiles (IM.delete i) w
                        Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
                                   $ set (projectiles . ix i . ptPict) pic
@@ -743,7 +802,7 @@ moveShell time i cid rot accel w
                                     w
     | time > -99 
         = case thingHit of
-                       Just p  -> shellExplosionAt oldPos
+                       Just p  -> projectileExplosion oldPos
                                     $ stopSoundFrom (ShellSound i)
                                     $ over projectiles (IM.delete i) w
                        Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
@@ -758,7 +817,7 @@ moveShell time i cid rot accel w
                                   $ smokeGen
                                     w
     | time > -200 = case thingHit of
-                       Just p  -> shellExplosionAt oldPos 
+                       Just p  -> projectileExplosion oldPos 
                                     $ stopSoundFrom (ShellSound i)
                                     $ over projectiles (IM.delete i) w
                        Nothing -> over (projectiles . ix i . ptPos) (+.+ vel)
@@ -766,12 +825,13 @@ moveShell time i cid rot accel w
                                   $ set (projectiles . ix i . ptUpdate)
                                             (moveShell (time-1) i cid rot (rotateV rot accel))
                                     w
-    | otherwise = shellExplosionAt oldPos 
+    | otherwise = projectileExplosion oldPos 
                                     $ stopSoundFrom (ShellSound i)
                                     $ over projectiles (IM.delete i) w
         where pt = _projectiles w IM.! i
               oldPos   = _ptPos pt
               vel      = _ptVel pt
+              projectileExplosion = _ptExplosion pt
               newPos   = oldPos +.+ vel
               (frict,g)    = randomR (0.6,0.9) $ _randGen w
               (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
@@ -870,6 +930,74 @@ aFlame a cid w
             resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
                                               (shoot $ aFlame angle)
 
+-- The following should be improved....
+makePoisonExplosionAt :: Point2 -> World -> World
+makePoisonExplosionAt p w = soundOnce grenadeBang 
+                        $ makeGasCloud p (velocities!!1)
+                        $ makeGasCloud p (velocities!!2)
+                        $ makeGasCloud p (velocities!!3)
+                        w
+    where 
+          xs = randomRs (-2,2) $ _randGen w  -- one infinite list of randoms
+          velocities = zip (take 10 xs) (drop 10 xs)
+
+makeTeslaExplosionAt :: Point2 -> World -> World
+makeTeslaExplosionAt pos w = soundOnce grenadeBang 
+                        -- This is obviously the best way....
+                        $ over projectiles (IM.insert (pks!!1) (makeTeslaArcAt (pks!!1) pos (xs!!1)))
+                        $ over projectiles (IM.insert (pks!!2) (makeTeslaArcAt (pks!!2) pos (xs!!2)))
+                        $ over projectiles (IM.insert (pks!!3) (makeTeslaArcAt (pks!!3) pos (xs!!3)))
+                        $ over projectiles (IM.insert (pks!!4) (makeTeslaArcAt (pks!!4) pos (xs!!4)))
+                        $ over projectiles (IM.insert (pks!!5) (makeTeslaArcAt (pks!!5) pos (xs!!5)))
+                        $ over projectiles (IM.insert (pks!!6) (makeTeslaArcAt (pks!!6) pos (xs!!6)))
+                        $ over projectiles (IM.insert (pks!!7) (makeTeslaArcAt (pks!!7) pos (xs!!7)))
+                        $ over projectiles (IM.insert (pks!!8) (makeTeslaArcAt (pks!!8) pos (xs!!8)))
+                        $ over projectiles (IM.insert (pks!!9) (makeTeslaArcAt (pks!!9) pos (xs!!9)))
+                        $ over projectiles (IM.insert (pks!!10) (makeTeslaArcAt (pks!!10) pos (xs!!10)))
+                        $ over projectiles (IM.insert (pks!!11) (makeTeslaArcAt (pks!!11) pos (xs!!11)))
+                        $ over projectiles (IM.insert (pks!!12) (makeTeslaArcAt (pks!!12) pos (xs!!12)))
+                        $ over projectiles (IM.insert (pks!!13) (makeTeslaArcAt (pks!!13) pos (xs!!13)))
+                        $ over projectiles (IM.insert (pks!!14) (makeTeslaArcAt (pks!!14) pos (xs!!14)))
+                        $ over projectiles (IM.insert (pks!!15) (makeTeslaArcAt (pks!!15) pos (xs!!15)))
+                        $ over projectiles (IM.insert (pks!!16) (makeTeslaArcAt (pks!!16) pos (xs!!16)))
+                        $ over projectiles (IM.insert (pks!!17) (makeTeslaArcAt (pks!!17) pos (xs!!17)))
+                        $ over projectiles (IM.insert (pks!!18) (makeTeslaArcAt (pks!!18) pos (xs!!18)))
+                        $ over projectiles (IM.insert (pks!!19) (makeTeslaArcAt (pks!!19) pos (xs!!19)))
+                        $ over projectiles (IM.insert (pks!!20) (makeTeslaArcAt (pks!!20) pos (xs!!20)))
+                        $ over projectiles (IM.insert (pks!!21) (makeTeslaArcAt (pks!!21) pos (xs!!21)))
+                        $ over projectiles (IM.insert (pks!!22) (makeTeslaArcAt (pks!!22) pos (xs!!22)))
+                        $ over projectiles (IM.insert (pks!!23) (makeTeslaArcAt (pks!!23) pos (xs!!23)))
+                        $ over projectiles (IM.insert (pks!!24) (makeTeslaArcAt (pks!!24) pos (xs!!24)))
+                        $ over projectiles (IM.insert (pks!!25) (makeTeslaArcAt (pks!!25) pos (xs!!25)))
+                        $ over projectiles (IM.insert (pks!!26) (makeTeslaArcAt (pks!!26) pos (xs!!26)))
+                        $ over projectiles (IM.insert (pks!!27) (makeTeslaArcAt (pks!!27) pos (xs!!27)))
+                        $ over projectiles (IM.insert (pks!!28) (makeTeslaArcAt (pks!!28) pos (xs!!28)))
+                        $ over projectiles (IM.insert (pks!!29) (makeTeslaArcAt (pks!!29) pos (xs!!29)))
+                        w
+    where 
+          -- rad or 360?
+          xs = randomRs (0,7) $ _randGen w
+          p = newProjectileKey w
+          pks = [p..]
+
+makeFlameExplosionAt :: Point2 -> World -> World
+makeFlameExplosionAt p w = soundOnce grenadeBang 
+                        $ makeFlame p (velocities!!1) (Just 0)
+                        $ makeFlame p (velocities!!2) (Just 90)
+                        $ makeFlame p (velocities!!3) (Just 180)
+                        $ makeFlame p (velocities!!4) (Just 0)
+                        $ makeFlame p (velocities!!5) (Just 0)
+                        $ makeFlame p (velocities!!6) (Just 0)
+                        $ makeFlame p (velocities!!7) (Just 0)
+                        $ makeFlame p (velocities!!8) (Just 0)
+                        $ makeFlame p (velocities!!9) (Just 0)
+                        $ makeFlame p (velocities!!10) (Just 0)
+                        $ w
+    where 
+          xs = randomRs (-2,2) $ _randGen w  -- one infinite list of randoms
+          velocities = zip (take 10 xs) (drop 10 xs)
+
+
 makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
 makeFlame pos vel maycid = over particles' ((:) theFlame)
     where theFlame = 
@@ -961,10 +1089,13 @@ reflect a b = a + 2*(a-b)
 
 moveGrenade :: Int -> Float -> Int -> World -> World
 moveGrenade 0 dir pID w = over projectiles (IM.delete pID) 
-                            $ makeExplosionAt (_ptPos (_projectiles w IM.! pID)) 
+                            $ explosion (_ptPos (_projectiles w IM.! pID)) 
                             -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) 
                             --      (drawWeapon $ grenadePic 50)
                             w
+                        where
+                            pt = _projectiles w IM.! pID
+                            explosion = _ptExplosion pt
 moveGrenade time dir pID w 
     = case hitWl of
         Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
@@ -1243,6 +1374,25 @@ grenade = Throwable
     }
     where fuseTime = 50
           f x = 50 / fromIntegral x
+
+
+flameGrenade :: Item
+flameGrenade = grenade {
+     _itName = "FLMGREN " ++ show fuseTime
+     , _twFire = throwGrenade' makeFlameExplosionAt fuseTime
+    }
+    where fuseTime = 50
+          f x = 50 / fromIntegral x
+
+teslaGrenade :: Item
+teslaGrenade = grenade {
+     _itName = "TLSGREN " ++ show fuseTime
+     , _twFire = throwGrenade' makeTeslaExplosionAt fuseTime
+    }
+    where fuseTime = 50
+          f x = 50 / fromIntegral x
+
+
 increaseFuse :: Int -> Int -> World -> World
 increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
                           & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
@@ -1282,15 +1432,16 @@ remoteBomb = defaultThrowable
     }
 
 
-throwGrenade :: Int -> Int -> World -> World
+throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World
-throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w
+throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w
     where addG = IM.insert i
-                   $ Projectile { _ptPos = p
+                   $ Shell { _ptPos = p
                               , _ptStartPos = p
                               , _ptVel = v
                               , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
                               , _ptID = i
                               , _ptUpdate = moveGrenade fuseTime dir i
+                              , _ptExplosion = explosion
                               }
           j = _crInvSel $ _creatures w IM.! n
           removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
@@ -1309,6 +1460,35 @@ throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set ran
           setWp :: World -> World
           setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
 
+throwGrenade :: Int -> Int -> World -> World
+throwGrenade = throwGrenade' makeExplosionAt
+--    setWp $ removePict $ over projectiles addG $ set randGen g w
+--    where addG = IM.insert i
+--                   $ Shell { _ptPos = p
+--                              , _ptStartPos = p
+--                              , _ptVel = v
+--                              , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
+--                              , _ptID = i
+--                              , _ptUpdate = moveGrenade fuseTime dir i
+--                              , _ptExplosion = makeExplosionAt
+--                              }
+--          j = _crInvSel $ _creatures w IM.! n
+--          removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
+--          i = newProjectileKey w
+--          (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
+--          (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
+--         -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w)
+--          v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
+--          v | magV v' > 6 = 6 *.* normalizeV v'
+--            | otherwise   = v'
+--          cr = _creatures w IM.! n
+--          p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
+--          p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
+--            | otherwise             = p'
+--          dir = argV v 
+--          setWp :: World -> World
+--          setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
+
 throwArmReset :: Int -> ItEffect
 throwArmReset x =
     ItInvEffect {_itInvEffect = f
@@ -2059,3 +2239,7 @@ makeLaserScope p ep d relFrac = Particle'
                                 ]
     ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
     }
+
+
+
+