Fix item drop bug
This commit is contained in:
@@ -3,9 +3,9 @@
|
|||||||
-- | Actions performed by creatures within the world
|
-- | Actions performed by creatures within the world
|
||||||
module Dodge.Creature.Action (
|
module Dodge.Creature.Action (
|
||||||
performActions,
|
performActions,
|
||||||
-- stripNoItems,
|
-- stripNoItems,
|
||||||
setMinInvSize,
|
setMinInvSize,
|
||||||
-- dropUnselected,
|
-- dropUnselected,
|
||||||
dropExcept,
|
dropExcept,
|
||||||
dropItem,
|
dropItem,
|
||||||
blinkActionMousePos,
|
blinkActionMousePos,
|
||||||
@@ -18,12 +18,16 @@ module Dodge.Creature.Action (
|
|||||||
pickUpItemID,
|
pickUpItemID,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Bifunctor
|
import Control.Applicative
|
||||||
--import Data.List (findIndex)
|
--import Data.List (findIndex)
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
import Data.Bifunctor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
import Dodge.Creature.Action.Blink
|
import Dodge.Creature.Action.Blink
|
||||||
import Dodge.CreatureEffect
|
import Dodge.CreatureEffect
|
||||||
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Default
|
import Dodge.Default
|
||||||
import Dodge.FloatFunction
|
import Dodge.FloatFunction
|
||||||
@@ -36,7 +40,6 @@ import Dodge.WallCreatureCollisions
|
|||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import Control.Monad
|
|
||||||
|
|
||||||
performActions :: World -> Creature -> Creature
|
performActions :: World -> Creature -> Creature
|
||||||
performActions w cr =
|
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.
|
-- | Get your creature to drop the item under the cursor.
|
||||||
youDropItem :: World -> World
|
youDropItem :: World -> World
|
||||||
youDropItem w = fromMaybe w $ do
|
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
|
guard $ not $ _crInvLock (you w) || cursed
|
||||||
return $ w
|
return $
|
||||||
|
w
|
||||||
& dropItem cr curpos
|
& dropItem cr curpos
|
||||||
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
|
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
|
||||||
where
|
where
|
||||||
cr = you w
|
cr = you w
|
||||||
cursed = fromMaybe True $ do
|
cursed = fromMaybe False $ do
|
||||||
it <- yourItem w
|
it <- yourItem w
|
||||||
return $ it ^. itCurseStatus /= Uncursed
|
return $ it ^. itCurseStatus /= Uncursed
|
||||||
|
|
||||||
|
|||||||
@@ -137,8 +137,9 @@ updateInventorySectionItems w = w
|
|||||||
f olditems = fromMaybe olditems $ do
|
f olditems = fromMaybe olditems $ do
|
||||||
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||||
invitms <- cr ^? crInv
|
invitms <- cr ^? crInv
|
||||||
str <- w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just
|
return $ case w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just of
|
||||||
return $ IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms
|
Just str -> IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms
|
||||||
|
_ -> IM.mapWithKey (invSelectionItem' cr) invitms
|
||||||
|
|
||||||
plainRegex :: String -> SelectionItem a -> Bool
|
plainRegex :: String -> SelectionItem a -> Bool
|
||||||
plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si))
|
plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si))
|
||||||
|
|||||||
Reference in New Issue
Block a user