Fix dropping items creating indexes outside of filter
This commit is contained in:
+32
-55
@@ -6,8 +6,8 @@ module Dodge.Update.Input (
|
||||
doRegexInput,
|
||||
) where
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Data.Char
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Data.Monoid (First)
|
||||
@@ -29,15 +29,6 @@ import LensHelp
|
||||
import SDL
|
||||
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 p u =
|
||||
u & p %~ (++ map toUpper thetext)
|
||||
@@ -95,33 +86,29 @@ doRegexInput ::
|
||||
Universe ->
|
||||
Universe
|
||||
doRegexInput i crregex crregex' u
|
||||
| backspacetonothing =
|
||||
u
|
||||
& 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
|
||||
| backspacetonothing || escapekey = closeregex i 0
|
||||
| endkeys || endmouse = closeregex (i + 1) (j -1)
|
||||
| otherwise =
|
||||
u
|
||||
& doTextInputOver
|
||||
(uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex . _Just)
|
||||
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
|
||||
itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i+1) . ssItems
|
||||
fmap fst $ IM.lookupMin itms
|
||||
itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i + 1) . ssItems
|
||||
fst <$> IM.lookupMin itms
|
||||
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
|
||||
endkeys =
|
||||
any
|
||||
((== Just InitialPress) . (`M.lookup` pkeys))
|
||||
[ScancodeReturn, ScancodeEscape, ScancodeSlash]
|
||||
[ScancodeReturn, ScancodeSlash]
|
||||
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
|
||||
backspacetonothing =
|
||||
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 w = case di ^? subInventory of
|
||||
Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
|
||||
Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
|
||||
Just NoSubInventory | secfocus (-1) 0 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
|
||||
Just NoSubInventory | secfocus 2 3 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
|
||||
Just CombineInventory{} ->
|
||||
w & hud . hudElement . subInventory . subInvMap
|
||||
%~ ( (smRegex %~ enternonzeroregex)
|
||||
. (smSelPos ?~ 0)
|
||||
. (setShownIntMap)
|
||||
. setShownIntMap
|
||||
)
|
||||
_ -> w
|
||||
where
|
||||
invfocus = fromMaybe False $ do
|
||||
secfocus a b = fromMaybe False $ do
|
||||
i <- di ^? diSections . sssSelPos . _Just
|
||||
return $ i == (-1) || i == 0
|
||||
closefocus = fromMaybe False $ do
|
||||
i <- di ^? diSections . sssSelPos . _Just
|
||||
return $ i == 2 || i == 3
|
||||
return $ i == a || i == b
|
||||
trybackspace cm = case cm ^? invRegex . _Just of
|
||||
Just (_ : _) ->
|
||||
cm & invRegex . _Just %~ init
|
||||
@@ -220,15 +204,15 @@ updateBackspaceRegex w = case di ^? subInventory of
|
||||
updateEnterRegex :: World -> World
|
||||
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
||||
Just NoSubInventory
|
||||
| invfocus ->
|
||||
| secfocus (-1) 0 ->
|
||||
w & cWorld . lWorld . creatures . ix 0 . crManipulation
|
||||
%~ ( (invRegex %~ startregex)
|
||||
%~ ( (invRegex %~ enterregex)
|
||||
. (manObject .~ InInventory SortInventory)
|
||||
)
|
||||
Just NoSubInventory
|
||||
| closefocus ->
|
||||
| secfocus 2 3 ->
|
||||
w & cWorld . lWorld . creatures . ix 0 . crManipulation
|
||||
%~ ( (closeRegex %~ startregex)
|
||||
%~ ( (closeRegex %~ enterregex)
|
||||
. (manObject .~ InNearby SortNearby)
|
||||
)
|
||||
Just CombineInventory{} ->
|
||||
@@ -240,16 +224,11 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
||||
_ -> w
|
||||
where
|
||||
di = w ^. hud . hudElement
|
||||
invfocus = fromMaybe False $ do
|
||||
secfocus a b = fromMaybe False $ do
|
||||
i <- di ^? diSections . sssSelPos . _Just
|
||||
return $ i == (-1) || i == 0
|
||||
closefocus = fromMaybe False $ do
|
||||
i <- di ^? diSections . sssSelPos . _Just
|
||||
return $ i == 2 || i == 3
|
||||
startregex Nothing = Just ""
|
||||
startregex x = x
|
||||
return $ i == a || i == b
|
||||
enterregex Nothing = Just ""
|
||||
enterregex (Just str) = Just str
|
||||
enterregex x = x
|
||||
|
||||
overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
|
||||
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
|
||||
where
|
||||
--theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
|
||||
theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
|
||||
theLoc = doWorldPos
|
||||
(w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1)
|
||||
w
|
||||
|
||||
toggleMap :: Universe -> Universe
|
||||
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
|
||||
|
||||
-- where
|
||||
-- w = u ^. uvWorld
|
||||
-- cfig = u ^. uvConfig
|
||||
|
||||
toggleTweakInv :: World -> World
|
||||
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
|
||||
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
|
||||
|
||||
Reference in New Issue
Block a user