Allow for custom reloading sounds

src/Dodge/Creature/State.hs

@@ -231,7 +231,8 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
-    Just ReloadAction{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
+    Just ReloadAction{_reloadAction = la} -> soundContinue 
+        (CrReloadSound cid) (_crPos cr) (_actionSound la) (Just 1) w
     _ -> w
 --        PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
 --                                        -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w

src/Dodge/Data.hs

@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
 module Dodge.Data 
     ( module Dodge.Data
     , module Dodge.Data.Material
+    , module Dodge.Data.LoadAction
     , module Dodge.Data.Wall
     , module Dodge.Combine.Data
     , module Dodge.Distortion.Data
@@ -29,6 +30,7 @@ module Dodge.Data
     , module Dodge.Data.Room
     ) where
 import Dodge.Data.Room
+import Dodge.Data.LoadAction
 import Dodge.Data.Material
 import Dodge.Data.Wall
 import Dodge.RoomCluster.Data
@@ -544,15 +546,6 @@ data ItemPortage
     | WornItem
     | NoPortage
 
-data LoadAction
-    = Eject  {_actionTime :: Int}
-    | Insert {_actionTime :: Int, _insertMax :: Maybe Int }
-    | Prime  {_actionTime :: Int}
-  deriving (Eq,Ord,Show)
-data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
-data InvSelAction
-    = NoInvSelAction
-    | ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction }
 
 -- I believe this is called every frame, not sure when though
 data ItEffect 
@@ -1477,9 +1470,6 @@ makeLenses ''ItEffect
 makeLenses ''FloorItem
 makeLenses ''ItemConsumption
 makeLenses ''AmmoType
-makeLenses ''LoadAction
-makeLenses ''InvSel
-makeLenses ''InvSelAction
 makeLenses ''TweakParam
 makeLenses ''Prop
 makeLenses ''Modification

src/Dodge/Data/LoadAction.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.LoadAction where
+import Sound.Data
+import Dodge.Item.Data
+import Control.Lens
+data LoadAction
+    = Eject  {_actionTime :: Int, _actionSound :: SoundID}
+    | Insert {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Maybe Int }
+    | Prime  {_actionTime :: Int, _actionSound :: SoundID}
+  deriving (Eq,Ord,Show)
+data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
+data InvSelAction
+    = NoInvSelAction
+    | ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType}
+makeLenses ''LoadAction
+makeLenses ''InvSel
+makeLenses ''InvSelAction

src/Dodge/Default/Weapon.hs

@@ -1,6 +1,7 @@
 module Dodge.Default.Weapon
     where
 import Dodge.Data
+import Dodge.Reloading.Action
 import Dodge.Item.Weapon.Bullet
 import Dodge.Default.Item
 import Dodge.Item.Draw
@@ -19,7 +20,7 @@ defaultLoadable = LoadableAmmo
     { _laAmmoType   = GenericAmmo
     , _laMax        = 15
     , _laLoaded     = 0
-    , _laCycle      = [Eject 10, Insert 10 Nothing, Prime 10]
+    , _laCycle      = [loadEject 10, loadInsert 10, loadPrime 10]
     , _laProgress   = Nothing
     }
 defaultBulletLoadable :: ItemConsumption

src/Dodge/Event.hs

@@ -8,7 +8,8 @@ We cannot handle multiple keys held down at once here,
 (eg left mouse button + right mouse button)
 because these are separate events.
 Instead we store the events in a set, and deal with the combinations in
-"Dodge.Update".  -}
+"Dodge.Update"; in particular see 'updatePressedButtons'.
+-}
 module Dodge.Event
     ( handleEvent
     ) where

src/Dodge/Inventory.hs

@@ -316,6 +316,7 @@ changeAugInvSel :: Int -> World -> World
 changeAugInvSel i w 
     | n == 0    = w
     | otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
+        & creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
   where 
     n = length (yourInv w) + length (_closeObjects w)
 

src/Dodge/Item/Display.hs

@@ -1,4 +1,5 @@
-module Dodge.Item.Display where
+module Dodge.Item.Display 
+    where
 import Dodge.Module
 import Dodge.Data
 import Dodge.Inventory.ItemSpace
@@ -11,6 +12,23 @@ import Data.Sequence
 itemString :: Item -> String
 itemString = head . itemDisplay
 
+selectedItemDisplay :: Creature -> Item -> [String]
+selectedItemDisplay cr it =  Prelude.take (itSlotsTaken it) $
+    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
+    : catMaybes [maybeWarmupStatus it]
+    ++ moduleStrings it ++ repeat "*"
+  where 
+    thename  = show . _iyBase $ _itType it
+    thenumber = showSelectedConsumption cr (_itConsumption it) 
+    theparam = fromMaybe []
+        . listToMaybe 
+        $ mapMaybe ($ it) 
+        [ maybeModeStatus
+--        , maybeWarmupStatus
+--        , maybeRateStatus
+        ]
+
+
 {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
 -- TODO make work on remote launchers
 itemDisplay :: Item -> [String]
@@ -28,17 +46,31 @@ itemDisplay it = Prelude.take (itSlotsTaken it) $
 --        , maybeWarmupStatus
 --        , maybeRateStatus
         ]
