justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Pressing return on regex jumps to item

Browse Source
This commit is contained in:
justin
2023-02-17 12:06:18 +00:00
parent 38fdf51517
commit 7e04deed43
2 changed files with 114 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory.hs
+1
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
ssLookupDown,
ssLookupGT,
ssSetCursor,
firstPosSelectionSections,
src/Dodge/Update/Input.hs
+113 -79
View File
@@ -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