Refactor, add bullet modules and weapon effect modifiers

src/Dodge/Combine.hs

@@ -0,0 +1,35 @@
+module Dodge.Combine
+    where
+--import Dodge.Data
+import Dodge.Combine.Data
+
+--import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntSet as IS
+import qualified Data.Map.Strict as M
+
+--combineList :: IM.IntMap Item -> [(Item , IS.IntSet)]
+--combineList 
+
+
+invert :: (Ord a) => M.Map b a -> M.Map a [b]
+invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty
+
+combineList :: [([ItemType], ItemType)]
+combineList =
+    [ ( [ Pistol, Pipe, Hardware ] , Rifle )
+    , ( [ Rifle, Hardware ] , Pistol )
+    , ( [ Pistol, Pistol, Hardware ] , SpreadGun 2 )
+    , ( [ SpreadGun 2, Pistol, Hardware ] , SpreadGun 3 )
+    , ( [ SpreadGun 3, Pistol, Hardware ] , SpreadGun 4 )
+    , ( [ SpreadGun 4, Pistol, Hardware ] , SpreadGun 5 )
+    , ( [ Pistol, AutoGun, Hardware ]     , LtAutoGun )
+    , ( [ LtAutoGun, Pipe, Hardware ]     , AutoGun )
+    , ( [ Rifle, Rifle, Hardware ] , MultGun 2 )
+    , ( [ MultGun 2, Rifle, Hardware ] , MultGun 3 )
+    , ( [ MultGun 3, Rifle, Hardware ] , MultGun 4 )
+    , ( [ MultGun 4, Rifle, Hardware ] , MultGun 5 )
+    , ( [ LtAutoGun, Pipe, Hardware ]  , AutoGun )
+    , ( [ Pistol, BigTube, Hardware] , Launcher 1 )
+    , ( [ Launcher 1, BigTube, Pistol, Hardware] , Launcher 2)
+    , ( [ Launcher 2, BigTube, Pistol, Hardware] , Launcher 3)
+    ]

src/Dodge/Combine/Data.hs

@@ -0,0 +1,34 @@
+module Dodge.Combine.Data
+    where
+data ItemType
+    = Pipe
+    | BigTube
+    | Plate
+    | MChip
+    | Magnet
+    | Motor
+    | LED
+    | Hardware
+    | Nailbox
+    | Plank
+    | Prism
+    | LightSensor
+    | SoundSensor
+    | HeatSensor
+    | CopperWire
+    | EmptyCan
+    | Pistol
+    | AutoGun
+    | Rifle
+    | LtAutoGun
+    | HvAutoGun
+    | HvRifle
+    | MultGun Int
+    | SpreadGun Int
+    | Launcher Int
+    | Battery
+    | PortableFusion
+    | AutoFiringMech
+    | FiringMech
+    | TargetingModule
+  deriving (Eq,Ord)

src/Dodge/Creature.hs

