Partial refactor of bullet weapon effect chain

ghcidOutput

@@ -1,99 +1 @@
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:(32,25)-(316,68): warning: [-Wincomplete-patterns]
+All good (616 modules, at 13:05:37)
-    Pattern match(es) are non-exhaustive
-    In a case alternative:
-        Patterns not matched:
-            FireRemoteShellMod
-            ExplodeRemoteShellMod
-            DoNothingMod
-            ForceFieldMod
-            ...
-   |
-32 | heldEffect effecttype = case effecttype of
-   |                         ^^^^^^^^^^^^^^^^^^...
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:325:5-18: warning: [-Wunused-local-binds]
-    Defined but not used: ‘directedTelPos’
-    |
-325 |     directedTelPos _ cr w = (p, a)
-    |     ^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:335:1-9: warning: [-Wmissing-signatures]
-    Top-level binding with no type signature:
-      gasEffect :: [(LabelDoubleTree ComposeLinkType Item
-                     -> Creature -> World -> World)
-                    -> LabelDoubleTree ComposeLinkType Item
-                    -> Creature
-                    -> World
-                    -> World]
-                   -> LabelDoubleTree ComposeLinkType Item
-                   -> Creature
-                   -> World
-                   -> World
-    |
-335 | gasEffect = foldl' (&) (overNozzles useGasParams)
-    | ^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:337:1-15: warning: [-Wmissing-signatures]
-    Top-level binding with no type signature:
-      bulletGunEffect :: [(LabelDoubleTree ComposeLinkType Item
-                           -> Creature -> World -> World)
-                          -> LabelDoubleTree ComposeLinkType Item
-                          -> Creature
-                          -> World
-                          -> World]
-                         -> LabelDoubleTree ComposeLinkType Item
-                         -> Creature
-                         -> World
-                         -> World
-    |
-337 | bulletGunEffect = foldl' (&) shootBullet
-    | ^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:(342,13)-(644,9): warning: [-Wincomplete-patterns]
-    Pattern match(es) are non-exhaustive
-    In a case alternative:
-        Patterns not matched:
-            TractorMod
-            FireRemoteShellMod
-            ExplodeRemoteShellMod
-            DoNothingMod
-            ...
-    |
-342 | useMod hm = case hm of
-    |             ^^^^^^^^^^...
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:649:5-26: warning: [-Wunused-local-binds]
-    Defined but not used: ‘increasecycleLasCircle’
-    |
-649 |     increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
-    |     ^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:651:5-14: warning: [-Wunused-local-binds]
-    Defined but not used: ‘fLasCircle’
-    |
-651 |     fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
-    |     ^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:656:5-18: warning: [-Wunused-local-binds]
-    Defined but not used: ‘directedTelPos’
-    |
-656 |     directedTelPos _ cr w = (p, a)
-    |     ^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:703:16-18: warning: [-Wunused-matches]
-    Defined but not used: ‘itm’
-    |
-703 | usePjCreationX itm cr = undefined
-    |                ^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:703:20-21: warning: [-Wunused-matches]
-    Defined but not used: ‘cr’
-    |
-703 | usePjCreationX itm cr = undefined
-    |                    ^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:778:17-18: warning: [-Wunused-matches]
-    Defined but not used: ‘it’
-    |
-778 | fireRemoteShell it cr w = undefined
-    |                 ^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:778:20-21: warning: [-Wunused-matches]
-    Defined but not used: ‘cr’
-    |
-778 | fireRemoteShell it cr w = undefined
-    |                    ^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:778:23: warning: [-Wunused-matches]
-    Defined but not used: ‘w’
-    |
-778 | fireRemoteShell it cr w = undefined
-    |                       ^

src/Dodge/Bullet.hs

@@ -62,7 +62,7 @@ shootBullet :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Worl
 shootBullet itm cr w = fromMaybe (error "cannot find bullet ammo when expected to") $ do
     atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
     leftitms <- itm ^? ldtLeft
