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 #-} {-# LANGUAGE TupleSections #-}
module Dodge.Inventory ( module Dodge.Inventory (
ssLookupDown,
ssLookupGT, ssLookupGT,
ssSetCursor, ssSetCursor,
firstPosSelectionSections, firstPosSelectionSections,
src/Dodge/Update/Input.hs
+89 -55
View File
@@ -6,20 +6,20 @@ module Dodge.Update.Input (
doRegexInput, doRegexInput,
) where ) where
import Data.Monoid (First) import qualified Data.IntMap.Strict as IM
import Dodge.Inventory
import Data.Maybe
import Dodge.DisplayInventory
import SelectionIntMap
import qualified Data.Map.Strict as M
import Data.Char import Data.Char
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid (First)
import Dodge.Base.You import Dodge.Base.You
import Dodge.Button.Event import Dodge.Button.Event
import Dodge.Combine import Dodge.Combine
import Dodge.Creature.Action import Dodge.Creature.Action
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Debug.Terminal import Dodge.Debug.Terminal
import Dodge.DisplayInventory
import Dodge.Event.Test import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Menu import Dodge.Menu
import Dodge.Reloading import Dodge.Reloading
import Dodge.Save import Dodge.Save
@@ -27,6 +27,7 @@ import Dodge.Terminal.LeftButton
import Dodge.WorldPos import Dodge.WorldPos
import LensHelp import LensHelp
import SDL import SDL
import SelectionIntMap
--doTextInputOver' :: Universe -> ASetter' a String -> a -> a --doTextInputOver' :: Universe -> ASetter' a String -> a -> a
--doTextInputOver' u p x = x & p %~ (++ map toUpper thetext) --doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
@@ -38,7 +39,8 @@ import SDL
-- | otherwise = id -- | otherwise = id
doTextInputOver :: ASetter' Universe String -> Universe -> Universe doTextInputOver :: ASetter' Universe String -> Universe -> Universe
doTextInputOver p u = u & p %~ (++ map toUpper thetext) doTextInputOver p u =
u & p %~ (++ map toUpper thetext)
& checkBackspace & checkBackspace
where where
thetext = u ^. uvWorld . input . textInput thetext = u ^. uvWorld . input . textInput
@@ -58,49 +60,71 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
doSubInvRegexInput :: Universe -> Universe doSubInvRegexInput :: Universe -> Universe
doSubInvRegexInput u doSubInvRegexInput u
| backspacetonothing | backspacetonothing =
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing
& uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
| endkeys || endmouse | endkeys || endmouse =
= u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
| otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just) | otherwise =
u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
where where
endkeys = any endkeys =
( (== Just InitialPress) . (`M.lookup` pkeys)) any
[ScancodeReturn,ScancodeEscape,ScancodeSlash] ((== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn, ScancodeEscape, ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just "" backspacetonothing =
u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
doRegexInput :: Int doRegexInput ::
-> ((Maybe String -> Identity (Maybe String)) Int ->
-> Manipulation -> Identity Manipulation) ( (Maybe String -> Identity (Maybe String)) ->
-> ((Maybe String Manipulation ->
-> Const (First String) (Maybe String)) Identity Manipulation
-> Manipulation -> Const (First String) Manipulation) ) ->
-> Universe ( ( Maybe String ->
-> Universe Const (First String) (Maybe String)
) ->
Manipulation ->
Const (First String) Manipulation
) ->
Universe ->
Universe
doRegexInput i crregex crregex' u doRegexInput i crregex crregex' u
| backspacetonothing | backspacetonothing =
= u u
& uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex .~ Nothing & uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex .~ Nothing
& uvWorld . hud . hudElement . diSections %~ & uvWorld . hud . hudElement . diSections
( ssSetCursor (ssLookupGT i 0) %~ ( ssSetCursor (ssLookupGT i 0)
. (overSection (ssItems . at i .~ Nothing)) . (overSection (ssItems . at i .~ Nothing))
) )
& uvWorld %~ setInvPosFromSS & uvWorld %~ setInvPosFromSS
| endkeys || endmouse = u | endkeys || endmouse = u
| otherwise = u & doTextInputOver & 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) (uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex . _Just)
where where
endkeys = any j = fromMaybe 0 $ do
( (== Just InitialPress) . (`M.lookup` pkeys)) itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i+1) . ssItems
[ScancodeReturn,ScancodeEscape,ScancodeSlash] fmap fst $ IM.lookupMin itms
endkeys =
any
((== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn, ScancodeEscape, ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex' . _Just == Just "" backspacetonothing =
u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . crregex' . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
@@ -111,7 +135,8 @@ doInputScreenInput s u =
where where
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
checkEndStatus checkEndStatus
| ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) | ScancodeReturn `M.member` pkeys =
(uvScreenLayers %~ tail)
. applyTerminalString (words s) . applyTerminalString (words s)
| ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail
| otherwise = id | otherwise = id
@@ -162,10 +187,11 @@ 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 | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ Just CombineInventory{} ->
( ( smRegex %~ enternonzeroregex ) w & hud . hudElement . subInventory . subInvMap
. ( smSelPos ?~ 0 ) %~ ( (smRegex %~ enternonzeroregex)
. ( setShownIntMap ) . (smSelPos ?~ 0)
. (setShownIntMap)
) )
_ -> w _ -> w
where where
@@ -176,33 +202,40 @@ updateBackspaceRegex w = case di ^? subInventory of
i <- di ^? diSections . sssSelPos . _Just i <- di ^? diSections . sssSelPos . _Just
return $ i == 2 || i == 3 return $ i == 2 || i == 3
trybackspace cm = case cm ^? invRegex . _Just of trybackspace cm = case cm ^? invRegex . _Just of
Just (_:_) -> cm & invRegex . _Just %~ init Just (_ : _) ->
cm & invRegex . _Just %~ init
& manObject .~ InInventory SortInventory & manObject .~ InInventory SortInventory
Just [] -> cm & invRegex .~ Nothing Just [] -> cm & invRegex .~ Nothing
Nothing -> cm Nothing -> cm
trybackspaceclose cm = case cm ^? closeRegex . _Just of trybackspaceclose cm = case cm ^? closeRegex . _Just of
Just (_:_) -> cm & closeRegex . _Just %~ init Just (_ : _) ->
cm & closeRegex . _Just %~ init
& manObject .~ InNearby SortNearby & manObject .~ InNearby SortNearby
Just [] -> cm & closeRegex .~ Nothing Just [] -> cm & closeRegex .~ Nothing
Nothing -> cm Nothing -> cm
di = w ^. hud . hudElement di = w ^. hud . hudElement
enternonzeroregex (Just (x:xs)) = Just (init (x:xs)) enternonzeroregex (Just (x : xs)) = Just (init (x : xs))
enternonzeroregex smr = smr enternonzeroregex smr = smr
updateEnterRegex :: World -> World updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ Just NoSubInventory
( ( invRegex %~ startregex ) | invfocus ->
. ( manObject .~ InInventory SortInventory) w & cWorld . lWorld . creatures . ix 0 . crManipulation
%~ ( (invRegex %~ startregex)
. (manObject .~ InInventory SortInventory)
) )
Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ Just NoSubInventory
( ( closeRegex %~ startregex ) | closefocus ->
. ( manObject .~ InNearby SortNearby) w & cWorld . lWorld . creatures . ix 0 . crManipulation
%~ ( (closeRegex %~ startregex)
. (manObject .~ InNearby SortNearby)
) )
Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ Just CombineInventory{} ->
( setShownIntMap w & hud . hudElement . subInventory . subInvMap
. (smSelPos ?~ 0 ) %~ ( setShownIntMap
. ( smRegex %~ enterregex) . (smSelPos ?~ 0)
. (smRegex %~ enterregex)
) )
_ -> w _ -> w
where where
@@ -229,12 +262,12 @@ pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
spaceAction :: World -> World spaceAction :: World -> World
spaceAction w = case w ^?! hud . hudElement of spaceAction w = case w ^?! hud . hudElement of
DisplayCarte -> w & hud . carteCenter .~ theLoc 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 (_, Left flit) -> pickUpItem 0 flit w
Just (_, Right but) -> doButtonEvent (_btEvent but) but w Just (_, Right but) -> doButtonEvent (_btEvent but) but w
_ -> w _ -> w
DisplayInventory {_subInventory = DisplayTerminal{}} DisplayInventory{_subInventory = DisplayTerminal{}} ->
-> 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 (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
@@ -242,8 +275,9 @@ spaceAction w = case w ^?! hud . hudElement of
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 -- where
-- w = u ^. uvWorld -- w = u ^. uvWorld
-- cfig = u ^. uvConfig -- cfig = u ^. uvConfig