From 64b1c2761ebc313020866dc4709ef4b0eaefd760 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 15 Jan 2023 11:55:32 +0000 Subject: [PATCH] Start adding filters to selection lists --- src/Dodge/Combine.hs | 7 +++- src/Dodge/Data/HUD.hs | 4 ++- src/Dodge/Data/SelectionList.hs | 8 +++-- src/Dodge/Inventory.hs | 4 +-- src/Dodge/Inventory/SelectionList.hs | 22 +++++------- src/Dodge/Item/Draw/SPic.hs | 2 +- src/Dodge/Menu.hs | 4 --- src/Dodge/Menu/Loading.hs | 2 +- src/Dodge/Menu/Option.hs | 8 +++-- src/Dodge/Render/HUD.hs | 36 ++++++++++--------- src/Dodge/Render/List.hs | 23 ++++++++++-- src/Dodge/SelectionList.hs | 9 +++++ src/Dodge/Update.hs | 1 + src/Dodge/Update/Input.hs | 52 ++++++++++++++++++---------- src/Dodge/Update/UsingInput.hs | 4 ++- src/Regex.hs | 8 +++++ 16 files changed, 128 insertions(+), 66 deletions(-) create mode 100644 src/Regex.hs diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 6ee361555..cd3b5ef11 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -8,6 +8,7 @@ module Dodge.Combine ( enterCombineInv, ) where +import qualified Data.Text as T import qualified Data.IntSet as IS import Control.Lens import Control.Monad @@ -92,7 +93,11 @@ toggleCombineInv w = case w ^. hud . hudElement of _ -> w & enterCombineInv enterCombineInv :: World -> World -enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory mi +enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory + { _subInvSel = mi + , _subInvRegex = T.pack "" + , _subInvRegexInput = False + } where mi = 0 <$ listToMaybe (combineItemListYou w) diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 1669903e2..0560a834e 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -10,6 +10,7 @@ import Dodge.Data.Button import Dodge.Data.FloorItem import Control.Lens import Geometry.Data +import qualified Data.Text as T data HUDElement = DisplayInventory @@ -21,7 +22,8 @@ data HUDElement data SubInventory = NoSubInventory | ExamineInventory {_subInvSel :: Maybe Int} - | CombineInventory {_subInvSel :: Maybe Int} + | CombineInventory {_subInvSel :: Maybe Int, _subInvRegex :: T.Text + , _subInvRegexInput :: Bool} | LockedInventory | DisplayTerminal {_termID :: Int} deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 2d91c8b3a..ef8d4ba21 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -4,7 +4,6 @@ {-# LANGUAGE StrictData #-} module Dodge.Data.SelectionList where import Color -import Picture.Data import Control.Lens import Dodge.Data.CardinalPoint --import Data.Aeson @@ -24,6 +23,8 @@ data SelectionList a = SelectionList { _slItems :: [SelectionItem a] , _slSelPos :: Maybe Int , _slLength :: Int + , _slRegex :: String + , _slRegexInput :: Bool } --deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -35,7 +36,7 @@ data CursorType = NoCursor | BorderCursor [CardinalPoint] data SelectionItem a = SelectionItem - { _siPictures :: [Picture] + { _siPictures :: [String] , _siHeight :: Int , _siIsSelectable :: Bool , _siWidth :: Int @@ -43,6 +44,9 @@ data SelectionItem a = SelectionItem , _siOffX :: Int , _siPayload :: a } + | SelectionFilter + { _siPictures :: [String] + } --deriving (Eq, Ord, Show, Read) --Generic, Flat) makeLenses ''ListDisplayParams diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 90eba1ba3..a3f9046ac 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -194,8 +194,8 @@ updateRBList w w & rbOptions .~ EquipOptions - { _opEquip = (equipSiteToPositions esite) - , _opSel = (chooseEquipmentPosition cr (equipSiteToPositions esite)) + { _opEquip = equipSiteToPositions esite + , _opSel = chooseEquipmentPosition cr (equipSiteToPositions esite) , _opItemID = itid , _opAllocateEquipment = DoNotMoveEquipment , _opActivateEquipment = NoChangeActivateEquipment diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index b44919e8e..148663bb7 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -19,7 +19,7 @@ makeInventorySelectionList w = defaultSelectionList inventorySelectionList :: World -> [SelectionItem ()] inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv) - ++ [SelectionItem displayFreeSlots 1 True (length thetext) invDimColor 2 ()] + ++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()] ++ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) where cr = you w @@ -29,7 +29,6 @@ inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv) 0 -> " INVENTORY FULL" 1 -> " +1 FREE SLOT" x -> " +" ++ show x ++ " FREE SLOTS" - displayFreeSlots = [color invDimColor $ text thetext] inventoryCursorPos :: World -> Maybe Int inventoryCursorPos w = case w ^? hud . hudElement . subInventory of @@ -48,10 +47,10 @@ invSelectionItem cr (i,it) = SelectionItem } where col = _itInvColor it - pics = take (itSlotsTaken it) . (++ replicate 10 (color col $ text "*")) $ case _itCurseStatus it of - UndroppableIdentified -> map (color yellow . text) (itemDisplay it) - _ | crSel cr == i -> map (color col . text) (selectedItemDisplay cr it) - _ -> map (color col . text) (itemDisplay it) + pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of + UndroppableIdentified -> itemDisplay it + _ | crSel cr == i -> selectedItemDisplay cr it + _ -> itemDisplay it closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem () closeObjectToSelectionItem n e = SelectionItem @@ -66,16 +65,13 @@ closeObjectToSelectionItem n e = SelectionItem where (pics,col) = closeObjectToTextPictures' n e -closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([Picture],Color) +closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([String],Color) closeObjectToTextPictures' nfreeslots e = case e of Left flit -> let it = _flIt flit - in (map (applycolor it . textindent) $ itemDisplay it, thecol it) - Right bt -> ([color yellow $ textindent $ _btText bt], yellow) + in (map textindent $ itemDisplay it, thecol it) + Right bt -> ([textindent $ _btText bt], yellow) where - textindent = text . (replicate clObjIntIn ' ' ++) - applycolor it - | nfreeslots >= itSlotsTaken it = color $ _itInvColor it - | otherwise = color invDimColor + textindent = (replicate clObjIntIn ' ' ++) thecol it | nfreeslots >= itSlotsTaken it = _itInvColor it | otherwise = invDimColor diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 6c1971cc8..6d24d27b7 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -247,7 +247,7 @@ addBullets :: Item -> Shape addBullets itm = fromMaybe mempty $ do x <- itm ^? itUse . heldConsumption . laLoaded hit <- itm ^? itType . iyBase . ibtHeld - ps <- fmap (take x) $ (ammoPosition itm hit) ^? amPosDirs + ps <- fmap (take x) $ ammoPosition itm hit ^? amPosDirs return $ foldMap (uncurry (drawBullet itm)) ps drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index c19700714..8b0eea7a6 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -12,7 +12,6 @@ import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Dodge.Concurrent import Dodge.Config.Update -import Dodge.Data.SelectionList import Dodge.Data.Universe import Dodge.Menu.Option import Dodge.Menu.OptionType @@ -24,7 +23,6 @@ import Dodge.StartNewGame import LensHelp import MaybeHelp import Padding -import ShortShow import System.Clipboard import Text.Read @@ -36,8 +34,6 @@ splashMenu u = splashMenuOptions :: [MenuOption] splashMenuOptions = [ Toggle (loadSaveSlot (SaveSlotNum 0)) displaycontinue - , Toggle id (\u -> MODString $ show $ u ^? uvScreenLayers . _head . scSelectionList . slSelPos . _Just) - , Toggle id (\u -> MODString $ shortShow $ u ^. uvWorld . input . mousePos) , Toggle (startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED") , Toggle reloadLevelStart (displaywhenseed "NEW WITH LAST SEED") , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED") diff --git a/src/Dodge/Menu/Loading.hs b/src/Dodge/Menu/Loading.hs index b2c156889..8238fe51e 100644 --- a/src/Dodge/Menu/Loading.hs +++ b/src/Dodge/Menu/Loading.hs @@ -10,7 +10,7 @@ loadingScreen str = OptionScreen , _scOffset = 0 , _scPositionedMenuOption = NoPositionedMenuOption , _scOptionFlag = LoadingScreen - , _scSelectionList = SelectionList [] Nothing 0 + , _scSelectionList = SelectionList [] Nothing 0 "" False , _scAvailableLines = 0 , _scListDisplayParams = optionListDisplayParams } diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 9eaf8f7b9..74467cc3a 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -66,6 +66,8 @@ makeOptionsSelectionList maxlines mselpos u mos pmo = { _slItems = optionsToSelections maxlines u mos pmo , _slSelPos = mselpos , _slLength = length $ optionsToSelections maxlines u mos pmo + , _slRegex = "" + , _slRegexInput = False } optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)] @@ -101,7 +103,7 @@ cycleOptions u = fromMaybe u $ do colStrToSelItem :: (Color, String) -> SelectionItem (Universe -> Universe) colStrToSelItem (col, str) = SelectionItem - { _siPictures = [color col $ text str] + { _siPictures = [str] , _siHeight = 1 , _siIsSelectable = True , _siWidth = length str @@ -118,11 +120,11 @@ optionValueOffset u mo = case _moString mo u of menuOptionToSelectionItem :: Universe -> Int -> MenuOption -> SelectionItem (Universe -> Universe) menuOptionToSelectionItem w padAmount mo = SelectionItem - { _siPictures = [color thecol $ text optionText] + { _siPictures = [optionText] , _siHeight = 1 , _siIsSelectable = isselectable , _siWidth = length optionText - , _siColor = white + , _siColor = thecol , _siOffX = 0 , _siPayload = f } diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index cb52dce8b..5411c4fd8 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -66,6 +66,8 @@ defaultSubInvSelectionList = { _slItems = [] , _slSelPos = Nothing , _slLength = 15 + , _slRegex = "" + , _slRegexInput = False } invDisplayParams :: World -> ListDisplayParams @@ -91,11 +93,11 @@ drawSubInventory subinv cfig w = case subinv of NoSubInventory -> drawNoSubInventory cfig w ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) - CombineInventory mi -> + CombineInventory mi regex x -> titledSub cfig - "COMBINE" - (combineListSelection w mi) + ("COMBINE") + (combineListSelection w mi (T.unpack regex) x) <> combineInventoryExtra mi cfig w titledSub :: Configuration -> String -> SelectionList a -> Picture @@ -115,7 +117,7 @@ drawExamineInventory cfig mtweaki w = itm = yourItem w f str = SelectionItem - { _siPictures = [text str] + { _siPictures = [str] , _siHeight = 1 , _siIsSelectable = True , _siWidth = length str @@ -238,8 +240,8 @@ displayTerminal tid cfig w = fromMaybe mempty $ do , drawSelectionList secondColumnParams cfig (thesellist tm) ] where - toselitm (str, col) = SelectionItem [color col $ text str] 1 True (length str) col 0 () - thesellist tm = SelectionList (thelist tm) Nothing (length (thelist tm)) + toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 () + thesellist tm = SelectionList (thelist tm) Nothing (length (thelist tm)) "" False thelist tm = map toselitm . displayTermInput tm . reverse @@ -331,15 +333,17 @@ determineInvSelCursorWidth w = case _rbOptions w of 47 | otherwise -> topInvW -combineListSelection :: World -> Maybe Int -> SelectionList () -combineListSelection w mi = +combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionList () +combineListSelection w mi regex x = defaultSubInvSelectionList & slItems .~ combineListSelectionItems w & slSelPos .~ mi + & slRegex .~ regex + & slRegexInput .~ x combineListSelectionItems :: World -> [SelectionItem ()] combineListSelectionItems w = case combineListSelectionItems' w of - [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0 ()] + [] -> [SelectionItem [thetext] 1 False (length thetext) white 0 ()] xs -> xs where thetext = "NO POSSIBLE COMBINATIONS" @@ -449,7 +453,7 @@ drawMapWall cfig thehud wl = color c . polygon $ map (cartePosToScreen cfig theh mainListCursor :: Color -> Int -> Configuration -> Picture mainListCursor c = openCursorAt 120 c 5 0 -picsToSelectable :: Int -> [Picture] -> SelectionItem () +picsToSelectable :: Int -> [String] -> SelectionItem () picsToSelectable wdth pics = SelectionItem { _siPictures = pics @@ -462,17 +466,15 @@ picsToSelectable wdth pics = } textSelItems :: [String] -> [SelectionItem ()] -textSelItems = map (picsToSelectable 15 . (: []) . text) +textSelItems = map (picsToSelectable 15 . (: [])) -itemText :: Item -> [Picture] +itemText :: Item -> [String] {-# INLINE itemText #-} itemText it = f $ case _itCurseStatus it of - UndroppableIdentified -> map (color yellow . text) (itemDisplay it) - -- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90))) - _ -> map (color thecolor . text) (itemDisplay it) + UndroppableIdentified -> itemDisplay it + _ -> itemDisplay it where - thecolor = _itInvColor it - f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*")) + f = take (itSlotsTaken it) . (++ replicate 10 "*") openCursorAt :: -- | Width diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index d6bd479a5..79393a68a 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,6 +1,7 @@ module Dodge.Render.List where --import Data.Foldable +import Regex import Data.Maybe import Dodge.Base.WinScale import Dodge.Base.Window @@ -25,7 +26,16 @@ drawSelectionList ldps cfig sl = <> drawSelectionCursor ldps cfig sl makeSelectionListPictures :: SelectionList a -> [Picture] -makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl +makeSelectionListPictures sl = regex ++ concatMap f theitems + where + theitems = case sl ^. slRegex of + "" -> _slItems sl + str -> filter (doregex str) (_slItems sl) + doregex str = regexList str . _siPictures + regex = case sl ^. slRegex of + "" | not (sl ^. slRegexInput) -> [] + str -> [text $ "SEARCH: " ++ str] + f si = map (color (_siColor si) . text) $ _siPictures si --case sl ^. slSizeRestriction of -- SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl -- _ -> concatMap _siPictures $ _slItems sl @@ -47,7 +57,16 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do _ -> 1 drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture -drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. slSelPos) (sl ^. slItems) +drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (g $ sl ^. slItems) + where + -- the following is quite hacky + f = case sl ^. slRegex of + "" | not (sl ^. slRegexInput) -> id + _ -> fmap (+1) + g (x:xs) = case sl ^. slRegex of + "" | not (sl ^. slRegexInput) -> (x:xs) + _ -> ((x & siHeight .~ 1) : x : xs) + g _ = [] -- given a list of pictures that are each the size of a "text" call, displays them as -- a list on the screen diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index eebe9beec..bc4f56a88 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -2,6 +2,7 @@ module Dodge.SelectionList where --import Color --import Dodge.WindowLayout +import Regex import Dodge.Data.Universe import LensHelp --import Data.Maybe @@ -19,5 +20,13 @@ defaultSelectionList = SelectionList {_slItems = [] , _slSelPos = Nothing , _slLength = 0 + , _slRegex = "" + , _slRegexInput = False } +getShownItems :: SelectionList a -> [SelectionItem a] +getShownItems sl = case sl ^. slRegex of + "" -> _slItems sl + str -> SelectionFilter ["FILTER: "++str] : filter (doregex str) (_slItems sl) + where + doregex str = regexList str . _siPictures diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 54ddd80b0..f74b1e95f 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -139,6 +139,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of optionScreenUpdate screen mop flag ldps sellist u _ -> case u ^? uvWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u + Just (CombineInventory _ _ True) -> doSubInvRegexInput u _ -> M.foldlWithKey' updateKeyInGame u pkeys where pkeys = u ^. uvWorld . input . pressedKeys diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index fcc2ea5f8..87cf14cfc 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -2,6 +2,7 @@ module Dodge.Update.Input ( updateKeyInGame, updateKeysInTerminal, doInputScreenInput, + doSubInvRegexInput, ) where import qualified Data.Map.Strict as M @@ -22,22 +23,15 @@ import Dodge.WorldPos import LensHelp import SDL -doInputScreenInput :: T.Text -> Universe -> Universe -doInputScreenInput s u = - u & uvScreenLayers . _head . scInput %~ (`T.append` T.toUpper thetext) - & checkBackspace - & checkEndStatus +doTextInputOver :: ASetter' Universe T.Text -> Universe -> Universe +doTextInputOver p u = u & p %~ (`T.append` T.toUpper thetext) + & checkBackspace where thetext = u ^. uvWorld . input . textInput checkBackspace - | backspaceInputted u = uvScreenLayers . _head . scInput %~ doBackspace + | backspaceInputted u = p %~ doBackspace | otherwise = id - pkeys = u ^. uvWorld . input . pressedKeys - checkEndStatus - | ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) . applyTerminalString (words $ T.unpack s) - | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail - | otherwise = id - + doBackspace :: T.Text -> T.Text doBackspace t = case T.unsnoc t of Nothing -> t @@ -49,17 +43,35 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks Just LongPress -> True _ -> False +doSubInvRegexInput :: Universe -> Universe +doSubInvRegexInput u = u + & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvRegex) + & checkEndStatus + where + pkeys = u ^. uvWorld . input . pressedKeys + checkEndStatus + | any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash] + = uvWorld . hud . hudElement . subInventory . subInvRegexInput .~ False + | otherwise = id + +doInputScreenInput :: T.Text -> Universe -> Universe +doInputScreenInput s u = + u & doTextInputOver (uvScreenLayers . _head . scInput) + & checkEndStatus + where + pkeys = u ^. uvWorld . input . pressedKeys + checkEndStatus + | ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) + . applyTerminalString (words $ T.unpack s) + | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail + | otherwise = id + updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal tmid u = - u & tmpoint %~ (`T.append` T.toUpper thetext) - & checkBackspace + u & doTextInputOver tmpoint & checkEndStatus where tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText - thetext = u ^. uvWorld . input . textInput - checkBackspace - | backspaceInputted u = tmpoint %~ doBackspace - | otherwise = id pkeys = u ^. uvWorld . input . pressedKeys checkEndStatus | pkeys ^. at ScancodeReturn == Just InitialPress = @@ -79,6 +91,10 @@ updateKeyInGame uv sc InitialPress = case sc of ScancodeT -> over uvWorld testEvent uv ScancodeX -> uv & uvWorld %~ toggleTweakInv ScancodeC -> over uvWorld toggleCombineInv uv + -- the following should be put in a more sensible place + --ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv + ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv + -- in fact the whole logic should probably be rethought, oh well _ -> uv updateKeyInGame uv sc LongPress = case sc of ScancodeF -> over uvWorld youDropItem uv diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index ade7e9442..a36e66b23 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -30,9 +30,11 @@ pressedMBEffects subinv pkeys w = case subinv of | ButtonLeft `M.member` pkeys && w ^?! input . hammers . ix SubInvHam /= HammerUp -> w & input . hammers . ix SubInvHam .~ HammerDown | otherwise -> pressedMBEffectsNoInventory pkeys w - CombineInventory mi + CombineInventory mi _ False | pkeys ^? ix ButtonLeft == Just False -> maybeexitcombine (maybe id doCombine mi w) & input . hammers . ix SubInvHam .~ HammerDown + CombineInventory _ _ True | pkeys ^? ix ButtonLeft == Just False + -> w & hud . hudElement . subInventory . subInvRegexInput .~ False DisplayTerminal tmid | pkeys ^? ix ButtonLeft == Just False && inTermFocus w -> doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w diff --git a/src/Regex.hs b/src/Regex.hs new file mode 100644 index 000000000..bd689aa60 --- /dev/null +++ b/src/Regex.hs @@ -0,0 +1,8 @@ +module Regex where +import Data.List + +regexIn :: String -> String -> Bool +regexIn = isInfixOf + +regexList :: String -> [String] -> Bool +regexList x = any (isInfixOf x)