-    mag <- lookup (AmmoInLink atype) leftitms
+    mag <- lookup (AmmoInLink 0 atype) leftitms
     thebullet <- mag ^? ldtValue . itUse . amagParams . ampBullet
     return $ w & cWorld . lWorld . instantBullets
         .:~ ( thebullet

src/Dodge/Data/ComposedItem.hs

@@ -11,7 +11,7 @@ import Data.Aeson.TH
 import Dodge.Data.Item.Use.Consumption.Ammo
 
 data ComposeLinkType 
-    = AmmoInLink AmmoType
+    = AmmoInLink Int AmmoType
     | AmmoModLink
     deriving (Eq,Ord,Show,Read)
 

src/Dodge/Data/DoubleTree.hs

@@ -9,6 +9,7 @@ import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Data.Bifunctor
+--import qualified Data.Map.Strict as M
 
 data DoubleTreeNodeType
     = DTRootNode

src/Dodge/Data/Item/Use.hs

@@ -13,6 +13,8 @@ module Dodge.Data.Item.Use (
     module Dodge.Data.Item.Targeting,
 ) where
 
+import Sound.Data
+import qualified Data.IntMap.Strict as IM
 import Geometry.Data
 import Control.Lens
 import Data.Aeson
@@ -32,8 +34,9 @@ data ItemUse
         , _heldMods :: HeldMod
         , _heldHammer :: HammerPosition
         , _heldAim :: AimParams
-        , _heldAmmoTypes :: [AmmoType]
+        , _heldAmmoTypes :: IM.IntMap AmmoType
         , _heldParams :: HeldParams
+        , _heldTriggerType :: TriggerType
 --        , _useTargeting :: Maybe TargetType
         }
     | LeftUse
@@ -62,6 +65,10 @@ data ItemUse
         }
     deriving (Eq, Show, Read) --Generic, Flat)
 
+data TriggerType = AutoTrigger
+    | HammerTrigger
+    deriving (Eq, Show, Read) --Generic, Flat)
+
 data HeldParams
     = DefaultHeldParams
     | GasSprayParams
@@ -72,6 +79,8 @@ data HeldParams
         , _recoil :: Float
         , _torqueAfter :: Float
         , _randomOffset :: Float
+        , _sidePush :: Float
+        , _bulGunSound :: SoundID
         }
     deriving (Eq, Show, Read) --Generic, Flat)
 
@@ -114,11 +123,24 @@ data AimParams = AimParams
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+
+data FlareType = DefaultFlareType
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
 data Muzzle = Muzzle
     { _mzPos :: V2 Float
     , _mzRot :: Float
     , _mzInaccuracy :: Float
     , _mzAmmoSlot :: Int
+    , _mzFlareType :: FlareType
+--    , _mzRecoil :: Float
+--    , _mzTorque :: Float
+--    , _mzSidePush :: Float
+--    , _mzRandomOffset :: Float
+--    , _mzVel :: Float
+--    , _mzRifling :: Float
+--    , _mzAmmoSlot :: Either Int
+--    , _mzAmmoPerShot :: Int
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
@@ -147,6 +169,8 @@ makeLenses ''HeldParams
 makeLenses ''AttachParams
 makeLenses ''ScrollAttachParams
 makeLenses ''AmmoParams
+deriveJSON defaultOptions ''FlareType
+deriveJSON defaultOptions ''TriggerType
 deriveJSON defaultOptions ''AmmoParams
 deriveJSON defaultOptions ''HeldParams
 deriveJSON defaultOptions ''Muzzle

src/Dodge/Default/Item.hs

@@ -4,6 +4,7 @@ module Dodge.Default.Item (
     module Dodge.Default.Item.Effect,
 ) where
 
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Dodge.Data.Item
@@ -41,10 +42,13 @@ defaultLeftItem = defaultHeldItem & itUse .~ defaultLeftUse
 defaultCraftItem :: Item
 defaultCraftItem = defaultHeldItem & itUse .~ CraftUse
 
+singleAmmo :: a -> IM.IntMap a
+singleAmmo x = IM.insert 0 x mempty
+
 defaultBulletWeapon :: Item
 defaultBulletWeapon =
     defaultWeapon
-        & itUse . heldAmmoTypes .~ [BulletAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo BulletAmmo
 --        & itUse . heldUse .~ HeldUseAmmoParams -- useAmmoParams
         & itType . iyModules . at ModBulletCollision ?~ EMPTYMODULE
 --        & itType . iyModules . at ModBulletPayload ?~ EMPTYMODULE

src/Dodge/Default/Item/Use.hs

@@ -5,6 +5,7 @@ module Dodge.Default.Item.Use (
     module Dodge.Default.Item.Use.Equipment,
 ) where
 
+import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Dodge.Data.Item.Use
 import Dodge.Default.Item.Use.AimParams
 import Dodge.Default.Item.Use.Consumption
@@ -33,12 +34,15 @@ defaultHeldUse =
         , _heldMods = DoNothingMod
         , _heldHammer = HammerUp
         , _heldAim = defaultAimParams
-        , _heldAmmoTypes = []
+        , _heldAmmoTypes = mempty
         , _heldParams = BulletShooterParams
             { _muzVel = 0.8
             , _rifling = 0.8
             , _recoil = 10
             , _torqueAfter = 0.2
             , _randomOffset = 0
+            , _sidePush = 0
+            , _bulGunSound = tap3S
             }
+        , _heldTriggerType = HammerTrigger
         }

src/Dodge/Default/Item/Use/AimParams.hs

@@ -13,10 +13,20 @@ defaultAimParams =
         , _aimStance = OneHand
         , --, _aimHandlePos = 10
           _aimHandlePos = V2 3 0
-        , _aimMuzzles = [Muzzle (V2 20 0) 0 0 0]
+        , _aimMuzzles = [defaultMuzzle]
         --        , _aimMuzPos = 20
         }
 
