Add burst fire, tentative inventory locking

src/Dodge/Combine.hs

@@ -25,8 +25,10 @@ itemCombinations = map (first toMultiset) $
     , p [BANGSTICK 1,CAN] revolver
     , p [BANGSTICK 1,TIN] pistol
     , p [PISTOL, SPRING, HARDWARE] ltAutoGun
-    ] ++
-    map (\i -> ([PIPE,BANGSTICK i],bangStick (i+1))) [1..8]
+    , p [REVOLVER, SPRING, HARDWARE] $ revolverX 1
+    ] 
+    ++ map (\i -> ([PIPE,BANGSTICK i],bangStick (i+1))) [1..8]
+    ++ map (\i -> ([REVOLVERX i,CAN] ,revolverX (i+1))) [1..6]
   where
     p = (,)
 

src/Dodge/Combine/Data.hs

@@ -9,6 +9,8 @@ data CombineType
     | BANGCANE
     | BANGROD
     | PISTOL
+    | REVOLVER
+    | REVOLVERX Int
     | HVAUTOGUN
     | LTAUTOGUN
     | MINIGUN

src/Dodge/Creature.hs

@@ -171,7 +171,8 @@ startInventory = IM.fromList $ zip [0..] startInvList
 testInventory :: IM.IntMap Item
 testInventory = IM.fromList $ zip [0..] 
     [ makeTypeCraftNum 9 PIPE
-    , makeTypeCraft HARDWARE
+    , makeTypeCraftNum 5 HARDWARE
+    , makeTypeCraftNum 3 SPRING
     , makeTypeCraft CAN
     , makeTypeCraft TIN
     ]

src/Dodge/Creature/Action.hs

@@ -210,9 +210,14 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid . mayberem
         Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
         _ -> id
 
-{- | Get your creature to drop the item under the cursor.  -}
 youDropItem :: World -> World
-youDropItem w = case yourItem w ^? _Just . itCurseStatus of
+youDropItem w 
+    | _crInvLock (you w) = w
+    | otherwise = youDropItem' w
+
+{- | Get your creature to drop the item under the cursor.  -}
+youDropItem' :: World -> World
+youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
     Just Uncursed -> w
         & dropItem cr (_crInvSel cr) 
         & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing

src/Dodge/Creature/Impulse/UseItem.hs

@@ -38,7 +38,11 @@ itemEffect cr it w = case it ^? itUse of
 
 --this is ugly
 useLeftItem :: Int -> World -> World
-useLeftItem cid w = case cr ^? crInv . ix crinvsel . itUse . lUse of
+useLeftItem cid w | _crInvLock $ _creatures w IM.! cid = w
+    | otherwise = useLeftItem' cid w
+
+useLeftItem' :: Int -> World -> World
+useLeftItem' cid w = case cr ^? crInv . ix crinvsel . itUse . lUse of
     Just f -> f cr crinvsel (w & creatures . ix cid . crLeftInvSel ?~ crinvsel)
     Nothing -> case _crLeftInvSel cr of
         Just invid -> case _itUse $ _crInv cr IM.! invid of

src/Dodge/Data.hs

@@ -93,6 +93,7 @@ data World = World
     , _modifications        :: IM.IntMap Modification
     , _yourID               :: !Int
     , _worldEvents          :: World -> World
+    , _delayedEvents        :: [(Int,World -> World)]
     , _pressPlates          :: IM.IntMap PressPlate
     , _buttons              :: IM.IntMap Button
     , _toPlaySounds         :: M.Map SoundOrigin Sound
@@ -228,6 +229,7 @@ data Creature = Creature
     , _crInv            :: IM.IntMap Item
     , _crInvSel         :: Int
     , _crInvCapacity    :: Int
+    , _crInvLock        :: Bool
     , _crLeftInvSel     :: Maybe Int
     , _crState          :: CreatureState
     , _crCorpse         :: Picture

src/Dodge/Default.hs

@@ -38,6 +38,7 @@ defaultCreature = Creature
     , _crInv    = IM.empty
     , _crInvSel = 0
     , _crInvCapacity = 25
+    , _crInvLock = False
     , _crLeftInvSel = Nothing
     , _crState  = defaultState
     , _crCorpse = setLayer 0 $ onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10

src/Dodge/Default/World.hs

@@ -48,6 +48,7 @@ defaultWorld = World
     , _testString = const []
     , _yourID = 0
     , _worldEvents = id
