Rehome launcher

src/Dodge/Config/KeyConfig.hs

@@ -31,44 +31,46 @@ data KeyConfig = KeyConfig
   deriving (Generic, Show)
 
 data KeyConfigSDL = KeyConfigSDL
-  { moveUpKey :: SDL.Scancode,
-    moveDownKey :: SDL.Scancode,
-    moveLeftKey :: SDL.Scancode,
-    moveRightKey :: SDL.Scancode,
-    pauseKey :: SDL.Scancode,
-    escapeKey :: SDL.Scancode,
-    dropItemKey :: SDL.Scancode,
-    toggleMapKey :: SDL.Scancode,
-    reloadKey :: SDL.Scancode,
-    testEventKey :: SDL.Scancode,
-    spaceActionKey :: SDL.Scancode,
-    rotateCameraPlusKey :: SDL.Scancode,
-    rotateCameraMinusKey :: SDL.Scancode,
-    zoomInKey :: SDL.Scancode,
-    zoomOutKey :: SDL.Scancode,
-    newMapKey :: SDL.Scancode 
+  { moveUpKey :: SDL.Scancode
+  , moveDownKey :: SDL.Scancode
+  , moveLeftKey :: SDL.Scancode
+  , moveRightKey :: SDL.Scancode
+  , pauseKey :: SDL.Scancode
+  , escapeKey :: SDL.Scancode
+  , dropItemKey :: SDL.Scancode
+  , toggleMapKey :: SDL.Scancode
+  , reloadKey :: SDL.Scancode
+  , testEventKey :: SDL.Scancode
+  , spaceActionKey :: SDL.Scancode
+  , rotateCameraPlusKey :: SDL.Scancode
+  , rotateCameraMinusKey :: SDL.Scancode
+  , zoomInKey :: SDL.Scancode
+  , zoomOutKey :: SDL.Scancode
+  , newMapKey :: SDL.Scancode
+  , modifierKey :: SDL.Scancode 
   }
   deriving (Generic, Show)
 
 defaultKeyConfigSDL :: KeyConfigSDL
 defaultKeyConfigSDL =
   KeyConfigSDL
-    { moveUpKey = SDL.ScancodeW,
-      moveDownKey = SDL.ScancodeS,
-      moveLeftKey = SDL.ScancodeA,
-      moveRightKey = SDL.ScancodeD,
-      pauseKey = SDL.ScancodeP,
-      escapeKey = SDL.ScancodeEscape,
-      dropItemKey = SDL.ScancodeF,
-      toggleMapKey = SDL.ScancodeM,
-      reloadKey = SDL.ScancodeR,
-      testEventKey = SDL.ScancodeT,
-      spaceActionKey = SDL.ScancodeSpace,
-      rotateCameraPlusKey = SDL.ScancodeQ,
-      rotateCameraMinusKey = SDL.ScancodeE,
-      zoomInKey = SDL.ScancodeJ,
-      zoomOutKey = SDL.ScancodeK,
-      newMapKey = SDL.ScancodeN
+    { moveUpKey = SDL.ScancodeW
+    , moveDownKey = SDL.ScancodeS
+    , moveLeftKey = SDL.ScancodeA
+    , moveRightKey = SDL.ScancodeD
+    , pauseKey = SDL.ScancodeP
+    , escapeKey = SDL.ScancodeEscape
+    , dropItemKey = SDL.ScancodeF
+    , toggleMapKey = SDL.ScancodeM
+    , reloadKey = SDL.ScancodeR
+    , testEventKey = SDL.ScancodeT
+    , spaceActionKey = SDL.ScancodeSpace
+    , rotateCameraPlusKey = SDL.ScancodeQ
+    , rotateCameraMinusKey = SDL.ScancodeE
+    , zoomInKey = SDL.ScancodeJ
+    , zoomOutKey = SDL.ScancodeK
+    , newMapKey = SDL.ScancodeN
+    , modifierKey = SDL.ScancodeCapsLock
     }
 
 --instance ToJSON KeyConfig where

src/Dodge/Creature.hs

@@ -29,6 +29,7 @@ import Dodge.Creature.ArmourChase
 import Dodge.Data
 import Dodge.Default
 import Dodge.Item.Weapon
+import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
 import Dodge.WorldEvent.Cloud

src/Dodge/Creature/LauncherCrit.hs

@@ -14,7 +14,7 @@ import Dodge.Creature.Rationality
 import Dodge.Creature.AlertLevel
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
-import Dodge.Item.Weapon
+import Dodge.Item.Weapon.Launcher
 --import Dodge.Item.Consumable
 --import Geometry
 import Picture

src/Dodge/Data.hs

@@ -148,6 +148,7 @@ data Creature = Creature
     , _crMaxHP          :: Int
     , _crInv            :: IM.IntMap Item
     , _crInvSel         :: Int
+    , _crLeftInvSel     :: Maybe Int
     , _crState          :: CreatureState
     , _crCorpse         :: Picture
     , _crApplyDamage    :: [DamageType] -> Creature -> (World -> World,Creature)
@@ -193,6 +194,7 @@ data Item
         { _itName :: String
         , _wpMaxAmmo :: Int
         , _wpLoadedAmmo :: Int
+        , _wpAmmo :: Ammo
         , _wpReloadTime :: Int
         , _wpReloadState :: Int
         , _itUseRate :: Int
@@ -381,6 +383,14 @@ data Particle
         , _btTimer'     :: Int
         }
 type HitEffect = Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World,Maybe Particle)
+
+data Ammo
+    = ShellAmmo
+        { _amPayload :: Point2 -> World -> World
+        }
+    | BulletAmmo
+        { }
+    | GenericAmmo
 data Projectile 
     = Projectile    
         { _pjPos :: Point2
@@ -399,7 +409,7 @@ data Projectile
         , _pjDraw :: Projectile -> Picture
         , _pjID :: Int
         , _pjUpdate :: Projectile -> World -> World
-        , _pjPayload :: Point2-> World -> World
+        , _pjPayload :: Point2 -> World -> World
         }
     | LinearShockwave 
         { _pjDraw :: Projectile -> Picture
@@ -645,6 +655,7 @@ makeLenses ''ItemPos
 makeLenses ''ItEffect
 makeLenses ''ItZoom
 makeLenses ''FloorItem
+makeLenses ''Ammo
 makeLenses ''Projectile
 makeLenses ''Particle
 makeLenses ''Wall

src/Dodge/Default.hs

@@ -88,6 +88,7 @@ defaultCreature = Creature
     , _crMaxHP  = 150
     , _crInv    = IM.empty
     , _crInvSel = 0
+    , _crLeftInvSel = Nothing
     , _crState  = defaultState
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
     , _crApplyDamage = defaultApplyDamage

src/Dodge/Default/Weapon.hs

@@ -0,0 +1,37 @@
+module Dodge.Default.Weapon
+    where
+import Dodge.Data
+import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Weapon.InventoryDisplay
+import Picture
+defaultGun :: Item
+defaultGun = Weapon 
+    { _itName = "default"
+    , _itIdentity = Pistol
+    , _wpMaxAmmo = 15
+    , _wpLoadedAmmo = 15
+    , _wpAmmo = GenericAmmo
+    , _wpReloadTime = 40
+    , _wpReloadState = 0
+    , _itUseRate = 8
+    , _itUseTime = 0
+    , _itUse = \_ -> id
+    , _itLeftClickUse = Nothing
+    , _wpSpread = 0.02
+    , _wpRange = 20
+    , _itHammer = HammerUp
+    , _itFloorPict = blank
+    , _itAmount = 1
+    , _itMaxStack = 1
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itZoom = ItZoom 20 0.2 1 20 0.2 1
+    , _itEquipPict = \_ _ -> blank
+    , _itScrollUp = const id
+    , _itScrollDown = const id
+    , _itAttachment = Nothing
+    , _itID = Nothing
+    , _itEffect = wpRecock
+    , _itInvDisplay = basicWeaponDisplay
+    , _itInvColor = white
+    }

src/Dodge/Event.hs

@@ -23,6 +23,7 @@ import Dodge.Inventory
 import Dodge.Config.Data
 --import Geometry
 import Preload.Update
+import qualified IntMapHelp as IM
 
 import Control.Lens
 import Data.Maybe
@@ -30,7 +31,6 @@ import Data.Maybe
 --import Data.List
 --import Data.Function (on)
 import qualified Data.Set as S
-import qualified Data.IntMap.Strict as IM
 import SDL
 
 handleEvent :: World -> Event -> Maybe World
@@ -100,10 +100,12 @@ wheelUpEvent w = case _carteDisplay w of
                                 <*> pure (_crInvSel (you w))
                                 <*> pure w
         | lbDown    -> w & cameraZoom +~ 0.1
+        | invKeyDown -> swapInvUp $ upInvPos w
         | otherwise -> upInvPos w
   where 
     rbDown = ButtonRight `S.member` _mouseButtons w
     lbDown = ButtonLeft `S.member` _mouseButtons w
+    invKeyDown = ScancodeCapsLock `S.member` _keys w
     z = _carteZoom w
     numLocs = (fst . IM.findMax $ _seenLocations w) + 1
 
@@ -116,13 +118,21 @@ wheelDownEvent w = case _carteDisplay w of
         | rbDown    -> fromMaybe (closeObjScrollDown w)
             $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w)) <*> pure w
         | lbDown     -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