@@ -157,7 +157,8 @@ startCr = defaultCreature
 startInventory :: IM.IntMap Item
 startInventory = IM.fromList (zip [0..20] 
     (
-    [blinkGun
+    [hvAutoGun
+    ,blinkGun
     ,miniGun
     ,bezierGun
     ,multGun

src/Dodge/Creature/Action/UseItem.hs

@@ -32,7 +32,7 @@ itemEffect
     -> World 
     -> World
 itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w)
-itemEffect cr it@Weapon{_itUse=eff} w = eff it cr w
+itemEffect cr it@Weapon{_itUse=eff} w = foldr ($) eff (_itUseModifiers it) it cr w
 itemEffect cr it@Throwable{_itUse = eff} w = eff it cr w
 itemEffect _ _ w = w
 

src/Dodge/Data.hs

@@ -194,8 +194,8 @@ data PressPlate = PressPlate
     }
 data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
 data ItemPos 
-    =  InInv   { _itCrId :: Int , _itInvId :: Int }
+    = InInv   { _itCrId :: Int , _itInvId :: Int }
-    | OnFloor  { _itFlID :: Int }
+    | OnFloor { _itFlID :: Int }
 data Item 
     = Weapon
         { _itName :: String
@@ -207,6 +207,7 @@ data Item
         , _itUseRate :: Int
         , _itUseTime :: Int
         , _itUse     :: Item -> Creature -> World -> World
+        , _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
         , _itLeftClickUse :: Maybe (Creature -> Int -> World -> World)
         , _wpSpread :: Float
         , _wpRange :: Float
@@ -391,23 +392,30 @@ data Particle
         , _btMaxTime'   :: Int
         , _btTimer'     :: Int
         }
-type HitEffect = Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World,Maybe Particle)
+type HitEffect = Particle 
+    -> [(Point2, Either3 Creature Wall ForceField)] 
+    -> World 
+    -> (World,Maybe Particle)
 
 data Ammo
     = ShellAmmo
         { _amPayload :: Point2 -> World -> World
         , _amString :: String
-        , _amPjMove :: [PjParam]
+        , _amPjParams :: [PjParam]
         , _amPjDraw :: Projectile -> Picture
         , _amParamSel :: Int
         }
     | BulletAmmo
         { _amString :: String 
+        , _amBulEff :: HitEffect
+        , _amBulWth :: Float
+        , _amBulVel :: Point2
         }
     | GenericAmmo
 data PjParam = PjParam
     { _pjMoveParam :: Int -> Item -> Creature -> Projectile -> World -> World
     , _pjIntParam  :: Int
+    , _pjMaxParam  :: Int
     , _pjDisplayParam :: Int -> String
     }
 data Projectile 
@@ -677,6 +685,7 @@ makeLenses ''ItEffect
 makeLenses ''ItZoom
 makeLenses ''FloorItem
 makeLenses ''Ammo
+makeLenses ''PjParam
 makeLenses ''Projectile
 makeLenses ''Particle
 makeLenses ''Wall

src/Dodge/Default/Weapon.hs

@@ -16,6 +16,7 @@ defaultGun = Weapon
     , _itUseRate = 8
     , _itUseTime = 0
     , _itUse = \_ _ -> id
+    , _itUseModifiers = []
     , _itLeftClickUse = Nothing
     , _wpSpread = 0.02
     , _wpRange = 20
@@ -37,6 +38,7 @@ defaultGun = Weapon
     , _itTargeting = Nothing
     , _itWorldTrigger = Nothing
     }
+
 defaultAutoGun :: Item
 defaultAutoGun = defaultGun 
     { _itScrollUp   = const id
@@ -48,7 +50,7 @@ defaultShellAmmo :: Ammo
 defaultShellAmmo = ShellAmmo
     { _amPayload = \_ -> id
     , _amString = "Shell"
-    , _amPjMove = []
+    , _amPjParams = []
     , _amPjDraw = \_ -> blank
     , _amParamSel = 0
     }

src/Dodge/Event.hs

@@ -92,12 +92,16 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
         | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
     (_, TopInventory)
         | rbDown -> fromMaybe (closeObjScrollDir y w) $ (yourItem w ^? itScrollUp) 
-                                <*> pure (_crInvSel (you w))
+            <*> pure (_crInvSel (you w))
-                                <*> pure w
+            <*> pure w
         | lbDown -> w & cameraZoom +~ y
         | invKeyDown -> swapInvDir yi $ dirInvPos yi w
         | otherwise -> dirInvPos yi w
-    (_, TweakInventory) -> w
+    (_, TweakInventory) 
+        | invKeyDown && rbDown -> w & moveYourAmmoSel yi
+        | invKeyDown -> dirInvPos yi w
+        | rbDown -> w & moveYourAmmoParam yi
+        | otherwise -> w & moveYourAmmoSel yi
     (_, _) -> w
   where
     yi = round $ signum y
@@ -106,6 +110,18 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
     lbDown = ButtonLeft `S.member` _mouseButtons w
     invKeyDown = ScancodeCapsLock `S.member` _keys w
 
+moveYourAmmoSel :: Int -> World -> World
+moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of
+    Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
+                    . wpAmmo . amParamSel %~ (`mod` (length l)) . (subtract i)
+    _ -> w
+moveYourAmmoParam :: Int -> World -> World
+moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of
+    Just n -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
+                    . wpAmmo . amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i)
+    _ -> w
+  where
+    paramid = _amParamSel $ _wpAmmo $ yourItem w
 swapInvDir :: Int -> World -> World
 swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n)
   where

src/Dodge/Event/Keyboard.hs

@@ -16,7 +16,7 @@ import Dodge.LightSources
 import Dodge.LevelGen
 import Dodge.Creature.Inanimate
 import qualified Data.IntMap.Strict as IM
