justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow scrolling within a larger selection to not remove larger selection

Browse Source
This commit is contained in:
justin
2024-11-25 17:20:09 +00:00
parent 83bcf3c0f7
commit 669f9667f1
16 changed files with 233 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+51 -31
View File
@@ -97,7 +97,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDrag k mmouseover ab bn -> fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelectionExtra
is <- w ^? hud . hudElement . diSelection . _Just . _3
return $ if concurrentIS is
then shiftInvItems k x ab bn is ss w
else collectInvItems k is w
@@ -109,8 +109,8 @@ tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World
tryDropSelected mpos w = do
guard $ maybe True (\(i,_) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
(0, _, xs) <- w ^? hud . hudElement . diSelection . _Just
-- xs <- w ^? hud . hudElement . diSelection . _Just . _3
return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
tryPickupSelected :: Int -> Maybe (Int,Int) -> World -> Maybe World
@@ -119,17 +119,16 @@ tryPickupSelected k mpos w = do
guard $ maybe True (\(i,_) -> i == 0) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
let nfreeslots = crNumFreeSlots cr
xs <- w ^? hud . hudElement . diSelectionExtra
xs <- w ^? hud . hudElement . diSelection . _Just . _3
let itmstopickup = mapMaybe g $ IS.toList xs
let slotsneeded = alaf Sum foldMap (_itInvSize . _flIt) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Nothing -> foldl' (flip $ pickUpItem 0) w itmstopickup
& hud . hudElement . diSelectionExtra .~ mempty
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
Just (_,j) -> foldr (pickUpItemAt j 0) w itmstopickup
& hud . hudElement . diSelection ?~ (0,j)
& hud . hudElement . diSelectionExtra
.~ IS.fromDistinctAscList [j..j+IS.size xs-1]
& hud . hudElement . diSelection ?~ (0,j
, IS.fromDistinctAscList [j..j+IS.size xs-1])
where
g i = do
NInt j <- w ^? hud . closeItems . ix i
@@ -142,14 +141,15 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect _ Nothing ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelectionExtra .~ mempty
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
OverInvDragSelect ssel (Just esel) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelectionExtra
.~ h ssel (snd esel) -- IM.keysSet [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
& augInvDirectSelect (min ssel esel)
-- & hud . hudElement . diSelectionExtra
-- .~ h ssel (snd esel) -- IM.keysSet [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
& augInvDirectSelect (f (min ssel esel) (h ssel (snd esel)))
_ -> w
where
f (x,y) z = (x,y,z)
h (k,i) j = fold $ do
sss <- w ^? hud . hudElement . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
@@ -170,7 +170,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
w
& hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
OverCombSelect x ->
w & hud . hudElement . subInventory . ciSelection ?~ x
w & hud . hudElement . subInventory . ciSelection ?~ f x
& worldEventFlags . at CombineInventoryChange ?~ ()
OverCombFilter ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing
@@ -202,18 +202,20 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
where
ldp = invDisplayParams w
mpos = w ^. input . mousePos
f (x,y) = (x,y,mempty)
startDrag :: (Int, Int) -> Configuration -> World -> World
startDrag (a, b) cfig w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
(i, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
startDrag (a, b) cfig w = setcontext . fromMaybe (augInvDirectSelect (a, b, IS.singleton b) w) $ do
(i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
guard $ i == a && b `IS.member` xs
return $ setmichosen xs w
--return $ setmichosen xs w
return w
where
setmichosen :: IS.IntSet -> World -> World
setmichosen x =
(input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
. (hud . hudElement . diSelectionExtra .~ IS.insert b x)
-- setmichosen :: IS.IntSet -> World -> World
-- setmichosen x =
-- (input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
-- . (hud . hudElement . diSelectionExtra .~ IS.insert b x)
setcontext = (input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
above :: Maybe (Int,Int)
above = do
sss <- w ^? hud . hudElement . diSections
@@ -223,6 +225,25 @@ startDrag (a, b) cfig w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mem
sss <- w ^? hud . hudElement . diSections
inverseSelSecYint (yint + 1) sss
yint = posSelSecYint cfig (invDisplayParams w) (w ^. input . mousePos . _y)
--startDrag (a, b) cfig w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
-- (i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
---- xs <- w ^? hud . hudElement . diSelectionExtra
-- guard $ i == a && b `IS.member` xs
-- return $ setmichosen xs w
-- where
-- setmichosen :: IS.IntSet -> World -> World
-- setmichosen x =
-- (input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
-- . (hud . hudElement . diSelectionExtra .~ IS.insert b x)
-- above :: Maybe (Int,Int)
-- above = do
-- sss <- w ^? hud . hudElement . diSections
-- inverseSelSecYint (yint - 1) sss
-- bneath :: Maybe (Int,Int)
-- bneath = do
-- sss <- w ^? hud . hudElement . diSections
-- inverseSelSecYint (yint + 1) sss
-- yint = posSelSecYint cfig (invDisplayParams w) (w ^. input . mousePos . _y)
concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView
@@ -367,9 +388,9 @@ doRegexInput ::
Input ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int, IS.IntSet) ->
Maybe String ->
(IM.IntMap (SelectionSection a), Maybe (Int, Int), Maybe String)
(IM.IntMap (SelectionSection a), Maybe (Int, Int, IS.IntSet), Maybe String)
doRegexInput inp i sss msel filts
| backspacetonothing || escapekey = endregex i 0
| endkeys = endregex (i + 1) (j -1)
@@ -420,21 +441,21 @@ updateBackspaceRegex w = case di ^? subInventory of
return $ case str of
(_ : _) ->
he & diInvFilter . _Just %~ init
& diSelection ?~ (x, 0)
& diSelection ?~ (x, 0,mempty)
[] -> he & diInvFilter .~ Nothing
trybackspace'' x he = fromMaybe he $ do
str <- he ^? diCloseFilter . _Just
return $ case str of
(_ : _) ->
he & diCloseFilter . _Just %~ init
& diSelection ?~ (x, 0)
& diSelection ?~ (x, 0,mempty)
[] -> he & diCloseFilter .~ Nothing
trybackspace' x ci = fromMaybe ci $ do
str <- ci ^? ciFilter . _Just
return $ case str of
(_ : _) ->
ci & ciFilter . _Just %~ init
& ciSelection ?~ (x, 0)
& ciSelection ?~ (x, 0,mempty)
[] -> ci & ciFilter .~ Nothing
di = w ^. hud . hudElement
@@ -442,15 +463,15 @@ updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{}
| secfocus [-1,0,1] ->
w & hud . hudElement . diSelection ?~ (-1, 0)
w & hud . hudElement . diSelection ?~ (-1, 0,mempty)
& hud . hudElement . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2,3] ->
w & hud . hudElement . diSelection ?~ (2, 0)
w & hud . hudElement . diSelection ?~ (2, 0,mempty)
& hud . hudElement . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciFilter %~ enterregex
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0)
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0,mempty)
_ -> w
where
di = w ^. hud . hudElement
@@ -486,7 +507,7 @@ selCloseObj :: World -> Maybe (Either FloorItem Button)
selCloseObj w = selobj <|> firstcitem <|> firstcbut
where
selobj = do
(i,j) <- w ^? hud . hudElement . diSelection . _Just
(i,j,_) <- w ^? hud . hudElement . diSelection . _Just
case i of
3 -> do
NInt k <- w ^? hud . closeItems . ix j
@@ -511,7 +532,6 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
{ _subInventory = NoSubInventory
, _diSections = mempty
, _diSelection = Nothing
, _diSelectionExtra = mempty
, _diInvFilter = mempty
, _diCloseFilter = mempty
}