+        | invKeyDown  -> downInvPos $ swapInvUp w
         | otherwise   -> downInvPos w
   where 
     rbDown = ButtonRight `S.member` _mouseButtons w
     lbDown = ButtonLeft `S.member` _mouseButtons w
     z = _carteZoom w
+    invKeyDown = ScancodeCapsLock `S.member` _keys w
     numLocs = (fst . IM.findMax $ _seenLocations w) + 1
 
+swapInvUp :: World -> World
+swapInvUp w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + 1) `mod` n)
+  where
+    i = _crInvSel $ you w
+    n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
+
 upInvPos :: World -> World
 upInvPos w = stopSoundFrom (CrReloadSound 0) $ w
     & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract 1

src/Dodge/Event/Keyboard.hs

@@ -53,8 +53,8 @@ handlePressedKeyInGame scode w
     | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
     | scode == testEventKey (_keyConfig w) = Just $ testEvent w
     | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
-    | scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
-    | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
+--    | scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
+--    | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
     | scode == ScancodeF5 = Just $ dropLight w 
     | scode == ScancodeF6 = Just $ dropLight' w 
 handlePressedKeyInGame _ w = Just w

src/Dodge/Event/Menu.hs

@@ -104,5 +104,3 @@ storeLevel :: World -> World
 storeLevel w = case _storedLevel w of
                  Nothing -> w & storedLevel ?~ w
                  _       -> w
