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

Allow dragging of selected items in inventory

Browse Source
This commit is contained in:
justin
2024-10-20 11:32:37 +01:00
parent 8b6f5529ff
commit f6e32ff6ef
7 changed files with 259 additions and 158 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+55 -15
View File
@@ -6,6 +6,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.Inventory
import Dodge.ListDisplayParams
import Dodge.SelectionSections
import Data.Monoid
@@ -32,7 +33,6 @@ import Dodge.Distortion
import Dodge.DrWdWd
import Dodge.EnergyBall
import Dodge.Flame
import Dodge.Inventory
import Dodge.Item.Location
import Dodge.Laser.Update
import Dodge.LightSource.Update
@@ -295,27 +295,67 @@ checkTermDist w = fromMaybe w $ do
return (w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing)
updateMouseInventorySelection :: Configuration -> World -> World
updateMouseInventorySelection cfig w
updateMouseInventorySelection cfig w = fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
return $ updateMouseInventorySelection' sss cfig w
-- check whether leftclickstart evaluates to True on very short left clicks
updateMouseInventorySelection' :: SelectionSections a -> Configuration -> World -> World
updateMouseInventorySelection' sss cfig w
| leftclickstart = case msel of
Nothing -> fromMaybe w $ do
ysel <- mysel
return $ w & hud . hudElement . subInventory . nsSelected .~ MouseInvSelect ysel Nothing
Just (i,j) -> w & hud . hudElement . subInventory . nsSelected .~
MouseInvChosen (i,j) (i,j)
| leftclickheld = w
| otherwise = w
Just p -> w & hud . hudElement . subInventory . nsSelected %~ startdrag p
| leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
Just MouseInvSelect{} -> w
& hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
Just (MouseInvChosen ssel esel)
| maybe False (<ssel) $ inverseSelBoundaryUp cfig ldp sss mpos -> w
& shiftInvItemsUp ssel esel (inverseSelBoundaryUp cfig ldp sss mpos)
Just (MouseInvChosen ssel esel)
| maybe False (>esel) $ inverseSelBoundaryDown cfig ldp sss mpos -> w
& shiftInvItemsDown ssel esel (inverseSelBoundaryDown cfig ldp sss mpos)
Just (MouseInvChosen ssel esel) -> w
_ -> w
& hud . hudElement . subInventory . nsSelected .~ NoMouseSel
| otherwise = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect ssel (Just esel)) -> w
& hud . hudElement . subInventory . nsSelected .~ MouseInvChosen (min ssel esel)
(max ssel esel)
Just (MouseInvSelect _ Nothing) -> w
& hud . hudElement . subInventory . nsSelected .~ NoMouseSel
_ -> w
where
leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0
leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons)
startdrag p (MouseInvChosen s e) | s <= p && p <= e = MouseInvChosen s e
startdrag p _ = MouseInvChosen p p
leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0 && nobuttonright
leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons) && nobuttonright
nobuttonright = not $ ButtonRight `M.member` (w ^. input . mouseButtons)
mpos = w ^. input . mousePos
ldp = invDisplayParams w
msel = do
sss <- msss
inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
mysel = do
sss <- msss
inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
msss = w ^? hud . hudElement . diSections
msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
shiftInvItemsUp :: (Int,Int) -> (Int,Int) -> Maybe (Int,Int) -> World -> World
shiftInvItemsUp (_,i) (_,j) (Just (_,k)) w = w
& flip (foldl' f) [i..j]
& hud . hudElement . subInventory . nsSelected . misChosenStart . _2 -~ 1
& hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 -~ 1
where
f w' i' = swapInvItems g i' w'
g i' m = fmap fst $ IM.cycleLT i' m
shiftInvItemsUp _ _ Nothing w = w
shiftInvItemsDown :: (Int,Int) -> (Int,Int) -> Maybe (Int,Int) -> World -> World
shiftInvItemsDown (_,i) (_,j) (Just (_,k)) w = w
& flip (foldl' f) (reverse [i..j])
& hud . hudElement . subInventory . nsSelected . misChosenStart . _2 +~ 1
& hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 +~ 1
where
f w' i' = swapInvItems g i' w'
g i' m = fmap fst $ IM.cycleGT i' m
shiftInvItemsDown _ _ Nothing w = w
updateMouseOverInventory :: Configuration -> World -> World
updateMouseOverInventory cfig w = fromMaybe w $ do