Work on preserving selections when picking up multiple items
This commit is contained in:
@@ -63,6 +63,7 @@ tryPutItemInInvAt mcipos i itid w = do
|
||||
(j, w') <- tryPutItemInInv mcipos itid w
|
||||
guard (i <= _unNInt j)
|
||||
return $ foldr f w' [i + 1 .. _unNInt j]
|
||||
-- return $ w'
|
||||
where
|
||||
f j = swapInvItems (\_ _ -> Just (j -1)) j
|
||||
|
||||
@@ -83,7 +84,7 @@ pickUpItemAt :: Int -> (Int,Int) -> World -> World
|
||||
pickUpItemAt invid (i,itid) w = fromMaybe w $ do
|
||||
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
|
||||
soundStart (CrSound 0) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid itid w
|
||||
& _Just . hud . diSections . ix 0 . ssSet %~ IS.map f
|
||||
-- & _Just . hud . diSections . ix 0 . ssSet %~ IS.map f
|
||||
where
|
||||
f j | j >= invid = j +1
|
||||
| otherwise = j
|
||||
|
||||
+2
-4
@@ -194,10 +194,8 @@ updateUniverseMid u = case _uvScreenLayers u of
|
||||
-- . (uvWorld . cWorld . highlightItems . filteredBy . non 0 -~ 1)
|
||||
. timeFlowUpdate
|
||||
. updateUseInputInGame
|
||||
$ over
|
||||
uvWorld
|
||||
(updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
|
||||
u
|
||||
. updateMouseInGame
|
||||
$ over uvWorld (updateCamera (u ^. uvConfig)) u
|
||||
where
|
||||
minusone x
|
||||
| x > 0 = Just $ x - 1
|
||||
|
||||
+126
-123
@@ -82,24 +82,28 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInven
|
||||
updateKeysInGame :: Universe -> Universe
|
||||
updateKeysInGame u = M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys)
|
||||
|
||||
updateMouseInGame :: Config -> World -> World
|
||||
updateMouseInGame cfig w
|
||||
| Just 0 <- lbpress = updateMouseClickInGame cfig w
|
||||
| Just _ <- lbpress = updateMouseHeldInGame cfig w
|
||||
| Just 0 <- lbrelease = updateMouseReleaseInGame cfig w
|
||||
| otherwise = w
|
||||
updateMouseInGame :: Universe -> Universe
|
||||
updateMouseInGame u
|
||||
| Just 0 <- lbpress = updateMouseClickInGame u
|
||||
| Just _ <- lbpress = updateMouseHeldInGame u
|
||||
| Just 0 <- lbrelease = updateMouseReleaseInGame u
|
||||
| otherwise = u
|
||||
where
|
||||
lbpress = w ^? input . mouseButtons . ix ButtonLeft
|
||||
lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft
|
||||
lbpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft
|
||||
lbrelease = u ^? uvWorld . input . mouseButtonsReleased . ix ButtonLeft
|
||||
|
||||
updateMouseHeldInGame :: Config -> World -> World
|
||||
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
||||
updateMouseHeldInGame :: Universe -> Universe
|
||||
updateMouseHeldInGame u = case u ^. uvWorld . input . mouseContext of
|
||||
OverInvDragSelect{}
|
||||
| ButtonRight `M.member` (w ^. input . mouseButtons) ->
|
||||
w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
|
||||
OverInvDrag k -> doDrag cfig 30 k w
|
||||
OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
|
||||
_ -> w
|
||||
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) ->
|
||||
u & uvWorld . input . mouseContext .~ MouseGameRotate
|
||||
(dist (mouseWorldPosW w) (w ^. wCam . camCenter))
|
||||
OverInvDrag k -> u & doDrag 30 k
|
||||
OverTerminalBar p -> u & uvWorld . tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
|
||||
_ -> u
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
cfig = u ^. uvConfig
|
||||
|
||||
setPixelOffsetBounded :: Config -> Point2 -> LDParams -> LDParams
|
||||
setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
|
||||
@@ -114,48 +118,49 @@ setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
|
||||
max (1 + 20 * (ldp ^. ldpVerticalGap + ldp ^?! ldpSize . _Just . _y . to fromIntegral) - h * b) y
|
||||
V2 a b = ldp ^. ldpPos . spScreenOff
|
||||
|
||||
doDrag :: Config -> Int -> Int -> World -> World
|
||||
doDrag cfig n k w = fromMaybe w $ do
|
||||
doDrag :: Int -> Int -> Universe -> Universe
|
||||
doDrag n k u = fromMaybe u $ do
|
||||
guard (n /= 0)
|
||||
ss <- w ^? hud . diSections . ix k . ssItems
|
||||
x <- mouseover
|
||||
is <- selectionSet w
|
||||
x <- mouseInvPos u ^? _Just . nonInf
|
||||
is <- selectionSet $ u ^. uvWorld . hud
|
||||
return $
|
||||
if concurrentIS is
|
||||
then shiftInvItems cfig n k x is ss w
|
||||
else collectInvItems k is w
|
||||
then u & shiftInvItems n k x is ss
|
||||
else u & uvWorld %~ collectInvItems k is
|
||||
where
|
||||
mouseover = inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf
|
||||
mpos = w ^. input . mousePos
|
||||
disss = w ^. hud . diSections
|
||||
w = u ^. uvWorld
|
||||
|
||||
tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
|
||||
tryDropSelected mpos w = do
|
||||
guard $ maybe True (\(i, _) -> i == 3) mpos
|
||||
tryDropSelected :: Universe -> Maybe Universe
|
||||
tryDropSelected u = do
|
||||
let mi = mouseInvPos u ^? _Just . nonInf . _1
|
||||
guard $ maybe True (== 3) mi
|
||||
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||
Sel 0 j <- w ^. hud . diSelection
|
||||
xs <- selectionSet w
|
||||
xs <- selectionSet $ u ^. uvWorld . hud
|
||||
let xmin = IS.findMin xs
|
||||
return
|
||||
. setInvPosFromSS
|
||||
return $ u & uvWorld %~ (\w' -> setInvPosFromSS
|
||||
. (hud . diSelection ?~ Sel 3 (j - xmin))
|
||||
. foldl' (flip $ dropItem cr) w
|
||||
. foldl' (flip $ dropItem cr) w'
|
||||
. IS.toDescList
|
||||
$ xs
|
||||
$ xs)
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
|
||||
selectionSet :: World -> Maybe IS.IntSet
|
||||
selectionSet w = do
|
||||
j <- w ^? hud . diSelection . _Just . slSec
|
||||
case w ^? hud . diSections . ix j . ssSet of
|
||||
selectionSet :: HUD -> Maybe IS.IntSet
|
||||
selectionSet h = do
|
||||
j <- h ^? diSelection . _Just . slSec
|
||||
case h ^? diSections . ix j . ssSet of
|
||||
Just is | not $ IS.null is -> Just is
|
||||
_ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
|
||||
_ -> IS.singleton <$> h ^? diSelection . _Just . slInt
|
||||
|
||||
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
|
||||
tryPickupSelected k mpos w = do
|
||||
tryPickupSelected :: Int -> Universe -> Maybe Universe
|
||||
tryPickupSelected k u = do
|
||||
guard $ k == 3
|
||||
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
|
||||
let mij = mouseInvPos u ^? _Just . nonInf
|
||||
guard $ maybe True (\(i,_) -> i == 0 || i == 1) mij
|
||||
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||
xs <- selectionSet w
|
||||
xs <- selectionSet $ u ^. uvWorld . hud
|
||||
sli <- w ^? hud . diSelection . _Just . slInt
|
||||
let xmin = IS.findMin xs
|
||||
joff = sli - xmin
|
||||
@@ -165,45 +170,45 @@ tryPickupSelected k mpos w = do
|
||||
slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
|
||||
ispickup = map (_unNInt . _itID) itmstopickup
|
||||
guard $ nfreeslots >= slotsneeded
|
||||
return $ case mpos of
|
||||
Just (0, j) -> foldr (pickUpItemAt j) w (zip is ispickup) & newdisel j joff
|
||||
_ -> foldl' (flip $ pickUpItem (head is)) w ispickup & newdisel (length (cr ^. crInv)) joff
|
||||
return $ case mij of
|
||||
Just (0, j) -> u & uvWorld %~ (\w' -> foldr (pickUpItemAt j) w' (zip is ispickup) & newdisel j joff)
|
||||
_ -> u & uvWorld %~ (\w' -> foldl' (flip $ pickUpItem (head is)) w' ispickup & newdisel (length (cr ^. crInv)) joff)
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
newdisel j joff = hud . diSelection ?~ Sel 0 (j + joff)
|
||||
g i = do
|
||||
NInt j <- w ^? hud . closeItems . ix i
|
||||
w ^? cWorld . lWorld . items . ix j
|
||||
|
||||
updateMouseReleaseInGame :: Config -> World -> World
|
||||
updateMouseReleaseInGame cfig w = input . mouseContext .~ MouseInGame
|
||||
$ case w ^. input . mouseContext of
|
||||
OverInvDrag k -> fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
|
||||
OverInvDragSelect ssel -> doDragSelect cfig ssel $ mresetssset w
|
||||
_ -> w
|
||||
updateMouseReleaseInGame :: Universe -> Universe
|
||||
updateMouseReleaseInGame u = uvWorld . input . mouseContext .~ MouseInGame
|
||||
$ case u ^. uvWorld . input . mouseContext of
|
||||
OverInvDrag k -> fromMaybe u $ tryDropSelected u <|> tryPickupSelected k u
|
||||
OverInvDragSelect ssel -> doDragSelect ssel $ mresetssset u
|
||||
_ -> u
|
||||
where
|
||||
mresetssset
|
||||
| ScancodeLShift `M.member` (w ^. input . pressedKeys) = id
|
||||
| otherwise = hud . diSections . each . ssSet .~ mempty
|
||||
mpos = inverseSelNumPos cfig invDP mpos' disss ^? _Just . nonInf
|
||||
mpos' = w ^. input . mousePos
|
||||
disss = w ^. hud . diSections
|
||||
| ScancodeLShift `M.member` (u ^. uvWorld . input . pressedKeys) = id
|
||||
| otherwise = uvWorld . hud . diSections . each . ssSet .~ mempty
|
||||
|
||||
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
|
||||
doDragSelect :: XInfinity (Int, Int) -> Universe -> Universe
|
||||
doDragSelect x u = fromMaybe u $ do
|
||||
sss <- u ^? uvWorld . hud . diSections
|
||||
y <- mouseInvPos u
|
||||
return $ IM.foldlWithKey' f u $ sssSelectionSlice sss x y
|
||||
where
|
||||
f w' i ss
|
||||
f u' i ss
|
||||
| i == 0 || i == 3 =
|
||||
w' & hud . diSections . ix i . ssSet %~ IS.symmetricDifference (IM.keysSet (ss ^. ssItems))
|
||||
| otherwise = w'
|
||||
u' & uvWorld . hud . diSections . ix i . ssSet %~ IS.symmetricDifference (IM.keysSet (ss ^. ssItems))
|
||||
| otherwise = u'
|
||||
|
||||
mouseInvHeight :: Config -> World -> XInfinity (Int,Int)
|
||||
mouseInvHeight cfig w =
|
||||
mouseInvHeight :: Universe -> XInfinity (Int,Int)
|
||||
mouseInvHeight u =
|
||||
inverseSelSecYint
|
||||
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
|
||||
(w ^. hud . diSections)
|
||||
(posSelSecYint (u^.uvConfig)
|
||||
invDP
|
||||
(u ^.uvWorld . input . mousePos . _y))
|
||||
(u ^.uvWorld . hud . diSections)
|
||||
|
||||
mouseInvPos :: Universe -> Maybe (XInfinity (Int,Int))
|
||||
mouseInvPos u = inverseSelNumPos
|
||||
@@ -212,65 +217,66 @@ mouseInvPos u = inverseSelNumPos
|
||||
(u^.uvWorld. input . mousePos)
|
||||
(u ^.uvWorld. hud . diSections)
|
||||
|
||||
updateMouseClickInGame :: Config -> World -> World
|
||||
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
MouseInGame ->
|
||||
w & input . mouseContext .~ OverInvDragSelect (mouseInvHeight cfig w)
|
||||
updateMouseClickInGame :: Universe -> Universe
|
||||
updateMouseClickInGame u = case w ^. input . mouseContext of
|
||||
MouseInGame -> u & uvWorld . input . mouseContext .~ OverInvDragSelect (mouseInvHeight u)
|
||||
OverInvSelect (-1, _)
|
||||
| selsec == Just (-1) ->
|
||||
w
|
||||
& hud . diSelection %~ endRegex (-1) w
|
||||
& hud . diInvFilter .~ Nothing
|
||||
u
|
||||
& uvWorld . hud . diSelection %~ endRegex (-1) w
|
||||
& uvWorld . hud . diInvFilter .~ Nothing
|
||||
OverInvSelect (2, _)
|
||||
| selsec == Just 2 ->
|
||||
w
|
||||
& hud . diSelection %~ endRegex 2 w
|
||||
& hud . diCloseFilter .~ Nothing
|
||||
OverInvSelect (5, j) -> fromMaybe w $ do
|
||||
u
|
||||
& uvWorld . hud . diSelection %~ endRegex 2 w
|
||||
& uvWorld . hud . diCloseFilter .~ Nothing
|
||||
OverInvSelect (5, j) -> fromMaybe u $ do
|
||||
k <- w ^? hud . closeButtons . ix j
|
||||
but <- w ^? cWorld . lWorld . buttons . ix k
|
||||
return $ doButtonEvent (but ^. btEvent) but w
|
||||
return $ u & uvWorld %~ doButtonEvent (but ^. btEvent) but
|
||||
OverInvSelect x
|
||||
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
|
||||
w & input . mouseContext .~ OverInvDragSelect (NonInf x)
|
||||
OverInvSelect x -> startDrag x w
|
||||
OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
|
||||
OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
|
||||
OutsideTerminal -> w & hud . subInventory .~ NoSubInventory
|
||||
u & uvWorld . input . mouseContext .~ OverInvDragSelect (NonInf x)
|
||||
OverInvSelect x -> u & uvWorld %~ startDrag x
|
||||
OverTerminal tmid TerminalTextInput{} -> u & uvWorld %~ terminalReturnEffect tmid
|
||||
OverTerminal tmid TerminalPressTo{} -> u & uvWorld %~ continueTerminal tmid
|
||||
OutsideTerminal -> u & uvWorld . hud . subInventory .~ NoSubInventory
|
||||
OverCombSelect x ->
|
||||
w
|
||||
& hud . subInventory . ciSelection ?~ f x
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
u
|
||||
& uvWorld .hud . subInventory . ciSelection ?~ f x
|
||||
& uvWorld .worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
OverCombFilter ->
|
||||
w
|
||||
& hud . subInventory . ciFilter .~ Nothing
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
& hud . subInventory . ciSelection %~ endCombineRegex w
|
||||
u
|
||||
& uvWorld . hud . subInventory . ciFilter .~ Nothing
|
||||
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
& uvWorld . hud . subInventory . ciSelection %~ endCombineRegex w
|
||||
OverCombCombine x ->
|
||||
w
|
||||
& tryCombine x
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
& maybeExitCombine
|
||||
u
|
||||
& uvWorld %~ tryCombine x
|
||||
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ maybeExitCombine
|
||||
OverCombEscape ->
|
||||
w
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
& hud . subInventory .~ NoSubInventory
|
||||
OverCombFiltInv (0, j) -> fromMaybe w $ do
|
||||
u
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld . hud . subInventory .~ NoSubInventory
|
||||
OverCombFiltInv (0, j) -> u & uvWorld %~ (\w' -> fromMaybe w' $ do
|
||||
str <-
|
||||
fmap (take 5) $
|
||||
w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
|
||||
w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
|
||||
>>= \k ->
|
||||
w ^? cWorld . lWorld . items . ix k
|
||||
w' ^? cWorld . lWorld . items . ix k
|
||||
>>= (listToMaybe . basicItemDisplay)
|
||||
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
|
||||
case w ^? hud . subInventory . ciFilter . _Just of
|
||||
case w' ^? hud . subInventory . ciFilter . _Just of
|
||||
Just ('#' : xs)
|
||||
| str == xs ->
|
||||
w & hud . subInventory . ciFilter .~ Nothing
|
||||
_ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
|
||||
_ -> w
|
||||
w' & hud . subInventory . ciFilter .~ Nothing
|
||||
_ -> w' & hud . subInventory . ciFilter ?~ ("#" ++ str)
|
||||
)
|
||||
_ -> u
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
f (x, y) = Sel x y
|
||||
selsec = w ^? hud . diSelection . _Just . slSec
|
||||
|
||||
@@ -302,17 +308,16 @@ startDrag (a, b) w =
|
||||
return $ hud . diSections . ix a . ssSet .~ mempty
|
||||
|
||||
shiftInvItems ::
|
||||
Config ->
|
||||
Int -> -- recurse limit
|
||||
Int -> -- section where drag started
|
||||
(Int, Int) -> -- selection item mouse is over
|
||||
IS.IntSet ->
|
||||
IM.IntMap (SelectionItem a) ->
|
||||
World ->
|
||||
World
|
||||
shiftInvItems cfig n k x xs ss w = setSelWhileDragging cfig . fromMaybe w $ do
|
||||
Universe ->
|
||||
Universe
|
||||
shiftInvItems n k x xs ss u = setSelWhileDragging . fromMaybe u $ do
|
||||
let xk = fst x
|
||||
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
|
||||
let yint = posSelSecYint (u^.uvConfig) invDP (w ^. input . mousePos . _y)
|
||||
bn =
|
||||
(\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
|
||||
=<< w ^? hud . diSections
|
||||
@@ -326,23 +331,23 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging cfig . fromMaybe w $ do
|
||||
_ | x < (k, mini) -> do
|
||||
guard $ not . null . fst $ IM.split mini ss
|
||||
guard $ Just (k, mini - 1) /= ab
|
||||
-- return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsUp k xs w
|
||||
return . doDrag cfig (n - 1) k $ shiftInvItemsUp k xs w
|
||||
return . doDrag (n - 1) k $ (uvWorld %~ shiftInvItemsUp k xs) u
|
||||
_ | x > (k, maxi) -> do
|
||||
guard $ not . null . snd $ IM.split maxi ss
|
||||
guard $ Just (k, maxi + 1) /= bn
|
||||
-- return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsDown k xs w
|
||||
return . doDrag cfig (n - 1) k $ shiftInvItemsDown k xs w
|
||||
return . doDrag (n - 1) k $ (uvWorld %~ shiftInvItemsDown k xs) u
|
||||
_ -> Nothing
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
|
||||
setSelWhileDragging :: Config -> World -> World
|
||||
setSelWhileDragging cfig w = fromMaybe w $ do
|
||||
Sel i _ <- w ^? hud . diSelection . _Just
|
||||
xs <- w ^? hud . diSections . ix i . ssSet
|
||||
setSelWhileDragging :: Universe -> Universe
|
||||
setSelWhileDragging u = fromMaybe u $ do
|
||||
Sel i _ <- u ^? uvWorld . hud . diSelection . _Just
|
||||
xs <- u ^? uvWorld . hud . diSections . ix i . ssSet
|
||||
-- (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
|
||||
(k, j) <- inverseSelNumPos cfig invDP (w ^. input . mousePos) (w ^. hud . diSections) ^? _Just . nonInf
|
||||
(k, j) <- mouseInvPos u ^? _Just . nonInf
|
||||
guard $ i == k && j `IS.member` xs
|
||||
return $ w & hud . diSelection . _Just . slInt .~ j
|
||||
return $ u & uvWorld . hud . diSelection . _Just . slInt .~ j
|
||||
|
||||
-- Sel i _ xs <- w ^? hud . diSelection . _Just
|
||||
-- (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
|
||||
@@ -561,8 +566,6 @@ tryCombine (i, j) w = fromMaybe w $ do
|
||||
& soundStart InventorySound p wrench1S Nothing
|
||||
& hud . diSections . ix 1 . ssSet .~ mempty
|
||||
|
||||
-- & hud . diSelection . _Just . slSet .~ mempty
|
||||
|
||||
maybeExitCombine :: World -> World
|
||||
maybeExitCombine w
|
||||
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
|
||||
|
||||
Reference in New Issue
Block a user