Fix dropping items creating indexes outside of filter
This commit is contained in:
@@ -23,7 +23,7 @@ import Dodge.Data.World
|
|||||||
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
|
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
|
||||||
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
|
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
|
||||||
Just (InInventory SortInventory) -> sss
|
Just (InInventory SortInventory) -> sss
|
||||||
{ _sssSections = updateSections availablelines ((-1),0) [filtinv,filtclose,invx ,youx, closex]
|
{ _sssSections = updateSections availablelines (-1,0) [filtinv,filtclose,invx ,youx, closex]
|
||||||
, _sssSelPos = Just (-1)
|
, _sssSelPos = Just (-1)
|
||||||
}
|
}
|
||||||
Just (InInventory (SelItem i _)) -> sss
|
Just (InInventory (SelItem i _)) -> sss
|
||||||
@@ -136,16 +136,6 @@ updateSection mspos sis' availablelines ss = ss
|
|||||||
}
|
}
|
||||||
where
|
where
|
||||||
sis = sis'
|
sis = sis'
|
||||||
-- case _ssRegex ss of
|
|
||||||
-- Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
|
|
||||||
-- _ -> sis'
|
|
||||||
-- f str = SelectionRegex
|
|
||||||
-- { _siPictures = ["FILTER: " ++ str]
|
|
||||||
-- , _siHeight = 1
|
|
||||||
-- , _siIsSelectable = True
|
|
||||||
-- , _siColor = white
|
|
||||||
-- , _siOffX = 0
|
|
||||||
-- }
|
|
||||||
oldoffset = ss ^. ssOffset
|
oldoffset = ss ^. ssOffset
|
||||||
scurs = do
|
scurs = do
|
||||||
csel <- mspos
|
csel <- mspos
|
||||||
|
|||||||
+10
-1
@@ -64,19 +64,27 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
|
|||||||
& pointcid . crInv %~ f
|
& pointcid . crInv %~ f
|
||||||
& pointcid %~ crCancelReloading
|
& pointcid %~ crCancelReloading
|
||||||
-- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING
|
-- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING
|
||||||
& pointcid . crManipulation . manObject . inInventory . ispItem %~ g
|
-- & pointcid . crManipulation . manObject . inInventory . ispItem %~ g
|
||||||
|
-- & pointcid . crManipulation . manObject %~ h
|
||||||
& pointcid . crLeftInvSel . lisMPos %~ g'
|
& pointcid . crLeftInvSel . lisMPos %~ g'
|
||||||
& removeAnySlotEquipment
|
& removeAnySlotEquipment
|
||||||
& dounequipfunction
|
& dounequipfunction
|
||||||
& doanyitemeffect
|
& doanyitemeffect
|
||||||
& pointcid . crInvEquipped %~ IM.delete invid
|
& pointcid . crInvEquipped %~ IM.delete invid
|
||||||
& pointcid . crInvEquipped %~ IM.mapKeys g
|
& pointcid . crInvEquipped %~ IM.mapKeys g
|
||||||
|
& updatemanipulation
|
||||||
where
|
where
|
||||||
-- TODO check whether this can be mapKeysMonotonic
|
-- TODO check whether this can be mapKeysMonotonic
|
||||||
|
|
||||||
getcid = cWorld . lWorld . creatures . ix cid
|
getcid = cWorld . lWorld . creatures . ix cid
|
||||||
pointcid = cWorld . lWorld . creatures . ix cid
|
pointcid = cWorld . lWorld . creatures . ix cid
|
||||||
|
|
||||||
|
updatemanipulation
|
||||||
|
| cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid
|
||||||
|
= (pointcid . crManipulation . manObject . inInventory . ispItem %~ g) . changeAugInvSel (-1)
|
||||||
|
| otherwise
|
||||||
|
= pointcid . crManipulation . manObject . inInventory . ispItem %~ g
|
||||||
|
|
||||||
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
||||||
itm = _crInv cr IM.! invid
|
itm = _crInv cr IM.! invid
|
||||||
dounequipfunction = fromMaybe id $ do
|
dounequipfunction = fromMaybe id $ do
|
||||||
@@ -92,6 +100,7 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
|
|||||||
f inv =
|
f inv =
|
||||||
let (xs, ys) = IM.split invid inv
|
let (xs, ys) = IM.split invid inv
|
||||||
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
||||||
|
-- the following might not work if a non-player creature drops their last item
|
||||||
g x
|
g x
|
||||||
| x > invid || Just x == maxk = max 0 $ x - 1
|
| x > invid || Just x == maxk = max 0 $ x - 1
|
||||||
| otherwise = x
|
| otherwise = x
|
||||||
|
|||||||
+32
-55
@@ -6,8 +6,8 @@ module Dodge.Update.Input (
|
|||||||
doRegexInput,
|
doRegexInput,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.IntMap.Strict as IM
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Monoid (First)
|
import Data.Monoid (First)
|
||||||
@@ -29,15 +29,6 @@ import LensHelp
|
|||||||
import SDL
|
import SDL
|
||||||
import SelectionIntMap
|
import SelectionIntMap
|
||||||
|
|
||||||
--doTextInputOver' :: Universe -> ASetter' a String -> a -> a
|
|
||||||
--doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
|
|
||||||
-- & checkBackspace
|
|
||||||
-- where
|
|
||||||
-- thetext = u ^. uvWorld . input . textInput
|
|
||||||
-- checkBackspace
|
|
||||||
-- | backspaceInputted u = p %~ doBackspace
|
|
||||||
-- | otherwise = id
|
|
||||||
|
|
||||||
doTextInputOver :: ASetter' Universe String -> Universe -> Universe
|
doTextInputOver :: ASetter' Universe String -> Universe -> Universe
|
||||||
doTextInputOver p u =
|
doTextInputOver p u =
|
||||||
u & p %~ (++ map toUpper thetext)
|
u & p %~ (++ map toUpper thetext)
|
||||||
@@ -95,33 +86,29 @@ doRegexInput ::
|
|||||||
Universe ->
|
Universe ->
|
||||||
Universe
|
Universe
|
||||||
doRegexInput i crregex crregex' u
|
doRegexInput i crregex crregex' u
|
||||||
| backspacetonothing =
|
| backspacetonothing || escapekey = closeregex i 0
|
||||||
u
|
| endkeys || endmouse = closeregex (i + 1) (j -1)
|
||||||
& uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex .~ Nothing
|
|
||||||
& uvWorld . hud . hudElement . diSections
|
|
||||||
%~ ( ssSetCursor (ssLookupGT i 0)
|
|
||||||
. (overSection (ssItems . at i .~ Nothing))
|
|
||||||
)
|
|
||||||
& uvWorld %~ setInvPosFromSS
|
|
||||||
| endkeys || endmouse = u
|
|
||||||
& uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex .~ Nothing
|
|
||||||
& uvWorld . hud . hudElement . diSections
|
|
||||||
%~ ( ssSetCursor (ssLookupDown (i+1) (j-1))
|
|
||||||
. (overSection (ssItems . at i .~ Nothing))
|
|
||||||
)
|
|
||||||
& uvWorld %~ setInvPosFromSS
|
|
||||||
| otherwise =
|
| otherwise =
|
||||||
u
|
u
|
||||||
& doTextInputOver
|
& doTextInputOver
|
||||||
(uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex . _Just)
|
(uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex . _Just)
|
||||||
where
|
where
|
||||||
|
closeregex a b =
|
||||||
|
u
|
||||||
|
& uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex .~ Nothing
|
||||||
|
& uvWorld . hud . hudElement . diSections
|
||||||
|
%~ ( ssSetCursor (ssLookupDown a b)
|
||||||
|
. overSection (ssItems . at i .~ Nothing)
|
||||||
|
)
|
||||||
|
& uvWorld %~ setInvPosFromSS
|
||||||
j = fromMaybe 0 $ do
|
j = fromMaybe 0 $ do
|
||||||
itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i+1) . ssItems
|
itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i + 1) . ssItems
|
||||||
fmap fst $ IM.lookupMin itms
|
fst <$> IM.lookupMin itms
|
||||||
|
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
|
||||||
endkeys =
|
endkeys =
|
||||||
any
|
any
|
||||||
((== Just InitialPress) . (`M.lookup` pkeys))
|
((== Just InitialPress) . (`M.lookup` pkeys))
|
||||||
[ScancodeReturn, ScancodeEscape, ScancodeSlash]
|
[ScancodeReturn, ScancodeSlash]
|
||||||
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
|
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
|
||||||
backspacetonothing =
|
backspacetonothing =
|
||||||
u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex' . _Just == Just ""
|
u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex' . _Just == Just ""
|
||||||
@@ -185,22 +172,19 @@ updateLongPressInGame uv sc = case sc of
|
|||||||
|
|
||||||
updateBackspaceRegex :: World -> World
|
updateBackspaceRegex :: World -> World
|
||||||
updateBackspaceRegex w = case di ^? subInventory of
|
updateBackspaceRegex w = case di ^? subInventory of
|
||||||
Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
|
Just NoSubInventory | secfocus (-1) 0 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
|
||||||
Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
|
Just NoSubInventory | secfocus 2 3 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
|
||||||
Just CombineInventory{} ->
|
Just CombineInventory{} ->
|
||||||
w & hud . hudElement . subInventory . subInvMap
|
w & hud . hudElement . subInventory . subInvMap
|
||||||
%~ ( (smRegex %~ enternonzeroregex)
|
%~ ( (smRegex %~ enternonzeroregex)
|
||||||
. (smSelPos ?~ 0)
|
. (smSelPos ?~ 0)
|
||||||
. (setShownIntMap)
|
. setShownIntMap
|
||||||
)
|
)
|
||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
invfocus = fromMaybe False $ do
|
secfocus a b = fromMaybe False $ do
|
||||||
i <- di ^? diSections . sssSelPos . _Just
|
i <- di ^? diSections . sssSelPos . _Just
|
||||||
return $ i == (-1) || i == 0
|
return $ i == a || i == b
|
||||||
closefocus = fromMaybe False $ do
|
|
||||||
i <- di ^? diSections . sssSelPos . _Just
|
|
||||||
return $ i == 2 || i == 3
|
|
||||||
trybackspace cm = case cm ^? invRegex . _Just of
|
trybackspace cm = case cm ^? invRegex . _Just of
|
||||||
Just (_ : _) ->
|
Just (_ : _) ->
|
||||||
cm & invRegex . _Just %~ init
|
cm & invRegex . _Just %~ init
|
||||||
@@ -220,15 +204,15 @@ updateBackspaceRegex w = case di ^? subInventory of
|
|||||||
updateEnterRegex :: World -> World
|
updateEnterRegex :: World -> World
|
||||||
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
||||||
Just NoSubInventory
|
Just NoSubInventory
|
||||||
| invfocus ->
|
| secfocus (-1) 0 ->
|
||||||
w & cWorld . lWorld . creatures . ix 0 . crManipulation
|
w & cWorld . lWorld . creatures . ix 0 . crManipulation
|
||||||
%~ ( (invRegex %~ startregex)
|
%~ ( (invRegex %~ enterregex)
|
||||||
. (manObject .~ InInventory SortInventory)
|
. (manObject .~ InInventory SortInventory)
|
||||||
)
|
)
|
||||||
Just NoSubInventory
|
Just NoSubInventory
|
||||||
| closefocus ->
|
| secfocus 2 3 ->
|
||||||
w & cWorld . lWorld . creatures . ix 0 . crManipulation
|
w & cWorld . lWorld . creatures . ix 0 . crManipulation
|
||||||
%~ ( (closeRegex %~ startregex)
|
%~ ( (closeRegex %~ enterregex)
|
||||||
. (manObject .~ InNearby SortNearby)
|
. (manObject .~ InNearby SortNearby)
|
||||||
)
|
)
|
||||||
Just CombineInventory{} ->
|
Just CombineInventory{} ->
|
||||||
@@ -240,16 +224,11 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
|||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
di = w ^. hud . hudElement
|
di = w ^. hud . hudElement
|
||||||
invfocus = fromMaybe False $ do
|
secfocus a b = fromMaybe False $ do
|
||||||
i <- di ^? diSections . sssSelPos . _Just
|
i <- di ^? diSections . sssSelPos . _Just
|
||||||
return $ i == (-1) || i == 0
|
return $ i == a || i == b
|
||||||
closefocus = fromMaybe False $ do
|
|
||||||
i <- di ^? diSections . sssSelPos . _Just
|
|
||||||
return $ i == 2 || i == 3
|
|
||||||
startregex Nothing = Just ""
|
|
||||||
startregex x = x
|
|
||||||
enterregex Nothing = Just ""
|
enterregex Nothing = Just ""
|
||||||
enterregex (Just str) = Just str
|
enterregex x = x
|
||||||
|
|
||||||
overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
|
overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
|
||||||
overSection f sss = fromMaybe sss $ do
|
overSection f sss = fromMaybe sss $ do
|
||||||
@@ -270,18 +249,16 @@ spaceAction w = case w ^?! hud . hudElement of
|
|||||||
w & hud . hudElement . subInventory .~ NoSubInventory
|
w & hud . hudElement . subInventory .~ NoSubInventory
|
||||||
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
|
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||||
where
|
where
|
||||||
--theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
|
theLoc = doWorldPos
|
||||||
theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
|
(w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1)
|
||||||
|
w
|
||||||
|
|
||||||
toggleMap :: Universe -> Universe
|
toggleMap :: Universe -> Universe
|
||||||
toggleMap u = case u ^?! uvWorld . hud . hudElement of
|
toggleMap u = case u ^?! uvWorld . hud . hudElement of
|
||||||
DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultDisplaySections}
|
DisplayCarte -> u & uvWorld . hud . hudElement
|
||||||
|
.~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultDisplaySections}
|
||||||
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
|
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
|
||||||
|
|
||||||
-- where
|
|
||||||
-- w = u ^. uvWorld
|
|
||||||
-- cfig = u ^. uvConfig
|
|
||||||
|
|
||||||
toggleTweakInv :: World -> World
|
toggleTweakInv :: World -> World
|
||||||
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
|
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
|
||||||
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
|
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
|
||||||
|
|||||||
Reference in New Issue
Block a user