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

Separate selected item from extra selected items

Browse Source
This commit is contained in:
justin
2024-11-22 15:34:14 +00:00
parent bc2c9c9369
commit 13f5dd09c8
6 changed files with 154 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
+8 -6
View File
@@ -5,9 +5,9 @@
module Dodge.Data.HUD where
import Data.IntSet (IntSet)
import Data.IntMap
import Control.Lens
import Data.IntMap
import Data.IntSet (IntSet)
import Dodge.Data.Button
import Dodge.Data.Combine
import Dodge.Data.FloorItem
@@ -21,7 +21,8 @@ data HUDElement
, _diSelection :: Maybe (Int, Int)
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _diSelectionExtra :: IntSet
, _diSelectionExtra :: IntSet -- this should probably be placed within _diSelection
-- would lead to inconsistency with _ciSelection
}
| DisplayCarte
@@ -33,9 +34,9 @@ data HUDElement
data SubInventory
= NoSubInventory
-- { _nsSelected :: MouseInventorySelection
-- }
| ExamineInventory
| -- { _nsSelected :: MouseInventorySelection
-- }
ExamineInventory
| CombineInventory
{ _ciSections :: IntMap (SelectionSection CombinableItem)
, _ciSelection :: Maybe (Int, Int)
@@ -55,4 +56,5 @@ data HUD = HUD
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
--makeLenses ''MouseInventorySelection
src/Dodge/Inventory/CheckSlots.hs
+1 -12
View File
@@ -16,22 +16,11 @@ import qualified IntMapHelp as IM
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w
| crNumFreeSlots ycr >= _itInvSize it =
Just $ findItemSlot (_crInv ycr)
Just . IM.newKey $ _crInv ycr
| otherwise = Nothing
where
ycr = you w
-- Assumes that the item is singular.
-- Do not want to stack floor items for now
findItemSlot :: IM.IntMap Item -> Int
findItemSlot = maybe 0 ((+ 1) . fst) . IM.lookupMax
--findItemSlot it inv = case it ^? itUse . useAmount of
-- Just _ ->
-- fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
-- _ -> newslot
-- where
-- newslot = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
src/Dodge/Render/HUD.hs
+2 -2
View File
@@ -135,12 +135,12 @@ drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
ys <- w ^? hud . hudElement . diSelectionExtra
guard $ not (IS.null ys)
(i,j) <- 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) <>)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) . IS.foldr f mempty $ IS.insert j ys
. color (withAlpha 0.2 white) . IS.foldr f mempty $ ys
drawDragSelect :: Configuration -> World -> Maybe Picture
drawDragSelect cfig w = do
src/Dodge/Update/Input/InGame.hs
+61 -18
View File
@@ -101,13 +101,14 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
return $ w & input . mouseContext . mcoSelEnd .~ msel
OverInvDrag k mmouseover -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
_ <- mmouseover
let mpos = w ^. input . mousePos
(j, i) <- w ^? hud . hudElement . diSelection . _Just
guard $ j == k -- this should always be the case?
x <- w ^? hud . hudElement . diSelectionExtra
return $ w & dragInvItems k (IS.insert i x) cfig mpos ldp sss
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelectionExtra
return $ if concurrentIS is
then shiftInvItems' k x is ss w
else collectInvItems is w
-- let mpos = w ^. input . mousePos
-- return $ w & dragInvItems k xs cfig mpos ldp sss
_ -> w
where
ldp = invDisplayParams w
@@ -115,24 +116,24 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
dropSelected :: World -> World
dropSelected w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, j) <- w ^? hud . hudElement . diSelection . _Just
(0, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
return $ IS.foldr (dropItem cr) w xs
tryDropSelected :: World -> Maybe World
tryDropSelected w = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, j) <- w ^? hud . hudElement . diSelection . _Just
(0, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
return $ IS.foldr (dropItem cr) w xs
tryPickupSelected :: World -> Maybe World
tryPickupSelected w = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(3, j) <- w ^? hud . hudElement . diSelection . _Just
(3, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
OverInvDrag 3 x <- w ^? input . mouseContext
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
return $ IS.foldr (dropItem cr) w xs
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
@@ -207,7 +208,7 @@ startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b `IS.member` IS.insert j xs
guard $ i == a && b `IS.member` xs
return $ setmichosen xs w
where
setmichosen x =
@@ -246,6 +247,44 @@ collectInvItems is w = fromMaybe w $ do
(k, ks) <- IS.minView js
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
shiftInvItems' ::
Int ->
(Int,Int) ->
IS.IntSet ->
IM.IntMap (SelectionItem a) ->
World ->
World
shiftInvItems' k x xs ss w = fromMaybe w $ do
(maxi,_) <- IS.maxView xs
(mini,_) <- IS.minView xs
if x < (k,mini)
then do
minss <- IM.lookupMin ss
guard (mini > fst minss)
return $ shiftInvItemsUp k xs w
else do
guard $ x > (k,maxi)
maxss <- IM.lookupMax ss
guard (maxi < fst maxss)
return $ shiftInvItemsDown k xs w
-- if
-- Just p -> fromMaybe w $ do
-- (k,_) <- IS.minView xs
-- guard $ p < (j,k)
-- ss <- sss ^? ix j . ssItems
-- minsss <- IM.lookupMin ss
-- guard (k > fst minsss)
-- return $ shiftInvItemsUp j xs w
-- _ -> case inverseSelBoundaryDown cfig ldp sss mpos of
-- Just p -> fromMaybe w $ do
-- (k,_) <- IS.maxView xs
-- guard $ p > (j,k)
-- ss <- sss ^? ix j . ssItems
-- maxsss <- IM.lookupMax ss
-- guard (k < fst maxsss)
-- return $ shiftInvItemsDown j xs w
-- _ -> w
shiftInvItems ::
Int ->
IS.IntSet ->
@@ -256,16 +295,20 @@ shiftInvItems ::
World ->
World
shiftInvItems j xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
Just p | p < (j, IS.findMin xs) -> fromMaybe w $ do
Just p -> fromMaybe w $ do
(k,_) <- IS.minView xs
guard $ p < (j,k)
ss <- sss ^? ix j . ssItems
minsss <- IM.lookupMin ss
guard (IS.findMin xs > fst minsss)
guard (k > fst minsss)
return $ shiftInvItemsUp j xs w
_ -> case inverseSelBoundaryDown cfig ldp sss mpos of
Just p | p > (j, IS.findMax xs) -> fromMaybe w $ do
Just p -> fromMaybe w $ do
(k,_) <- IS.maxView xs
guard $ p > (j,k)
ss <- sss ^? ix j . ssItems
maxsss <- IM.lookupMax ss
guard (IS.findMax xs < fst maxsss)
guard (k < fst maxsss)
return $ shiftInvItemsDown j xs w
_ -> w