+showSelectedConsumption :: Creature -> ItemConsumption -> String
+showSelectedConsumption cr ic = case ic of
+    LoadableAmmo{} -> showReloadProgress cr ic
+    ChargeableAmmo{} -> show $ _wpCharge ic
+    ItemItselfConsumable{} -> show (_icAmount ic)
+    NoConsumption -> ""
+
+showReloadProgress :: Creature -> ItemConsumption -> String
+showReloadProgress cr ic = case cr ^?! crInvSel . iselAction of
+    ReloadAction i la _ -> show i ++ showLoadActionType la
+    _ -> case ic ^? laProgress . _Just . ix 0 of
+        Nothing -> show $ _laLoaded ic
+        Just la -> show (_actionTime la) ++ showLoadActionType la
+
+showLoadProgress :: Int -> Maybe [LoadAction] -> String
+showLoadProgress x mlas = case mlas ^? _Just . ix 0 of
+    Just la -> show (_actionTime la) ++ showLoadActionType la
+    Nothing -> show x
 
 showConsumption :: ItemConsumption -> String
 showConsumption ic = case ic of
-    am@LoadableAmmo{} -> showLoading ic ++ show (_laLoaded am)
+    LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic)
     am@ChargeableAmmo{} -> show $ _wpCharge am
     x@ItemItselfConsumable{} -> show (_icAmount x)
     NoConsumption -> ""
-showLoading :: ItemConsumption -> String
-showLoading ic = case ic ^? laProgress . _Just . ix 0 of
-    Just la -> showLoadActionType la
-    Nothing -> ""
 showLoadActionType :: LoadAction -> String
 showLoadActionType la = case la of
     Eject {}    -> "E"

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -17,6 +17,7 @@ module Dodge.Item.Weapon.BatteryGuns
     , splitBeamCombine
     ) where
 import Dodge.Data
+import Dodge.Reloading.Action
 import Dodge.Tesla
 import Dodge.Beam
 import Dodge.Item.Weapon.LaserPath
@@ -74,7 +75,7 @@ teslaGun :: Item
 teslaGun = defaultBatteryGun 
     { _itConsumption = defaultLoadable
         & laMax .~ 200
-        & laCycle .~ [Eject 10, Insert 10 Nothing, Prime 60]
+        & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
     , _itUse = ruseInstant shootTeslaArc NoHammer
         [ ammoCheckI
         , withTempLight 1 100 (V3 0 0 1)
@@ -253,7 +254,7 @@ lasGun :: Item
 lasGun = defaultAutoBatteryGun 
     { _itConsumption = defaultLoadable
         & laMax .~ 200
-        & laCycle .~ [Eject 10, Insert 10 Nothing, Prime 60]
+        & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
     , _itUse = ruseInstant shootLaser NoHammer
         [ ammoCheckI
         , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
@@ -318,7 +319,7 @@ tractorGun :: Item
 tractorGun = lasGun 
     { _itConsumption = defaultLoadable
         & laMax .~ 10000
-        & laCycle .~ [Eject 10, Insert 10 Nothing, Prime 60]
+        & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
     , _itUse = ruseInstant aTractorBeam NoHammer
         [ ammoCheckI
         ]

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -10,6 +10,7 @@ module Dodge.Item.Weapon.BulletGun.Cane
     , miniGunX
     ) where
 --import Dodge.Particle.Bullet.HitEffect
+import Dodge.Reloading.Action
 --import Dodge.WorldEvent.HitEffect
 import Dodge.Item.Weapon.BulletGun.Clip
 import Dodge.Data
@@ -73,7 +74,7 @@ bangCane = defaultBulletWeapon
     } & itUse . useAim . aimStance .~ OneHand
     & itType . iyBase .~ BANGCANE
     & itConsumption . laMax .~ 1
-    & itConsumption . laCycle .~ [Insert 10 (Just 1)]
+    & itConsumption . laCycle .~ [loadPartialInsert 10 1]
 bangCaneX :: Int -> Item
 bangCaneX i = bangCane
     { _itUse = ruseAmmoParamsRate 6 upHammer
@@ -139,7 +140,7 @@ rifle = bangCane
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itType . iyBase .~ RIFLE
     & itConsumption . laMax .~ 1
-    & itConsumption . laCycle .~ [Eject 5, Insert 5 Nothing,Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 5 ,loadPrime 5]
     & itUse . useAim . aimWeight .~ 6
     & itUse . useAim . aimRange .~ 1
 --    & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
@@ -148,7 +149,7 @@ repeater :: Item
 repeater = rifle
     & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
     & itType . iyBase .~ REPEATER
-    & itConsumption . laCycle .~ [Eject 5, Insert 15 Nothing,Prime 15]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 15 ,loadPrime 15]
     & itConsumption . laMax .~ 15
     & itDimension . dimSPic .~ (\it -> noPic $ baseRifleShape
             <> makeTinClipAt 0 (V3 10 (-2) 0) it
@@ -251,7 +252,7 @@ miniGunX i = defaultAutoGun
         { _laMax = 1500
         , _laLoaded = 1500
         }
-        & laCycle .~ [Eject 40, Insert 40 Nothing,Prime 40]
+        & laCycle .~ [loadEject 40, loadInsert 40 ,loadPrime 40]
     , _itUse = miniGunUse i
         & useDelay .~ WarmUpNoDelay {_warmTime = 0,_warmMax = 100}
         & useAim . aimWeight .~ 6

src/Dodge/Item/Weapon/BulletGun/Rod.hs

@@ -7,6 +7,7 @@ module Dodge.Item.Weapon.BulletGun.Rod
     , machineGun
     ) where
 import Dodge.Data
+import Dodge.Reloading.Action
 import Dodge.Item.Weapon.BulletGun.Clip
 import Dodge.Particle.HitEffect
 import Dodge.Particle.Damage
@@ -70,7 +71,7 @@ bangRod = defaultBulletWeapon
         }
     } 
     & itConsumption . laMax .~ 1
-    & itConsumption . laCycle .~ [Eject 5, Insert 10 Nothing, Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 5]
     & itType . iyBase .~ BANGROD
     & itUse . useAim . aimWeight .~ 8
     & itUse . useAim . aimRange .~ 1
@@ -141,6 +142,6 @@ machineGun = bangRod
         & useDelay .~ VariableRate {_rateMax = 25, _rateMaxMax = 24, _rateMinMax = 7, _rateTime = 0}
         )
     & itConsumption . laMax .~ 100
