diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 9a989a1a7..6c210ef0f 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -114,7 +114,6 @@ enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory sm sm = initialSelPos $ SelectionIntMap { _smItems = combineList w , _smSelPos = Nothing - , _smRegex = "" - , _smRegexInput = False + , _smRegex = NoSMRegex , _smShownItems = IM.fromAscList $ zip [0..] (combineList w) } diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index bb12a9b38..096c16cea 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -30,6 +30,12 @@ data SelectionList a = SelectionList } --deriving (Eq, Ord, Show, Read) --Generic, Flat) +data Regex = NoRegex + | Regex + { _regString :: String + , _regInput :: Bool + } + data SelectionSections a = SelectionSections { _sssSections :: IntMap (SelectionSection a) , _sssSelPos :: Maybe Int @@ -55,12 +61,17 @@ data SelectionSection a = SelectionSection , _ssDescriptor :: String } +data SMRegex = NoSMRegex + | SMRegex + { _smrString :: String + , _smrInput :: Bool + } + deriving (Show) data SelectionIntMap a = SelectionIntMap { _smItems :: [SelectionItem a] , _smSelPos :: Maybe Int - , _smRegex :: String - , _smRegexInput :: Bool + , _smRegex :: SMRegex , _smShownItems :: IntMap (SelectionItem a) } --deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -98,5 +109,7 @@ makeLenses ''SelectionIntMap makeLenses ''SelectionSection makeLenses ''SelectionSections makeLenses ''SectionCursor +makeLenses ''Regex +makeLenses ''SMRegex --deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 454cce5a1..e032aa912 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -68,13 +68,6 @@ data ScreenLayer { _scInput :: String , _scFooter :: String } --- | WaitScreen --- { _scWaitMessage :: Universe -> String --- , _scWaitTime :: Int --- } --- | DisplayScreen --- { _scDisplay :: Universe -> Picture --- } data MenuOptionDisplay = MODString {_modString :: String} diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 1f7897f38..2db6c41bb 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -1,4 +1,7 @@ -module Dodge.InputFocus where +module Dodge.InputFocus + ( inTermFocus + , inputFocus + ) where import Dodge.Data.SelectionList import Data.Maybe @@ -14,4 +17,4 @@ inTermFocus w = fromMaybe False $ do inputFocus :: World -> Bool inputFocus w = inTermFocus w - || (w ^? hud . hudElement . subInventory . subInvMap . smRegexInput) == Just True + || (w ^? hud . hudElement . subInventory . subInvMap . smRegex . smrInput) == Just True diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 4220521e9..b3b2d0dbb 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -16,7 +16,6 @@ module Dodge.Inventory ( updateTerminal, closeObjScrollDir, closeObjectCol, - changeInvSel, changeSwapInvSel, changeAugInvSel, crNumFreeSlots, @@ -322,19 +321,6 @@ closeObjScrollDir x | x < 0 = over (hud . closeObjects) rotD | otherwise = id -changeInvSel :: Int -> World -> World -changeInvSel i w - | i == 0 || n == 0 = w - | otherwise = w - & pointcrInvSel . isel . ispItem %~ (`mod` n) . subtract i - & pointcrInvSel . isel . iselAction .~ NoInvSelAction - & pointcrInvSel . isel . ispCloseObject %~ (`mod` numCO) . subtract i - where - -- arguably this should jump the invpos into the inventory proper - pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel - n = length $ w ^?! cWorld . lWorld . creatures . ix 0 . crInv - numCO = length $ w ^. hud . closeObjects - changeSwapInvSel :: Int -> World -> World changeSwapInvSel k w = case you w ^? crInvSel . isel of Just (SelItem i _) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 0c4b9ed90..60851fae2 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -60,7 +60,6 @@ defaultListDisplayParams = invDisplayParams :: World -> ListDisplayParams invDisplayParams w = defaultListDisplayParams - -- & ldpWidth .~ FixedSelectionWidth topInvW & ldpCursorType .~ BorderCursor selcursortype & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w) where @@ -106,13 +105,8 @@ 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 sl -> - let mi = _smSelPos sl - in titledSub' - cfig - "COMBINE" - sl - <> combineInventoryExtra sl mi cfig w + CombineInventory sl -> titledSub' cfig "COMBINE" sl + <> combineInventoryExtra sl (_smSelPos sl) cfig w titledSub :: Configuration -> String -> SelectionList a -> Picture titledSub cfig subtitle subitems = @@ -155,15 +149,13 @@ floorItemPickupInfo n itm | n >= ceiling (_itInvSize itm) = ", but you have space to pick it up." | otherwise = ", and you don't have space to pick it up." --- this should not produce Nothing, and the logic should be changed to reflect --- this +-- note the use of ^?! +-- it is probably desirable for this to crash hard for now yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a yourAugmentedItem f x g w = case you w ^? crInvSel . isel of Just (SelItem i _) -> f $ yourInv w ^?! ix i - Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix (i - n - 1) + Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i _ -> x - where - n = length $ yourInv w drawNoSubInventory :: Configuration -> World -> Picture drawNoSubInventory cfig w = @@ -193,36 +185,30 @@ drawNoSubInventory cfig w = f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture -examineInventoryExtra mtweaki mitm cfig = - pictures - [ fromMaybe mempty $ do - tweaki <- mtweaki - -- consider moving this functionality out into a tweaks module - tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki - return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15 - -- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) - ] +examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do + tweaki <- mtweaki + -- consider moving this functionality out into a tweaks module + tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki + return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15 + -- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) combineInventoryExtra :: SelectionIntMap CombinableItem -> Maybe Int -> Configuration -> World -> Picture -combineInventoryExtra sm mi cfig w = - pictures - [ fromMaybe mempty $ do - i <- mi - let cpos = getIthPos i (sm ^. smShownItems) - col <- sm ^? smShownItems . ix i . siColor - return $ - pictures - [ fromMaybe mempty $ do - strs <- sm ^? smShownItems . ix i . siPayload . ciInfo - return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs - , fromMaybe mempty $ do - lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs - return $ - lnkMidPosInvSelsCol cfig w cpos col lnks - <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks - <> combineCounts cfig w lnks - ] - ] +combineInventoryExtra sm mi cfig w = fromMaybe mempty $ do + i <- mi + let cpos = getIthPos i (sm ^. smShownItems) + col <- sm ^? smShownItems . ix i . siColor + return $ + pictures + [ fromMaybe mempty $ do + strs <- sm ^? smShownItems . ix i . siPayload . ciInfo + return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs + , fromMaybe mempty $ do + lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs + return $ + lnkMidPosInvSelsCol cfig w cpos col lnks + <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks + <> combineCounts cfig w lnks + ] secondColumnParams :: ListDisplayParams secondColumnParams = diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 22189b104..352e5cf06 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -8,7 +8,7 @@ import Dodge.Data.Universe --import qualified IntMapHelp as IM testStringInit :: Universe -> [String] testStringInit u = - [ show $ u ^. uvWorld . input . scrollTestValue + [ show $ u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex ] showTimeFlow :: TimeFlowStatus -> String diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 16b9777f3..639dd6f03 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -143,7 +143,8 @@ 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 SelectionIntMap {_smRegexInput=True}) -> doSubInvRegexInput u + Just (CombineInventory SelectionIntMap {_smRegex=smr}) + | smr ^? smrInput == Just 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 536900e9d..1fdbab261 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -46,17 +46,21 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks doSubInvRegexInput :: Universe -> Universe doSubInvRegexInput u - | endkeys || backspacetonothing || endmouse - = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False + | backspacetonothing + = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ const NoSMRegex & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos - | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex) + & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap + | endkeys || endmouse + = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . smrInput %~ const False + & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos + | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex. smrString) & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap where 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 "" + backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . smrString == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys @@ -100,14 +104,19 @@ updateKeyInGame uv sc InitialPress = case sc of -- the following should be put in a more sensible place --ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv ScancodeSlash -> uv - & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True + & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enterregex & uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0 ScancodeBackspace -> uv - & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True + & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enternonzeroregex & uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0 -- in fact the whole logic should probably be rethought, oh well _ -> uv + where + enterregex NoSMRegex = SMRegex "" True + enterregex (SMRegex str _) = SMRegex str True + enternonzeroregex (SMRegex (x:xs) _) = SMRegex (init (x:xs)) True + enternonzeroregex smr = smr updateKeyInGame uv sc LongPress = case sc of ScancodeF -> over uvWorld youDropItem uv ScancodeSpace -> over uvWorld spaceAction uv diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 159a004bb..85b639cf4 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -35,14 +35,15 @@ updateWheelEvent yi w = case w ^. hud . hudElement of | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w DisplayInventory {_subInventory = ExamineInventory mi} | invKeyDown && rbDown -> w & moveTweakSel yi - | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w + | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w | rbDown -> w & changeTweakParam mi yi | otherwise -> w & moveTweakSel yi - DisplayInventory {_subInventory = CombineInventory SelectionIntMap {_smRegexInput = False}} - -> w & moveCombineSel yi + DisplayInventory {_subInventory = CombineInventory sm} + | regexnotinput $ _smRegex sm -> w & moveCombineSel yi DisplayInventory {_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w _ -> w where + regexnotinput smr = not $ smr ^? smrInput == Just True y = fromIntegral yi numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1 rbDown = ButtonRight `M.member` _mouseButtons (_input w) diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index e1791d4e7..abd3f73cf 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -30,10 +30,11 @@ updateUsingInput w = case w ^. hud . hudElement of pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World pressedMBEffects subinv pkeys w = case subinv of NoSubInventory -> pressedMBEffectsNoInventory pkeys w - CombineInventory SelectionIntMap{_smSelPos = mi, _smRegexInput = False} - | lbinitialpress -> maybeexitcombine (maybe id doCombine mi w) - CombineInventory SelectionIntMap{_smRegexInput = True} - | lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False + CombineInventory SelectionIntMap{_smSelPos = mi, _smRegex = smr} + | lbinitialpress && regexnotinput smr -> maybeexitcombine (maybe id doCombine mi w) + CombineInventory SelectionIntMap{} + | lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegex. smrInput + %~ const False DisplayTerminal tmid | lbinitialpress && inTermFocus w -> doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w @@ -41,6 +42,7 @@ pressedMBEffects subinv pkeys w = case subinv of w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True _ -> w where + regexnotinput smr = not $ smr ^? smrInput == Just True lbinitialpress = pkeys ^? ix ButtonLeft == Just False maybeexitcombine w' | ButtonRight `M.member` _mouseButtons (_input w) = diff --git a/src/SelectionIntMap.hs b/src/SelectionIntMap.hs index 5e0799d41..bfe0a024f 100644 --- a/src/SelectionIntMap.hs +++ b/src/SelectionIntMap.hs @@ -10,8 +10,8 @@ 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 + NoSMRegex -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms) + SMRegex str _ -> sm & smShownItems .~ IM.fromAscList (zip [0..] (f str : filter (regexList str . _siPictures) allitms)) where allitms = sm ^. smItems @@ -55,6 +55,3 @@ getIthYOffset :: Float -> Float -> SelectionIntMap a -> Int -> Float getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1) where yint = getIthPos i (sm ^. smShownItems) - ---selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a ---selectionSectionsToIntMap ss = undefined