---import Dodge.Event.Test
+import Dodge.Event.Test
 import Dodge.Event.Menu
 
 import SDL
@@ -51,13 +51,13 @@ handlePressedKeyInGame scode w
     | scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
     | scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
     | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
---    | scode == testEventKey (_keyConfig w) = Just $ testEvent 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 == ScancodeF5 = Just $ dropLight w 
     | scode == ScancodeF6 = Just $ dropLight' w 
-    | scode == ScancodeT = Just $ w & inventoryMode %~ toggleInv TweakInventory
+    | scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory
     | scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory
     | scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory
 handlePressedKeyInGame _ w = Just w
@@ -79,13 +79,11 @@ gotoTerminal w = case _menuLayers w of
 
 spaceAction :: World -> World
 spaceAction w = if _carteDisplay w
-    then 
+    then w & carteCenter .~ theLoc
-        w & carteCenter .~ theLoc
+    else case (_inventoryMode w, listToMaybe $ _closeActiveObjects w) of
-    else 
+        (TopInventory,Just (Left flit)) -> pickUpItem 0 flit w
-        case listToMaybe $ _closeActiveObjects w of
+        (TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w
-            Just (Left flit) -> pickUpItem 0 flit w
+        _ -> w & inventoryMode .~ TopInventory
-            Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
-            Nothing -> w
   where
     theLoc = fst (_seenLocations w IM.! _selLocation w) w
     updateTopCloseObject i = closeActiveObjects %~ ( Right (_buttons w IM.! i) : ) . tail 

src/Dodge/Item/Weapon.hs

@@ -18,6 +18,7 @@ import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Laser
+import Dodge.Item.Weapon.Shell
 import Dodge.Default.Weapon
 import Dodge.Item.Weapon.Booster
 import Dodge.Item.Weapon.Grenade
@@ -43,23 +44,22 @@ import qualified Data.Set as S
 --import qualified Data.Map as M
 
 pistol :: Item
-pistol = Weapon 
+pistol = defaultGun 
     { _itName = "PISTOL"
     , _itIdentity = Pistol
     , _wpMaxAmmo = 15
     , _wpLoadedAmmo = 15
-    , _wpAmmo = GenericAmmo
     , _wpReloadTime = 40
     , _wpReloadState = 0
     , _itUseRate = 8
     , _itUseTime = 0
-    , _itUse = \_ ->
+    , _itUse = useAmmoParams 
-        hammerCheck
+    , _itUseModifiers = 
-        . shootWithSound 0 
+        [ hammerCheckI
-        . withRandomDir 0.1
+        , shootWithSoundI 0 
-        . withMuzFlare
+        , withRandomDirI 0.1
-        . withVelWthHiteff (30,0) 2 
+        , withMuzFlareI
-        $ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
+        ]
     , _itLeftClickUse = Nothing
     , _wpSpread = 0.02
     , _wpRange = 20
@@ -80,7 +80,20 @@ pistol = Weapon
     , _itInvColor = white
     , _itTargeting = Nothing
     , _itWorldTrigger = Nothing
+    , _wpAmmo = basicBullet    
     }
+basicBullet :: Ammo
+basicBullet = BulletAmmo
+    { _amString = "BULLET"
+    , _amBulEff = destroyOnImpact bulHitCr bulHitWall' bulHitFF'
+    , _amBulWth = 2
+    , _amBulVel = (30,0)
+    }
+useAmmoParams :: Item -> Creature -> World -> World
+useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b) 
+  where
+    b = _wpAmmo it
+
 effectGun :: String -> (Creature -> World -> World) -> Item
 effectGun name eff = defaultGun
     { _itName = name ++ "Gun"
@@ -118,6 +131,7 @@ autoGun = defaultGun
     , _itScrollUp   = incCharMode
     , _itScrollDown = decCharMode
     , _itInvDisplay = basicWeaponDisplay
+    , _wpAmmo = basicBullet    
     }
 autoFireMode, singleFireMode, autoGunNonTwistEff :: Creature -> World -> World
 autoFireMode = shootWithSound (fromIntegral autoGunSound) 
@@ -289,19 +303,25 @@ hvAutoGun = defaultAutoGun
     , _wpReloadState = 0
     , _itUseRate = 25
     , _itUseTime = 0