-    & itConsumption . laCycle .~ [Eject 10, Insert 40 Nothing, Prime 10]
+    & itConsumption . laCycle .~ [loadEject 10, loadInsert 40 , loadPrime 10]
     & itInvSize .~ 3
     & itParams. torqueAfter .~ 0.2 -- not sure if this is necessary?

src/Dodge/Item/Weapon/BulletGun/Stick.hs

@@ -8,6 +8,7 @@ module Dodge.Item.Weapon.BulletGun.Stick
     , revolverX
     ) where
 import Dodge.Item.Weapon.BulletGun.Clip
+import Dodge.Reloading.Action
 import Dodge.Data
 import Dodge.ChainEffect
 import Dodge.Default.Weapon
@@ -78,7 +79,7 @@ bangStick i = defaultBulletWeapon
     }
     & itType . iyBase .~ BANGSTICK i
     & itConsumption . laMax .~ i
-    & itConsumption . laCycle .~ [Insert 10 (Just 1)]
+    & itConsumption . laCycle .~ [loadPartialInsert 10 1]
 baseStickShapeX :: Int -> Shape
 baseStickShapeX i = foldMap f [0..i-1]
   where
@@ -108,7 +109,7 @@ revolver = pistol
     & itConsumption .~ 
         (defaultBulletLoadable
             & laMax .~ 6
-            & laCycle .~ [Insert 10 (Just 1)] )
+            & laCycle .~ [loadPartialInsert 10 1] )
     & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> revolverClip it)
     & itType . iyBase .~ REVOLVER
 
@@ -157,7 +158,7 @@ pistol :: Item
 pistol = bangStick 1
     & itConsumption .~ ( defaultBulletLoadable
         & laMax .~ 15
-        & laCycle .~ [Eject 5, Insert 5 Nothing, Prime 5] )
+        & laCycle .~ [loadEject 5, loadInsert 5 , loadPrime 5] )
     & itUse .~ ruseAmmoParamsRate 6 upHammer (ammoHammerCheck : pistolAfterHamMods)
     & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it)
     & itParams %~

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -13,6 +13,7 @@ module Dodge.Item.Weapon.BulletGuns
     , module Dodge.Item.Weapon.BulletGun.Rod
     ) where
 import Dodge.Item.Weapon.BulletGun.Stick
+import Dodge.Reloading.Action
 import Dodge.Item.Weapon.BulletGun.Cane
 import Dodge.Item.Weapon.BulletGun.Rod
 --import Dodge.Item.Weapon.BulletGun.Clip
@@ -44,7 +45,7 @@ autoGun = defaultAutoGun
         { _laMax = 30
         , _laLoaded = 30
         }
-        & laCycle .~ [Eject 30, Insert 30 Nothing, Prime 10]
+        & laCycle .~ [loadEject 30, loadInsert 30 , loadPrime 10]
     , _itUse   = ruseAmmoParamsRate 4 NoHammer
         [ ammoCheckI
         , charFiringStratI
@@ -131,7 +132,7 @@ bangCone = defaultBulletWeapon
     }
     & itType . iyBase .~ BANGCONE
     & itConsumption . laMax .~ 5
-    & itConsumption . laCycle .~ [Eject 5, Insert 20 Nothing, Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
 coneRandItemUpdate :: State StdGen (Item -> Item)
 coneRandItemUpdate = do
     wth <- state $ randomR (1,5)
@@ -159,7 +160,7 @@ blunderbuss = bangCone
         }
     }
     & itConsumption . laMax .~ 25
-    & itConsumption . laCycle .~ [Eject 5, Insert 30 Nothing, Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 30 , loadPrime 5]
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itUse . useAim . aimWeight .~ 6
     & itType . iyBase .~ BLUNDERBUSS
@@ -167,7 +168,7 @@ bigBlunderbuss :: Item
 bigBlunderbuss = blunderbuss
     & itType . iyBase .~ BIGBLUNDERBUSS
     & itConsumption . laMax .~ 50
-    & itConsumption . laCycle .~ [Eject 5, Insert 40 Nothing, Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 40 , loadPrime 5]
     & itParams . recoil .~ 200
     & itParams . torqueAfter .~ 0.3
     & itParams . randomOffset .~ 16