-
-

src/Dodge/Floor.hs

@@ -32,7 +32,8 @@ import Dodge.Creature
 --import Dodge.LightSources
 import Dodge.LevelGen.Data
 --import Dodge.LevelGen.SwarmPlacement
-import Dodge.Item.Weapon
+--import Dodge.Item.Weapon
+import Dodge.Item.Weapon.Launcher
 
 --import Data.Tree
 --import Data.Maybe (fromJust,isNothing)

src/Dodge/Item/Weapon.hs

@@ -10,7 +10,7 @@ import Dodge.Creature.Action
 import Dodge.RandomHelp
 import Dodge.WorldEvent
 import Dodge.Default
-import Dodge.Default.Shell
+--import Dodge.Default.Shell
 import Dodge.Item.Draw
 import Dodge.Particle.Bullet.HitEffect
 import Dodge.Particle.Bullet.Spawn
@@ -20,6 +20,7 @@ import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Laser
+import Dodge.Default.Weapon
 import Dodge.Item.Weapon.Booster
 import Dodge.Item.Weapon.Grenade
 import Dodge.Item.Attachment.Data
@@ -49,6 +50,7 @@ pistol = Weapon
     , _itIdentity = Pistol
     , _wpMaxAmmo = 15
     , _wpLoadedAmmo = 15
+    , _wpAmmo = GenericAmmo
     , _wpReloadTime = 40
     , _wpReloadState = 0
     , _itUseRate = 8
@@ -79,8 +81,6 @@ pistol = Weapon
     , _itInvDisplay = basicWeaponDisplay
     , _itInvColor = white
     }
