diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 09c453f12..d85019f8d 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -23,7 +23,7 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of 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) } Just (InInventory (SelItem i _)) -> sss @@ -136,16 +136,6 @@ updateSection mspos sis' availablelines ss = ss } where 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 scurs = do csel <- mspos diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 1693c75dd..259856581 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -64,19 +64,27 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount & pointcid . crInv %~ f & pointcid %~ crCancelReloading -- & 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' & removeAnySlotEquipment & dounequipfunction & doanyitemeffect & pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.mapKeys g + & updatemanipulation where -- TODO check whether this can be mapKeysMonotonic getcid = 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 itm = _crInv cr IM.! invid dounequipfunction = fromMaybe id $ do @@ -92,6 +100,7 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount f inv = let (xs, ys) = IM.split invid inv 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 | x > invid || Just x == maxk = max 0 $ x - 1 | otherwise = x @@ -429,7 +438,7 @@ ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionIte ssLookupDown i j sss = case ssLookupGT i j sss of Nothing -> ssLookupMin sss x -> x - + ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do ss <- sss ^? sssSections . ix i diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 046d70ba9..a6237a3aa 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -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