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

Change selection set to work for multiple sections

Browse Source
This commit is contained in:
justin
2026-05-13 11:18:52 +01:00
parent e4bd971017
commit 91480c957d
14 changed files with 372 additions and 299 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
+1 -2
View File
@@ -4,7 +4,6 @@
module Dodge.Data.HUD where
import Control.Lens
import qualified Data.IntSet as IS
import Dodge.Data.Combine
import Dodge.Data.Item.Location
import Dodge.Data.SelectionList
@@ -36,7 +35,7 @@ data HUD = HUD
, _closeButtons :: [Int]
}
data Selection = Sel {_slSec :: Int, _slInt :: Int, _slSet :: IS.IntSet}
data Selection = Sel {_slSec :: Int, _slInt :: Int}
makeLenses ''HUD
makeLenses ''Selection
src/Dodge/Default/World.hs
+1 -1
View File
@@ -177,7 +177,7 @@ defaultHUD =
HUD
{ _subInventory = NoSubInventory
, _diSections = mempty
, _diSelection = Just (Sel 1 0 mempty)
, _diSelection = Just (Sel 1 0)
, _diInvFilter = mempty
, _diCloseFilter = mempty
, _closeItems = mempty
src/Dodge/DisplayInventory.hs
+15 -17
View File
@@ -10,6 +10,7 @@ module Dodge.DisplayInventory (
toggleCombineInv,
) where
import qualified Data.IntSet as IS
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -95,16 +96,15 @@ checkInventorySelectionExists w
| isJust $ w ^? hud . diSections . ix i . ssItems . ix j = w
| otherwise = scrollAugNextInSection w
where
Sel i j _ = fromMaybe (Sel 1 (-1) mempty) $ w ^? hud . diSelection . _Just
Sel i j = fromMaybe (Sel 1 (-1)) $ w ^? hud . diSelection . _Just
checkCombineSelectionExists :: SubInventory -> SubInventory
checkCombineSelectionExists si
| Just sss <- si ^? ciSections
, Sel i j _ <- fromMaybe (Sel 0 0 mempty) $ si ^? ciSelection . _Just
, Sel i j <- fromMaybe (Sel 0 0) $ si ^? ciSelection . _Just
, isNothing $ si ^? ciSections . ix i . ssItems . ix j =
si & ciSelection ?~ Sel 0 (-1) mempty
& ciSelection
%~ scrollSelectionSections (-1) sss
si & ciSelection ?~ Sel 0 (-1)
& ciSelection %~ scrollSelectionSections (-1) sss
| otherwise = si
displayIndents :: Int -> Int
@@ -246,28 +246,27 @@ updateSectionsPositioning ::
IM.IntMap (SelSection a) ->
IM.IntMap (SelSection a)
updateSectionsPositioning h mselpos allavailablelines lsss sss =
IM.intersectionWithKey (\k -> updateSection (h k) (m k)) ls ssizes `g` offsets
IM.intersectionWithKey (\k -> updateSection (h k) (m k)) lsss ssizes `g` offsets
where
offsets = fmap _ssOffset sss
offsets = fmap (\ss -> (_ssOffset ss, ss ^. ssSet)) sss
m k = do
Sel k' i _ <- mselpos
Sel k' i <- mselpos
guard $ k == k'
return i
ls = lsss
-- defaults non-existing offsets to 0
g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
g = merge (mapMissing (const ($ (0,mempty)))) dropMissing (zipWithMatched (const ($)))
lk = mselpos ^.. _Just . slSec
ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls
ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines lsss
updateSection :: Int -> Maybe Int -> IMSI a -> Int -> Int -> SelSection a
updateSection indent mcsel sis availablelines oldoffset =
updateSection :: Int -> Maybe Int -> IMSI a -> Int -> (Int,IS.IntSet) -> SelSection a
updateSection indent mcsel sis availablelines (oldoffset,sset) =
SelSection
{ _ssItems = sis
, _ssOffset = offset
, _ssShownItems = shownitems
, _ssShownLength = min aslength availablelines
, _ssIndent = indent
, _ssSet = mempty
, _ssSet = sset
}
where
shownitems = tweakfirst . tweaklast $ take availablelines shownstrings
@@ -324,8 +323,7 @@ enterCombineInv cfig w =
w & hud . subInventory
.~ CombineInventory
{ _ciSections = updateCombineSections w cfig mempty
, _ciSelection = Just (Sel 0 0 mempty)
, _ciSelection = Just (Sel 0 0)
, _ciFilter = Nothing
}
& hud . diInvFilter
.~ Nothing
& hud . diInvFilter .~ Nothing
src/Dodge/Inventory.hs
+15 -10
View File
@@ -95,11 +95,11 @@ rmInvItem cid invid w =
where
pointcid = cWorld . lWorld . creatures . ix cid
updateselectionextra
| cid == 0 = hud . diSelection . _Just . slSet %~ IS.foldl' h mempty
-- | cid == 0 = hud . diSelection . _Just . slSet %~ IS.foldl' h mempty
| otherwise = id
h x i | i > _unNInt invid = IS.insert (i-1) x
| i < _unNInt invid = IS.insert i x
| otherwise = x
-- h x i | i > _unNInt invid = IS.insert (i-1) x
-- | i < _unNInt invid = IS.insert i x
-- | otherwise = x
updateselection
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1
@@ -159,7 +159,9 @@ changeSwapSelSet yi w
swapSelSet :: (Int -> IS.IntSet -> World -> World) -> World -> World
swapSelSet f w = fromMaybe w $ do
Sel j i is' <- w ^. hud . diSelection
-- Sel j i is' <- w ^. hud . diSelection
Sel j i <- w ^. hud . diSelection
is' <- w ^? hud . diSections . ix j . ssSet
let is = if IS.null is'
then IS.singleton i
else is'
@@ -231,7 +233,9 @@ multiSelScroll yi w
multiSelScroll' :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
multiSelScroll' f w = fromMaybe w $ do
Sel j i is <- w ^. hud . diSelection
--Sel j i is <- w ^. hud . diSelection
Sel j i <- w ^. hud . diSelection
is <- w ^? hud . diSections . ix j . ssSet
ss <- w ^? hud . diSections . ix j . ssItems
k <- f i ss
let insertordelete
@@ -240,7 +244,8 @@ multiSelScroll' f w = fromMaybe w $ do
| otherwise = IS.insert i . IS.insert k
return $
w
& hud . diSelection . _Just . slSet %~ insertordelete
-- & hud . diSelection . _Just . slSet %~ insertordelete
& hud . diSections . ix j . ssSet %~ insertordelete
& hud . diSelection . _Just . slInt .~ k
changeSwapOther ::
@@ -259,7 +264,7 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
| otherwise = j
return $
w
& swapAnyExtraSelection i k
& swapAnyExtraSelection 3 i k
& cWorld
. lWorld
. creatures
@@ -285,7 +290,7 @@ swapItemWith f (j, i) = case j of
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w
| Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j, i) w
| Just (Sel j i) <- w ^. hud . diSelection = swapItemWith f (j, i) w
| otherwise = w
invSetSelection :: Selection -> World -> World
@@ -297,7 +302,7 @@ invSetSelection sel w =
& cWorld . lWorld %~ crUpdateItemLocations 0
invSetSelectionPos :: Int -> Int -> World -> World
invSetSelectionPos i j = invSetSelection (Sel i j mempty)
invSetSelectionPos i j = invSetSelection (Sel i j)
scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w
src/Dodge/Inventory/Add.hs
+3 -1
View File
@@ -6,6 +6,7 @@ module Dodge.Inventory.Add (
pickUpItemAt,
) where
import Dodge.Data.SelectionList
import Linear
import qualified Data.IntSet as IS
import Control.Lens
@@ -44,7 +45,8 @@ tryPutItemInInv cid itid w = do
& cWorld . highlightItems . at itid ?~ 20
where
updateselectionextra i
| cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
-- | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
| cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
. (hud . diSelection . _Just . slInt %~ f i)
| otherwise = id
f j i | i >= _unNInt j = i + 1
src/Dodge/Inventory/Location.hs
+2 -1
View File
@@ -95,7 +95,8 @@ setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where
thesel = fromMaybe SelNothing $ do
Sel i j _ <- w ^? hud . diSelection . _Just
--Sel i j _ <- w ^? hud . diSelection . _Just
Sel i j <- w ^? hud . diSelection . _Just
case i of
(-1) -> Just SortInventory
0 -> do
src/Dodge/Inventory/Swap.hs
+21 -12
View File
@@ -11,13 +11,14 @@ import Dodge.Base.You
import Dodge.Inventory.Location
import Dodge.Data.DoubleTree
import Sound.Data
import qualified Data.IntSet as IS
--import qualified Data.IntSet as IS
import Data.Maybe
import Control.Lens
import Dodge.Data.SelectionList
import qualified IntMapHelp as IM
import Dodge.Data.World
import Control.Monad
import qualified Data.IntSet as IS
swapInvItems ::
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
@@ -28,12 +29,12 @@ swapInvItems f i w = fromMaybe w $ do
ss <- w ^? hud . diSections . ix 0 . ssItems
k <- f i ss
let updateselection = case w ^? hud . diSelection . _Just of
Just (Sel 0 j _) | j == k -> hud . diSelection . _Just . slInt .~ i
Just (Sel 0 j _) | j == i -> hud . diSelection . _Just . slInt .~ k
Just (Sel 0 j) | j == k -> hud . diSelection . _Just . slInt .~ i
Just (Sel 0 j) | j == i -> hud . diSelection . _Just . slInt .~ k
_ -> id
return $
w
& swapAnyExtraSelection i k
& swapAnyExtraSelection 0 i k
& checkConnection InventorySound disconnectItemS i k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
& updateselection
@@ -54,14 +55,22 @@ swapInvItems f i w = fromMaybe w $ do
Just epos -> crEquipment . ix epos .~ NInt b
Nothing -> id
swapAnyExtraSelection :: Int -> Int -> World -> World
swapAnyExtraSelection i k w = fromMaybe w $ do
is <- w ^? hud . diSelection . _Just . slSet
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 . diSelection . _Just . slSet
%~ (f . g . IS.delete i . IS.delete k)
swapAnyExtraSelection :: Int -> Int -> Int -> World -> World
swapAnyExtraSelection seci i k w = w
& hud . diSections . ix seci . ssSet %~ f
where
f is
| i `IS.member` is && not (k `IS.member` is) = IS.insert k $ IS.delete i is
| k `IS.member` is && not (i `IS.member` is) = IS.insert i $ IS.delete k is
| otherwise = is
-- fromMaybe w $ do
-- is <- w ^? hud . diSelection . _Just . slSet
-- 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 . diSelection . _Just . slSet
-- %~ (f . g . IS.delete i . IS.delete k)
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
checkConnection so s i j w = fromMaybe w $ do
src/Dodge/Render/HUD.hs
+30 -15
View File
@@ -127,7 +127,8 @@ drawMouseOver cfig w =
. translateScreenPos cfig (invDP ^. ldpPos)
. color (0.3 *^ white)
-- . color white
$ selSecDrawCursor invDP curs sss (Sel j i mempty)
-- $ selSecDrawCursor invDP curs sss (Sel j i mempty)
$ selSecDrawCursor invDP curs sss (Sel j i)
-- curs = BoundaryCursor [West]
curs = BackdropCurs
combinvsel = do
@@ -139,31 +140,45 @@ drawMouseOver cfig w =
return
. translateScreenPos cfig (idp ^. ldpPos)
. color (0.3 * white)
$ selSecDrawCursor idp curs sss (Sel j i mempty)
$ selSecDrawCursor idp curs sss (Sel j i)
drawDragSelected :: Config -> World -> Maybe Picture
drawDragSelected cfig w = do
ys <- w ^? hud . diSelection . _Just . slSet
guard $
not (IS.null ys)
&& ( case w ^? hud . subInventory of
ys0 <- w ^? hud . diSections . ix 0 . ssSet
ys2 <- w ^? hud . diSections . ix 3 . ssSet
ys4 <- w ^? hud . diSections . ix 5 . ssSet
guard $ case w ^? hud . subInventory of
Just NoSubInventory -> True
_ -> False
)
Sel i _ _ <- w ^? hud . diSelection . _Just
sss <- w ^? hud . diSections
let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
let f i x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x) <>)
return
. translateScreenPos cfig (invDP ^. ldpPos)
. color (0.2 *^ white)
. IS.foldr f mempty
$ ys
$ IS.foldr (f 0) mempty ys0
<> IS.foldr (f 3) mempty ys2
<> IS.foldr (f 5) mempty ys4
-- ys <- w ^? hud . diSelection . _Just . slSet
-- guard $
-- not (IS.null ys)
-- && ( case w ^? hud . subInventory of
-- Just NoSubInventory -> True
-- _ -> False
-- )
-- Sel i _ _ <- w ^? hud . diSelection . _Just
-- sss <- w ^? hud . diSections
-- let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
-- return
-- . translateScreenPos cfig (invDP ^. ldpPos)
-- . color (0.2 *^ white)
-- . IS.foldr f mempty
-- $ ys
drawDragSelecting :: Config -> World -> Maybe Picture
drawDragSelecting cfig w = do
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
sss <- w ^? hud . diSections
let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty)
let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x)
return
. translateScreenPos cfig (invDP ^. ldpPos)
. color (0.2 *^ white)
@@ -261,7 +276,7 @@ drawRBOptions cfig w = fold $ do
i <- w ^? rbState . opSel
let ae = equipmentDesignation invid w
sss <- w ^? hud . diSections
Sel i' j _ <- w ^? hud . diSelection . _Just
Sel i' j <- w ^? hud . diSelection . _Just
curpos <- selSecYint i' j sss
itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0
ind <- sss ^? ix i' . ssItems . ix j . siOffX
@@ -352,7 +367,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
invDP
(BoundCurs [North, South, East, West])
(w ^. hud . diSections)
(Sel 0 i mempty)
(Sel 0 i)
drawTerminalDisplay :: World -> Config -> Int -> Picture
drawTerminalDisplay w cfig tid = fold $ do
@@ -407,7 +422,7 @@ drawTerminalCursorLink w cfig tm = fold $ do
invDP
(BoundCurs [North, South, East, West])
(w ^. hud . diSections)
(Sel 5 j mempty)
(Sel 5 j)
)
<>
lConnectCol (lp + V2 155 0) rp lcol white white
src/Dodge/SelectedClose.hs
+1 -1
View File
@@ -13,7 +13,7 @@ interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e o
getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getSelectedCloseObj w = do
Sel i j _ <- w ^? hud . diSelection . _Just
Sel i j <- w ^? hud . diSelection . _Just
case i of
3 -> Left <$> w ^? hud . closeItems . ix j
5 -> do
src/Dodge/SelectionSections.hs
+14 -17
View File
@@ -16,7 +16,6 @@ import Control.Lens
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
@@ -28,13 +27,8 @@ import Geometry.Data
scrollSelectionSections :: Int -> IMSS a -> Maybe Selection -> Maybe Selection
scrollSelectionSections yi sss msel
| yi == 0 = msel
| yi > 0 = g $ foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
| otherwise = g $ foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
where
g msel'
| msel'^?_Just.slSec /= msel^?_Just.slSec
= msel'&_Just.slSet.~IS.empty
| otherwise = msel'
| yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
| otherwise = foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
nextInSectionSS :: IMSS a -> Maybe Selection -> Maybe Selection
nextInSectionSS = ssScrollUsing ssLookupNextMax
@@ -52,11 +46,11 @@ ssScrollMinOnFail ::
IMSS a ->
Maybe Selection ->
Maybe Selection
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j q) $ l <|> ssLookupMin sss
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j) $ l <|> ssLookupMin sss
where
q = fold (msel ^? _Just . slSet)
-- q = fold (msel ^? _Just . slSet)
l = do
Sel i j _ <- msel
Sel i j <- msel
f i j sss
---- this version removes the selected set when scrolling outside it
@@ -81,12 +75,15 @@ ssSetCursor ::
Maybe Selection ->
Maybe Selection
ssSetCursor f sss msel = fromMaybe msel $ do
(i, j, _) <- f sss
let newxs = fromMaybe mempty $ do
Sel k _ xs <- msel
guard $ k == i && j `IS.member` xs
return xs
return $ Just (Sel i j newxs)
(i,j,_) <- f sss
return $ Just (Sel i j)
-- = fromMaybe msel $ do
-- (i, j, _) <- f sss
-- let newxs = fromMaybe mempty $ do
-- Sel k _ xs <- msel
-- guard $ k == i && j `IS.member` xs
-- return xs
-- return $ Just (Sel i j newxs)
ssLookupMax :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
src/Dodge/TestString.hs
+2 -1
View File
@@ -58,7 +58,8 @@ crs :: Universe -> [Creature]
crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
testStringInit :: Universe -> [String]
testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
testStringInit u = u ^.. uvWorld . hud . diSections . each . ssSet . to show
--testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
--[show . getSum $ foldMap (Sum . crslime) (crs u)]
-- u ^.. tocrs . each . crType . slimeSplitTimer . to show
-- u ^.. tocrs . ix 1 . crPos . _xy . to show
src/Dodge/Update.hs
+2 -1
View File
@@ -450,7 +450,8 @@ updateMouseContextGame cfig u = \case
return $ OverInvSelect selpos
overcomb = do
sss <- w ^? hud . subInventory . ciSections
Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
-- Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
Sel xl xr <- w ^? hud . subInventory . ciSelection . _Just
let msel = (xl, xr)
let mpossel = inverseSelNumPos cfig secondColumnLDP (w ^. input . mousePos) sss ^? _Just . nonInf
return $ case mpossel of
src/Dodge/Update/Input/InGame.hs
+68 -22
View File
@@ -49,7 +49,7 @@ import SDL
updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInventory of
DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} ->
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _))} ->
u
& tohud . subInventory %~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
@@ -165,13 +165,20 @@ tryDropSelected mpos w = do
xs <- selectionSet w
let xmin = IS.findMin xs
return
. (hud . diSelection ?~ Sel 3 (j-xmin) (IS.fromDistinctAscList [0..IS.size xs - 1]))
. (hud . diSelection ?~ Sel 3 (j-xmin) )
. (hud . diSections . ix 3 . ssSet .~ IS.fromDistinctAscList [0..IS.size xs - 1])
. foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
selectionSet :: World -> Maybe IS.IntSet
selectionSet w = case w ^? hud . diSelection . _Just . slSet of
Just is' | not $ IS.null is' -> Just is'
selectionSet w = do
j <- w ^? hud . diSelection . _Just . slSec
case w ^? hud . diSections . ix j . ssSet of
Just is | not $ IS.null is -> Just is
_ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
--selectionSet :: World -> Maybe IS.IntSet
--selectionSet w = case w ^? hud . diSelection . _Just . slSet of
-- Just is' | not $ IS.null is' -> Just is'
-- _ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
@@ -193,7 +200,9 @@ tryPickupSelected k mpos w = do
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) joff xs
where
newdisel j joff xs =
hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
-- hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
(hud . diSelection ?~ Sel 0 (j+joff))
. (hud . diSections . ix 0 . ssSet .~ IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j
@@ -206,23 +215,44 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDragSelect (Just ssel) mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . diSelection . _Just . slSet
%~ getuniques
( maybe
& (fromMaybe id $ do
j <- w ^? hud . diSelection . _Just . slSec
return $ hud . diSections . ix j . ssSet
%~ getuniques
( maybe
mempty
(h ssel)
mempty
--(h ssel)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
))
& hud . diSections . ix (fst ssel) . ssSet
%~ getuniques
( maybe
mempty
(h ssel)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
)
-- & hud . diSelection . _Just . slSet
-- %~ getuniques
-- ( maybe
-- mempty
-- (h ssel)
-- (guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
-- )
OverInvDragSelect (Just ssel) (Just esel) ->
w & input . mouseContext .~ MouseInGame
& invSetSelection (f (fst ssel, esel) (h ssel esel))
-- & invSetSelection (f (fst ssel, esel) (h ssel esel))
& hud . diSections . ix (fst ssel) . ssSet .~ h ssel esel
& invSetSelection (f (fst ssel, esel))
OverInvDragSelect{} ->
w & input . mouseContext .~ MouseInGame
& hud . diSelection . _Just . slSet %~ const mempty
-- & hud . diSelection . _Just . slSet %~ const mempty
& hud . diSections . each . ssSet %~ const mempty
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x, y) = Sel x y
-- need to set this in OverInvDragSelect (twice)?
h (k, i) j = fold $ do
sss <- w ^? hud . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
@@ -298,7 +328,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
_ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w
where
f (x, y) = Sel x y mempty
f (x, y) = Sel x y
selsec = w ^? hud . diSelection . _Just . slSec
endRegex :: Int -> World -> Maybe Selection -> Maybe Selection
@@ -317,12 +347,18 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
return (k -1)
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
-- _ -> invSetSelection (Sel a b (IS.singleton b)) w
_ -> invSetSelection (Sel a b mempty) w
startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w) $ do
i <- w ^? hud . diSelection . _Just . slSec
xs <- w ^? hud . diSections . ix i . ssSet
guard $ i == a && b `IS.member` xs
return w
where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
--startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
-- Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
-- _ -> invSetSelection (Sel a b mempty) w
-- where
-- setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
shiftInvItems ::
@@ -359,10 +395,15 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
Sel i _ xs <- w ^? hud . diSelection . _Just
Sel i _ <- w ^? hud . diSelection . _Just
xs <- w ^? hud . diSections . ix i . ssSet
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
guard $ i == k && j `IS.member` xs
return $ w & hud . diSelection . _Just . slInt .~ j
-- Sel i _ xs <- w ^? hud . diSelection . _Just
-- (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
-- guard $ i == k && j `IS.member` xs
-- return $ w & hud . diSelection . _Just . slInt .~ j
updateFunctionKeys :: Universe -> Universe
@@ -508,7 +549,8 @@ updateBackspaceRegex w = case di ^? subInventory of
return $ case str of
(_ : _) ->
he & filtset . _Just %~ init
& selset ?~ Sel x 0 mempty
& selset ?~ Sel x 0
-- & selset ?~ Sel x 0 mempty
[] -> he & filtset .~ Nothing
di = w ^. hud
@@ -516,15 +558,18 @@ updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . subInventory of
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . diSelection ?~ Sel (-1) 0 mempty
-- w & hud . diSelection ?~ Sel (-1) 0 mempty
w & hud . diSelection ?~ Sel (-1) 0
& hud . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . diSelection ?~ Sel 2 0 mempty
-- w & hud . diSelection ?~ Sel 2 0 mempty
w & hud . diSelection ?~ Sel 2 0
& hud . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . subInventory . ciFilter %~ enterregex
& hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
-- & hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
& hud . subInventory . ciSelection ?~ Sel (-1) 0
_ -> w
where
secfocus xs = fromMaybe False $ do
@@ -567,7 +612,8 @@ tryCombine (i, j) w = fromMaybe w $ do
return $
createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))
& soundStart InventorySound p wrench1S Nothing
& hud . diSelection . _Just . slSet .~ mempty
& hud . diSections . ix 1 . ssSet.~ mempty
-- & hud . diSelection . _Just . slSet .~ mempty
maybeExitCombine :: World -> World
maybeExitCombine w