+defaultMuzzle :: Muzzle
+defaultMuzzle = Muzzle
+    { _mzPos = V2 20 0
+    , _mzRot = 0
+    , _mzInaccuracy = 0.05
+    , _mzAmmoSlot = 0
+    , _mzFlareType = DefaultFlareType
+    }
+
+
 defaultItZoom :: ItZoom
 defaultItZoom =
     ItZoom

src/Dodge/HeldUse.hs

@@ -1,10 +1,14 @@
 module Dodge.HeldUse where
 
+import qualified SDL
+import Dodge.Base.You
+import Dodge.Data.MuzzleEffect
+import ListHelp
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Color
 import Data.Maybe
-import Data.Traversable
+--import Data.Traversable
 import Dodge.Base.Coordinate
 import Dodge.Bullet
 import Dodge.Creature.HandPos
@@ -26,7 +30,7 @@ import qualified IntMapHelp as IM
 import LensHelp
 import RandomHelp
 import Sound.Data
-import Data.Foldable
+--import Data.Foldable
 
 heldEffect :: HeldMod -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 heldEffect effecttype = case effecttype of
@@ -215,18 +219,19 @@ heldEffect effecttype = case effecttype of
         , ammoCheckI
         , blCheck
         ]
-    PistolMod -> bulletGunEffect
+    PistolMod -> bulGunEffect
-        [ withSidePushI 50
+--        bulletGunEffect
-        , withRecoil
+--        [ withSidePushI 50
-        , withFlare
+--        , withRecoil
-        , withTorqueAfter
+--        , withFlare
-        , duplicateLoadedBarrels
+--        , withTorqueAfter
-        , withSoundStart tap3S
+--        , duplicateLoadedBarrels
-        , useAmmoAmount 1
+--        , withSoundStart tap3S
-        , useTimeCheck
+--        , useAmmoAmount 1
-        , ammoCheckI
+--        , useTimeCheck
-        , blCheck
+--        , ammoCheckI
-        ]
+--        , blCheck
+--        ]
     AutoPistolMod -> bulletGunEffect
         [ withFlare
         , withSidePushI 50
@@ -314,6 +319,11 @@ heldEffect effecttype = case effecttype of
         , blCheck
         ]
     TractorMod -> foldl' (&) (aTractorBeam . _ldtValue) [ammoCheckI]
+    FireRemoteShellMod -> undefined
+    ExplodeRemoteShellMod -> undefined
+    DoNothingMod -> const $ const id
+    ForceFieldMod -> undefined
+    DetectorMod _ -> undefined
   where
     f = do
         nzpres <- state $ randomR (3, 4)
@@ -322,24 +332,157 @@ heldEffect effecttype = case effecttype of
         HammerUp -> it & itParams . lasCycle .~ 1
         _ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
     thegapDualBeam = _dbGap . _itParams
-    directedTelPos _ cr w = (p, a)
+    --directedTelPos _ cr w = (p, a)
-      where
+    --  where
-        p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
+    --    p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
-        a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
+    --    a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
     modcrpos x cr = fromMaybe cr $ do
         invid <- cr ^? crManipulation . manObject . inInventory . ispItem
         return $ cr & crDir %~ tweenAngles x (_crOldDir cr)
             & crPos %~ alongSegBy x (_crOldPos cr)
             & crInv . ix (invid + 1) . itUse . amagParams . ampBullet . buDelayFraction .~ x
 
+gasEffect :: [(LabelDoubleTree ComposeLinkType Item
+               -> Creature -> World -> World)
+              -> LabelDoubleTree ComposeLinkType Item
+              -> Creature
+              -> World
+              -> World]
+             -> LabelDoubleTree ComposeLinkType Item
+             -> Creature
+             -> World
+             -> World
 gasEffect = foldl' (&) (overNozzles useGasParams)
 
+bulGunEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+bulGunEffect = hammerCheck $ useTimeCheck bulGunEffect'
+
+bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+bulGunEffect' t cr w = fromMaybe (error "error in bulGunEffect") $ do
+    muzzles <- t ^? ldtValue . itUse . heldAim . aimMuzzles
+    let (_,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
+        cmew = foldl' (useLoadedAmmo (_ldtValue t) cr) (CME 0 0 False,w) loadedmuzzles
+    return $ uncurry (applyCME (_ldtValue t) cr) cmew
+
+applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
+applyCME itm cr cme 
+    | _cmeSound cme = applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr
+    | otherwise = id
+  where
+    spush = fromMaybe 0 $ itm ^? itUse . heldParams . sidePush
+
+applyRecoil :: Item -> Creature -> World -> World
+applyRecoil itm cr = over (cWorld . lWorld . creatures . ix cid) pushback
+  where
+    cid = _crID cr
+    recoilAmount = fromMaybe 0 $ itm ^? itUse . heldParams . recoil
+    pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0))
+
+applySidePush :: Float -> Creature -> World -> World
+applySidePush 0 _ w = w
+applySidePush maxSide cr w = w
+            & cWorld . lWorld . creatures . ix cid %~ push
+            & randGen .~ g
+  where
+    cid = _crID cr
+    push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
+    (pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w
+
+applyTorqueCME :: Item -> Creature -> World -> World
+applyTorqueCME itm cr w
+    | cid == 0 = w
+        & wCam . camRot +~ rot
+        & rotateScope
+        & randGen .~ g
+    | otherwise = w
+        & cWorld . lWorld . creatures . ix cid . crDir +~ rot
+        & randGen .~ g
+  where
+    cid = _crID cr
+    (rot, g) = randomR (- torque, torque) $ _randGen w
+    torque = fromMaybe 0 $ itm ^? itUse . heldParams . torqueAfter
+    rotateScope = fromMaybe id $ do
+        i <- yourScopeInvID w
+        return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
+    
+
+-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
+loadMuzzle :: LabelDoubleTree ComposeLinkType Item 
+    -> Muzzle -> (LabelDoubleTree ComposeLinkType Item,(Muzzle, Int,Maybe Int))
+loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,(mz, 0,Nothing)) $ do
+    let as = _mzAmmoSlot mz
+        amamount = 1
+    (i,(_,mag)) <- findWithIx (isAmmoIntLink as . fst) l
+    availableammo <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
+    let usedammo = min amamount availableammo
+    return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
+        , (mz, usedammo, mag ^? ldtValue . itLocation . ipInvID)
+        )
+
+makeMuzzleFlare :: (Muzzle,Int,Maybe Int) -> Item -> Creature -> World -> World
+makeMuzzleFlare _ _ _ = id
+
+isAmmoIntLink :: Int -> ComposeLinkType -> Bool
+isAmmoIntLink i (AmmoInLink j _) = i == j
+isAmmoIntLink _ _ = False
+
+useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World) -> (Muzzle,Int,Maybe Int) 
+    -> (CumulativeMuzzleEffect,World)
+useLoadedAmmo _ cr (cme,w) (_,0,_) = (cme,failsound w)
+  where
+    failsound = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
+        Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing
+        _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing
+useLoadedAmmo itm cr (cme,w) (mz,x,mid) = fromMaybe (cme,w) $ do
+    magid <- mid
+    -- should be able to pass the magazine in from elsewhere?
+    thebullet <- cr ^? crInv . ix magid . itUse . amagParams . ampBullet
+    return $ (cme & cmeSound .~ True,
+        w & cWorld . lWorld . creatures . ix cid . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
+            & flip (foldl' (&)) (replicate x (makeBullet thebullet itm cr mz))
+        )
+  where
+    cid = _crID cr
+
+makeBullet :: Bullet -> Item -> Creature -> Muzzle -> World -> World
+makeBullet thebullet itm cr mz w =
+        w & randGen .~ g
+            & cWorld . lWorld . instantBullets
+                .:~ (thebullet
+                & buPos .~ bulpos
+--                & buTrajectory .~ BasicBulletTrajectory
+                & buVel %~ (rotateV dir . (muzvel *.*))
+                & buDrag *~ _rifling (_heldParams $ _itUse itm)
+            )
+  where
+    bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
+    (a,g) = randomR (-inacc,inacc) $ _randGen w
+    inacc = _mzInaccuracy mz
+    muzvel = _muzVel $ _heldParams $ _itUse itm
+    dir = _crDir cr + _mzRot mz + a
+
+bulletGunEffect :: [(LabelDoubleTree ComposeLinkType Item
+               -> Creature -> World -> World)
+              -> LabelDoubleTree ComposeLinkType Item
+              -> Creature
+              -> World
+              -> World]
+             -> LabelDoubleTree ComposeLinkType Item
+             -> Creature
+             -> World
+             -> World
 bulletGunEffect = foldl' (&) shootBullet
 
 useMod :: HeldMod -> 
     [(LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) 
         -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World]
 useMod hm = case hm of
+    TractorMod -> undefined
+    FireRemoteShellMod -> undefined
+    ExplodeRemoteShellMod -> undefined
+    DoNothingMod -> undefined
+    ForceFieldMod -> undefined
+    DetectorMod _ -> undefined
 --    HeldModNothing -> []
     PoisonSprayerMod ->
         [ useAmmoAmount 1
@@ -646,17 +789,17 @@ useMod hm = case hm of
     f = do
         nzpres <- state $ randomR (3, 4)
         return $ sprayNozzles . ix 0 . nzPressure .~ nzpres
-    increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
+    --increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
-    --f it = [it & itParams . lasCycle +~ x | x <- [0,100 .. 1900] ]
+    ----f it = [it & itParams . lasCycle +~ x | x <- [0,100 .. 1900] ]
-    fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
+    --fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
     increasecycleLasWide n it = case _heldHammer (_itUse it) of
         HammerUp -> it & itParams . lasCycle .~ 1
         _ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
     thegapDualBeam = _dbGap . _itParams
-    directedTelPos _ cr w = (p, a)
+    --directedTelPos _ cr w = (p, a)
-      where
+    --  where
-        p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
+    --    p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
-        a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
+    --    a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
     modcrpos x cr = fromMaybe cr $ do
         invid <- cr ^? crManipulation . manObject . inInventory . ispItem
         return $ cr & crDir %~ tweenAngles x (_crOldDir cr)
@@ -694,13 +837,13 @@ usePjCreation :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Wo
 usePjCreation itm cr = fromMaybe id $ do
     atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
     leftitms <- itm ^? ldtLeft
-    mag <- lookup (AmmoInLink atype) leftitms
+    mag <- lookup (AmmoInLink 0 atype) leftitms
     apm <- mag ^? ldtValue
     muz <- itm ^? ldtValue . itUse . heldAim . aimMuzzles . ix 0
     return $ createProjectile apm muz (_ldtValue itm) cr
 
 usePjCreationX :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-usePjCreationX itm cr = undefined
+usePjCreationX = undefined
 --usePjCreationX ams itm cr = fromMaybe id $ do
 --    muzs <- itm ^? itUse . heldAim . aimMuzzles
 --    return $ foldr
@@ -769,13 +912,13 @@ useGasParams nz itm cr =
     gastype = fromMaybe (error "cannot find gas ammo") $ do
         atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
         leftitms <- itm ^? ldtLeft
-        mag <- lookup (AmmoInLink atype) leftitms
+        mag <- lookup (AmmoInLink 0 atype) leftitms
         mag ^? ldtValue . itUse . amagParams . ampCreateGas
     dir = _crDir cr
     pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
 
 fireRemoteShell :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-fireRemoteShell it cr w = undefined
+fireRemoteShell = undefined
 --fireRemoteShell :: [Item] -> Item -> Creature -> World -> World
 --fireRemoteShell ams it cr w =
 --    set

src/Dodge/Item/Grammar.hs

@@ -38,8 +38,8 @@ baseComposedItem ibt itm = case ibt of
 heldComposedItem :: Item -> CIL
 heldComposedItem itm = (WeaponCI, map f ats, [])
   where
-    ats = itm ^.. itUse . heldAmmoTypes . traverse
+    ats = maybe [] IM.toList $ itm ^? itUse . heldAmmoTypes
-    f atype = (AmmoInLink atype,AmmoCI atype)
+    f (i,atype) = (AmmoInLink i atype,AmmoCI atype)
 
 ammoComposedItem :: Item -> CIL
 ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do

src/Dodge/Item/Held/BatteryGuns.hs

@@ -30,13 +30,13 @@ teslaGun =
         & itUse . heldAim . aimWeight .~ 6
         & itUse . heldAim . aimStance .~ TwoHandFlat
         -- & itUse . heldAim . aimMuzPos .~ 4
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 4 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 4 0) 0 0 0 DefaultFlareType]
         & itType . iyBase .~ HELD TESLAGUN
 
 lasGun :: Item
 lasGun =
     defaultAutoBatteryGun
