Fix bug on dropping item when reloading

This commit is contained in:
2022-06-22 19:22:17 +01:00
parent 4d1b5d3ca8
commit c34468aa49
6 changed files with 48 additions and 49 deletions
+1 -1
View File
@@ -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
+2 -2
View File
@@ -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
+25 -18
View File
@@ -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 d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
--crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool
--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
+4
View File
@@ -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
+15 -27
View File
@@ -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]
selectedItemDisplay cr it = Prelude.take (itSlotsTaken it) $
(midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
: catMaybes [maybeWarmupStatus it]
itemDisplayWithNumber :: String -> Item -> [String]
itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $
(midPadL 15 ' ' thename (' ' : numberstr) ++ theparam)
: 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) $
(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
]
itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it
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
x@ItemItselfConsumable{} -> show (_icAmount x)
ChargeableAmmo{} -> show $ _wpCharge ic
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
+1 -1
View File
@@ -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)