From 048135c370a2c04e42c7e84e1b1ee180e12b6df2 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 15 Jan 2023 23:17:47 +0000 Subject: [PATCH] Rethink selection lists as intmaps --- src/Dodge/Combine.hs | 76 ++++++++++++++++++++++++++-- src/Dodge/Combine/List.hs | 3 ++ src/Dodge/Data/Combine.hs | 10 ++++ src/Dodge/Data/HUD.hs | 8 +-- src/Dodge/Data/SelectionList.hs | 15 +++++- src/Dodge/Default/SelectionList.hs | 13 +++++ src/Dodge/Inventory/SelectionList.hs | 2 +- src/Dodge/Menu/Loading.hs | 3 +- src/Dodge/Menu/Option.hs | 5 +- src/Dodge/Render/HUD.hs | 74 +++++++-------------------- src/Dodge/Render/List.hs | 21 ++++++++ src/Dodge/SelectionList.hs | 37 +++++++++----- src/Dodge/Update.hs | 2 +- src/Dodge/Update/Input.hs | 11 ++-- src/Dodge/Update/Scroll.hs | 7 +-- src/Dodge/Update/UsingInput.hs | 8 +-- src/SelectionIntMap.hs | 43 ++++++++++++++++ 17 files changed, 245 insertions(+), 93 deletions(-) create mode 100644 src/Dodge/Combine/List.hs create mode 100644 src/Dodge/Data/Combine.hs create mode 100644 src/Dodge/Default/SelectionList.hs create mode 100644 src/SelectionIntMap.hs diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 3d5f04e9c..0368bcb18 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -6,8 +6,14 @@ module Dodge.Combine ( combineListInfo, toggleCombineInv, enterCombineInv, + combineListSelection, + picsToSelectable, ) where +import Dodge.Data.Combine +import Dodge.Item.Display +import Color +import Dodge.Data.SelectionList import qualified Data.IntSet as IS import Control.Lens import Control.Monad @@ -44,6 +50,19 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv where g (amount, i) = replicate (_getItAmount amount) i +combineList :: World -> [SelectionItem CombinableItem] +combineList = map f . combineListInfo + where + f (is,(strs,itm)) = SelectionItem + { _siPictures = itemDisplay itm + , _siHeight = length (itemDisplay itm) + , _siIsSelectable = True + , _siWidth = maximum (map length (itemDisplay itm)) + , _siColor = _itInvColor itm + , _siOffX = 0 + , _siPayload = CombinableItem is itm strs + } + combineListInfo :: World -> [([Int], ([String], Item))] combineListInfo w = filter f . map (cmm inv) $ combineItemListYouX w where @@ -93,10 +112,7 @@ toggleCombineInv w = case w ^. hud . hudElement of enterCombineInv :: World -> World enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory - { _subInvSel = mi - , _subInvRegex = "" - , _subInvRegexInput = False - } + (combineListSelection w mi "" False) where mi = 0 <$ listToMaybe (combineItemListYou w) @@ -105,3 +121,55 @@ combineSizes = map (itSlotsTaken . snd) . combineItemListYou combinePoss :: World -> [Int] combinePoss = scanl' (+) 0 . combineSizes + +combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionIntMap CombinableItem +combineListSelection w mi regex x = SelectionIntMap + { _smItems = combineList w + , _smSelPos = mi + , _smLength = length (combineList w) + , _smRegex = regex + , _smRegexInput = x + , _smShownItems = IM.fromAscList $ zip [0..] (combineList w) + } + +combineListSelectionItems :: World -> [SelectionItem ()] +combineListSelectionItems w = case combineListSelectionItems' w of + [] -> [SelectionItem [thetext] 1 False (length thetext) white 0 ()] + xs -> xs + where + thetext = "NO POSSIBLE COMBINATIONS" + +combineListSelectionItems' :: World -> [SelectionItem ()] +combineListSelectionItems' = map (picsToSelectable 15 . itemText . snd) . combineItemListYou + +combineToSelectionItem :: Int -> [String] -> SelectionItem () +combineToSelectionItem wdth pics = + SelectionItem + { _siPictures = pics + , _siHeight = length pics + , _siIsSelectable = True + , _siWidth = wdth + , _siColor = white + , _siOffX = 0 + , _siPayload = () + } + +picsToSelectable :: Int -> [String] -> SelectionItem () +picsToSelectable wdth pics = + SelectionItem + { _siPictures = pics + , _siHeight = length pics + , _siIsSelectable = True + , _siWidth = wdth + , _siColor = white + , _siOffX = 0 + , _siPayload = () + } + +itemText :: Item -> [String] +{-# INLINE itemText #-} +itemText it = f $ case _itCurseStatus it of + UndroppableIdentified -> itemDisplay it + _ -> itemDisplay it + where + f = take (itSlotsTaken it) . (++ replicate 10 "*") diff --git a/src/Dodge/Combine/List.hs b/src/Dodge/Combine/List.hs new file mode 100644 index 000000000..08ab2c8e2 --- /dev/null +++ b/src/Dodge/Combine/List.hs @@ -0,0 +1,3 @@ +module Dodge.Combine.List where + + diff --git a/src/Dodge/Data/Combine.hs b/src/Dodge/Data/Combine.hs new file mode 100644 index 000000000..3338bf1e7 --- /dev/null +++ b/src/Dodge/Data/Combine.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} +module Dodge.Data.Combine where +import Control.Lens +import Dodge.Data.Item +data CombinableItem = CombinableItem + { _ciInvIDs :: [Int] + , _ciItem :: Item + , _ciInfo :: [String] + } +makeLenses ''CombinableItem diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 144b056f9..c7829a5fc 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -5,7 +5,8 @@ module Dodge.Data.HUD where ---import Dodge.Data.SelectionList +import Dodge.Data.Combine +import Dodge.Data.SelectionList import Dodge.Data.Button import Dodge.Data.FloorItem import Control.Lens @@ -20,9 +21,8 @@ data HUDElement data SubInventory = NoSubInventory - | ExamineInventory {_subInvSel :: Maybe Int} - | CombineInventory {_subInvSel :: Maybe Int, _subInvRegex :: String - , _subInvRegexInput :: Bool} + | ExamineInventory {_subInvMSel :: Maybe Int} + | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem} | 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 7da947333..42009712f 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -6,6 +6,7 @@ module Dodge.Data.SelectionList where import Color import Control.Lens import Dodge.Data.CardinalPoint +import Data.IntMap.Strict (IntMap) --import Data.Aeson --import Data.Aeson.TH @@ -25,6 +26,17 @@ data SelectionList a = SelectionList , _slLength :: Int , _slRegex :: String , _slRegexInput :: Bool + , _slRegexList :: [(SelectionItem a, Maybe Int)] + } + --deriving (Eq, Ord, Show, Read) --Generic, Flat) + +data SelectionIntMap a = SelectionIntMap + { _smItems :: [SelectionItem a] + , _smSelPos :: Maybe Int + , _smLength :: Int + , _smRegex :: String + , _smRegexInput :: Bool + , _smShownItems :: IntMap (SelectionItem a) } --deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -44,7 +56,7 @@ data SelectionItem a = SelectionItem , _siOffX :: Int , _siPayload :: a } - | SelectionFilter + | SelectionInfo { _siPictures :: [String] , _siHeight :: Int , _siIsSelectable :: Bool @@ -57,5 +69,6 @@ data SelectionItem a = SelectionItem makeLenses ''ListDisplayParams makeLenses ''SelectionList makeLenses ''SelectionItem +makeLenses ''SelectionIntMap --deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/Default/SelectionList.hs b/src/Dodge/Default/SelectionList.hs new file mode 100644 index 000000000..a7912aaf7 --- /dev/null +++ b/src/Dodge/Default/SelectionList.hs @@ -0,0 +1,13 @@ +module Dodge.Default.SelectionList where + +import Dodge.Data.SelectionList + +defaultSelectionList :: SelectionList a +defaultSelectionList = SelectionList + {_slItems = [] + , _slSelPos = Nothing + , _slLength = 0 + , _slRegex = "" + , _slRegexInput = False + , _slRegexList = [] + } diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 148663bb7..a3d42b98c 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -1,12 +1,12 @@ module Dodge.Inventory.SelectionList where +import Dodge.Default.SelectionList import Dodge.Inventory.Color import Dodge.Item.Display import Dodge.Inventory.ItemSpace import Picture.Base import Dodge.Inventory.CheckSlots import Dodge.Base.You -import Dodge.SelectionList import Dodge.Data.SelectionList import Dodge.Data.World import qualified Data.IntMap.Strict as IM diff --git a/src/Dodge/Menu/Loading.hs b/src/Dodge/Menu/Loading.hs index 8238fe51e..4361d0d17 100644 --- a/src/Dodge/Menu/Loading.hs +++ b/src/Dodge/Menu/Loading.hs @@ -1,5 +1,6 @@ module Dodge.Menu.Loading where +import Dodge.Default.SelectionList import Dodge.Menu.Option import Dodge.Data.Universe @@ -10,7 +11,7 @@ loadingScreen str = OptionScreen , _scOffset = 0 , _scPositionedMenuOption = NoPositionedMenuOption , _scOptionFlag = LoadingScreen - , _scSelectionList = SelectionList [] Nothing 0 "" False + , _scSelectionList = defaultSelectionList , _scAvailableLines = 0 , _scListDisplayParams = optionListDisplayParams } diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 74467cc3a..d53fc710d 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -1,6 +1,7 @@ module Dodge.Menu.Option where --import Dodge.ScodeToChar +import Dodge.Default.SelectionList import Data.Maybe --import Dodge.WindowLayout @@ -62,12 +63,10 @@ makeOptionsSelectionList :: PositionedMenuOption -> SelectionList (Universe -> Universe) makeOptionsSelectionList maxlines mselpos u mos pmo = - SelectionList + defaultSelectionList { _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)] diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index d3714219a..fba59d664 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,6 +3,8 @@ module Dodge.Render.HUD ( drawHUD, ) where +import Dodge.Default.SelectionList +import Dodge.Combine import Dodge.Creature.Info import Control.Lens import qualified Data.Map.Strict as M @@ -10,15 +12,15 @@ import Data.Maybe import qualified Data.Vector as V import Dodge.Base import Dodge.Clock -import Dodge.Combine +--import Dodge.Combine import Dodge.Data.CardinalPoint import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.Inventory -import Dodge.Inventory.ItemSpace +--import Dodge.Inventory.ItemSpace import Dodge.Inventory.SelectionList -import Dodge.Item.Display +--import Dodge.Item.Display import Dodge.Item.Info import Dodge.Render.Connectors import Dodge.Render.List @@ -59,16 +61,6 @@ defaultListDisplayParams = , _ldpWidth = FixedSelectionWidth 15 } -defaultSubInvSelectionList :: SelectionList a -defaultSubInvSelectionList = - SelectionList - { _slItems = [] - , _slSelPos = Nothing - , _slLength = 15 - , _slRegex = "" - , _slRegexInput = False - } - invDisplayParams :: World -> ListDisplayParams invDisplayParams w = defaultListDisplayParams @@ -92,11 +84,12 @@ 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 regex x -> - titledSub + CombineInventory sl -> + let mi = _smSelPos sl + in titledSub' cfig ("COMBINE") - (combineListSelection w mi regex x) + sl <> combineInventoryExtra mi cfig w titledSub :: Configuration -> String -> SelectionList a -> Picture @@ -104,12 +97,17 @@ titledSub cfig subtitle subitems = invHead cfig subtitle <> drawSelectionList secondColumnParams cfig subitems +titledSub' :: Configuration -> String -> SelectionIntMap a -> Picture +titledSub' cfig subtitle subitems = + invHead cfig subtitle + <> drawSelectionMap secondColumnParams cfig subitems + drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture drawExamineInventory cfig mtweaki w = titledSub cfig "EXAMINE" - (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm + (defaultSelectionList & slItems .~ ammoTweakSelectionItems itm ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w)) ) w)) <> examineInventoryExtra mtweaki itm cfig where @@ -240,7 +238,10 @@ displayTerminal tid cfig w = fromMaybe mempty $ do ] where toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 () - thesellist tm = SelectionList (thelist tm) Nothing (length (thelist tm)) "" False + thesellist tm = defaultSelectionList + { _slItems = thelist tm + , _slLength = length (thelist tm) + } thelist tm = map toselitm . displayTermInput tm . reverse @@ -336,23 +337,6 @@ determineInvSelCursorWidth w = case _rbOptions w of Just NoSubInventory -> True _ -> False -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 [thetext] 1 False (length thetext) white 0 ()] - xs -> xs - where - thetext = "NO POSSIBLE COMBINATIONS" - -combineListSelectionItems' :: World -> [SelectionItem ()] -combineListSelectionItems' = map (picsToSelectable 15 . itemText . snd) . combineItemListYou ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()] ammoTweakSelectionItems = textSelItems . ammoTweakStrings @@ -456,29 +440,9 @@ 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 -> [String] -> SelectionItem () -picsToSelectable wdth pics = - SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - , _siWidth = wdth - , _siColor = white - , _siOffX = 0 - , _siPayload = () - } - textSelItems :: [String] -> [SelectionItem ()] textSelItems = map (picsToSelectable 15 . (: [])) -itemText :: Item -> [String] -{-# INLINE itemText #-} -itemText it = f $ case _itCurseStatus it of - UndroppableIdentified -> itemDisplay it - _ -> itemDisplay it - where - f = take (itSlotsTaken it) . (++ replicate 10 "*") - openCursorAt :: -- | Width Float -> diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index af14bffaf..bcd608727 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,5 +1,6 @@ module Dodge.Render.List where +import qualified Data.IntMap.Strict as IM --import Data.Foldable import Dodge.SelectionList import Data.Maybe @@ -25,11 +26,28 @@ drawSelectionList ldps cfig sl = (makeSelectionListPictures sl) <> drawSelectionCursor ldps cfig sl +drawSelectionMap :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture +drawSelectionMap ldps cfig sl = + listPicturesAtScaleOff + (_ldpVerticalGap ldps) + (_ldpScale ldps) + (_ldpPosX ldps) + (_ldpPosY ldps) + cfig + 0 --(_slOffset sl) + (makeSelectionMapPictures sl) + <> drawSelectionMapCursor ldps cfig sl + makeSelectionListPictures :: SelectionList a -> [Picture] makeSelectionListPictures sl = concatMap f $ getShownItems sl where f si = map (color (_siColor si) . text) $ _siPictures si +makeSelectionMapPictures :: SelectionIntMap a -> [Picture] +makeSelectionMapPictures sl = foldMap f $ _smShownItems sl + where + f si = map (color (_siColor si) . text) $ _siPictures si + drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do i <- mi @@ -45,6 +63,9 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do FixedSelectionWidth x -> x _ -> 1 +drawSelectionMapCursor :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture +drawSelectionMapCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. smSelPos) (IM.elems $ _smShownItems sl) + drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl) where diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index 8c9edc359..7d0545ee7 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -16,25 +16,34 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight) dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot) dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom -defaultSelectionList :: SelectionList a -defaultSelectionList = SelectionList - {_slItems = [] - , _slSelPos = Nothing - , _slLength = 0 - , _slRegex = "" - , _slRegexInput = False - } - getShownItems :: SelectionList a -> [SelectionItem a] -getShownItems sl = case sl ^. slRegex of - "" | not (sl ^. slRegexInput) -> _slItems sl - str -> SelectionFilter +getShownItems sl = case sl ^. slRegexList of + [] -> sl ^. slItems + xs -> map fst xs + +makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)] +makeRegexList sl = case sl ^. slRegex of + "" | not (sl ^. slRegexInput) -> [] + str -> (SelectionInfo { _siPictures = ["FILTER: "++str] , _siHeight = 1 , _siIsSelectable = False , _siWidth = length $ "FILTER: "++str , _siColor = white , _siOffX = 0 - }: filter (doregex str) (_slItems sl) + }, Nothing) : filter (doregex str) (zip (_slItems sl) $ fmap Just [0..]) where - doregex str = regexList str . _siPictures + doregex str = regexList str . _siPictures . fst + +setShownItems :: SelectionList a -> SelectionList a +setShownItems sl = sl & slRegexList .~ makeRegexList sl + +moveSelectionListSelection :: Int -> SelectionList a -> SelectionList a +moveSelectionListSelection yi sl = sl & slSelPos %~ f + where + f x | maxsel == 0 = Nothing + | x == Nothing = Just 0 + | otherwise = fmap ((`mod` maxsel) . subtract yi) x + maxsel = case _slRegex sl of + "" -> length (_slItems sl) + _ -> length (_slRegexList sl) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 3cbf60862..d4997a9c3 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -138,7 +138,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 + Just (CombineInventory SelectionIntMap {_smRegexInput=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 219eb976a..afe906ea9 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -5,6 +5,7 @@ module Dodge.Update.Input ( doSubInvRegexInput, ) where +import SelectionIntMap import qualified Data.Map.Strict as M import Data.Char import Dodge.Base.You @@ -45,8 +46,12 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks doSubInvRegexInput :: Universe -> Universe doSubInvRegexInput u | any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash] - = u & uvWorld . hud . hudElement . subInventory . subInvRegexInput .~ False - | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvRegex) + = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False + | ScancodeBackspace `M.member` pkeys + && u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just "" + = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False + | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex) + & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap where pkeys = u ^. uvWorld . input . pressedKeys @@ -89,7 +94,7 @@ updateKeyInGame uv sc InitialPress = case sc of 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 + ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput) True uv -- in fact the whole logic should probably be rethought, oh well _ -> uv updateKeyInGame uv sc LongPress = case sc of diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index f3e44537a..feb5561da 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -2,10 +2,11 @@ module Dodge.Update.Scroll ( updateWheelEvent, ) where +import SelectionIntMap +import Dodge.SelectionList import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base -import Dodge.Combine import Dodge.Data.Universe import Dodge.HeldScroll import Dodge.InputFocus @@ -49,11 +50,11 @@ updateWheelEvent yi w = case w ^. hud . hudElement of invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w) moveCombineSel :: Int -> World -> World -moveCombineSel yi w = moveSubSel yi (length $ combineItemListYou w) w +moveCombineSel yi = hud . hudElement . subInventory . subInvMap %~ moveSelectionMapSelection yi moveSubSel :: Int -> Int -> World -> World moveSubSel yi maxyi = - hud . hudElement . subInventory . subInvSel . _Just + hud . hudElement . subInventory . subInvMSel . _Just %~ ((`mod` maxyi) . subtract yi) guardDisconnectedID :: Int -> World -> World -> World diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index a36e66b23..07511048d 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -3,6 +3,7 @@ module Dodge.Update.UsingInput ( updateUsingInput, ) where +import Dodge.Data.SelectionList import Control.Lens import qualified Data.Map.Strict as M import Dodge.Base.You @@ -30,11 +31,12 @@ 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 _ False + CombineInventory SelectionIntMap {_smSelPos = mi, _smRegexInput = 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 + CombineInventory SelectionIntMap {_smRegexInput = True} + | pkeys ^? ix ButtonLeft == Just False + -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False DisplayTerminal tmid | pkeys ^? ix ButtonLeft == Just False && inTermFocus w -> doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w diff --git a/src/SelectionIntMap.hs b/src/SelectionIntMap.hs new file mode 100644 index 000000000..99ac6bd93 --- /dev/null +++ b/src/SelectionIntMap.hs @@ -0,0 +1,43 @@ +module SelectionIntMap where + +import Data.Foldable +import Data.Maybe +import Color +import Regex +import qualified Data.IntMap.Strict as IM +import Dodge.Data.SelectionList +import LensHelp + +setShownIntMap :: SelectionIntMap a -> SelectionIntMap a +setShownIntMap sm = case sm ^. smRegex of + "" | not (sm ^. smRegexInput) -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms) + str -> sm & smShownItems + .~ IM.fromAscList (zip [0..] (f str : filter (regexList str . _siPictures) allitms)) + where + allitms = sm ^. smItems + f str = SelectionInfo + { _siPictures = ["FILTER: " ++ str] + , _siHeight = 1 + , _siIsSelectable = False + , _siWidth = length ("FILTER: " ++ str) + , _siColor = white + , _siOffX = 0 + } + +-- assumes that at least one item is selectable! +-- also assumes that the integer is 1 or -1 +moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a +moveSelectionMapStep x sm = fromMaybe sm $ do + i <- _smSelPos sm + (n,_) <- IM.lookupMax (sm ^. smShownItems) + let j = (i + x) `mod` (n + 1) + case sm ^? smShownItems . ix j . siIsSelectable of + Just True -> Just $ sm & smSelPos ?~ j + _ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j) + +moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a +moveSelectionMapSelection i sm = foldl' + (&) + sm + (replicate (abs i) (moveSelectionMapStep (signum i))) +