Work on selection sets
This commit is contained in:
@@ -3,6 +3,7 @@
|
||||
|
||||
module Dodge.Data.Input where
|
||||
|
||||
import Dodge.Data.CardinalPoint
|
||||
import Dodge.Data.Config
|
||||
import Dodge.Data.Terminal.Status
|
||||
import Control.Lens
|
||||
@@ -16,7 +17,7 @@ data MouseContext
|
||||
| MouseInGame
|
||||
| MouseMenu {_mcoMenuClick :: Maybe Int}
|
||||
| OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
|
||||
| OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe Int }
|
||||
| OverInvDragSelect { _mcoSecSelStart :: XInfinity (Int,Int) } --, _mcoSelEnd :: Maybe (XInfinity (Int,Int)) }
|
||||
| OverInvSelect { _mcoInvSelect :: (Int,Int)}
|
||||
| OverCombFiltInv { _mcoInvFilt :: (Int,Int)}
|
||||
| OverCombSelect { _mcoCombSelect :: (Int,Int)}
|
||||
|
||||
+25
-4
@@ -176,14 +176,35 @@ drawDragSelected cfig w = do
|
||||
|
||||
drawDragSelecting :: Config -> World -> Maybe Picture
|
||||
drawDragSelecting cfig w = do
|
||||
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
|
||||
x <- w ^? input . mouseContext . mcoSecSelStart
|
||||
sss <- w ^? hud . diSections
|
||||
let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x)
|
||||
y <- inverseSelNumPos cfig invDP (w^.input.mousePos) sss
|
||||
let f i ss
|
||||
| i ==0 || i == 3 = IM.foldMapWithKey (\j _ -> selSecDrawCursor invDP BackdropCurs sss (Sel i j))
|
||||
(ss ^. ssItems)
|
||||
| otherwise = mempty
|
||||
return
|
||||
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.2 *^ white)
|
||||
. foldMap f
|
||||
$ [min j b .. max j b]
|
||||
. IM.foldMapWithKey f
|
||||
$ sssSelectionSlice sss x y
|
||||
-- OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
|
||||
-- sss <- w ^? hud . diSections
|
||||
-- let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x)
|
||||
-- return
|
||||
-- . translateScreenPos cfig (invDP ^. ldpPos)
|
||||
-- . color (0.2 *^ white)
|
||||
-- . foldMap f
|
||||
-- $ [min j b .. max j b]
|
||||
|
||||
|
||||
--
|
||||
-- return $ IM.foldMapWithKey f s
|
||||
-- where
|
||||
-- f i ss = IM.foldMapWithKey (g i) (ss ^. ssItems)
|
||||
-- g i j si
|
||||
-- | si ^. siIsSelectable = [(i,j)]
|
||||
-- | otherwise = mempty
|
||||
|
||||
drawSubInventory :: SubInventory -> Config -> World -> Picture
|
||||
drawSubInventory subinv cfig w = case subinv of
|
||||
|
||||
@@ -8,6 +8,9 @@ module Dodge.SelectionSections (
|
||||
inverseSelSecYint,
|
||||
posSelSecYint,
|
||||
inverseSelNumPos,
|
||||
ssLookupGE,
|
||||
ssLookupLE,
|
||||
sssSelectionSlice,
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
@@ -149,6 +152,22 @@ ssLookupGT' i sss = do
|
||||
Just (j', si) -> return (i', j', si)
|
||||
Nothing -> ssLookupGT' i' sss
|
||||
|
||||
ssLookupGE :: XInfinity (Int,Int) -> IMSS a -> Maybe (Int,Int,SelectionItem a)
|
||||
ssLookupGE x sss = case x of
|
||||
NegInf -> ssLookupMin sss
|
||||
PosInf -> Nothing
|
||||
NonInf (i,j) -> case sss ^? ix i . ssItems . ix j of
|
||||
Nothing -> ssLookupGT i j sss
|
||||
Just s -> Just (i,j,s)
|
||||
|
||||
ssLookupLE :: XInfinity (Int,Int) -> IMSS a -> Maybe (Int,Int,SelectionItem a)
|
||||
ssLookupLE x sss = case x of
|
||||
NegInf -> Nothing
|
||||
PosInf -> ssLookupMax sss
|
||||
NonInf (i,j) -> case sss ^? ix i . ssItems . ix j of
|
||||
Nothing -> ssLookupLT i j sss
|
||||
Just s -> Just (i,j,s)
|
||||
|
||||
ssLookupGE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
|
||||
ssLookupGE' i sss = do
|
||||
(i', ss) <- IM.lookupGE i sss
|
||||
@@ -213,3 +232,14 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
|
||||
inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (XInfinity (Int, Int))
|
||||
inverseSelNumPos cfig ldp (V2 x y) =
|
||||
inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)
|
||||
|
||||
sssSelectionSlice :: IMSS a -> XInfinity (Int,Int) -> XInfinity (Int,Int) -> IMSS a
|
||||
sssSelectionSlice sss x1 x2 = fromMaybe mempty $ do
|
||||
let (xmin,xmax) | x1 < x2 = (x1,x2)
|
||||
| otherwise = (x2,x1)
|
||||
(mini,minj,_) <- ssLookupGE xmin sss
|
||||
(maxi,maxj,_) <- ssLookupLE xmax sss
|
||||
return $ fst (IM.split (maxi+1) . snd $ IM.split (mini-1) sss)
|
||||
& ix mini . ssItems %~ snd . IM.split (minj-1)
|
||||
& ix maxi . ssItems %~ fst . IM.split (maxj+1)
|
||||
|
||||
|
||||
@@ -85,7 +85,7 @@ updateMouseInGame :: Config -> World -> World
|
||||
updateMouseInGame cfig w
|
||||
| Just 0 <- lbpress = updateMouseClickInGame cfig w
|
||||
| Just _ <- lbpress = updateMouseHeldInGame cfig w
|
||||
| Just 0 <- lbrelease = updateMouseReleaseInGame w
|
||||
| Just 0 <- lbrelease = updateMouseReleaseInGame cfig w
|
||||
| otherwise = w
|
||||
where
|
||||
lbpress = w ^? input . mouseButtons . ix ButtonLeft
|
||||
@@ -96,36 +96,29 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
||||
OverInvDragSelect{}
|
||||
| ButtonRight `M.member` (w ^. input . mouseButtons) ->
|
||||
w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
|
||||
OverInvDragSelect (Just sstart) _ ->
|
||||
case inverseSelNumPos cfig invDP (w ^. input . mousePos) sss of
|
||||
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
|
||||
Just m
|
||||
| fmap fst m == NonInf (fst sstart) -> w & input . mouseContext . mcoSelEnd ?~ (m ^?! nonInf . _2)
|
||||
| fmap fst m < NonInf (fst sstart) -> w & input . mouseContext . mcoSelEnd ?~ 0
|
||||
| otherwise -> w & input . mouseContext . mcoSelEnd .~
|
||||
fmap fst (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
|
||||
-- Just (NonInf (i, j))
|
||||
-- | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
|
||||
-- | i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
|
||||
-- OverInvDragSelect {} -> w
|
||||
-- OverInvDragSelect (Just sstart) _ ->
|
||||
-- case inverseSelNumPos cfig invDP (w ^. input . mousePos) sss of
|
||||
-- Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
|
||||
-- Just m
|
||||
-- | fmap fst m == NonInf (fst sstart) -> w & input . mouseContext . mcoSelEnd ?~ (m ^?! nonInf . _2)
|
||||
-- | fmap fst m < NonInf (fst sstart) -> w & input . mouseContext . mcoSelEnd ?~ 0
|
||||
-- | otherwise -> w & input . mouseContext . mcoSelEnd .~
|
||||
-- fmap fst (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
|
||||
-- Just NegInf -> w & input . mouseContext . mcoSelEnd ?~ 0
|
||||
-- Just PosInf -> w & input . mouseContext . mcoSelEnd .~
|
||||
-- fmap fst (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
|
||||
-- not sure how the above performs when filtering...
|
||||
OverInvDragSelect Nothing _ -> fromMaybe w $ do
|
||||
ysel <-
|
||||
inverseSelSecYint
|
||||
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
|
||||
sss
|
||||
^? nonInf
|
||||
guard (isGroupSelectableSection $ fst ysel)
|
||||
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
|
||||
-- -- not sure how the above performs when filtering...
|
||||
-- OverInvDragSelect Nothing _ -> fromMaybe w $ do
|
||||
-- ysel <-
|
||||
-- inverseSelSecYint
|
||||
-- (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
|
||||
-- sss
|
||||
-- ^? nonInf
|
||||
-- guard (isGroupSelectableSection $ fst ysel)
|
||||
-- return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
|
||||
OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
|
||||
OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
|
||||
_ -> w
|
||||
where
|
||||
sss = w ^. hud . diSections
|
||||
-- where
|
||||
-- sss = w ^. hud . diSections
|
||||
|
||||
setPixelOffsetBounded :: Config -> Point2 -> LDParams -> LDParams
|
||||
setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
|
||||
@@ -204,76 +197,77 @@ tryPickupSelected k mpos w = do
|
||||
NInt j <- w ^? hud . closeItems . ix i
|
||||
w ^? cWorld . lWorld . items . ix j
|
||||
|
||||
updateMouseReleaseInGame :: World -> World
|
||||
updateMouseReleaseInGame w = case w ^. input . mouseContext of
|
||||
updateMouseReleaseInGame :: Config -> World -> World
|
||||
updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of
|
||||
OverInvDrag k mpos ->
|
||||
input . mouseContext .~ MouseInGame $
|
||||
fromMaybe w $
|
||||
tryDropSelected mpos w <|> tryPickupSelected k mpos w
|
||||
OverInvDragSelect (Just ssel) mesel
|
||||
OverInvDragSelect ssel
|
||||
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
|
||||
w
|
||||
& input
|
||||
. mouseContext
|
||||
.~ MouseInGame
|
||||
& ( 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
|
||||
( 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))
|
||||
& 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
|
||||
. diSections
|
||||
. each
|
||||
. ssSet
|
||||
%~ const mempty
|
||||
w & input . mouseContext .~ MouseInGame
|
||||
& doDragSelect cfig ssel
|
||||
OverInvDragSelect ssel -> w & input . mouseContext .~ MouseInGame
|
||||
& hud . diSections . ix 0 . ssSet .~ mempty
|
||||
& hud . diSections . ix 3 . ssSet .~ mempty
|
||||
& doDragSelect cfig ssel
|
||||
|
||||
-- OverInvDragSelect (Just ssel) mesel
|
||||
-- | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
|
||||
-- w
|
||||
-- & input
|
||||
-- . mouseContext
|
||||
-- .~ MouseInGame
|
||||
-- & ( 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
|
||||
-- ( 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))
|
||||
-- & 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
|
||||
-- . 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
|
||||
@@ -282,6 +276,21 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
|
||||
(yss, _) = IM.split (max i j + 1) xss
|
||||
return . IM.keysSet $ yss
|
||||
|
||||
doDragSelect :: Config -> XInfinity (Int,Int) -> World -> World
|
||||
doDragSelect cfig x w = fromMaybe w $ do
|
||||
sss <- w ^? hud . diSections
|
||||
y <- inverseSelNumPos cfig invDP (w^.input.mousePos) sss
|
||||
return $ IM.foldlWithKey' f w $ sssSelectionSlice sss x y
|
||||
where
|
||||
f w' i ss
|
||||
| i == 0 || i == 3 = w'
|
||||
& hud . diSections . ix i . ssSet %~ symmetricDifference (IM.keysSet (ss ^. ssItems))
|
||||
| otherwise = w'
|
||||
|
||||
-- this is in Data.IntSet 0.8
|
||||
symmetricDifference :: IS.IntSet -> IS.IntSet -> IS.IntSet
|
||||
symmetricDifference x y = (x `IS.union` y) IS.\\ (x `IS.intersection` y)
|
||||
|
||||
isGroupSelectableSection :: Int -> Bool
|
||||
isGroupSelectableSection = \case
|
||||
0 -> True
|
||||
@@ -290,15 +299,19 @@ isGroupSelectableSection = \case
|
||||
|
||||
updateMouseClickInGame :: Config -> World -> World
|
||||
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
|
||||
let sss = w ^. hud . diSections
|
||||
ysel <-
|
||||
inverseSelSecYint
|
||||
MouseInGame -> w & input . mouseContext .~ OverInvDragSelect
|
||||
(inverseSelSecYint
|
||||
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
|
||||
sss
|
||||
^? nonInf
|
||||
guard (isGroupSelectableSection $ fst ysel)
|
||||
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
|
||||
(w ^. hud . diSections))
|
||||
-- fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
|
||||
-- let sss = w ^. hud . diSections
|
||||
-- ysel <-
|
||||
-- inverseSelSecYint
|
||||
-- (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
|
||||
-- sss
|
||||
-- ^? nonInf
|
||||
-- guard (isGroupSelectableSection $ fst ysel)
|
||||
-- return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
|
||||
OverInvSelect (-1, _)
|
||||
| selsec == Just (-1) ->
|
||||
w
|
||||
@@ -323,8 +336,9 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
return $ doButtonEvent (but ^. btEvent) but w
|
||||
OverInvSelect x
|
||||
| ScancodeLShift `M.member` (w ^. input . pressedKeys)
|
||||
&& isGroupSelectableSection (fst x) ->
|
||||
w & input . mouseContext .~ OverInvDragSelect (Just x) (Just $ snd x)
|
||||
-> w & input . mouseContext .~ OverInvDragSelect (NonInf x)
|
||||
-- && isGroupSelectableSection (fst x) ->
|
||||
-- w & input . mouseContext .~ OverInvDragSelect (Just x) (Just $ snd x)
|
||||
OverInvSelect x -> startDrag x w
|
||||
OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
|
||||
OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
|
||||
|
||||
Reference in New Issue
Block a user