@@ -175,7 +176,7 @@ biggerBlunderbuss :: Item
 biggerBlunderbuss = bigBlunderbuss
     & itType . iyBase .~ BIGGERBLUNDERBUSS
     & itConsumption . laMax .~ 75
-    & itConsumption . laCycle .~ [Eject 5, Insert 50 Nothing, Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 50 , loadPrime 5]
     & itParams . recoil .~ 250
     & itParams . torqueAfter .~ 0.5
     & itParams . randomOffset .~ 20
@@ -183,7 +184,7 @@ biggestBlunderbuss :: Item
 biggestBlunderbuss = biggerBlunderbuss
     & itType . iyBase .~ BIGGESTBLUNDERBUSS
     & itConsumption . laMax .~ 100
-    & itConsumption . laCycle .~ [Eject 5, Insert 60 Nothing, Prime 5]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 60 , loadPrime 5]
     & itParams . recoil .~ 300
     & itParams . torqueAfter .~ 0.7
     & itParams . randomOffset .~ 24

src/Dodge/Item/Weapon/Launcher.hs

@@ -5,6 +5,7 @@ module Dodge.Item.Weapon.Launcher
     , fireTrackingShell
     ) where
 import Dodge.Data
+import Dodge.Reloading.Action
 import Dodge.Default
 import Dodge.Default.Weapon
 import Dodge.Item.Location
@@ -44,7 +45,7 @@ launcher = defaultWeapon
             }
         & laMax .~ 1
         & laLoaded .~ 1