-    , _itUse =  \_ -> rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
+    , _itUse =  \it -> rateIncAB 24 10 (torqueBeforeForced 0.1 (mkHvBul it)) 
+        (torqueAfter 0.2 (mkHvBul it))
     , _wpRange = 20
     , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
     , _itAimingSpeed = 0.2
     , _itAimingRange = 1
     , _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _wpAmmo = BulletAmmo
+        {_amString = "HVBULLET"
+        , _amBulEff = penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
+        , _amBulWth = 6
+        , _amBulVel = (80,0)
+        }
     }
   where 
-    mkHvBul = withSound (fromIntegral longGunSound)
+    mkHvBul it = withSound (fromIntegral longGunSound)
         . withThinSmoke
         . withMuzFlare
-        . withVelWthHiteff (80,0) 6 
+        $ useAmmoParams it
-        $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
 ltAutoGun :: Item                           
 ltAutoGun = defaultAutoGun 
     { _itName = "AUTO-LT"
@@ -337,11 +357,11 @@ miniGun = defaultAutoGun
     , _itUseRate = 2
     , _itUseTime = 0
     , _itUse = \_ -> withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15
-                        . withRandomDir 0.1
+        . withRandomDir 0.1
-                        . withRandomOffset 9
+        . withRandomOffset 9
-                        . withMuzFlare
+        . withMuzFlare
-                        . withVelWthHiteff (30,0) 2 
+        . withVelWthHiteff (30,0) 2 
-                        $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
+        $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
     , _wpRange = 20
     , _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
     , _itAimingSpeed = 0.4
@@ -529,6 +549,16 @@ aTeslaArc' cr w
     (sideOffset,g) = randomR (-5,5) $ _randGen w
     dir = _crDir cr
 
+remoteShellPic' :: Projectile -> Picture
+remoteShellPic' pj
+    | t > 40 = onLayerL [levLayer CrLayer - 2] 
+                        $ uncurry translate pos $ rotate dir $ remoteShellPic t
+    | otherwise = uncurry translate pos $ rotate dir $ remoteShellPic t
+  where
+    t = _pjTimer pj
+    pos = _pjPos pj
+    dir = _pjDir pj
+
 remoteShellPic 
     :: Int -- ^ Timer
     -> Picture
@@ -735,13 +765,18 @@ fireRemoteLauncher cr w = setLocation
     cid = _crID cr
     dir = _crDir cr
     pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
-    remRocket = IM.insert i $ Projectile 
+    remRocket = IM.insert i $ Shell 
         { _pjPos = pos
         , _pjStartPos = pos
         , _pjVel = rotateV dir (1,0)
-        , _pjDraw = \_ -> blank
+        , _pjDraw = remoteShellPic'
         , _pjID = i
-        , _pjUpdate = \_ -> moveRemoteShell 50 i cid itid dir
+        , _pjUpdate = \pj -> decTimMvVel pj . moveRemoteShell cid itid pj
+        , _pjAcc = (0,0)
+        , _pjDir = dir
+        , _pjSpin = 0
+        , _pjPayload = makeExplosionAt
+        , _pjTimer = 50
         }
     j = _crInvSel cr
     newitid = IM.newKey $ _itemPositions w
@@ -756,69 +791,44 @@ fireRemoteLauncher cr w = setLocation
         _ -> w'
     itid = fromMaybe newitid maybeitid
 
-moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World
+moveRemoteShell :: Int -> Int -> Projectile -> World -> World
-moveRemoteShell time i cid itid _ w 
+moveRemoteShell cid itid pj w 
     | time > 40 = if circOnSomeWall oldPos 4 w
-                  then doExplosion w
+        then doExplosion w
-                  else over (projectiles . ix i . pjPos) (+.+ vel)
+        else w & setScope
-                                  $ set (projectiles . ix i . pjDraw) (\_ -> piclow)
-                                  $ set (projectiles . ix i . pjUpdate) 
-                                            (\_ -> moveRemoteShell (time-1) i cid itid newdir)
-                                    $ setScope
-                                    w
     | time >= 20 = case thingHit of
         Just _  -> doExplosion w
-        Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
+        Nothing -> setScope w & projectiles . ix i . pjDir .~ newdir
-                   $ set (projectiles . ix i . pjDraw) (\_ -> pic)
-                   $ set (projectiles . ix i . pjUpdate) 
-                             (\_ -> moveRemoteShell (time-1) i cid itid newdir)
-                     $ setScope
-                     w
     | time > -99 = case thingHit of
-        Just _  -> doExplosion
+        Just _  -> doExplosion $ stopSoundFrom (ShellSound i) w
-            $ stopSoundFrom (ShellSound i)
+        Nothing -> w & set randGen g
-            w
+            & projectiles . ix i %~ 
-        Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
+                ( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
-            $ set randGen g
+                . ( pjDir .~ newdir )
-            $ set (projectiles . ix i . pjDraw) (\_ -> pic)
+                )
-            $ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
+            & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
-            $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
+            & smokeGen
-            $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
+            & makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
-            $ smokeGen
+            & setScope
-            $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
-            $ setScope
-            w
     | time > -200 = case thingHit of
-        Just _  -> doExplosion
+        Just _  -> doExplosion $ stopSoundFrom (ShellSound i) w
-            $ stopSoundFrom (ShellSound i)
+        Nothing -> setScope w
-            w
+    | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w
-        Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
-            $ set (projectiles . ix i . pjDraw) (\_ -> pic)
-            $ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
-            $ setScope
-            w
-    | otherwise = doExplosion
-        $ stopSoundFrom (ShellSound i)
-        w
   where 
-    pj = _projectiles w IM.! i
+    time = _pjTimer pj
-    oldPos   = _pjPos pj
+    i = _pjID pj
-    vel      = _pjVel pj
+    oldPos = _pjPos pj
-    newPos   = oldPos +.+ vel
+    vel    = _pjVel pj
+    newPos = oldPos +.+ vel
     newdir 
       | SDL.ButtonRight `S.member` _mouseButtons w
           && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId
                   = _cameraRot w + argV (_mousePos w)
       | otherwise = dir
     accel    = rotateV newdir (2,0)
-    (frict,g)    = randomR (0.6,0.9) $ _randGen w
+    (frict,g)  = randomR (0.6,0.9) $ _randGen w
     (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
     dir      = argV vel
-    pic      = uncurry translate newPos 
-                               $ rotate (argV accel) $ remoteShellPic time
-    piclow   = onLayerL [levLayer CrLayer - 2] 
-                        $ uncurry translate newPos $ rotate (argV accel)
-                          $ remoteShellPic time
     hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
     hitWl    = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl

src/Dodge/Item/Weapon/Launcher.hs

@@ -1,21 +1,22 @@
 module Dodge.Item.Weapon.Launcher
     where
 import Dodge.Data
-import Dodge.Item.Weapon.TriggerType
 import Dodge.Default.Weapon
+import Dodge.Default.Shell
 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.Item.Weapon.Shell
-import Dodge.Default.Shell
+import Dodge.Item.Weapon.TriggerType
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
+import Geometry
+import Picture
+import qualified IntMapHelp as IM
 
 import Data.Maybe
 import Control.Lens
@@ -45,7 +46,7 @@ launcher = defaultGun
     , _wpAmmo = defaultShellAmmo 
         { _amPayload = makeExplosionAt
         , _amString = ""
-        , _amPjMove = basicAmPjMoves
+        , _amPjParams = basicAmPjMoves
         , _amPjDraw = shellPic
         }
     }
@@ -54,19 +55,58 @@ basicAmPjMoves :: [PjParam]
 basicAmPjMoves = 
     [spinDrag
     ,spinStart
+    ,thrustParam
     ]
 spinDrag :: PjParam
 spinDrag = PjParam
-    { _pjMoveParam = \_ _ _ -> reduceSpinBy 0.995
+    { _pjMoveParam = \i _ _ -> reduceSpinBy (1 - (fromIntegral i)*2 / 200)
-    , _pjIntParam  = 0
+    , _pjIntParam  = 1
-    , _pjDisplayParam = ("SPIN DRAG:" ++ ) . show
+    , _pjDisplayParam = pjPadText "SPIN SLOWDOWN" . show
+    , _pjMaxParam = 5
     }
+pjPadText :: String -> String -> String
+pjPadText s = (rightPad 12 ' ' s ++ ) . (' ':)
 spinStart :: PjParam
 spinStart = PjParam
-    { _pjMoveParam = \_ _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr) 
+    { _pjMoveParam = \i _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr) i
-    , _pjIntParam  = 0
+    , _pjIntParam  = 2
-    , _pjDisplayParam = ("SPIN START:" ++ ) . show
+    , _pjDisplayParam = pjPadText "SPIN AMOUNT" . show
+    , _pjMaxParam = 5
     }
+thrustParam :: PjParam
+thrustParam = PjParam
+    { _pjMoveParam = \i _ _ -> pjThrust i
+    , _pjIntParam = 1
+    , _pjDisplayParam = pjPadText "THRUST DELAY" . show
+    , _pjMaxParam = 5
+    }
+
+pjThrust :: Int -> Projectile -> World -> World
+pjThrust i = pjEffTimeRange (st,et) $ doThrust
+  where
+    et | i == 0 = 36
+       | otherwise = 40 - (fromIntegral i * 20)
+    st = et - 100
+
+doThrust :: Projectile -> World -> World
+doThrust pj w = w
+    & randGen .~ g
+    & 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
+  where
+    accel = _pjAcc pj
+    i = _pjID pj
+    oldPos   = _pjPos pj
+    vel      = _pjVel 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
+    smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
+    
+
 
 flameLauncher :: Item
 flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
@@ -86,7 +126,7 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
     i = IM.newKey $ _projectiles w
     pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
     dir = _crDir cr
-    ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjMove am)
+    ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
     theShell = defaultShell
         { _pjPos = pos
         , _pjStartPos = pos
@@ -108,18 +148,10 @@ moveShell pj w
         then doExplode
         else w
     | isJust thingHit = doExplode
-    | time >= 20 = w
+    | time > -300 = w
-    | time > -99 = w
-        & randGen .~ g
-        & 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
     | otherwise = doExplode
   where 
     time = _pjTimer pj
-    accel = _pjAcc pj
     doExplode = w
         & projectileExplosion oldPos 
         & stopSoundFrom (ShellSound i)
@@ -129,13 +161,9 @@ moveShell pj w
     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
     hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
     hitWl    = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
-    r1 = randInCirc 10 & evalState $ _randGen w
-    smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
 
 reduceSpinBy :: Float -> Projectile -> World -> World
 reduceSpinBy x pj = projectiles . ix (_pjID pj) .  pjSpin *~ x
@@ -151,16 +179,18 @@ shellPic pj
     pos = _pjPos pj
     t = _pjTimer pj
 
-decTimMvVel :: Projectile -> World -> World
+
-decTimMvVel pj = projectiles . ix pjid %~
+pjEffTimeRange
-    ( (pjTimer -~ 1) 
+    :: (Int,Int)
-    . (pjPos   %~ (+.+ vel) )
+    -> (Projectile -> World -> World)
-    . (pjAcc   %~ rotateV rot )
+    -> Projectile
-    )
+    -> World 
+    -> World
+pjEffTimeRange (st,et) f pj
+    | t <= et && t >= st = f pj
+    | otherwise = id
   where
-    rot = _pjSpin pj
+    t = _pjTimer pj
-    vel = _pjVel pj
-    pjid = _pjID pj
 
 pjEffAtTime 
     :: Int
@@ -174,13 +204,15 @@ pjEffAtTime t f pj
 
 trySpinByCID
     :: Int -- ^ creature id
+    -> Int -- ^ Spin amount
     -> Projectile
     -> World 
     -> World
-trySpinByCID cid pj w = w & projectiles . ix pjid . pjSpin .~ newSpin
+trySpinByCID cid i pj w = w & projectiles . ix pjid . pjSpin .~ newSpin
   where
     pjid = _pjID pj
     dir      = argV $ _pjVel pj
     newSpin   = case w ^? creatures . ix cid of
-        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
+        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
         _ -> 0
+    spinFactor = 5 * (6 - fromIntegral i)

src/Dodge/Item/Weapon/Shell.hs

@@ -0,0 +1,27 @@
+module Dodge.Item.Weapon.Shell
+    where
+import Dodge.Data
+import Geometry.Vector
+
+import Control.Lens
+decTimMvVel :: Projectile -> World -> World
+decTimMvVel pj = projectiles . ix pjid %~
+    ( (pjTimer -~ 1) 
+    . (pjPos   %~ (+.+ vel) )
+    . (pjAcc   %~ rotateV rot )
+    )
+  where
+    rot = _pjSpin pj
+    vel = _pjVel pj
+    pjid = _pjID pj
+
+--pjAutoSpin :: Projectile -> World -> World
+--pjAutoSpin pj = projectiles . ix pjid %~
+--    ( (pjDir -~ 1) 
+--    . (pjPos   %~ (+.+ vel) )
+--    . (pjAcc   %~ rotateV rot )
+--    )
+--  where
+--    rot = _pjSpin pj
+--    vel = _pjVel pj
+--    pjid = _pjID pj

src/Dodge/Item/Weapon/TriggerType.hs

@@ -153,8 +153,7 @@ withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
     cid = _crID cr
     push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
     (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
-{- |
+{- | Applies a world effect and sound effect after an ammo check. -}
-Applies a world effect and sound effect after an ammo check. -}
 shootWithSound 
     :: Int  -- ^ Sound identifier
     -> (Creature -> World -> World) 
@@ -178,6 +177,30 @@ shootWithSound soundid f cr w
                       && _itUseTime item == 0
                       && _wpLoadedAmmo item > 0
     reloadCondition = _wpLoadedAmmo item == 0
+{- | Applies a world effect and sound effect after an ammo check. -}
+shootWithSoundI
+    :: Int  -- ^ Sound identifier
+    -> (Item -> Creature -> World -> World) 
+            -- ^ Shoot effect, takes creature id as input
+    -> Item 
+    -> Creature 
+    -> World 
+    -> World
+shootWithSoundI soundid f item cr w
+    | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+        $ soundOncePos soundid (_crPos cr)
+        $ set (pointerToItem . itUseTime) (_itUseRate item)
+        $ f item cr w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    itRef = _crInvSel cr
+    pointerToItem = creatures . ix cid . crInv . ix itRef
+    fireCondition = _wpReloadState item == 0
+        && _itUseTime item == 0
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
 {- | 
 Applies a world effect after an item use cooldown check. -}
 useTimeCheck
@@ -205,6 +228,19 @@ hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
   where 
     cid = _crID cr
     setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
+{- | Applies a world effect after a hammer position check. -}
+hammerCheckI
+    :: (Item -> Creature -> World -> World)  -- ^ Underlying effect
+    -> Item
+    -> Creature 
+    -> World
+    -> World
+hammerCheckI f it cr w = case it ^? itHammer of
+    Just HammerUp -> f it cr $ setHammerDown w
+    _             -> setHammerDown w
+  where 
+    cid = _crID cr
+    setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
 {- | Applies a world effect after an ammo check. -}
 shoot 
     :: (Creature -> World -> World) 
@@ -272,6 +308,17 @@ withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
   where 
     pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
     pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+
+withMuzFlareI
+    :: (Item -> Creature -> World -> World)  -- ^ Underlying effect
+    -> Item
+    -> Creature
+    -> World 
+    -> World
+withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w
+  where 
+    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+    pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
 {- | Applies the effect to a randomly rotated creature.  -}
 withRandomDir 
     :: Float    -- ^ Max possible rotation
@@ -283,6 +330,18 @@ withRandomDir
 withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w
   where 
     (a, g) = randomR (-acc,acc) $ _randGen w
+{- | Applies the effect to a randomly rotated creature.  -}
+withRandomDirI
+    :: Float    -- ^ Max possible rotation
+    -> (Item -> Creature -> World -> World) 
+                -- ^ Underlying effect
+    -> Item
+    -> Creature
+    -> World 
+    -> World
+withRandomDirI acc f it cr w = f it (cr & crDir +~ a) $ set randGen g w
+  where 
+    (a, g) = randomR (-acc,acc) $ _randGen w
 {- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
 withVelWthHiteff 
     :: Point2       -- ^ Velocity, x direction is forward with respect to the creature

src/Dodge/Render/HUD.hs

@@ -35,10 +35,11 @@ drawInventory w = case _inventoryMode w of
         ++ displayInv 0 w
     TweakInventory   -> 
         mCurs it w
-        ++ [cursorAt 120 col 5 iPos w]
+        ++ [cursorAt 120 col 5 0 iPos w
+            ,cursorsZ w iPos it
+            ]
         ++ displayInv 0 w 
         ++ displayMidList w (ammoTweakStrings it) "TWEAK"
-        ++ mCurs it w
     CombineInventory -> displayInv 0 w ++ invHead w "COMBINE"
     InspectInventory -> displayInv 0 w ++ invHead w "INSPECT"
   where 
@@ -47,22 +48,47 @@ drawInventory w = case _inventoryMode w of
     it = yourItem w
     col = itCol it
 
+cursorsZ :: World -> Int -> Item -> Picture
+cursorsZ w ipos it = case it ^? wpAmmo . amParamSel of
+    Nothing -> winScale w $ zDraw sp (155- hw, hh - 77.5)
+    Just jpos -> winScale w $ zDraw sp (155 - hw, hh - (20 * fromIntegral jpos + 77.5))
+  where
+    hh = halfHeight w
+    hw = halfWidth w
+    sp = (125 - hw, hh - (20 * fromIntegral ipos + 17.5))
+
 topInvCursor :: Color -> Int -> World -> [Picture]
 topInvCursor col iPos w 
     | ButtonRight `S.member` _mouseButtons w = 
-        [cursorAt 100 col 5 iPos w
+        [cursorAt 100 col 5 0 iPos w
-        ,openCursorAt 20 col 105 iPos w]
+        ,openCursorAt 20 col 105 0 iPos w]
-    | otherwise = [ openCursorAt 120 col 5 iPos w ]
+    | otherwise = [ openCursorAt 120 col 5 0 iPos w ]
 
 ammoTweakStrings :: Item -> [String]
-ammoTweakStrings it = case it ^? wpAmmo . amPjMove of
+ammoTweakStrings it = case it ^? wpAmmo . amPjParams of
     Just l -> map pjTweakString l
     _ -> ["NOT TWEAKABLE"]
 
 mCurs :: Item -> World -> [Picture]
 mCurs it w = case it ^? wpAmmo . amParamSel of
     Nothing -> []
-    Just i -> [openCursorAt 120 white 200 i w]
+    Just i 
+        | ButtonRight `S.member` _mouseButtons w -> 
+            [cursorAt x white y 60 i w
+            ,openCursorAt 20 white (x+y) 60 i w
+            ]
+        | otherwise -> [openCursorAt 140 white 155 60 i w]
+  where
+    x = 117.5
+    y = 155
+
+zDraw :: Point2 -> Point2 -> Picture
+zDraw (x,y) (a,b) = line
+    [(x,y)
+    ,(0.5 * (x+a), y)
+    ,(0.5 * (x+a), b)
+    ,(a, b)
+    ]
 
 pjTweakString :: PjParam -> String
 pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
@@ -70,11 +96,11 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
 displayMidList :: World -> [String] -> String -> [Picture]
 displayMidList w strs s =
     invHead w s
-    ++ renderListAt (200,0) (map (,white) strs) w
+    ++ renderListAt (150,-60) (map (,white) strs) w
 
 invHead :: World -> String -> [Picture]
-invHead w s = [winScale w . translate (-150) (150-halfHeight w) 
+invHead w s = [winScale w . translate (-130) (halfHeight w - 40) 
-    . dShadCol white . scale 0.5 0.5 $ text s
+    . dShadCol white . scale 0.4 0.4 $ text s
     ]
 
 displayListTopLeft :: [(String,Color)] -> World -> [Picture]
@@ -200,17 +226,18 @@ dShadCol c p = pictures
     ]
 
 drawListCursor :: Color -> Int -> World -> Picture
-drawListCursor c = openCursorAt 120 c 5
+drawListCursor c = openCursorAt 120 c 5 0
 
 openCursorAt 
     :: Float    -- ^ Width
     -> Color
     -> Float    -- ^ x offset
+    -> Float    -- ^ y offset
     -> Int      -- ^ y offset (discrete)
     -> World 
     -> Picture
-openCursorAt wth col xoff yint w = winScale w
+openCursorAt wth col xoff yoff yint w = winScale w
-    . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20)
+    . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
     $ lineCol 
         [(( wth,12.5) ,withAlpha 0 col)
         ,(( 0,12.5)   ,col)
@@ -221,11 +248,12 @@ cursorAt
     :: Float    -- ^ Width
     -> Color
     -> Float    -- ^ x offset
+    -> Float    -- ^ y offset
     -> Int      -- ^ y offset (discrete)
     -> World 
     -> Picture
-cursorAt wth col xoff yint w = winScale w
+cursorAt wth col xoff yoff yint w = winScale w
-    . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20)
+    . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
     . color col
     $ line 
         [( wth,12.5)