-defaultGun :: Item
-defaultGun = pistol
 defaultAutoGun :: Item
 defaultAutoGun = autoGun 
     { _itScrollUp   = const id
@@ -259,44 +259,6 @@ tractorGun = defaultAutoGun
     , _itAimingRange = 0.5
     , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
     }
-launcher :: Item
-launcher = defaultGun 
-    { _itName = "ROCKO"
-    , _itIdentity = Launcher
-    , _wpMaxAmmo = 30
-    , _wpLoadedAmmo = 30
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate = 20
-    , _itUseTime = 0
-    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
-    , _wpSpread = 0.02
-    , _wpRange = 20
-    , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
-    , _itAimingSpeed = 0.2
-    , _itAimingRange = 0.5
-    , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
-    , _itHammer = NoHammer
-    , _itEffect = NoItEffect
-    }
-flameLauncher :: Item
-flameLauncher = launcher
-    { _itName = "FLROCKO"
-    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
-    }
-
-poisonLauncher :: Item
-poisonLauncher = launcher 
-    { _itName = "POISROCK"
-    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
-    }
-
-teslaLauncher :: Item
-teslaLauncher = launcher 
-    { _itName = "TESLROCK"
-    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
-    }
-
 useTargetPos 
     :: (Point2 -> Creature -> World -> World)
     -> Creature
@@ -618,102 +580,6 @@ aTeslaArc' cr w
     (sideOffset,g) = randomR (-5,5) $ _randGen w
     dir = _crDir cr
 
-aRocketWithPayload
-    :: (Point2 -> World -> World)   -- ^ Payload
-    -> Creature
-    -> World
-    -> World
-aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w
-  where 
-    cid = _crID cr
-    i = newProjectileKey w
-    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
-    dir = _crDir cr
-    theShell = makeShellAt pl i cid pos dir
-    
-makeShellAt 
-    :: (Point2 -> World -> World) 
-                -- ^ Payload
-    -> Int      -- ^ Projectile id
-    -> Int      -- ^ Creature id
-    -> Point2   -- ^ Start position
-    -> Float    -- ^ Direction
-    -> Projectile
-makeShellAt pl i cid pos dir = defaultShell
-    { _pjPos = pos
-    , _pjStartPos = pos
-    , _pjVel = rotateV dir (1,0)
-    , _pjDraw = \_ -> blank
-    , _pjID = i
-    , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
-    , _pjPayload = pl
-    }
-
-moveShell 
-    :: Int      -- ^ Timer (frames)
-    -> Int      -- ^ Projectile id
-    -> Int      -- ^ Creature id
-    -> Float    -- ^ Rotation
-    -> Point2   -- ^ Acceleration
-    -> World -> World
-moveShell time i cid rot accel w 
-    | time > 40 = if circOnSomeWall oldPos 4 w
-        then doExplode
-        else w
-            & projectiles . ix i . pjPos    %~ (+.+ vel)
-            & projectiles . ix i . pjDraw   .~ (\_ -> piclow)
-            & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel))
-    | isJust thingHit = doExplode
-    | time == 35 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel
-    | time >= 20 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
-    | time > -99 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & randGen .~ g
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
-        & projectiles . ix i . pjVel    %~ (\v -> accel +.+ frict *.* v)
-        & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
-        & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
-        & smokeGen
-    | time > -200 = w
-        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
-        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
-    | otherwise = doExplode
-  where 
-    doExplode = w
-        & projectileExplosion oldPos 
-        & stopSoundFrom (ShellSound i)
-        & projectiles %~ IM.delete i
-    pj = _projectiles w IM.! i
-    oldPos   = _pjPos pj
-    vel      = _pjVel pj
-    projectileExplosion = _pjPayload pj
-    newPos   = oldPos +.+ vel
-    (frict,g)  = randomR (0.6,0.9) $ _randGen w
-    (sparkD,_) = randomR (-0.2,0.2) $ _randGen w
-    dir      = argV vel
-    pic      = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
-    piclow   = onLayerL [levLayer CrLayer - 2] 
-        $ uncurry translate newPos $ rotate (argV accel) shellPic
-    hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
-    hitWl    = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
-    thingHit = hitCr <|> hitWl
-    spin   = case w ^? creatures . ix cid of
-        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
-        _ -> 0
-    r1 = randInCirc 10 & evalState $ _randGen w
-    smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
-    rot' = rot * 0.995
-
-shellPic :: Picture
-shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
 remoteShellPic 
     :: Int -- ^ Timer
     -> Picture

src/Dodge/Item/Weapon/Booster.hs

@@ -32,62 +32,29 @@ boostSelfL
     -> World
     -> World
 boostSelfL x cr invid w = case boostPoint x cr w of
-    Left p -> wWithShock p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix invid %~ 
-                (wpLoadedAmmo .~ 0)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
-    Right p -> wWithShock p & creatures . ix cid . crPos .~ p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix invid %~ 
-                (wpLoadedAmmo -~ 1)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
+    Left p -> crEff p (wpLoadedAmmo .~ 0)
+    Right p -> crEff p (wpLoadedAmmo -~ 1)
   where
     cid = _crID cr
-    --cpos = _crPos cr
+    cpos = _crPos cr
     r = _crRad cr
     pid = fromMaybe (IM.newKey $ _projectiles w) 
         (cr ^? crInv . ix invid . itAttachment . _Just . itInt)
-    wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w
+    crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
+        & creatures . ix cid %~ 
+             (crPos .~ p) 
+            . (crInv . ix invid %~ 
+                ammoEff
+                . (itEffect . itEffectCounter .~ 1)
+                . (itAttachment .~ Just (ItInt pid))
+                )
 
 boostSelf
     :: Float    -- ^ boost amount
     -> Creature
     -> World
     -> World
-boostSelf x cr w = case boostPoint x cr w of
-    Left p -> wWithShock p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix (_crInvSel cr) %~ 
-                (wpLoadedAmmo .~ 0)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
-    Right p -> wWithShock p & creatures . ix cid . crPos .~ p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix (_crInvSel cr) %~ 
-                (wpLoadedAmmo -~ 1)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
-  where
-    cid = _crID cr
-    r = _crRad cr
-    pid = fromMaybe (IM.newKey $ _projectiles w) 
-        (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt)
-    wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w
+boostSelf x cr = boostSelfL x cr (_crInvSel cr)
 
 addBoostShockwave
     :: Int

src/Dodge/Item/Weapon/Launcher.hs

