Implement downwards inventory drag, buggy
This commit is contained in:
+2
-7
@@ -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
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user