+    , _delayedEvents = []
     , _pressPlates = IM.empty
     , _buttons = IM.empty
     , _toPlaySounds = M.empty

src/Dodge/Event.hs

@@ -126,6 +126,9 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
         | rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
         | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
     (_, TopInventory)
+            -- functions that modify the inventory should be centralised so that
+            -- this lock can be sensibly applied, perhaps
+        | _crInvLock (_creatures w IM.! (_yourID w)) -> w
         | rbDown -> case yourItem w ^? _Just . itScroll of
             Nothing -> closeObjScrollDir y w
             Just f  -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)

src/Dodge/Inventory/Lock.hs

@@ -0,0 +1,9 @@
+module Dodge.Inventory.Lock where
+import Dodge.Data
+import Control.Lens
+
+lockInv :: Int -> World -> World
+lockInv cid = creatures . ix cid . crInvLock %~ (|| True)
+
+unlockInv :: Int -> World -> World
+unlockInv cid = creatures . ix cid . crInvLock %~ (&& False)

src/Dodge/Item/Data.hs

@@ -59,7 +59,10 @@ data ItZoom = ItZoom
     , _itZoomMin    :: Float
     , _itZoomFac    :: Float 
     }
-data CurseStatus = Uncursed | UndroppableIdentified | UndroppableUnidentified
+data CurseStatus 
+    = Uncursed 
+    | UndroppableIdentified 
+    | UndroppableUnidentified
 data AimParams = AimParams
     { _aimSpeed     :: Float
     , _aimRange     :: Float

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -55,10 +55,9 @@ withVelWthHiteff
     -> World
 withVelWthHiteff vel drag width hiteff cr = particles .:~ newbul
   where 
-    cid = _crID cr
-    newbul = aGenBulAt (Just cid) pos (rotateV dir vel) drag hiteff width
+    newbul = aGenBulAt (Just (_crID cr)) pos (rotateV dir vel) drag hiteff width
+    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle dir
     dir = _crDir cr
-    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
 
 {- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
 withDelayedVelWthHiteff 

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Weapon.BulletGuns
     ( pistol
     , revolver
+    , revolverX
     , bangStick
     , bangRod
     , bangCane
@@ -156,9 +157,30 @@ bangRod = bangCane
       & itUse . useAim . aimStance .~ TwoHandTwist
       & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
 
+revolverX :: Int -> Item
+revolverX i = revolver
+    { _itName = "REVx"++show i
+    , _itCombineType = REVOLVERX i
+    , _itUse = useAmmoParamsRate 8 upHammer
+        [ ammoHammerCheck
+        , useTimeCheck
+        -- rather than locking the inventory, a better solution may be to check
+        -- that the weapon is still in your hands in the repeated frames
+        , lockInvFor 10
+        , \f it -> repeatOnFrames (take (_ammoLoaded (_itConsumption it) - 1) [2,4,6,8,10]) f it
+        , withSoundStart tap3S 
+        , useAmmoUpTo 1
+--        , applyInaccuracy
+        , withMuzFlareI
+--        , spreadLoaded
+        , withRecoilI 25
+        ]
+    }   & itConsumption . ammoMax .~ i * 6
+
 revolver :: Item
 revolver = pistol
     { _itName = "REVOLVER"
+    , _itCombineType = REVOLVER
     , _itConsumption = defaultAmmo 
         { _aoType = basicBullet
         , _ammoMax = 6
@@ -180,11 +202,10 @@ pistol = defaultGun
         , _reloadType = ActiveClear
         }
     , _itUse = useAmmoParamsRate 8 upHammer
-        [ ammoCheckI
-        , hammerCheckI
+        [ ammoHammerCheck
         , useTimeCheck
-        , withSoundStart tap3S 
         , useAmmoAmount 1
+        , withSoundStart tap3S 
         , applyInaccuracy
         , withMuzFlareI
         ]
@@ -261,10 +282,10 @@ ltAutoGun = defaultAutoGun
     { _itName = "AUTO-LT"
     , _itCombineType = LTAUTOGUN
     , _itConsumption = defaultAmmo 
-        { _aoType = ltBullet
-        , _ammoMax = 25
-        , _ammoLoaded = 25
-        , _reloadTime = 80
+        { _aoType = basicBullet
+        , _ammoMax = 15
+        , _ammoLoaded = 0
+        , _reloadTime = 90
         }
     , _itUse = useAmmoParamsRate 2 NoHammer
         [ ammoCheckI

src/Dodge/Item/Weapon/TriggerType.hs

@@ -1,8 +1,11 @@
+{-# LANGUAGE TupleSections #-}
 {- |
 Weapon effects when pulling the trigger.  -}
 module Dodge.Item.Weapon.TriggerType
     ( useAmmoAmount
     , useAllAmmo
+    , useAmmoUpTo
+    , lockInvFor
     , withMuzFlareI
     , withOldDir
     , trigDoAlso
@@ -27,6 +30,7 @@ module Dodge.Item.Weapon.TriggerType
     , withWarmUp
     , spreadNumI
     , spreadLoaded
+    , repeatOnFrames
 --    , numBarrels
     , duplicateLoadedBarrels
     , randWalkAngle -- ^ should be made into a modifier, perhaps
@@ -45,15 +49,17 @@ import Dodge.SoundLogic
 import Dodge.Reloading
 import Dodge.WorldEvent
 import Dodge.RandomHelp
+import Dodge.Inventory.Lock
 --import Dodge.Default
 import Sound.Data
 import Geometry
 --import Geometry.Vector3D
 import Dodge.LightSource
 --import Data.Preload
+import LensHelp
 
 import System.Random
-import Control.Lens
+--import Control.Lens
 import Control.Monad.State
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
@@ -66,6 +72,10 @@ type ChainEffect
     -> World 
     -> World
 
+lockInvFor :: Int -> ChainEffect
+lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, unlockInv (_crID cr)))
+    . lockInv (_crID cr)
+
 -- Note that this uses the "base" creature and item values
 trigDoAlso 
     :: (Item -> Creature -> World -> World)
@@ -239,6 +249,10 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff
 useAllAmmo :: ChainEffect
 useAllAmmo eff item cr = eff item cr
     . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded .~ 0)
+useAmmoUpTo :: Int -> ChainEffect
+useAmmoUpTo amAmount eff item cr = eff item cr
+    . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded 
+        %~ (max 0 . subtract amAmount))
 useAmmoAmount :: Int -> ChainEffect
 useAmmoAmount amAmount eff item cr = eff item cr
     . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded -~ amAmount)
@@ -430,6 +444,15 @@ spreadLoaded eff item cr w = foldr f w dirs
 --    loadedSpreadParam = 0.5 * (fromIntegral (numBulLoaded - numBarrels) + 1)
     numBulLoaded = _ammoLoaded $ _itConsumption item
 
+-- pump the updated creature into the chain in later frames
+repeatOnFrames :: [Int] -> ChainEffect
+repeatOnFrames is f it cr w = f it cr w
+    & delayedEvents .++~ (is <&> (, f'))
+  where
+    f' w' = fromMaybe w' $ do
+        cr' <- w' ^? creatures . ix (_crID cr)
+        return $ f it cr' w'
+
 duplicateLoadedBarrels :: ChainEffect
 duplicateLoadedBarrels eff item cr w = foldr f w poss
   where

src/Dodge/Update.hs

@@ -57,6 +57,7 @@ functionalUpdate cfig w = checkEndGame
      . simpleCrSprings 
      . zoneCreatures 
      . updateDoors
+    . updateDelayedEvents
      . resetWorldEvents
      . dbArg _worldEvents
      . updateModifications
@@ -269,3 +270,11 @@ visibleWalls p1 p2 ws
   where 
     f wl = (uncurry intersectSegSeg (_wlLine wl) p1 p2, wl)
     theTest wl = _wlOpacity wl /= Opaque
+
+updateDelayedEvents :: World -> World
+updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents w)
+    in neww & delayedEvents .~ catMaybes newde
+  where
+    f w' (i,g) 
+        | i <= 0    = (g w', Nothing)
+        | otherwise = (w', Just (i-1,g))

src/LensHelp.hs

@@ -1,9 +1,14 @@
 module LensHelp 
     ( module Control.Lens
     , (.:~)
+    , (.++~)
     ) where
 import Control.Lens
 
 infixr 4 .:~
 (.:~) :: ASetter s t [a] [a] -> a -> s -> t
 (.:~) m x = m %~ (x :)
+
+infixr 4 .++~
+(.++~) :: ASetter s t [a] [a] -> [a] -> s -> t
+(.++~) m x = m %~ (x ++)