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/Data/HUD.hs
+4 -3
View File
@@ -5,6 +5,7 @@
module Dodge.Data.HUD where
import qualified Data.IntSet as IS
import Dodge.Data.Item.Location
import NewInt
import Control.Lens
@@ -18,10 +19,10 @@ data HUDElement
= DisplayInventory
{ _subInventory :: SubInventory
, _diSections :: IMSS ()
, _diSelection :: Maybe (Int, Int)
, _diSelection :: Maybe (Int, Int, IntSet)
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _diSelectionExtra :: IntSet -- this should probably be placed within _diSelection
-- , _diSelectionExtra :: IntSet -- this should probably be placed within _diSelection
-- would lead to inconsistency with _ciSelection
}
| DisplayCarte
@@ -39,7 +40,7 @@ data SubInventory
ExamineInventory
| CombineInventory
{ _ciSections :: IntMap (SelectionSection CombinableItem)
, _ciSelection :: Maybe (Int, Int)
, _ciSelection :: Maybe (Int, Int, IS.IntSet)
, _ciFilter :: Maybe String
}
| LockedInventory
src/Dodge/Default/World.hs
+2 -2
View File
@@ -165,8 +165,8 @@ defaultDisplayInventory =
DisplayInventory
{ _subInventory = NoSubInventory
, _diSections = mempty
, _diSelection = Just (1, 0)
, _diSelectionExtra = mempty
, _diSelection = Just (1, 0, mempty)
-- , _diSelectionExtra = mempty
, _diInvFilter = mempty
, _diCloseFilter = mempty
}
src/Dodge/DisplayInventory.hs
+7 -7
View File
@@ -52,7 +52,7 @@ updateCombineSections w cfig =
updateSectionsPositioning
(const 5)
(const 0)
(w ^? hud . hudElement . subInventory . ciSelection . _Just)
(fmap (\(x,y,_) -> (x,y)) $ w ^? hud . hudElement . subInventory . ciSelection . _Just)
(getAvailableListLines secondColumnParams cfig)
[(0, sclose), (-1, sfclose)]
where
@@ -93,7 +93,7 @@ updateInventoryPositioning u =
-- this is possibly not completely correct
checkInventorySelectionExists :: Universe -> Universe
checkInventorySelectionExists u = fromMaybe u $ do
(i, j) <- (u ^? uvWorld . hud . hudElement . diSelection . _Just) <|> Just (0, -1)
(i, j,_) <- (u ^? uvWorld . hud . hudElement . diSelection . _Just) <|> Just (0, -1, mempty)
Just $ case u ^? uvWorld . hud . hudElement . diSections . ix i . ssItems . ix j of
Nothing -> u & uvWorld %~ scrollAugNextInSection
_ -> u
@@ -101,12 +101,12 @@ checkInventorySelectionExists u = fromMaybe u $ do
checkCombineSelectionExists :: Universe -> Universe
checkCombineSelectionExists u = fromMaybe u $ do
sss <- u ^? uvWorld . hud . hudElement . subInventory . ciSections
(i, j) <-
(i, j, _) <-
u ^? uvWorld . hud . hudElement . subInventory . ciSelection . _Just
<|> Just (0, 0)
<|> Just (0, 0, mempty)
Just $ case u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix i . ssItems . ix j of
Nothing ->
u & uvWorld . hud . hudElement . subInventory . ciSelection ?~ (0, -1)
u & uvWorld . hud . hudElement . subInventory . ciSelection ?~ (0, -1,mempty)
& uvWorld . hud . hudElement . subInventory . ciSelection
%~ scrollSelectionSections (-1) sss
_ -> u
@@ -137,7 +137,7 @@ updateDisplaySections w cfig =
[statushead,statusdisplay,invhead,invx,youx, nearbyhead, closex
,interfaceshead,interfaces]
where
mselpos = w ^? hud . hudElement . diSelection . _Just
mselpos = fmap (\(x,y,_) -> (x,y)) $ w ^? hud . hudElement . diSelection . _Just
invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
(sfinv, sinv) =
filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
@@ -356,7 +356,7 @@ enterCombineInv cfig w =
| otherwise = cm'
selpos
| null cm' = Nothing
| otherwise = Just (0, 0)
| otherwise = Just (0, 0,mempty)
filtsection =
SelectionSection
{ _ssItems = mempty
src/Dodge/InputFocus.hs
+5 -5
View File
@@ -59,12 +59,12 @@ inputFocus ::
World ->
Maybe ((String -> f String) -> World -> f World)
inputFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{} -> case he ^? diSelection . _Just of
Just (-1, _) -> Just $ hud . hudElement . diInvFilter . _Just
Just (2, _) -> Just $ hud . hudElement . diCloseFilter . _Just
Just NoSubInventory{} -> case he ^? diSelection . _Just . _1 of
Just (-1) -> Just $ hud . hudElement . diInvFilter . _Just
Just 2 -> Just $ hud . hudElement . diCloseFilter . _Just
_ -> Nothing
Just CombineInventory{} -> case he ^? subInventory . ciSelection . _Just of
Just (-1, _) -> Just $ hud . hudElement . subInventory . ciFilter . _Just
Just CombineInventory{} -> case he ^? subInventory . ciSelection . _Just . _1 of
Just (-1) -> Just $ hud . hudElement . subInventory . ciFilter . _Just
_ -> Nothing
Just DisplayTerminal{_termID = tmid} -> do
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
src/Dodge/Inventory.hs
+8 -7
View File
@@ -16,6 +16,7 @@ module Dodge.Inventory (
swapItemWith,
) where
import qualified Data.IntSet as IS
import Dodge.Inventory.Swap
import Data.Function
import Data.Maybe
@@ -78,7 +79,7 @@ rmInvItem cid invid w =
where
pointcid = cWorld . lWorld . creatures . ix cid
updateselectionextra
| cid == 0 = hud . hudElement . diSelectionExtra .~ mempty
| cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ const mempty
| otherwise = id
updateselection
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
@@ -183,15 +184,15 @@ swapItemWith f (j, i) w = case j of
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
Just (0, i) -> w & swapInvItems f i
Just (3, i) -> w & changeSwapOther ispCloseItem 3 f i
Just (5, i) -> w & changeSwapOther ispCloseButton 5 f i
Just (0, i, _) -> w & swapInvItems f i
Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
_ -> w
augInvDirectSelect :: (Int, Int) -> World -> World
augInvDirectSelect (i, j) w =
augInvDirectSelect :: (Int, Int, IS.IntSet) -> World -> World
augInvDirectSelect sel w =
w
& hud . hudElement . diSelection ?~ (i, j)
& hud . hudElement . diSelection ?~ sel
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
src/Dodge/Inventory/Add.hs
+2 -1
View File
@@ -59,7 +59,8 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
& cWorld . lWorld %~ crUpdateItemLocations cid
)
where
updateselectionextra | cid == 0 = hud . hudElement . diSelectionExtra .~ mempty
updateselectionextra | cid == 0
= hud . hudElement . diSelection . _Just . _3 %~ const mempty
| otherwise = id
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
src/Dodge/Inventory/Location.hs
+1 -1
View File
@@ -83,7 +83,7 @@ setInvPosFromSS w =
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where
thesel = fromMaybe SelNothing $ do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
case i of
(-1) -> Just SortInventory
0 -> do
src/Dodge/Inventory/Swap.hs
+4 -4
View File
@@ -27,8 +27,8 @@ swapInvItems f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
k <- f i ss
let updateselection = case w ^? hud . hudElement . diSelection . _Just of
Just (0, j) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
Just (0, j,_) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
Just (0, j,_) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
_ -> id
return $
w
@@ -71,11 +71,11 @@ swapInvItems f i w = fromMaybe w $ do
swapAnyExtraSelection :: Int -> Int -> World -> World
swapAnyExtraSelection i k w = fromMaybe w $ do
is <- w ^? hud . hudElement . diSelectionExtra
is <- w ^? hud . hudElement . diSelection . _Just . _3
let f = if i `IS.member` is then IS.insert k else id
g = if k `IS.member` is then IS.insert i else id
return $
w & hud . hudElement . diSelectionExtra
w & hud . hudElement . diSelection . _Just . _3
%~ (f . g . IS.delete i . IS.delete k)
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
src/Dodge/Render/HUD.hs
+8 -6
View File
@@ -54,11 +54,12 @@ drawHUD cfig w = case w ^. hud . hudElement of
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig =
drawSelectionSections sss ldp cfig
<> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
<> drawRootCursor w sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
<> drawSSCursor sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
<> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp cfig
<> iextra
<> drawMouseOver cfig w
where
f = fmap (\(x,y,_) -> (x,y))
ldp = invDisplayParams w
curs = invCursorParams w
iextra = fromMaybe mempty $ do
@@ -129,9 +130,9 @@ drawMouseOver cfig w =
drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
ys <- w ^? hud . hudElement . diSelectionExtra
ys <- w ^? hud . hudElement . diSelection . _Just . _3
guard $ not (IS.null ys)
(i, _) <- w ^? hud . hudElement . diSelection . _Just
(i, _, _) <- w ^? hud . hudElement . diSelection . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
let f x = (selSecDrawCursorAt 15 idp BackdropCursor sss (i, x) <>)
@@ -173,7 +174,8 @@ drawCombineInventory cfig sss w =
<> combineInventoryExtra sss msel cfig w
where
curs = BoundaryCursor [North, South, West]
msel = w ^? hud . hudElement . subInventory . ciSelection . _Just
msel = fmap (\(x,y,_) -> (x,y))
$ w ^? hud . hudElement . subInventory . ciSelection . _Just
drawExamineInventory :: Configuration -> World -> Picture
drawExamineInventory cfig w =
@@ -238,7 +240,7 @@ drawRBOptions cfig w = fromMaybe mempty $ do
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w
sss <- w ^? hud . hudElement . diSections
(i', j) <- w ^? hud . hudElement . diSelection . _Just
(i', j,_) <- w ^? hud . hudElement . diSelection . _Just
curpos <- selSecYint i' j sss
let ytext = drawListElement 0 1 0 curpos . text
midstr = equipAllocString ae
src/Dodge/SelectionSections.hs
+22 -13
View File
@@ -10,6 +10,7 @@ module Dodge.SelectionSections (
inverseSelNumPos,
) where
import qualified Data.IntSet as IS
import Control.Applicative
import qualified Control.Foldl as L
import Control.Lens
@@ -25,8 +26,8 @@ import Geometry.Data
scrollSelectionSections ::
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
Maybe (Int, Int,IS.IntSet) ->
Maybe (Int, Int,IS.IntSet)
scrollSelectionSections yi sss msel
| yi == 0 = msel
| yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
@@ -34,8 +35,8 @@ scrollSelectionSections yi sss msel
nextInSectionSS ::
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
nextInSectionSS = ssScrollUsing ssLookupNextMax
--setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
@@ -46,8 +47,8 @@ nextInSectionSS = ssScrollUsing ssLookupNextMax
ssScrollUsing ::
(Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
ssScrollUsing g =
ssScrollMinOnFail
g
@@ -56,22 +57,30 @@ ssScrollUsing g =
ssScrollMinOnFail ::
(Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j, q i j)) $ l <|> ssLookupMin sss
where
q i j = fromMaybe mempty $ do
(k,_,xs) <- msel ^? _Just
guard $ j `IS.member` xs && i == k
return xs
l = do
(i, j) <- msel
(i, j, _) <- msel
f i j sss
ssSetCursor ::
(IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
ssSetCursor f sss msel = fromMaybe msel $ do
(i, j, _) <- f sss
return $ Just (i, j)
let newxs = fromMaybe mempty $ do
(k,_,xs) <- msel
guard $ k == i && j `IS.member` xs
return xs
return $ Just (i, j,newxs)
ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
src/Dodge/TestString.hs
-1
View File
@@ -24,7 +24,6 @@ testStringInit :: Universe -> [String]
testStringInit u =
[ show $ u ^? uvWorld . input . mouseContext . mcoSelEnd
, show $ u ^? uvWorld . hud . hudElement . diSelection
, show $ u ^? uvWorld . hud . hudElement . diSelectionExtra
]
-- , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
-- <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
src/Dodge/Update.hs
+2 -1
View File
@@ -360,7 +360,8 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
return $ OverInvSelect selpos
overcomb = do
sss <- w ^? hud . hudElement . subInventory . ciSections
msel <- w ^? hud . hudElement . subInventory . ciSelection . _Just
(xl,xr,_) <- w ^? hud . hudElement . subInventory . ciSelection . _Just
let msel = (xl,xr)
let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
return $ case mpossel of
Nothing -> OverCombEscape
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
}
src/Dodge/Update/Scroll.hs
+2 -2
View File
@@ -33,8 +33,8 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
NoRightButtonOptions -> w
| bdown ButtonLeft -> w & wCam . camZoom +~ y
| invKeyDown -> changeSwapSel yi $ w & hud . hudElement . diSelectionExtra .~ mempty
| otherwise -> scrollAugInvSel yi $ w & hud . hudElement . diSelectionExtra .~ mempty
| invKeyDown -> changeSwapSel yi $ w-- & hud . hudElement . diSelectionExtra .~ mempty
| otherwise -> scrollAugInvSel yi $ w-- & hud . hudElement . diSelectionExtra .~ mempty
DisplayInventory{_subInventory = ExamineInventory}
| invKeyDown -> scrollAugInvSel yi w
| otherwise -> w