diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 957e95729..1693c75dd 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -1,6 +1,7 @@ {-# LANGUAGE TupleSections #-} module Dodge.Inventory ( + ssLookupDown, ssLookupGT, ssSetCursor, firstPosSelectionSections, diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 785118916..046d70ba9 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -6,20 +6,20 @@ module Dodge.Update.Input ( doRegexInput, ) where -import Data.Monoid (First) -import Dodge.Inventory -import Data.Maybe -import Dodge.DisplayInventory -import SelectionIntMap -import qualified Data.Map.Strict as M +import qualified Data.IntMap.Strict as IM import Data.Char +import qualified Data.Map.Strict as M +import Data.Maybe +import Data.Monoid (First) import Dodge.Base.You import Dodge.Button.Event import Dodge.Combine import Dodge.Creature.Action import Dodge.Data.Universe import Dodge.Debug.Terminal +import Dodge.DisplayInventory import Dodge.Event.Test +import Dodge.Inventory import Dodge.Menu import Dodge.Reloading import Dodge.Save @@ -27,25 +27,27 @@ import Dodge.Terminal.LeftButton import Dodge.WorldPos 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 +-- checkBackspace -- | backspaceInputted u = p %~ doBackspace -- | otherwise = id doTextInputOver :: ASetter' Universe String -> Universe -> Universe -doTextInputOver p u = u & p %~ (++ map toUpper thetext) - & checkBackspace +doTextInputOver p u = + u & p %~ (++ map toUpper thetext) + & checkBackspace where thetext = u ^. uvWorld . input . textInput - checkBackspace + checkBackspace | backspaceInputted u = p %~ doBackspace | otherwise = id - + doBackspace :: String -> String doBackspace [] = [] doBackspace s = init s @@ -58,50 +60,72 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks doSubInvRegexInput :: Universe -> Universe doSubInvRegexInput u - | backspacetonothing - = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing - & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos - & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap - | endkeys || endmouse - = u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos - | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just) - & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap + | backspacetonothing = + u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing + & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos + & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap + | endkeys || endmouse = + u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos + | otherwise = + u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just) + & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap where - endkeys = any - ( (== Just InitialPress) . (`M.lookup` pkeys)) - [ScancodeReturn,ScancodeEscape,ScancodeSlash] + endkeys = + any + ((== Just InitialPress) . (`M.lookup` pkeys)) + [ScancodeReturn, ScancodeEscape, ScancodeSlash] endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) - backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just "" - && ScancodeBackspace `M.lookup` pkeys == Just InitialPress + backspacetonothing = + u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just "" + && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys -doRegexInput :: Int - -> ((Maybe String -> Identity (Maybe String)) - -> Manipulation -> Identity Manipulation) - -> ((Maybe String - -> Const (First String) (Maybe String)) - -> Manipulation -> Const (First String) Manipulation) - -> Universe - -> Universe +doRegexInput :: + Int -> + ( (Maybe String -> Identity (Maybe String)) -> + Manipulation -> + Identity Manipulation + ) -> + ( ( Maybe String -> + Const (First String) (Maybe String) + ) -> + Manipulation -> + Const (First String) Manipulation + ) -> + 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 + | 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 - | otherwise = u & doTextInputOver - (uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex . _Just) + & 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 = + u + & doTextInputOver + (uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex . _Just) where - endkeys = any - ( (== Just InitialPress) . (`M.lookup` pkeys)) - [ScancodeReturn,ScancodeEscape,ScancodeSlash] + j = fromMaybe 0 $ do + itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i+1) . ssItems + fmap fst $ IM.lookupMin itms + endkeys = + any + ((== Just InitialPress) . (`M.lookup` pkeys)) + [ScancodeReturn, ScancodeEscape, ScancodeSlash] endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) - backspacetonothing = u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex' . _Just == Just "" - && ScancodeBackspace `M.lookup` pkeys == Just InitialPress + backspacetonothing = + u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex' . _Just == Just "" + && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys doInputScreenInput :: String -> Universe -> Universe @@ -111,14 +135,15 @@ doInputScreenInput s u = where pkeys = u ^. uvWorld . input . pressedKeys checkEndStatus - | ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) - . applyTerminalString (words s) + | ScancodeReturn `M.member` pkeys = + (uvScreenLayers %~ tail) + . applyTerminalString (words s) | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail | otherwise = id updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal tmid u = - u & doTextInputOver tmpoint + u & doTextInputOver tmpoint & checkEndStatus where tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText @@ -159,14 +184,15 @@ updateLongPressInGame uv sc = case sc of _ -> uv 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 | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose - Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ - ( ( smRegex %~ enternonzeroregex ) - . ( smSelPos ?~ 0 ) - . ( setShownIntMap ) - ) + Just CombineInventory{} -> + w & hud . hudElement . subInventory . subInvMap + %~ ( (smRegex %~ enternonzeroregex) + . (smSelPos ?~ 0) + . (setShownIntMap) + ) _ -> w where invfocus = fromMaybe False $ do @@ -176,34 +202,41 @@ updateBackspaceRegex w = case di ^? subInventory of i <- di ^? diSections . sssSelPos . _Just return $ i == 2 || i == 3 trybackspace cm = case cm ^? invRegex . _Just of - Just (_:_) -> cm & invRegex . _Just %~ init - & manObject .~ InInventory SortInventory + Just (_ : _) -> + cm & invRegex . _Just %~ init + & manObject .~ InInventory SortInventory Just [] -> cm & invRegex .~ Nothing Nothing -> cm trybackspaceclose cm = case cm ^? closeRegex . _Just of - Just (_:_) -> cm & closeRegex . _Just %~ init - & manObject .~ InNearby SortNearby + Just (_ : _) -> + cm & closeRegex . _Just %~ init + & manObject .~ InNearby SortNearby Just [] -> cm & closeRegex .~ Nothing Nothing -> cm di = w ^. hud . hudElement - enternonzeroregex (Just (x:xs)) = Just (init (x:xs)) + enternonzeroregex (Just (x : xs)) = Just (init (x : xs)) enternonzeroregex smr = smr updateEnterRegex :: World -> World updateEnterRegex w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ - ( ( invRegex %~ startregex ) - . ( manObject .~ InInventory SortInventory) - ) - Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ - ( ( closeRegex %~ startregex ) - . ( manObject .~ InNearby SortNearby) - ) - Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ - ( setShownIntMap - . (smSelPos ?~ 0 ) - . ( smRegex %~ enterregex) - ) + Just NoSubInventory + | invfocus -> + w & cWorld . lWorld . creatures . ix 0 . crManipulation + %~ ( (invRegex %~ startregex) + . (manObject .~ InInventory SortInventory) + ) + Just NoSubInventory + | closefocus -> + w & cWorld . lWorld . creatures . ix 0 . crManipulation + %~ ( (closeRegex %~ startregex) + . (manObject .~ InNearby SortNearby) + ) + Just CombineInventory{} -> + w & hud . hudElement . subInventory . subInvMap + %~ ( setShownIntMap + . (smSelPos ?~ 0) + . (smRegex %~ enterregex) + ) _ -> w where di = w ^. hud . hudElement @@ -216,7 +249,7 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of startregex Nothing = Just "" startregex x = x enterregex Nothing = Just "" - enterregex (Just str) = Just str + enterregex (Just str) = Just str overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a overSection f sss = fromMaybe sss $ do @@ -229,12 +262,12 @@ pauseGame u = u & uvScreenLayers .~ [pauseMenu u] spaceAction :: World -> World spaceAction w = case w ^?! hud . hudElement of DisplayCarte -> w & hud . carteCenter .~ theLoc - DisplayInventory {_subInventory = NoSubInventory} -> case selectedCloseObject w of + DisplayInventory{_subInventory = NoSubInventory} -> case selectedCloseObject w of Just (_, Left flit) -> pickUpItem 0 flit w Just (_, Right but) -> doButtonEvent (_btEvent but) but w _ -> w - DisplayInventory {_subInventory = DisplayTerminal{}} - -> w & hud . hudElement . subInventory .~ NoSubInventory + DisplayInventory{_subInventory = DisplayTerminal{}} -> + w & hud . hudElement . subInventory .~ NoSubInventory _ -> w & hud . hudElement . subInventory .~ NoSubInventory where --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w @@ -242,8 +275,9 @@ spaceAction w = case w ^?! hud . hudElement of 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