-        & itUse . heldAmmoTypes .~ [ElectricalAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
         & itParams
             .~ Refracting
                 { _phaseV = 1
@@ -59,7 +59,7 @@ lasGun =
         & itUse . heldAim . aimStance .~ TwoHandUnder
         -- & itUse . heldAim . aimHandlePos .~ 5
         -- & itUse . heldAim . aimMuzPos .~ 30
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0 DefaultFlareType]
         & itType . iyBase .~ HELD LASGUN
 
 lasGunTweak :: TweakParam
@@ -84,7 +84,7 @@ tractorGun =
         & itUse . heldMods .~ TractorMod
         & itUse . heldAim . aimWeight .~ 6
         & itUse . heldAim . aimRange .~ 1
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0 DefaultFlareType]
         & itType . iyBase .~ HELD TRACTORGUN
 
 tractorGunTweak :: TweakParam
@@ -102,7 +102,7 @@ lasWide n =
         & itParams . lasColor .~ yellow
         & itParams . lasDamage .~ 2
         & itUse . heldMods .~ LasWideMod n
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 y) 0 0 0 | y <- spreadFromCenter n 1]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 y) 0 0 0 DefaultFlareType | y <- spreadFromCenter n 1]
 
 defaultBatteryGun :: Item
 defaultBatteryGun =
