Fix bug on dropping item when reloading

src/Dodge/Creature.hs

@@ -107,7 +107,7 @@ multGunCrit = defaultCreature
     , _crRad = 10
     , _crHP = 300
     , _crUpdate = defaultImpulsive [sentinelExtraWatchUpdate
-            [ ( const $ not . crHasAmmo
+            [ ( const $ not . crWeaponReady
               , \_ _ -> StrategyActions Reload reloadActions
               )
             , (const $ not . crSafeDistFromTarg 150 

src/Dodge/Creature/State.hs

@@ -28,10 +28,10 @@ import qualified IntMapHelp as IM
 --import FoldableHelp
 
 
---import qualified Data.IntSet as IS
---import Data.Maybe
 import Data.Function
 import Control.Lens
+--import qualified Data.IntSet as IS
+--import Data.Maybe
 --import Control.Applicative
 --import qualified SDL
 --import qualified SDL.Mixer as Mix

src/Dodge/Creature/Test.hs

@@ -6,6 +6,23 @@ the creature NEED NOT be the same as the creature with that id in the world,
 in fact a creature with that id need not exist.
 -}
 module Dodge.Creature.Test
+    ( crIsAiming
+    , crIsReloading
+    , crIsArmouredFrom
+    , oneH
+    , twists
+    , twoFlat
+    , crWeaponReady
+    , crInAimStance
+    , crNearPoint
+    , isAnimate
+    , crCanShoot
+    , crHasTargetLOS
+    , crAwayFromPost
+    , crHasTarget
+    , crStratConMatches
+    , crSafeDistFromTarg
+    )
     where
 import Dodge.Data
 import Dodge.Base.Collide
@@ -14,29 +31,22 @@ import SameConstr
 
 import Data.List (find)
 import Data.Maybe
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
-andTest :: (a -> Bool) -> (a -> Bool) -> a -> Bool
-andTest f g a = f a && g a
-
-onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
-onBoth f g h x = f (g x) (h x)
-
 crIsReloading :: Creature -> Bool
 crIsReloading cr = case cr ^? crInvSel . iselAction of
     Just ReloadAction {} -> True
     _ -> False
 
 crWeaponReady :: Creature -> Bool
-crWeaponReady cr = isNothing $ cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just
+crWeaponReady cr = fromMaybe False $ do
+    ic <- cr ^? crInv . ix (crSel cr) . itConsumption
+    return (_laLoaded ic > 0 && _laPrimed ic)
 
 crCanSeeCr :: Creature -> (World, Creature) -> Bool
 crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
 
-crCanSeeCID :: Int -> (World, Creature) -> Bool
-crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
-
 crIsAiming :: Creature -> Bool
 crIsAiming cr = _posture (_crStance cr) == Aiming
 
@@ -64,14 +74,11 @@ crAwayFromPost cr = case find sentinelGoal . _crGoal $ _crActionPlan cr of
     sentinelGoal (SentinelAt _ _) = True
     sentinelGoal _ = False
 
-crHasAmmo :: Creature -> Bool
-crHasAmmo cr = maybe False (> 0) $ cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded
-
 crCanShoot :: Creature -> Bool
-crCanShoot p = crIsAiming p && crHasAmmo p
+crCanShoot cr = crIsAiming cr && crWeaponReady cr
 
 crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as cr = crIsAiming cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr)
+crInAimStance as cr = crIsAiming cr
     && cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance == Just as
 
 oneH :: Creature -> Bool
@@ -106,8 +113,8 @@ hasFrontArmour p cr = fromMaybe False $ do
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool
 --crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr)
 
-crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool
+--crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool
-crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
+--crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
 
 crNearPoint :: Float -> Point2 -> Creature -> Bool
 crNearPoint d p cr = dist (_crPos cr) p < d + _crRad cr

src/Dodge/Inventory.hs

@@ -55,6 +55,7 @@ rmInvItem :: Int      -- ^ Creature id
 rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
     Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
     _ -> w & creatures . ix cid . crInv %~ f
+        & creatures . ix cid . crInvSel %~ stopCrInvSelAction
         & creatures . ix cid . crInvSel . iselPos %~ g
         & creatures . ix cid . crLeftInvSel %~ g'
         & removeAnySlotEquipment
@@ -64,6 +65,9 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
         & creatures . ix cid . crInvEquipped %~ IM.mapKeys g
                 -- TODO check whether this can be mapKeysMonotonic
   where
+    stopCrInvSelAction (InvSel i a)
+        | i == invid = InvSel i NoInvSelAction
+        | otherwise  = InvSel i a
     cr = _creatures w IM.! cid
     itm = _crInv cr IM.! invid
     dounequipfunction = fromMaybe id $ do

src/Dodge/Item/Display.hs

@@ -1,4 +1,8 @@
 module Dodge.Item.Display 
+    ( itemDisplay
+    , selectedItemDisplay
+    , itemString
+    )
     where
 import Dodge.Module
 import Dodge.Data
@@ -12,40 +16,27 @@ import Data.Sequence
 itemString :: Item -> String
 itemString = head . itemDisplay
 
-selectedItemDisplay :: Creature -> Item -> [String]
+itemDisplayWithNumber :: String -> Item -> [String]
-selectedItemDisplay cr it =  Prelude.take (itSlotsTaken it) $
+itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $
-    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
+    (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam)
-    : catMaybes [maybeWarmupStatus it]
+    : catMaybes [maybeWarmupStatus it,maybeRateStatus it]
     ++ moduleStrings it ++ repeat "*"
   where 
     thename  = show . _iyBase $ _itType it
-    thenumber = showSelectedConsumption cr (_itConsumption it) 
     theparam = fromMaybe []
         . listToMaybe 
         $ mapMaybe ($ it) 
         [ maybeModeStatus
---        , maybeWarmupStatus
---        , maybeRateStatus
         ]
 
+selectedItemDisplay :: Creature -> Item -> [String]
+selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itConsumption it)) it
 
 {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
 -- TODO make work on remote launchers
 itemDisplay :: Item -> [String]
-itemDisplay it = Prelude.take (itSlotsTaken it) $
+itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it
-    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
+
-    : catMaybes [maybeWarmupStatus it]
-    ++ moduleStrings it ++ repeat "*"
-  where 
-    thename  = show . _iyBase $ _itType it
-    thenumber = showConsumption (_itConsumption it) 
-    theparam = fromMaybe []
-        . listToMaybe 
-        $ mapMaybe ($ it) 
-        [ maybeModeStatus
---        , maybeWarmupStatus
---        , maybeRateStatus
-        ]
 showSelectedConsumption :: Creature -> ItemConsumption -> String
 showSelectedConsumption cr ic = case ic of
     LoadableAmmo{} -> showReloadProgress cr ic
@@ -68,9 +59,10 @@ showLoadProgress x mlas = case mlas ^? _Just . ix 0 of
 showConsumption :: ItemConsumption -> String
 showConsumption ic = case ic of
     LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic)
