Allow dragging after single click
This commit is contained in:
+1
-1
@@ -1 +1 @@
|
|||||||
All good (593 modules, at 11:22:57)
|
All good (593 modules, at 12:39:43)
|
||||||
|
|||||||
+24
-17
@@ -166,8 +166,12 @@ updateUniverseMid u = case _uvScreenLayers u of
|
|||||||
. updateClouds
|
. updateClouds
|
||||||
)
|
)
|
||||||
(sl : _) -> u & updateUseInputOnScreen sl
|
(sl : _) -> u & updateUseInputOnScreen sl
|
||||||
[] -> timeFlowUpdate . updateUseInputInGame $ over uvWorld
|
[] ->
|
||||||
(updateMouseInGame (u ^. uvConfig)) u
|
timeFlowUpdate . updateUseInputInGame $
|
||||||
|
over
|
||||||
|
uvWorld
|
||||||
|
(updateMouseInGame (u ^. uvConfig))
|
||||||
|
u
|
||||||
|
|
||||||
timeFlowUpdate :: Universe -> Universe
|
timeFlowUpdate :: Universe -> Universe
|
||||||
timeFlowUpdate u = case u ^. uvWorld . timeFlow of
|
timeFlowUpdate u = case u ^. uvWorld . timeFlow of
|
||||||
@@ -287,7 +291,7 @@ functionalUpdate u =
|
|||||||
. over uvWorld updateRBList
|
. over uvWorld updateRBList
|
||||||
. over uvWorld updateCloseObjects
|
. over uvWorld updateCloseObjects
|
||||||
. over uvWorld updateWheelEvents
|
. over uvWorld updateWheelEvents
|
||||||
-- . over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
|
-- . over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
|
||||||
. over uvWorld zoneClouds
|
. over uvWorld zoneClouds
|
||||||
. over uvWorld zoneCreatures
|
. over uvWorld zoneCreatures
|
||||||
-- . over uvWorld updateInventorySelectionList
|
-- . over uvWorld updateInventorySelectionList
|
||||||
@@ -308,10 +312,11 @@ updateMouseContext :: Configuration -> Universe -> Universe
|
|||||||
updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
||||||
OverInvDrag i _ _ _ -> u & uvWorld . input . mouseContext .~ invdrag i
|
OverInvDrag i _ _ _ -> u & uvWorld . input . mouseContext .~ invdrag i
|
||||||
OverInvDragSelect{} -> u
|
OverInvDragSelect{} -> u
|
||||||
_ -> u & uvWorld . input . mouseContext
|
_ ->
|
||||||
.~ fromMaybe
|
u & uvWorld . input . mouseContext
|
||||||
aimcontext
|
.~ fromMaybe
|
||||||
(overmenu <|> overinv <|> overcomb <|> overterm)
|
aimcontext
|
||||||
|
(overmenu <|> overinv <|> overcomb <|> overterm)
|
||||||
where
|
where
|
||||||
overmenu = do
|
overmenu = do
|
||||||
screen <- u ^? uvScreenLayers . ix 0
|
screen <- u ^? uvScreenLayers . ix 0
|
||||||
@@ -320,7 +325,11 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
|||||||
_ -> fromMaybe MouseMenuCursor $ do
|
_ -> fromMaybe MouseMenuCursor $ do
|
||||||
ldps <- screen ^? scListDisplayParams
|
ldps <- screen ^? scListDisplayParams
|
||||||
let ymax = maybe 0 length $ screen ^? scSelectionList
|
let ymax = maybe 0 length $ screen ^? scSelectionList
|
||||||
yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
|
yi <-
|
||||||
|
ldpVerticalSelection
|
||||||
|
(u ^. uvConfig)
|
||||||
|
ldps
|
||||||
|
(u ^. uvWorld . input . mousePos)
|
||||||
guard (yi >= 0 && yi < ymax)
|
guard (yi >= 0 && yi < ymax)
|
||||||
return $
|
return $
|
||||||
if isselectable yi
|
if isselectable yi
|
||||||
@@ -329,7 +338,6 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
|||||||
isselectable yi =
|
isselectable yi =
|
||||||
fromMaybe False $
|
fromMaybe False $
|
||||||
u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable
|
u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable
|
||||||
-- mmoving = u ^. uvWorld . input . mouseMoving
|
|
||||||
w = u ^. uvWorld
|
w = u ^. uvWorld
|
||||||
aimcontext
|
aimcontext
|
||||||
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
|
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
|
||||||
@@ -338,10 +346,10 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
|||||||
invdrag i' = fromMaybe (OverInvDrag i' Nothing Nothing Nothing) $ do
|
invdrag i' = fromMaybe (OverInvDrag i' Nothing Nothing Nothing) $ do
|
||||||
sss <- w ^? hud . hudElement . diSections
|
sss <- w ^? hud . hudElement . diSections
|
||||||
let yint = posSelSecYint cfig (invDisplayParams w) (mpos ^. _y)
|
let yint = posSelSecYint cfig (invDisplayParams w) (mpos ^. _y)
|
||||||
(i,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
|
(i, j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
|
||||||
let above = inverseSelSecYint (yint - 1) sss
|
let above = inverseSelSecYint (yint - 1) sss
|
||||||
bneath = inverseSelSecYint (yint + 1) sss
|
bneath = inverseSelSecYint (yint + 1) sss
|
||||||
return $ OverInvDrag i' (Just (i,j)) above bneath
|
return $ OverInvDrag i' (Just (i, j)) above bneath
|
||||||
overinv = do
|
overinv = do
|
||||||
sss <- w ^? hud . hudElement . diSections
|
sss <- w ^? hud . hudElement . diSections
|
||||||
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
|
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
|
||||||
@@ -356,7 +364,7 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
|||||||
let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
|
let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
|
||||||
return $ case mpossel of
|
return $ case mpossel of
|
||||||
Nothing -> OverCombEscape
|
Nothing -> OverCombEscape
|
||||||
Just (-1, i) | (-1,i) == msel -> OverCombFilter
|
Just (-1, i) | (-1, i) == msel -> OverCombFilter
|
||||||
Just x | x == msel -> OverCombCombine x
|
Just x | x == msel -> OverCombCombine x
|
||||||
Just x -> OverCombSelect x
|
Just x -> OverCombSelect x
|
||||||
overterm = do
|
overterm = do
|
||||||
@@ -364,11 +372,10 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
|
|||||||
tm <- w ^? cWorld . lWorld . terminals . ix tmid
|
tm <- w ^? cWorld . lWorld . terminals . ix tmid
|
||||||
return $
|
return $
|
||||||
if isOverTerminalScreen cfig tm mpos
|
if isOverTerminalScreen cfig tm mpos
|
||||||
then
|
then fromMaybe NoMouseContext $ do
|
||||||
fromMaybe NoMouseContext $ do
|
let s = tm ^. tmInput . tiText
|
||||||
let s = tm ^. tmInput . tiText
|
guard $ not (null s) && _tmStatus tm == TerminalReady
|
||||||
guard $ not (null s) && _tmStatus tm == TerminalReady
|
return $ OverTerminalReturn tmid
|
||||||
return $ OverTerminalReturn tmid
|
|
||||||
else OverTerminalEscape
|
else OverTerminalEscape
|
||||||
|
|
||||||
isOverTerminalScreen :: Configuration -> Terminal -> Point2 -> Bool
|
isOverTerminalScreen :: Configuration -> Terminal -> Point2 -> Bool
|
||||||
|
|||||||
@@ -205,7 +205,7 @@ startDrag (a, b) cfig w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mem
|
|||||||
setmichosen :: IS.IntSet -> World -> World
|
setmichosen :: IS.IntSet -> World -> World
|
||||||
setmichosen x =
|
setmichosen x =
|
||||||
(input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
|
(input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
|
||||||
. (hud . hudElement . diSelectionExtra .~ x)
|
. (hud . hudElement . diSelectionExtra .~ IS.insert b x)
|
||||||
above :: Maybe (Int,Int)
|
above :: Maybe (Int,Int)
|
||||||
above = do
|
above = do
|
||||||
sss <- w ^? hud . hudElement . diSections
|
sss <- w ^? hud . hudElement . diSections
|
||||||
|
|||||||
Reference in New Issue
Block a user