@@ -137,7 +137,7 @@ dualBeam :: Item
 dualBeam =
     lasGun
         & itType . iyBase .~ HELD DUALBEAM
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0 DefaultFlareType]
         & itParams
             .~ DualBeam
                 { _phaseV = 1

src/Dodge/Item/Held/Cane.hs

@@ -8,6 +8,7 @@ module Dodge.Item.Held.Cane (
     miniGunX,
 ) where
 
+import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Dodge.Base
 import Dodge.Data.Item
 import Dodge.Default
@@ -25,6 +26,8 @@ defaultBangCane =
                 , _recoil = 50
                 , _torqueAfter = 0.1
                 , _randomOffset = 0
+                , _sidePush = 0
+                , _bulGunSound = tap3S
                 }
         & itDimension . dimRad .~ 8
         & itDimension . dimCenter .~ V3 5 0 0
@@ -32,7 +35,7 @@ defaultBangCane =
         & itUse . heldMods .~ BangCaneMod
         & itUse . heldAim . aimStance .~ OneHand
         -- & itUse . heldAim . aimHandlePos .~ 5
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.01 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.01 0 DefaultFlareType]
 
 volleyGun :: Int -> Item
 volleyGun i =
@@ -43,7 +46,7 @@ volleyGun i =
         & itUse . heldAim . aimStance .~ TwoHandFlat
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
         & itUse . heldAim . aimMuzzles .~ 
-            ([Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3] <*> [0..])
+            ([Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3] <*> [0..] <*> repeat DefaultFlareType)
         & itUse . heldParams . torqueAfter .~ 0.15 + 0.05 * fromIntegral i
         & itType . iyBase .~ HELD (VOLLEYGUN i)
 
@@ -56,7 +59,7 @@ multiGun i =
         & itUse . heldAim . aimStance .~ TwoHandFlat
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
         & itUse . heldAim . aimMuzzles .~ 
-            ([Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3] <*> [0..])
+            ([Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3] <*> [0..] <*> repeat DefaultFlareType)
         & itUse . heldParams . torqueAfter .~ 0.15 + 0.05 * fromIntegral i
         & itType . iyBase .~ HELD (MULTIGUN i)
 
@@ -68,7 +71,7 @@ rifle =
         & itUse . heldAim . aimWeight .~ 6
         & itUse . heldAim . aimRange .~ 1
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 25 0) 0 0.01 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 25 0) 0 0.01 0 DefaultFlareType]
         & itType . iyModules . at ModHeldAttach ?~ EMPTYMODULE
 
 repeater :: Item
@@ -103,14 +106,14 @@ miniGunUse i =
         & heldAim . aimRange .~ 1
         & heldAim . aimStance .~ TwoHandUnder
         & heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-        & heldAmmoTypes .~ [BeltBulletAmmo]
+        & heldAmmoTypes .~ singleAmmo BeltBulletAmmo
 
 miniGunX :: Int -> Item
 miniGunX i =
     autoRifle
         & itUse .~ miniGunUse i
         & itUse . heldAim . aimTurnSpeed .~ 0.5
-        & itUse . heldAim . aimMuzzles .~ replicate i (Muzzle (V2 30 0) 0 0.05 0)
+        & itUse . heldAim . aimMuzzles .~ replicate i (Muzzle (V2 30 0) 0 0.05 0 DefaultFlareType)
         & itUse . heldParams . recoil .~ 10
         & itUse . heldParams . torqueAfter .~ 0.01
         & itUse . heldParams . randomOffset .~ 10

src/Dodge/Item/Held/Cone.hs

@@ -1,5 +1,6 @@
 module Dodge.Item.Held.Cone where
 
+import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Control.Lens
 import Dodge.Data.Item
 import Dodge.Default.Item
@@ -15,13 +16,15 @@ bangCone =
         & itUse . heldDelay . rateMax .~ 20
         & itUse . heldMods .~ BangConeMod
         -- & itUse . heldAim . aimHandlePos .~ 5
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.5 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.5 0 DefaultFlareType]
         & itUse . heldParams .~ BulletShooterParams
                 { _muzVel = 0.7
                 , _rifling = 0.8
                 , _recoil = 150
                 , _torqueAfter = 0.1
                 , _randomOffset = 12
+                , _sidePush = 0
+                , _bulGunSound = bangEchoS
                 }
         & itType . iyBase .~ HELD BANGCONE
 