@@ -0,0 +1,159 @@
+module Dodge.Item.Weapon.Launcher
+    where
+import Dodge.Data
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Default.Weapon
+import Dodge.SoundLogic.Synonyms
+import Picture
+import qualified IntMapHelp as IM
+import Dodge.WorldEvent.Explosion
+import Dodge.Picture.Layer
+import Dodge.Item.Draw
+import Geometry
+import Dodge.Default.Shell
+import Dodge.Base
+import Dodge.SoundLogic
+import Dodge.WorldEvent.SpawnParticle
+import Dodge.WorldEvent.Cloud
+import Dodge.RandomHelp
+
+import Data.Maybe
+import Control.Lens
+import Control.Applicative
+import Control.Monad.State
+import System.Random
+
+launcher :: Item
+launcher = defaultGun 
+    { _itName = "ROCKO"
+    , _itIdentity = Launcher
+    , _wpMaxAmmo = 30
+    , _wpLoadedAmmo = 30
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 20
+    , _itUseTime = 0
+    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
+    , _wpSpread = 0.02
+    , _wpRange = 20
+    , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itAimingSpeed = 0.2
+    , _itAimingRange = 0.5
+    , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itHammer = NoHammer
+    , _itEffect = NoItEffect
+    }
+flameLauncher :: Item
+flameLauncher = launcher
+    { _itName = "FLROCKO"
+    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
+    }
+
+poisonLauncher :: Item
+poisonLauncher = launcher 
+    { _itName = "POISROCK"
+    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
+    }
+
+teslaLauncher :: Item
+teslaLauncher = launcher 
+    { _itName = "TESLROCK"
+    , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
+    }
+
+aRocketWithPayload
+    :: (Point2 -> World -> World)   -- ^ Payload
+    -> Creature
+    -> World
+    -> World
+aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w
+  where 
+    cid = _crID cr
+    i = IM.newKey $ _projectiles w
+    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+    dir = _crDir cr
+    theShell = makeShellAt pl i cid pos dir
+    
+makeShellAt 
+    :: (Point2 -> World -> World) 
+                -- ^ Payload
+    -> Int      -- ^ Projectile id
+    -> Int      -- ^ Creature id
+    -> Point2   -- ^ Start position
+    -> Float    -- ^ Direction
+    -> Projectile
+makeShellAt pl i cid pos dir = defaultShell
+    { _pjPos = pos
+    , _pjStartPos = pos
+    , _pjVel = rotateV dir (1,0)
+    , _pjDraw = \_ -> blank
+    , _pjID = i
+    , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
+    , _pjPayload = pl
+    }
+
+moveShell 
+    :: Int      -- ^ Timer (frames)
+    -> Int      -- ^ Projectile id
+    -> Int      -- ^ Creature id
+    -> Float    -- ^ Rotation
+    -> Point2   -- ^ Acceleration
+    -> World -> World
+moveShell time i cid rot accel w 
+    | time > 40 = if circOnSomeWall oldPos 4 w
+        then doExplode
+        else w
+            & projectiles . ix i . pjPos    %~ (+.+ vel)
+            & projectiles . ix i . pjDraw   .~ (\_ -> piclow)
+            & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel))
+    | isJust thingHit = doExplode
+    | time == 35 = w
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
+        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
+        & projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel
+    | time >= 20 = w
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
+        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
+        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
+    | time > -99 = w
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
+        & randGen .~ g
+        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
+        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
+        & projectiles . ix i . pjVel    %~ (\v -> accel +.+ frict *.* v)
+        & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
+        & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
+        & smokeGen
+    | time > -200 = w
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
+        & projectiles . ix i . pjDraw   .~ (\_ -> pic)
+        & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
+    | otherwise = doExplode
+  where 
+    doExplode = w
+        & projectileExplosion oldPos 
+        & stopSoundFrom (ShellSound i)
+        & projectiles %~ IM.delete i
+    pj = _projectiles w IM.! i
+    oldPos   = _pjPos pj
+    vel      = _pjVel pj
+    projectileExplosion = _pjPayload pj
+    newPos   = oldPos +.+ vel
+    (frict,g)  = randomR (0.6,0.9) $ _randGen w
+    (sparkD,_) = randomR (-0.2,0.2) $ _randGen w
+    dir      = argV vel
+    pic      = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
+    piclow   = onLayerL [levLayer CrLayer - 2] 
+        $ uncurry translate newPos $ rotate (argV accel) shellPic
+    hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
+    hitWl    = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
+    thingHit = hitCr <|> hitWl
+    spin   = case w ^? creatures . ix cid of
+        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
+        _ -> 0
+    r1 = randInCirc 10 & evalState $ _randGen w
+    smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
+    rot' = rot * 0.995
+
+shellPic :: Picture
+shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]

src/Dodge/Room.hs

@@ -7,6 +7,7 @@ module Dodge.Room
     ) where
 import Dodge.Data
 import Dodge.Item.Weapon
+import Dodge.Item.Weapon.Launcher
 import Dodge.Creature
 --import Dodge.Creature.Inanimate
 --import Dodge.LevelGen

src/IntMapHelp.hs

@@ -3,6 +3,7 @@ module IntMapHelp
     , newKey
     , insertNewKey
     , insertWithNewKeys
+    , swapKeys
     )
     where
 --import Data.List hiding (foldr,insert)
@@ -19,3 +20,6 @@ insertNewKey x m = case lookupMax m of
 {- | Insert a list of values with new keys -}
 insertWithNewKeys :: [a] -> IntMap a -> IntMap a
 insertWithNewKeys xs m = union m $ fromList $ zip [newKey m..] xs
+{- | Swaps two keys. Unsafe: assumes both keys exist. -}
+swapKeys :: Int -> Int -> IntMap a -> IntMap a
+swapKeys i j m = insert i (m ! j) $ insert j (m ! i) m