Fix item drop bug

This commit is contained in:
2023-02-23 12:19:33 +00:00
parent d513914886
commit 6fff71cdcc
2 changed files with 16 additions and 9 deletions
+13 -7
View File
@@ -3,9 +3,9 @@
-- | Actions performed by creatures within the world
module Dodge.Creature.Action (
performActions,
-- stripNoItems,
-- stripNoItems,
setMinInvSize,
-- dropUnselected,
-- dropUnselected,
dropExcept,
dropItem,
blinkActionMousePos,
@@ -18,12 +18,16 @@ module Dodge.Creature.Action (
pickUpItemID,
) where
import Data.Bifunctor
import Control.Applicative
--import Data.List (findIndex)
import Control.Monad
import Data.Bifunctor
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Action.Blink
import Dodge.CreatureEffect
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Default
import Dodge.FloatFunction
@@ -36,7 +40,6 @@ import Dodge.WallCreatureCollisions
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Control.Monad
performActions :: World -> Creature -> Creature
performActions w cr =
@@ -188,14 +191,17 @@ dropItem cr invid = rmInvItem (_crID cr) invid . copyInvItemToFloor cr invid --
-- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
curpos <-
you w ^? crManipulation . manObject . inInventory . ispItem
<|> fmap fst (IM.lookupMax =<< w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems)
guard $ not $ _crInvLock (you w) || cursed
return $ w
return $
w
& dropItem cr curpos
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
where
cr = you w
cursed = fromMaybe True $ do
cursed = fromMaybe False $ do
it <- yourItem w
return $ it ^. itCurseStatus /= Uncursed
+3 -2
View File
@@ -137,8 +137,9 @@ updateInventorySectionItems w = w
f olditems = fromMaybe olditems $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
invitms <- cr ^? crInv
str <- w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just
return $ IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms
return $ case w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just of
Just str -> IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms
_ -> IM.mapWithKey (invSelectionItem' cr) invitms
plainRegex :: String -> SelectionItem a -> Bool
plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si))