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