-    am@ChargeableAmmo{} -> show $ _wpCharge am
+    ChargeableAmmo{} -> show $ _wpCharge ic
-    x@ItemItselfConsumable{} -> show (_icAmount x)
+    ItemItselfConsumable{} -> show (_icAmount ic)
     NoConsumption -> ""
+
 showLoadActionType :: LoadAction -> Int -> String
 showLoadActionType la x = case la of
     LoadEject   {}  -> "E"
@@ -78,10 +70,6 @@ showLoadActionType la x = case la of
     LoadAdd     {}  -> "A" ++ show x
     LoadPrime   {}  -> "P"
 
---    & itInvDisplay .~ \it -> head (basicItemDisplay it) : 
---        ["*FIRERATE:" ++ fromMaybe "" (maybeRateStatus it)
---        ]
-
 maybeWarmupStatus :: Item -> Maybe String
 maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
     Nothing -> Nothing

src/Dodge/Update.hs

@@ -53,7 +53,7 @@ updateUniverse u = case _menuLayers u of
 functionalUpdate :: Configuration -> World -> World
 functionalUpdate cfig w = checkEndGame 
 --    . updateRandGen
-    . (mouseButtons . each .~ True)
+    . (mouseButtons . each .~ True)  -- to determine if the mouse button is held
     . (worldClock +~ 1)
     . doRewind
     . (doubleMouseHammer %~ moveHammerUp)