Cleanup
This commit is contained in:
@@ -3,11 +3,10 @@ module Dodge.Update.Input.InGame (
|
||||
updateMouseInGame,
|
||||
) where
|
||||
|
||||
import qualified Data.IntSet as IS
|
||||
import Dodge.ListDisplayParams
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntSet as IS
|
||||
import Data.List (sort)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
@@ -23,6 +22,7 @@ import Dodge.Event.Test
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Inventory
|
||||
import Dodge.Inventory.Add
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.Menu
|
||||
import Dodge.Save
|
||||
import Dodge.SelectionSections
|
||||
@@ -99,10 +99,10 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
||||
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
|
||||
return $ w & input . mouseContext . mcoSelEnd .~ msel
|
||||
OverInvDrag Nothing -> w
|
||||
OverInvDrag {} -> fromMaybe w $ do
|
||||
OverInvDrag{} -> fromMaybe w $ do
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
let mpos = w ^. input . mousePos
|
||||
(0,i) <- w ^? hud . hudElement . diSelection . _Just
|
||||
(0, i) <- w ^? hud . hudElement . diSelection . _Just
|
||||
x <- w ^? hud . hudElement . diSelectionExtra
|
||||
return $ w & dragInvItems (IS.insert i x) cfig mpos ldp sss
|
||||
_ -> w
|
||||
@@ -112,49 +112,50 @@ 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, j) <- w ^? hud . hudElement . diSelection . _Just
|
||||
xs <- w ^? hud . hudElement . diSelectionExtra
|
||||
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
|
||||
|
||||
updateMouseReleaseInGame :: World -> World
|
||||
updateMouseReleaseInGame w = case w ^. input . mouseContext of
|
||||
OverInvFiltDrag -> w & input . mouseContext .~ MouseInGame
|
||||
OverInvFiltDragDrop -> w & input . mouseContext .~ MouseInGame
|
||||
updateMouseReleaseInGame w = case w ^. input . mouseContext of
|
||||
OverInvDrag mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
|
||||
j <- mpos
|
||||
return $ w & input . mouseContext .~ OverInvSelect (0,j)
|
||||
j <- mpos
|
||||
return $ w & input . mouseContext .~ OverInvSelect (0, j)
|
||||
OverInvDragSelect _ Nothing ->
|
||||
w & input . mouseContext .~ MouseInGame
|
||||
& hud . hudElement . diSelectionExtra .~ mempty
|
||||
w & input . mouseContext .~ MouseInGame
|
||||
& hud . hudElement . diSelectionExtra .~ mempty
|
||||
OverInvDragSelect ssel (Just esel) ->
|
||||
w & input . mouseContext .~ MouseInGame
|
||||
& hud . hudElement . diSelectionExtra
|
||||
.~ IS.fromAscList [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
|
||||
& augInvDirectSelect (min ssel esel)
|
||||
w & input . mouseContext .~ MouseInGame
|
||||
& hud . hudElement . diSelectionExtra
|
||||
.~ IS.fromAscList [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
|
||||
& augInvDirectSelect (min ssel esel)
|
||||
_ -> w
|
||||
|
||||
updateMouseClickInGame :: Configuration -> World -> World
|
||||
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
MouseInGame -> fromMaybe w $ do
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
|
||||
return $
|
||||
w & input . mouseContext
|
||||
.~ OverInvDragSelect ysel Nothing
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
|
||||
return $
|
||||
w & input . mouseContext
|
||||
.~ OverInvDragSelect ysel Nothing
|
||||
OverInvSelect x -> startDrag x w
|
||||
OverTerminalReturn tmid -> terminalReturnEffect tmid w
|
||||
OverTerminalEscape -> w
|
||||
& hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
|
||||
OverTerminalEscape ->
|
||||
w
|
||||
& hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
|
||||
OverCombSelect x ->
|
||||
w & hud . hudElement . subInventory . ciSelection ?~ x
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
OverCombFilter ->
|
||||
w & hud . hudElement . subInventory . ciFilter .~ Nothing
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
OverCombCombine (i, j) ->
|
||||
(worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
|
||||
tryCombine (i, j) w
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
OverCombCombine x ->
|
||||
w
|
||||
& tryCombine x
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
& maybeExitCombine
|
||||
OverCombEscape ->
|
||||
w
|
||||
& worldEventFlags . at InventoryChange ?~ ()
|
||||
@@ -178,13 +179,11 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
mpos = w ^. input . mousePos
|
||||
|
||||
startDrag :: (Int, Int) -> World -> World
|
||||
startDrag (a, b) w = case w ^? hud . hudElement . diInvFilter . _Just of
|
||||
Just {} -> w & input . mouseContext .~ OverInvFiltDrag
|
||||
_ -> 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)
|
||||
return $ setmichosen xs w
|
||||
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)
|
||||
return $ setmichosen xs w
|
||||
where
|
||||
setmichosen x =
|
||||
(input . mouseContext .~ OverInvDrag (Just b))
|
||||
@@ -198,7 +197,7 @@ dragInvItems ::
|
||||
IM.IntMap (SelectionSection a) ->
|
||||
World ->
|
||||
World
|
||||
dragInvItems is cfig mpos ldp sss w
|
||||
dragInvItems is cfig mpos ldp sss w
|
||||
| nonconcurrent = collectInvItems is w
|
||||
| otherwise = shiftInvItems is cfig mpos ldp sss w
|
||||
where
|
||||
@@ -208,19 +207,18 @@ concurrentIS :: IS.IntSet -> Bool
|
||||
concurrentIS = go . IS.minView
|
||||
where
|
||||
go Nothing = True
|
||||
go (Just (i,is)) = fromMaybe True $ do
|
||||
(j,js) <- IS.minView is
|
||||
return $ i + 1 == j && go (Just (j,js))
|
||||
go (Just (i, is)) = fromMaybe True $ do
|
||||
(j, js) <- IS.minView is
|
||||
return $ i + 1 == j && go (Just (j, js))
|
||||
|
||||
collectInvItems :: IS.IntSet -> World -> World
|
||||
collectInvItems is w = fromMaybe w $ do
|
||||
(j,js) <- IS.minView is
|
||||
(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'
|
||||
|
||||
(k, ks) <- IS.minView js
|
||||
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
|
||||
|
||||
shiftInvItems ::
|
||||
IS.IntSet ->
|
||||
@@ -231,9 +229,9 @@ shiftInvItems ::
|
||||
World ->
|
||||
World
|
||||
shiftInvItems xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
|
||||
Just p | p < (0,IS.findMin xs) -> shiftInvItemsUp xs w
|
||||
Just p | p < (0, IS.findMin xs) -> shiftInvItemsUp xs w
|
||||
_ -> case inverseSelBoundaryDown cfig ldp sss mpos of
|
||||
Just p | p > (0,IS.findMax xs) -> shiftInvItemsDown xs w
|
||||
Just p | p > (0, IS.findMax xs) -> shiftInvItemsDown xs w
|
||||
_ -> w
|
||||
|
||||
shiftInvItemsUp :: IS.IntSet -> World -> World
|
||||
@@ -252,7 +250,6 @@ shiftInvItemsDown is w = fromMaybe w $ do
|
||||
f i' w' = swapInvItems g i' w'
|
||||
g i' m = fst <$> IM.lookupGT i' m
|
||||
|
||||
|
||||
updateFunctionKeys :: Universe -> Universe
|
||||
updateFunctionKeys u =
|
||||
M.foldlWithKey'
|
||||
@@ -342,7 +339,7 @@ doRegexInput ::
|
||||
(IM.IntMap (SelectionSection a), Maybe (Int, Int), Maybe String)
|
||||
doRegexInput inp i sss msel filts
|
||||
| backspacetonothing || escapekey = endregex i 0
|
||||
| endkeys || endmouse = endregex (i + 1) (j -1)
|
||||
| endkeys = endregex (i + 1) (j -1)
|
||||
| otherwise =
|
||||
( sss
|
||||
, msel
|
||||
@@ -362,7 +359,6 @@ doRegexInput inp i sss msel filts
|
||||
any
|
||||
((== Just InitialPress) . (`M.lookup` pkeys))
|
||||
[ScancodeReturn, ScancodeSlash]
|
||||
endmouse = (Just 0 ==) $ inp ^? mouseButtons . ix ButtonLeft
|
||||
backspacetonothing =
|
||||
filts == Just ""
|
||||
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
|
||||
@@ -481,7 +477,7 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
|
||||
thepointer = hud . hudElement . subInventory
|
||||
|
||||
tryCombine ::
|
||||
-- IM.IntMap (SelectionSection CombinableItem) ->
|
||||
-- IM.IntMap (SelectionSection CombinableItem) ->
|
||||
(Int, Int) ->
|
||||
World ->
|
||||
World
|
||||
@@ -498,5 +494,4 @@ maybeExitCombine :: World -> World
|
||||
maybeExitCombine w
|
||||
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
|
||||
| otherwise =
|
||||
w & hud . hudElement . subInventory
|
||||
.~ NoSubInventory --MouseInvNothing
|
||||
w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
|
||||
Reference in New Issue
Block a user