-        & laCycle .~ [Eject 30, Insert 30 Nothing, Prime 10]
+        & laCycle .~ [loadEject 30, loadInsert 30, loadPrime 10]
     , _itUse = ruseRate 20 usePjCreation upHammer
         [ hammerCheckI
         , ammoCheckI

src/Dodge/Item/Weapon/SonicGuns.hs

@@ -1,5 +1,6 @@
 module Dodge.Item.Weapon.SonicGuns where
 import Dodge.Data
+import Dodge.Reloading.Action
 import Dodge.Creature.HandPos
 --import Dodge.Particle.TeslaArc
 --import Dodge.SoundLogic.LoadSound
@@ -32,7 +33,7 @@ sonicGun :: Item
 sonicGun = defaultAutoGun 
     { _itConsumption = defaultLoadable
         & laMax .~ 10
-        & laCycle .~ [Eject 10, Insert 10 Nothing, Prime 60]
+        & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
     , _itUse = ruseRate 8 aSonicWave (HasHammer HammerUp)
         [ ammoHammerCheck
         , useTimeCheck

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -7,6 +7,7 @@ module Dodge.Item.Weapon.SprayGuns
     , flameWall
     ) where
 import Dodge.Data
+import Dodge.Reloading.Action
 import Dodge.Particle.Flame
 --import Dodge.Data.SoundOrigin
 --import Dodge.Base
@@ -68,7 +69,7 @@ flameSpitter :: Item
 flameSpitter = flameThrower
     & itType . iyBase .~ FLAMESPITTER
     & itConsumption . laMax .~ 10
-    & itConsumption . laCycle .~ [Eject 5, Insert 10 Nothing, Prime 20]
+    & itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
     & itParams . sprayNozzles . ix 0 . nzPressure .~ 4
     & itUse . useAim . aimStance .~ OneHand
     & itUse . useDelay .~ FixedRate {_rateMax =12,_rateTime = 0}
@@ -122,7 +123,7 @@ flameThrower = defaultAutoGun
             {_amString = "FLAME"
             ,_amCreateGas = aFlame
             }
-        & laCycle .~ [Eject 5, Insert 10 Nothing, Prime 20]
+        & laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
     , _itUse = ruseInstant (overNozzles useGasParams) NoHammer
         [ ammoCheckI
         , useAmmoAmount 1

src/Dodge/Item/Weapon/TriggerType.hs

@@ -127,7 +127,7 @@ ammoCheckI :: ChainEffect
 ammoCheckI eff item cr w
     | _laLoaded (_itConsumption item) <= 0 = w -- fromMaybe w (startReloadingWeapon cr w)
 --    | _reloadState (_itConsumption item) /= Nothing' = w 
-    | otherwise = eff item cr $ w & creatures . ix (_crID cr) %~ crStopReloading
+    | otherwise = eff item cr $ w & creatures . ix (_crID cr) %~ crCancelReloading
 
 -- combined ammo and hammer check: want to be able to auto-reload even if the
 -- hammer is down?
@@ -136,7 +136,7 @@ ammoHammerCheck eff it cr w
     | _laLoaded (_itConsumption it) <= 0 = w -- fromMaybe w (startReloadingWeapon cr w)
         & setHammerDown
     | otherwise = case it ^? itUse . useHammer . hammerPosition of
-        Just HammerUp -> eff it cr $ setHammerDown w & creatures . ix (_crID cr) %~ crStopReloading
+        Just HammerUp -> eff it cr $ setHammerDown w & creatures . ix (_crID cr) %~ crCancelReloading
         _             -> setHammerDown w
   where 
     cid = _crID cr

src/Dodge/Reloading.hs

@@ -1,6 +1,5 @@
 module Dodge.Reloading 
-    ( tryStartLoading
+    ( crCancelReloading
-    , crStopReloading
     , crStartReloading
     , stepReloading
     ) where
@@ -11,35 +10,56 @@ import Dodge.Data
 import Control.Lens
 import Data.Maybe
 
-crStartReloading :: Creature -> World -> World
+crCancelReloading :: Creature -> Creature
-crStartReloading cr w = fromMaybe w $ w & creatures . ix (_crID cr) %%~ tryStartLoading
+crCancelReloading cr = cr 
-
+    & crInv . ix (crSel cr) . itConsumption . laProgress %~ const Nothing
-crStopReloading :: Creature -> Creature
+    & crInvSel . iselAction .~ NoInvSelAction
-crStopReloading cr = cr & crStance . posture .~ AtEase
 
 stepReloading :: Creature -> Creature
 stepReloading cr = case cr ^?! crInvSel . iselAction of
-    ReloadAction x la 
+    ReloadAction x la _
         | x > 0     -> cr & crInvSel . iselAction . actionProgress -~ 1
         | otherwise -> cr & completeLoadAction la
     _ -> cr
 
+crStartReloading :: Creature -> World -> World
+crStartReloading cr w = fromMaybe w $ w
+    & creatures . ix (_crID cr) %%~ tryStartLoading
+
 tryStartLoading :: Creature -> Maybe Creature
 tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress of
-    Just Nothing -> Just . continueLoading $ cr 
+    Just Nothing -> Just . startLoadAction $ cr
         & crInv . ix (crSel cr) . itConsumption %~ setLoadCycle
-    Just (Just _) -> Just . continueLoading $ cr
+    Just (Just (a:_)) -> Just . startNextLoadAction a $ cr
-    Nothing -> Nothing
+    Just (Just []) -> Nothing
+    _ -> Nothing
+--    Just (Just _) -> Just . continueLoading $ cr
+--    Nothing -> Nothing
+
+startLoadAction :: Creature -> Creature
+startLoadAction cr = continueLoading $ cr 
+    & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
+  where
+    la = cr ^?! crInv . ix (crSel cr) . itConsumption . laProgress . _Just . ix 0
 
 setLoadCycle :: ItemConsumption -> ItemConsumption
 setLoadCycle ic = ic & laProgress ?~ _laCycle ic
 
+startNextLoadAction :: LoadAction -> Creature -> Creature
+startNextLoadAction la cr = cr
+    & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
+
 continueLoading :: Creature -> Creature
 continueLoading cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just of
-    Just (la:_) -> cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la
+    Just (la:_) -> cr & crInvSel . iselAction . reloadAction .~ la
+        & crInvSel . iselAction . actionProgress .~ _actionTime la
+    Just [] -> case cr ^?! crInv . ix (crSel cr) . itConsumption of
+        ic | _laLoaded ic < _laMax ic -> continueLoading $ cr
+            & crInv . ix (crSel cr) . itConsumption . laProgress ?~ _laCycle ic 
+        _ -> cr & crInvSel . iselAction .~ NoInvSelAction
+        & crInv . ix (crSel cr) . itConsumption . laProgress .~ Nothing
     _     -> cr & crInvSel . iselAction .~ NoInvSelAction
         & crInv . ix (crSel cr) . itConsumption . laProgress .~ Nothing
-        & crStance . posture .~ AtEase
 
 completeLoadAction :: LoadAction -> Creature -> Creature
 completeLoadAction la cr = continueLoading $ cr

src/Dodge/Reloading/Action.hs

@@ -0,0 +1,15 @@
+module Dodge.Reloading.Action where
+import Dodge.SoundLogic.ExternallyGeneratedSounds
+import Dodge.Data.LoadAction
+
+loadInsert :: Int -> LoadAction
+loadInsert x = Insert x insertS Nothing
+
+loadPartialInsert :: Int -> Int -> LoadAction
+loadPartialInsert x y = Insert x insertOneS (Just y)
+
+loadEject :: Int -> LoadAction
+loadEject x = Eject x ejectS
+
+loadPrime :: Int -> LoadAction
+loadPrime x = Prime x primeS

src/Dodge/Render/HUD.hs

@@ -49,7 +49,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
   where
     cr = you w
     inv = _crInv cr
-    invlist = concatMap itemText (IM.elems inv)
+    invlist = concatMap (itemText' cr) (IM.toList inv)
         ++ displayFreeSlots
         ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
 --        ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
@@ -367,6 +367,18 @@ mapWall cfig w wl =
 mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
+itemText' :: Creature -> (Int,Item) -> [Picture]
+{-# INLINE itemText' #-}
+itemText' cr (i,it) = f $ case _itCurseStatus it of
+    UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
+    _ | crSel cr == i -> map (color thecolor . text) (selectedItemDisplay cr it)
+    _ -> map (color thecolor . text) (itemDisplay it)
+  where
+    thecolor = _itInvColor it
+    f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))
+
+
+
 itemText :: Item -> [Picture]
 {-# INLINE itemText #-}
 itemText it = f $ case _itCurseStatus it of

src/Dodge/SoundLogic.hs

@@ -197,4 +197,5 @@ soundMultiFrom (so:sos) pos sType mtime w
     a = soundAngle pos w
 {- | Sets '_soundTime' to 0.  -}
 stopSoundFrom :: SoundOrigin -> World -> World
-stopSoundFrom so = over (playingSounds . ix so . soundTime) (fmap $ min 0)
+stopSoundFrom so = playingSounds . ix so . soundTime ?~ 0
+--stopSoundFrom so = over (playingSounds . ix so . soundTime) (fmap $ min 0)

src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs

@@ -1,4 +1,4 @@
--- generated at 2022-06-19 19:56:56.88468711 UTC
+-- generated at 2022-06-21 17:36:17.190436966 UTC
 module Dodge.SoundLogic.ExternallyGeneratedSounds where
 import Sound.Data
 soundToVol :: SoundID -> Float
@@ -21,62 +21,66 @@ soundToVol v = case _getSoundID v of
     15 -> 200
     16 -> 40
     17 -> 300
-    18 -> 2000
+    18 -> 500
-    19 -> 500
+    19 -> 2000
-    20 -> 100
+    20 -> 500
-    21 -> 1000
+    21 -> 100
-    22 -> 100
+    22 -> 1000
-    23 -> 1000
+    23 -> 100
-    24 -> 40
+    24 -> 1000
-    25 -> 2000
+    25 -> 40
-    26 -> 50
+    26 -> 2000
-    27 -> 2000
+    27 -> 50
-    28 -> 50
+    28 -> 2000
-    29 -> 1000
+    29 -> 50
-    30 -> 8000
+    30 -> 1000
-    31 -> 2000
+    31 -> 8000
     32 -> 2000
-    33 -> 1000
+    33 -> 2000
-    34 -> 2000
+    34 -> 1000
-    35 -> 100
+    35 -> 2000
-    36 -> 40
+    36 -> 100
     37 -> 40
-    38 -> 2000
+    38 -> 40
-    39 -> 100
+    39 -> 2000
-    40 -> 40
+    40 -> 100
-    41 -> 300
+    41 -> 40
     42 -> 300
-    43 -> 2000
+    43 -> 300
-    44 -> 1000
+    44 -> 2000
     45 -> 1000
     46 -> 1000
-    47 -> 40
+    47 -> 1000
-    48 -> 50
+    48 -> 40
-    49 -> 500
+    49 -> 50
     50 -> 500
-    51 -> 1000
+    51 -> 500
-    52 -> 20
+    52 -> 1000
-    53 -> 500
+    53 -> 20
-    54 -> 300
+    54 -> 500
-    55 -> 500
+    55 -> 300
-    56 -> 1000
+    56 -> 500
-    57 -> 2000
+    57 -> 500
-    58 -> 2000
+    58 -> 1000
     59 -> 500
     60 -> 2000
-    61 -> 100
+    61 -> 2000
-    62 -> 300
+    62 -> 500
-    63 -> 1000
+    63 -> 2000
     64 -> 100
-    65 -> 2000
+    65 -> 300
     66 -> 1000
-    67 -> 200
+    67 -> 100
-    68 -> 500
+    68 -> 2000
-    69 -> 100
+    69 -> 1000
-    70 -> 2000
+    70 -> 200
-    71 -> 2000
+    71 -> 500
-    72 -> 2000
+    72 -> 100
-    73 -> 100
+    73 -> 2000
+    74 -> 2000
+    75 -> 2000
+    76 -> 500
+    77 -> 100
     _ -> 50
 soundToOnomato :: SoundID -> String
 soundToOnomato v = case _getSoundID v of
@@ -98,62 +102,66 @@ soundToOnomato v = case _getSoundID v of
     15 -> "CRAKLE"
     16 -> "TAP"
     17 -> "DWAAH"
-    18 -> "BANGG"
+    18 -> "PRUM"
-    19 -> "CRTINK"
+    19 -> "BANGG"
-    20 -> "PHF"
+    20 -> "CRTINK"
-    21 -> "ZHM"
+    21 -> "PHF"
-    22 -> "THUD"
+    22 -> "ZHM"
-    23 -> "CRASH"
+    23 -> "THUD"
-    24 -> "TAPTIP"
+    24 -> "CRASH"
-    25 -> "CHUGUGUG"
+    25 -> "TAPTIP"
-    26 -> "HSSS"
+    26 -> "CHUGUGUG"
-    27 -> "BOOM"
+    27 -> "HSSS"
-    28 -> "HSS"
+    28 -> "BOOM"
-    29 -> "TAKH"
+    29 -> "HSS"
-    30 -> "RINGGG"
+    30 -> "TAKH"
-    31 -> "CRH"
+    31 -> "RINGGG"
-    32 -> "UGGAUGGA"
+    32 -> "CRH"
-    33 -> "CRUMPLE"
+    33 -> "UGGAUGGA"
-    34 -> "CREUH"
+    34 -> "CRUMPLE"
-    35 -> "SMACK"
+    35 -> "CREUH"
-    36 -> "CLICK"
+    36 -> "SMACK"
-    37 -> "TIPTOP"
+    37 -> "CLICK"
-    38 -> "CRUH"
+    38 -> "TIPTOP"
-    39 -> "CHNKCHNKCHUNK"
+    39 -> "CRUH"
-    40 -> "TIPTAP"
+    40 -> "CHNKCHNKCHUNK"
-    41 -> "TNKTNKTNK"
+    41 -> "TIPTAP"
-    42 -> "CHPCHPCHP"
+    42 -> "TNKTNKTNK"
-    43 -> "SCREE"
+    43 -> "CHPCHPCHP"
-    44 -> "BRAP"
+    44 -> "SCREE"
-    45 -> "CRSK"
+    45 -> "BRAP"
-    46 -> "CRNKL"
+    46 -> "CRSK"
-    47 -> "TAPP"
+    47 -> "CRNKL"
-    48 -> "SHUHP"
+    48 -> "TAPP"
-    49 -> "DEDEDUM"
+    49 -> "SHUHP"
-    50 -> "TAK"
+    50 -> "DEDEDUM"
-    51 -> "CRISH"
+    51 -> "TAK"
-    52 -> "SWSH"
+    52 -> "CRISH"
-    53 -> "BIPBIPBIP"
+    53 -> "SWSH"
-    54 -> "BEP"
+    54 -> "BIPBIPBIP"
-    55 -> "KRTNKL"
+    55 -> "BEP"
-    56 -> "CRSNK"
+    56 -> "CLIKCLIK"
-    57 -> "CHUGUGUG"
+    57 -> "KRTNKL"
-    58 -> "BANG"
+    58 -> "CRSNK"
-    59 -> "DEDA"
+    59 -> "DUDURAH"
-    60 -> "WHSSH"
+    60 -> "CHUGUGUG"
-    61 -> "HNH"
+    61 -> "BANG"
-    62 -> "BWAH"
+    62 -> "DEDA"
-    63 -> "CRUNK"
+    63 -> "WHSSH"
-    64 -> "DRR"
+    64 -> "HNH"
-    65 -> "BRAP"
+    65 -> "BWAH"
-    66 -> "BLPCHCH"
+    66 -> "CRUNK"
-    67 -> "ZMM"
+    67 -> "DRR"
-    68 -> "WRRR"
+    68 -> "BRAP"
-    69 -> "FWUMP"
+    69 -> "BLPCHCH"
-    70 -> "BRAHCHCH"
+    70 -> "ZMM"
-    71 -> "BRPBRPBRP"
+    71 -> "WRRR"
-    72 -> "WE-OH"
+    72 -> "FWUMP"
-    73 -> "FHP"
+    73 -> "BRAHCHCH"
+    74 -> "BRPBRPBRP"
+    75 -> "WE-OH"
+    76 -> "CUHRAM"
+    77 -> "FHP"
     _ -> error "unitialised sound"
 soundPathList :: [String]
 soundPathList =
@@ -175,6 +183,7 @@ soundPathList =
     , "elecCrackle.CRAKLE.200.wav"
     , "foot2.TAP.40.wav"
     , "skwareFadeTwoSec.DWAAH.300.wav"
+    , "insertOne.PRUM.500.wav"
     , "bangEcho.BANGG.2000.wav"
     , "smallGlass3.CRTINK.500.wav"
     , "whiteNoiseFadeOut.PHF.100.wav"
@@ -212,8 +221,10 @@ soundPathList =
     , "knife.SWSH.20.wav"
     , "computerBeeping.BIPBIPBIP.500.wav"
     , "tone440.BEP.300.wav"
+    , "prime.CLIKCLIK.500.wav"
     , "smallGlass2.KRTNKL.500.wav"
     , "glassShat1.CRSNK.1000.wav"
+    , "eject.DUDURAH.500.wav"
     , "seagullChatter1.CHUGUGUG.2000.wav"
     , "bang.BANG.2000.wav"
     , "deda.DEDA.500.wav"
@@ -230,6 +241,7 @@ soundPathList =
     , "shotgun.BRAHCHCH.2000.wav"
     , "mini.BRPBRPBRP.2000.wav"
     , "seagullWhistle.WE-OH.2000.wav"
+    , "insert.CUHRAM.500.wav"
     , "whiteNoiseFadeIn.FHP.100.wav"
     ]
 dedumS :: SoundID
@@ -268,115 +280,123 @@ foot2S :: SoundID
 foot2S = SoundID 16
 skwareFadeTwoSecS :: SoundID
 skwareFadeTwoSecS = SoundID 17
+insertOneS :: SoundID
+insertOneS = SoundID 18
 bangEchoS :: SoundID
-bangEchoS = SoundID 18
+bangEchoS = SoundID 19
 smallGlass3S :: SoundID
-smallGlass3S = SoundID 19
+smallGlass3S = SoundID 20
 whiteNoiseFadeOutS :: SoundID
-whiteNoiseFadeOutS = SoundID 20
+whiteNoiseFadeOutS = SoundID 21
 teleS :: SoundID
-teleS = SoundID 21
+teleS = SoundID 22
 hitS :: SoundID
-hitS = SoundID 22
+hitS = SoundID 23
 stone1S :: SoundID
-stone1S = SoundID 23
+stone1S = SoundID 24
 twoStep1S :: SoundID
-twoStep1S = SoundID 24
+twoStep1S = SoundID 25
 seagullChatterS :: SoundID
-seagullChatterS = SoundID 25
+seagullChatterS = SoundID 26
 foamSprayLoopS :: SoundID
-foamSprayLoopS = SoundID 26
+foamSprayLoopS = SoundID 27
 explosionS :: SoundID
-explosionS = SoundID 27
+explosionS = SoundID 28
 foamSprayFadeOutS :: SoundID
-foamSprayFadeOutS = SoundID 28
+foamSprayFadeOutS = SoundID 29
 tap2S :: SoundID
-tap2S = SoundID 29
+tap2S = SoundID 30
 tinitusS :: SoundID
-tinitusS = SoundID 30
+tinitusS = SoundID 31
 seagullCry1S :: SoundID
-seagullCry1S = SoundID 31
+seagullCry1S = SoundID 32
 seagullBarkS :: SoundID
-seagullBarkS = SoundID 32
+seagullBarkS = SoundID 33
 stone3S :: SoundID
-stone3S = SoundID 33
+stone3S = SoundID 34
 seagullCry2S :: SoundID
-seagullCry2S = SoundID 34
+seagullCry2S = SoundID 35
 hit1S :: SoundID
-hit1S = SoundID 35
+hit1S = SoundID 36
 click1S :: SoundID
-click1S = SoundID 36
+click1S = SoundID 37
 twoStepSlowS :: SoundID
-twoStepSlowS = SoundID 37
+twoStepSlowS = SoundID 38
 seagullCryS :: SoundID
-seagullCryS = SoundID 38
+seagullCryS = SoundID 39
 crankSlowS :: SoundID
-crankSlowS = SoundID 39
+crankSlowS = SoundID 40
 twoStepS :: SoundID
-twoStepS = SoundID 40
+twoStepS = SoundID 41
 reloadS :: SoundID
-reloadS = SoundID 41
+reloadS = SoundID 42
 reload1S :: SoundID
-reload1S = SoundID 42
+reload1S = SoundID 43
 tone440sawtoothS :: SoundID
-tone440sawtoothS = SoundID 43
+tone440sawtoothS = SoundID 44
 tap3S :: SoundID
-tap3S = SoundID 44
+tap3S = SoundID 45
 glassShat4S :: SoundID
-glassShat4S = SoundID 45
+glassShat4S = SoundID 46
 glassShat2S :: SoundID
-glassShat2S = SoundID 46
+glassShat2S = SoundID 47
 foot3S :: SoundID
-foot3S = SoundID 47
+foot3S = SoundID 48
 pickUpS :: SoundID
-pickUpS = SoundID 48
+pickUpS = SoundID 49
 dededumS :: SoundID
-dededumS = SoundID 49
+dededumS = SoundID 50
 tap1S :: SoundID
-tap1S = SoundID 50
+tap1S = SoundID 51
 metal4S :: SoundID
-metal4S = SoundID 51
+metal4S = SoundID 52
 knifeS :: SoundID
-knifeS = SoundID 52
+knifeS = SoundID 53
 computerBeepingS :: SoundID
-computerBeepingS = SoundID 53
+computerBeepingS = SoundID 54
 tone440S :: SoundID
-tone440S = SoundID 54
+tone440S = SoundID 55
+primeS :: SoundID
+primeS = SoundID 56
 smallGlass2S :: SoundID
-smallGlass2S = SoundID 55
+smallGlass2S = SoundID 57
 glassShat1S :: SoundID
-glassShat1S = SoundID 56
+glassShat1S = SoundID 58
+ejectS :: SoundID
+ejectS = SoundID 59
 seagullChatter1S :: SoundID
-seagullChatter1S = SoundID 57
+seagullChatter1S = SoundID 60
 bangS :: SoundID
-bangS = SoundID 58
+bangS = SoundID 61
 dedaS :: SoundID
-dedaS = SoundID 59
+dedaS = SoundID 62
 missileLaunchS :: SoundID
-missileLaunchS = SoundID 60
+missileLaunchS = SoundID 63
 gruntS :: SoundID
-gruntS = SoundID 61
+gruntS = SoundID 64
 sineRaisePitchOneSecS :: SoundID
-sineRaisePitchOneSecS = SoundID 62
+sineRaisePitchOneSecS = SoundID 65
 metal2S :: SoundID
-metal2S = SoundID 63
+metal2S = SoundID 66
 slideDoorS :: SoundID
-slideDoorS = SoundID 64
+slideDoorS = SoundID 67
 autoGunS :: SoundID
-autoGunS = SoundID 65
+autoGunS = SoundID 68
 oldMachineBootS :: SoundID
-oldMachineBootS = SoundID 66
+oldMachineBootS = SoundID 69
 buzzS :: SoundID
-buzzS = SoundID 67
+buzzS = SoundID 70
 fireLoudS :: SoundID
-fireLoudS = SoundID 68
+fireLoudS = SoundID 71
 tap4S :: SoundID
-tap4S = SoundID 69
+tap4S = SoundID 72
 shotgunS :: SoundID
-shotgunS = SoundID 70
+shotgunS = SoundID 73
 miniS :: SoundID
-miniS = SoundID 71
+miniS = SoundID 74
 seagullWhistleS :: SoundID
-seagullWhistleS = SoundID 72
+seagullWhistleS = SoundID 75
+insertS :: SoundID
+insertS = SoundID 76
 whiteNoiseFadeInS :: SoundID
-whiteNoiseFadeInS = SoundID 73
+whiteNoiseFadeInS = SoundID 77