Allow filtering of combinations with mouse click on inventory

This commit is contained in:
2024-11-04 00:07:37 +00:00
parent adca54c1ef
commit fafef1275b
11 changed files with 125 additions and 80 deletions
+1 -1
View File
@@ -21,6 +21,7 @@ data HUDElement
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _diSelectionExtra :: Int
, _diMouseOver :: Maybe (Int, Int)
}
| DisplayCarte
@@ -33,7 +34,6 @@ data MouseInventorySelection
data SubInventory
= NoSubInventory
{ _nsSelected :: MouseInventorySelection
, _nsMouseOver :: Maybe (Int, Int)
}
| ExamineInventory
| CombineInventory
+1 -1
View File
@@ -162,13 +162,13 @@ defaultDisplayInventory =
DisplayInventory
{ _subInventory = NoSubInventory
{_nsSelected = MouseInvNothing
, _nsMouseOver = Just (0,3)
}
, _diSections = defaultInvSections
, _diSelection = Just (1,0)
, _diSelectionExtra = 0
, _diInvFilter = mempty
, _diCloseFilter = mempty
, _diMouseOver = Nothing
}
defaultInvSections :: IM.IntMap (SelectionSection ())
+26 -7
View File
@@ -5,10 +5,10 @@ module Dodge.DisplayInventory (
updateCombinePositioning,
) where
import Data.Bifunctor
import Dodge.Inventory
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Base.You
@@ -18,10 +18,12 @@ import Dodge.Data.Config
import Dodge.Data.DoubleTree
import Dodge.Data.SelectionList
import Dodge.Data.Universe
import Dodge.Inventory
import Dodge.Inventory.SelectionList
import Dodge.Item.Grammar
import Dodge.ListDisplayParams
import Dodge.SelectionList
import Dodge.SelectionSections
import ListHelp
import Picture.Base
@@ -29,13 +31,14 @@ toggleCombineInv :: Universe -> Universe
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} ->
uv & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
.~ NoSubInventory MouseInvNothing
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
updateCombinePositioning :: Universe -> Universe
updateCombinePositioning u =
u & uvWorld . hud . hudElement . subInventory . ciSections
%~ updateCombineSections (_uvWorld u) (_uvConfig u)
& checkCombineSelectionExists
updateCombineSections ::
World ->
@@ -87,11 +90,24 @@ updateInventoryPositioning u =
-- this is possibly not completely correct
checkInventorySelectionExists :: Universe -> Universe
checkInventorySelectionExists u = fromMaybe u $ do
(i,j) <- u ^? uvWorld . hud . hudElement . diSelection . _Just
(i, j) <- (u ^? uvWorld . hud . hudElement . diSelection . _Just) <|> Just (0, -1)
Just $ case u ^? uvWorld . hud . hudElement . diSections . ix i . ssItems . ix j of
Nothing -> u & uvWorld %~ scrollAugNextInSection
_ -> u
checkCombineSelectionExists :: Universe -> Universe
checkCombineSelectionExists u = fromMaybe u $ do
sss <- u ^? uvWorld . hud . hudElement . subInventory . ciSections
(i, j) <-
u ^? uvWorld . hud . hudElement . subInventory . ciSelection . _Just
<|> Just (0, 0)
Just $ case u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix i . ssItems . ix j of
Nothing ->
u & uvWorld . hud . hudElement . subInventory . ciSelection ?~ (0,-1)
& uvWorld . hud . hudElement . subInventory . ciSelection
%~ scrollSelectionSections (-1) sss
_ -> u
updateDisplaySections ::
World ->
Configuration ->
@@ -137,9 +153,10 @@ updateDisplaySections w cfig =
(fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr)
-- this clearly deserves refactoring, also check if drawInventory/iextra
-- needs it at the same time
removeindentiffiltering = if maybe False isFilteringInv (w ^? hud . hudElement . diSections)
then const 0
else id
removeindentiffiltering =
if maybe False isFilteringInv (w ^? hud . hudElement . diSections)
then const 0
else id
cr = you w
filterSectionsPair ::
@@ -275,6 +292,8 @@ enterCombineInv cfig w =
sss
selpos
Nothing
& hud . hudElement . diInvFilter
.~ Nothing
where
cm' = IM.fromDistinctAscList . zip [0 ..] $ combineList w
cm
+1 -1
View File
@@ -105,7 +105,7 @@ getRootItemBounds i inv = do
drawDIMouseOver :: World -> Picture
drawDIMouseOver w = fromMaybe mempty $ do
(j, i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
(j, i) <- w ^? hud . hudElement . diMouseOver . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
+7 -3
View File
@@ -3,6 +3,7 @@ module Dodge.SelectionSections (
nextInSectionSS,
ssLookupDown,
ssLookupGT,
ssTryLookup,
ssSetCursor,
-- setFirstPosSelectionSections,
selSecYint,
@@ -77,6 +78,12 @@ ssSetCursor f sss msel = fromMaybe msel $ do
(i, j, _) <- f sss
return $ Just (i, j)
ssTryLookup :: Maybe (Int,Int) -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssTryLookup msel sss = fromMaybe (ssLookupMin sss) $ do
(i,j) <- msel
itm <- sss ^? ix i . ssItems . ix j
return $ Just (i,j,itm)
ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
(i, _) <- IM.lookupMax sss
@@ -193,8 +200,6 @@ selSecYint i j sss = do
where
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i sss
-- it is annoying that Control.Foldl doesn't seem to allow for scans to be done
-- at the same time as folds
inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int)
inverseSelSecYint yint sss = do
((i, ss), othersss) <- IM.minViewWithKey sss
@@ -203,7 +208,6 @@ inverseSelSecYint yint sss = do
then inverseSelSecYint (yint - l) othersss
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
--j <- L.fold (L.findIndex (\x -> x - _ssOffset ss > yint)) ls
(j,_) <- L.fold (L.find (\(_,x) -> x - _ssOffset ss > yint)) $ IM.toList ls
return (i, j)
+1 -1
View File
@@ -223,7 +223,7 @@ disconnectTerminal tm =
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
.~ NoSubInventory MouseInvNothing
_ -> w
damageCodeCommand :: TerminalCommand
+1 -1
View File
@@ -23,7 +23,7 @@ import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSelection . _Just
, show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
, show $ u ^? uvWorld . hud . hudElement . subInventory . nsMouseOver . _Just
, show $ u ^? uvWorld . hud . hudElement . diMouseOver . _Just
, show $ fmap fst $ IM.lookupMin =<< (u ^? uvWorld . hud . hudElement . diSections . ix 0 . ssItems)
-- , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
]
+2 -2
View File
@@ -294,7 +294,7 @@ checkTermDist w = fromMaybe w $ do
guard $ dist btpos (_crPos $ you w) > 40
return $
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
.~ NoSubInventory MouseInvNothing
updateMouseInventorySelection :: Configuration -> World -> World
updateMouseInventorySelection cfig w = fromMaybe w $ do
@@ -382,7 +382,7 @@ updateMouseOverInventory :: Configuration -> World -> World
updateMouseOverInventory cfig w = fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
return $
w & hud . hudElement . subInventory . nsMouseOver
w & hud . hudElement . diMouseOver
.~ inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
where
ldp = invDisplayParams w
+48 -27
View File
@@ -2,7 +2,7 @@ module Dodge.Update.Input.InGame (
updateUseInputInGame,
) where
import Dodge.SoundLogic
import Control.Monad
import Control.Applicative
import qualified Data.IntMap.Strict as IM
import Data.List (sort)
@@ -23,6 +23,7 @@ import Dodge.Inventory.Add
import Dodge.Menu
import Dodge.Save
import Dodge.SelectionSections
import Dodge.SoundLogic
import Dodge.Terminal.LeftButton
import Dodge.Update.Input.Text
import Dodge.WorldPos
@@ -40,16 +41,13 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
| inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
| lbinitialpress ->
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
CombineInventory{_ciSections = sss, _ciSelection = msel}
CombineInventory{_ciSections = sss, _ciSelection = msel}
| lbinitialpress -> u & uvWorld %~ updateCombineInvClick msel sss
| inSubInvRegex (u ^. uvWorld) ->
u
& uvWorld . hud . hudElement . subInventory
%~ docombineregexinput
%~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
| lbinitialpress ->
(uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
over uvWorld (tryCombine sss msel) u
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_
| inInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement %~ dodisplayregexinput (-1)
@@ -67,15 +65,6 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
w = u ^. uvWorld
pkeys = u ^. uvWorld . input . pressedKeys
lbinitialpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft == Just 0
docombineregexinput ci = fromMaybe ci $ do
sss <- ci ^? ciSections
msel <- ci ^? ciSelection
filts <- ci ^? ciFilter
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
return $
ci & ciSections .~ sss'
& ciSelection .~ msel'
& ciFilter .~ filts'
dodisplayregexinput x di = fromMaybe di $ do
sss <- di ^? diSections
msel <- di ^? diSelection
@@ -94,6 +83,37 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
di & diSections .~ sss'
& diSelection .~ msel'
& diCloseFilter .~ filts'
docombineregexinput sss msel ci = fromMaybe ci $ do
filts <- ci ^? ciFilter
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
return $
ci & ciSections .~ sss'
& ciSelection .~ msel'
& ciFilter .~ filts'
updateCombineInvClick ::
Maybe (Int, Int) ->
IM.IntMap (SelectionSection CombinableItem) ->
World ->
World
updateCombineInvClick msel sss w = fromMaybe trydocombination $ do
(i,j) <- w ^? hud . hudElement . diMouseOver . _Just
guard $ i == 0
str <- fmap (take 5) $ w ^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $ case w ^? hud . hudElement . subInventory . ciFilter . _Just of
Just (_:xs) | str == xs -> w
& hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
where
trydocombination =
(worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
tryCombine sss msel w
& worldEventFlags . at CombineInventoryChange ?~ ()
--checkCombineSelectionExists :: SubInventory -> SubInventory
--checkCombineSelectionExists x@CombineInventory{_ciSections=sss,_ciSelection=msel}
-- = x & ciSelection %~ ssSetCursor (ssTryLookup msel) sss
--checkCombineSelectionExists x = x
updatePressedButtonsCarte :: World -> World
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
@@ -276,11 +296,11 @@ spaceAction w = case w ^. hud . hudElement of
_ -> w
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
.~ NoSubInventory MouseInvNothing
& worldEventFlags . at InventoryChange ?~ ()
_ ->
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
.~ NoSubInventory MouseInvNothing
where
theLoc =
doWorldPos
@@ -292,13 +312,14 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
DisplayCarte ->
u & uvWorld . hud . hudElement
.~ DisplayInventory
{ _subInventory = NoSubInventory MouseInvNothing Nothing
{ _subInventory = NoSubInventory MouseInvNothing
, _diSections = defaultInvSections
, _diSelection = Nothing
, _diSelectionExtra = 0
-- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
, _diInvFilter = mempty
, -- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
_diInvFilter = mempty
, _diCloseFilter = mempty
, _diMouseOver = Nothing
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
@@ -306,7 +327,7 @@ toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} ->
w
& thepointer .~ NoSubInventory MouseInvNothing Nothing
& thepointer .~ NoSubInventory MouseInvNothing
_ -> w & thepointer .~ ExamineInventory -- mi
where
thepointer = hud . hudElement . subInventory
@@ -325,9 +346,9 @@ tryCombine sss msel w = fromMaybe w $ do
& cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
& soundStart InventorySound p wrench1S Nothing
maybeExitCombine :: Universe -> Universe
maybeExitCombine u
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
maybeExitCombine :: World -> World
maybeExitCombine w
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
| otherwise =
u & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing