Allow filtering of combinations with mouse click on inventory
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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 ())
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user