src/Dodge/Item/Held/Launcher.hs

@@ -31,8 +31,8 @@ launcher =
         & itUse . heldAim . aimStance .~ TwoHandOver
         -- & itUse . heldAim . aimHandlePos .~ V2 3 0
         -- & itUse . heldAim . aimMuzPos .~ 20
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 20 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 20 0) 0 0 0 DefaultFlareType]
-        & itUse . heldAmmoTypes .~ [ProjectileAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo ProjectileAmmo
         & itType . iyBase .~ HELD LAUNCHER
         & itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
 
@@ -42,7 +42,7 @@ launcherX i =
         & itType . iyBase .~ HELD (LAUNCHERX i)
 --        & itUse . heldUse .~ HeldPJCreationX i
         & itUse . heldMods .~ LauncherXMod i
-        & itUse . heldAim . aimMuzzles .~ ([Muzzle (V2 20 0) a 0 | a <- angles] <*> [0..])
+        & itUse . heldAim . aimMuzzles .~ ([Muzzle (V2 20 0) a 0 | a <- angles] <*> [0..] <*> [DefaultFlareType])
   where
     angles = take i [0,2*pi/ fromIntegral i ..]
     --angles = take i [1,2 ..]

src/Dodge/Item/Held/Rod.hs

@@ -7,6 +7,7 @@ module Dodge.Item.Held.Rod (
     machineGun,
 ) where
 
+import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Dodge.Data.Item
 import Dodge.Default
 --import Dodge.Item.Weapon.Bullet
@@ -24,6 +25,8 @@ bangRod =
                 , _recoil = 50
                 , _torqueAfter = 0.3
                 , _randomOffset = 0
+                , _sidePush = 0
+                , _bulGunSound = bangEchoS
                 }
         & itUse . heldDelay . rateMax .~ 12
         & itUse . heldMods .~ BangRodMod
@@ -35,7 +38,7 @@ bangRod =
         & itUse . heldAim . aimStance .~ OneHand
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
         -- & itUse . heldAim . aimHandlePos .~ 5
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0.1 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0.1 0 DefaultFlareType]
 --        & itUse . heldConsumption . laAmmoType .~ hvBulletAmmo
 
 elephantGun :: Item

src/Dodge/Item/Held/SprayGuns.hs

@@ -17,7 +17,7 @@ poisonSprayer :: Item
 poisonSprayer =
     flameThrower
         & itType . iyBase .~ HELD POISONSPRAYER
-        & itUse . heldAmmoTypes .~ [GasAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo GasAmmo
         & itUse . heldParams .~ GasSprayParams CreatePoisonGas --aGasCloud
         & itUse . heldMods .~ PoisonSprayerMod
 
@@ -88,7 +88,7 @@ flameThrower =
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 5, _izMin = 1.5}
         & itUse . heldAim . aimStance .~ TwoHandUnder
         -- & itUse . heldAim . aimHandlePos .~ 0
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 18 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 18 0) 0 0 0 DefaultFlareType]
-        & itUse . heldAmmoTypes .~ [GasAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo GasAmmo
         & itType . iyBase .~ HELD FLAMETHROWER
         & itUse . heldParams .~ GasSprayParams CreateFlame --aGasCloud

src/Dodge/Item/Held/Stick.hs

@@ -6,6 +6,7 @@ module Dodge.Item.Held.Stick (
     smg,
 ) where
 
+import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Dodge.Base
 import Dodge.Data.Item
 import Dodge.Default.Item
@@ -23,6 +24,8 @@ bangStick i =
                 , _recoil = 25
                 , _torqueAfter = 0.18 + 0.02 * fromIntegral i
                 , _randomOffset = 0
+                , _sidePush = 0
+                , _bulGunSound = tap3S
                 }
         & itType . iyBase .~ HELD (BANGSTICK i)
         & itInvSize .~ fromIntegral i / 3
@@ -30,7 +33,8 @@ bangStick i =
         & itDimension . dimCenter .~ V3 5 0 0
         & itUse . heldDelay . rateMax .~ 8
         & itUse . heldMods .~ BangStickMod
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 10 0) a 0.01 0 | a <- spreadAroundCenter i baseStickSpread]
+        & itUse . heldAim . aimMuzzles 
+            .~ [Muzzle (V2 10 0) a 0.01 0 DefaultFlareType | a <- spreadAroundCenter i baseStickSpread]
 
 baseStickSpread :: Float
 baseStickSpread = 0.2
@@ -38,15 +42,16 @@ baseStickSpread = 0.2
 pistol :: Item
 pistol =
     bangStick 1
-        & itUse . heldAmmoTypes .~ [BulletAmmo]
+--        & itUse . heldAmmoTypes .~ [BulletAmmo]
         & itUse . heldDelay . rateMax .~ 6
         & itUse . heldMods .~ PistolMod
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 10 0) 0 0.05 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 10 0) 0 0.05 0 DefaultFlareType]
         & itUse . heldParams
             %~ ( (muzVel .~ 0.8)
                     . (rifling .~ 0.8)
                     . (recoil .~ 10)
                     . (torqueAfter .~ 0.2)
+                    . (sidePush .~ 50)
                )
         & itType . iyBase .~ HELD PISTOL
 
@@ -72,6 +77,6 @@ smg =
         & itUse . heldMods .~ SmgMod --(ammoCheckI : smgAfterHamMods)
         & itType . iyBase .~ HELD SMG
         & itUse . heldAim . aimStance .~ TwoHandUnder
-        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 20 0) 0 0 0]
+        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 20 0) 0 0 0 DefaultFlareType]
         -- & itUse . heldAim . aimHandlePos .~ 2
         & itUse . heldParams . torqueAfter .~ 0.05

src/Dodge/Item/Held/Utility.hs

@@ -44,7 +44,7 @@ forceFieldGun =
         -- than the list below
         --[ hammerCheckI , ammoCheckI , useAmmoAmount 1]
         & itType . iyBase .~ HELD FORCEFIELDGUN
-        & itUse . heldAmmoTypes .~ [ElectricalAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
 
 {- |
 Sends out pulses that display walls.

src/Dodge/Item/Weapon/Drone.hs

@@ -16,7 +16,7 @@ droneLauncher =
         & itUse . heldAim . aimWeight .~ 8
         & itUse . heldAim . aimRange .~ 0.5
         & itUse . heldAim . aimStance .~ TwoHandOver
-        & itUse . heldAmmoTypes .~ [DroneAmmo]
+        & itUse . heldAmmoTypes .~ singleAmmo DroneAmmo
         & itType . iyBase .~ HELD DRONELAUNCHER
 
 lasDronesPic :: Item -> SPic

src/Dodge/Item/Weapon/TriggerType.hs

@@ -53,6 +53,7 @@ module Dodge.Item.Weapon.TriggerType (
     duplicateOffsetsV2,
     duplicateOffsetsFocus,
     hammerCheckL,
+    hammerCheck,
     shootL,
     useTimeCheck,
     ammoCheckI,
@@ -145,7 +146,7 @@ ammoCheckI :: ChainEffect
 ammoCheckI eff itm cr w = fromMaybe (failsound w) $ do
     atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
     leftitms <- itm ^? ldtLeft
-    mag <- lookup (AmmoInLink atype) leftitms
+    mag <- lookup (AmmoInLink 0 atype) leftitms
     x <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
     guard $ x > 0
     return $ eff itm cr $ w -- & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading
@@ -363,7 +364,7 @@ useAmmoAmount :: Int -> ChainEffect
 useAmmoAmount amAmount eff item cr = fromMaybe id $ do
     atype <- item ^? ldtValue . itUse . heldAmmoTypes . ix 0
     leftitms <- item ^? ldtLeft
-    mag <- lookup (AmmoInLink atype) leftitms
+    mag <- lookup (AmmoInLink 0 atype) leftitms
     magid <- mag ^? ldtValue . itLocation . ipInvID
 --    invid <- ams ^? ix 0 . itLocation . ipInvID
     return $ eff item cr
@@ -380,7 +381,8 @@ useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay . rateTime
     _ -> w
   where
     cid = _crID cr
-    setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime +~ userate
+    setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime 
+        +~ userate
     itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
     userate = fromMaybe 0 $ item ^? ldtValue . itUse . heldDelay . rateMax
 
@@ -390,6 +392,14 @@ blCheck f it cr w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
     Just 0 -> f it cr w
     _ -> w
 
+hammerCheck :: ChainEffect
+hammerCheck f it cr w = case it ^? ldtValue . itUse . heldTriggerType of
+    Just HammerTrigger -> case w ^? input . mouseButtons . ix SDL.ButtonLeft of
+        Just 0 -> f it cr w
+        _ -> w
+    _ -> f it cr w
+
+
 {- | Applies a world effect after a hammer position check.
 Arbitrary inventory position.
 -}

src/ListHelp.hs

@@ -20,6 +20,8 @@ module ListHelp
     , foldrWhileArb
 
     , wordsBy
+
+    , findWithIx
     ) where
 import Data.List
 import Data.Ord
@@ -117,3 +119,6 @@ wordsBy x xs = case dropWhile (==x) xs of
     xs' -> w : wordsBy x xs''
       where
         (w,xs'') = break (==x) xs'
+
+findWithIx :: (a -> Bool) -> [a] -> Maybe (Int,a)
+findWithIx t = find (t . snd) . zip [0..]