Implement downwards inventory drag, buggy

This commit is contained in:
2024-10-25 10:40:22 +01:00
parent 0c5a21765a
commit 4da5bfa497
2 changed files with 38 additions and 27 deletions
+2 -7
View File
@@ -1,10 +1,5 @@
/home/justin/Haskell/loop/src/Dodge/Update.hs:356:5-9: warning: [-Wunused-local-binds]
/home/justin/Haskell/loop/src/Dodge/Update.hs:366:5-9: warning: [-Wunused-local-binds]
Defined but not used: mysel
|
356 | mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
366 | mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
| ^^^^^
/home/justin/Haskell/loop/src/Dodge/Update.hs:359:17-19: warning: [-Wunused-matches]
Defined but not used: sss
|
359 | shiftInvItemsUp sss (_,i) w = fromMaybe w $ do
| ^^^
+36 -20
View File
@@ -292,8 +292,9 @@ checkTermDist w = fromMaybe w $ do
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos (_crPos $ you w) > 40
return $ w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
return $
w & hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
updateMouseInventorySelection :: Configuration -> World -> World
updateMouseInventorySelection cfig w = fromMaybe w $ do
@@ -306,8 +307,9 @@ updateMouseInventorySelection' sss cfig w
| leftclickstart = case msel of
Nothing -> fromMaybe w $ do
ysel <- mysel
return $ w & hud . hudElement . subInventory . nsSelected
.~ MouseInvSelect ysel Nothing
return $
w & hud . hudElement . subInventory . nsSelected
.~ MouseInvSelect ysel Nothing
Just p -> startDrag p w
| leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
Just MouseInvSelect{} ->
@@ -319,7 +321,7 @@ updateMouseInventorySelection' sss cfig w
| otherwise = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect ssel (Just esel)) ->
w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
& hud . hudElement . diSelectionExtra
& hud . hudElement . diSelectionExtra
.~ (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
& augInvDirectSelect (min ssel esel)
Just (MouseInvSelect _ Nothing) ->
@@ -334,35 +336,49 @@ updateMouseInventorySelection' sss cfig w
msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
startDrag :: (Int,Int) -> World -> World
startDrag (a,b) w = fromMaybe (augInvDirectSelect (a,b) $ setmichosen 0 w) $ do
(i,j) <- w ^? hud . hudElement . diSelection . _Just
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen 0 w) $ do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
x <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b >= j && b <= j + x
return $ setmichosen x w
where
setmichosen x = (hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
. (hud . hudElement . diSelectionExtra .~ x)
setmichosen x =
(hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
. (hud . hudElement . diSelectionExtra .~ x)
shiftInvItems :: (Int,Int) -> Configuration -> Point2
-> ListDisplayParams
-> SelectionSections a
-> World
-> World
shiftInvItems ::
(Int, Int) ->
Configuration ->
Point2 ->
ListDisplayParams ->
SelectionSections a ->
World ->
World
shiftInvItems topsel cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
Just p | p < topsel -> shiftInvItemsUp sss topsel w
_ -> w
Just p | p < topsel -> shiftInvItemsUp topsel w
_ -> fromMaybe w $ do
x <- w ^? hud . hudElement . diSelectionExtra
return $ case inverseSelBoundaryDown cfig ldp sss mpos of
Just p | p > (topsel & _2 +~ x) -> shiftInvItemsDown topsel x w
_ -> w
where
mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
shiftInvItemsUp :: SelectionSections a -> (Int,Int) -> World -> World
shiftInvItemsUp sss (_,i) w = fromMaybe w $ do
shiftInvItemsUp :: (Int, Int) -> World -> World
shiftInvItemsUp (_, i) w = fromMaybe w $ do
x <- w ^? hud . hudElement . diSelectionExtra
return $ foldl' f w [i..i+x]
return $ foldl' f w [i .. i + x]
where
f w' i' = swapInvItems g i' w'
g i' m = fmap fst $ IM.cycleLT i' m
shiftInvItemsDown :: (Int, Int) -> Int -> World -> World
shiftInvItemsDown (_, i) x w = foldl' f w $ reverse [i .. i + x]
where
f w' i' = swapInvItems g i' w'
g i' m = fmap fst $ IM.cycleGT i' m
--shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
--shiftInvItemsUp (_, i) (_, j) Just{} w =
-- w