Improve scroll selection/inventory modification
This commit is contained in:
@@ -5,6 +5,7 @@ module Dodge.Update.Input.InGame (
|
||||
updateMouseInGame,
|
||||
) where
|
||||
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.Button.Event
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
@@ -98,7 +99,7 @@ updateMouseHeldInGame :: Config -> World -> World
|
||||
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
||||
OverInvDragSelect{}
|
||||
| ButtonRight `M.member` (w ^. input . mouseButtons) ->
|
||||
w & input . mouseContext .~ MouseGameRotate
|
||||
w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
|
||||
OverInvDragSelect (Just sstart) _ ->
|
||||
let sss = w ^. hud . diSections
|
||||
msel = inverseSelNumPos cfig invDP (w ^. input . mousePos) sss
|
||||
@@ -289,23 +290,6 @@ startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
|
||||
where
|
||||
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
|
||||
|
||||
concurrentIS :: IS.IntSet -> Bool
|
||||
concurrentIS = go . IS.minView
|
||||
where
|
||||
go x = fromMaybe True $ do
|
||||
(i, is) <- x
|
||||
(j, js) <- IS.minView is
|
||||
return $ i + 1 == j && go (Just (j, js))
|
||||
|
||||
collectInvItems :: Int -> IS.IntSet -> World -> World
|
||||
collectInvItems secid is w = fromMaybe w $ do
|
||||
guard $ secid == 0
|
||||
(j, js) <- IS.minView is
|
||||
return $ h j js w
|
||||
where
|
||||
h j js w' = fromMaybe w' $ do
|
||||
(k, ks) <- IS.minView js
|
||||
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
|
||||
|
||||
shiftInvItems ::
|
||||
Config ->
|
||||
@@ -346,20 +330,6 @@ setSelWhileDragging w = fromMaybe w $ do
|
||||
guard $ i == k && j `IS.member` xs
|
||||
return $ w & hud . diSelection . _Just . slInt .~ j
|
||||
|
||||
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
|
||||
shiftInvItemsUp j is w = IS.foldl' f w is
|
||||
where
|
||||
f w' i' = swapItemWith g (j, i') w'
|
||||
g i' m = fst <$> IM.lookupLT i' m
|
||||
|
||||
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
|
||||
shiftInvItemsDown j is w = fromMaybe w $ do
|
||||
let i = IS.findMax is
|
||||
guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
|
||||
return $ IS.foldr f w is
|
||||
where
|
||||
f i' = swapItemWith g (j, i')
|
||||
g i' m = fst <$> IM.lookupGT i' m
|
||||
|
||||
updateFunctionKeys :: Universe -> Universe
|
||||
updateFunctionKeys u =
|
||||
|
||||
Reference in New Issue
Block a user