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

Tweak mouse context/cursors

Browse Source
This commit is contained in:
justin
2024-11-15 22:53:33 +00:00
parent 4434093d81
commit 0621709f7b
7 changed files with 288 additions and 205 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+8 -3
View File
@@ -18,9 +18,14 @@ data PressType
data MouseContext
= NoMouseContext
| OverInv { _mcoInv :: (Int,Int)}
| OverCombInv { _mcoCombInv :: (Int,Int)}
| OverTerminalScreen
| MouseAiming
| OverInvSelect { _mcoInvSelect :: (Int,Int)}
| OverInvFilt { _mcoInvFilt :: (Int,Int)}
| OverCombSelect { _mcoCombSelect :: (Int,Int)}
| OverCombCombine { _mcoCombCombine :: (Int,Int)}
| OverCombFilter
| OverTerminalReturn
| OverTerminalEscape
data Input = Input
{ _mousePos :: Point2 -- in pixels, from the center of the screen
src/Dodge/Render/HUD.hs
+5 -6
View File
@@ -117,7 +117,8 @@ drawMouseOver :: Configuration -> World -> Picture
drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
where
invsel = do
(j, i) <- w ^? input . mouseContext . mcoInv
(j, i) <- w ^? input . mouseContext . mcoInvSelect <|>
w ^? input . mouseContext . mcoInvFilt
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
@@ -125,7 +126,8 @@ drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
$ selSecDrawCursorAt 15 idp curs sss (j, i)
curs = BackdropCursor
combinvsel = do
(j, i) <- w ^? input . mouseContext . mcoCombInv
(j, i) <- (w ^? input . mouseContext . mcoCombSelect)
<|> (w ^? input . mouseContext . mcoCombCombine)
sss <- w ^? hud . hudElement . subInventory . ciSections
let idp = secondColumnParams
return . translateScreenPos cfig (idp ^. ldpPos)
@@ -179,9 +181,7 @@ drawExamineInventory cfig w =
secondColumnParams
cfig
( defaultSelectionList & slItems
.~ map -- tweakItems itm
-- ++
f
.~ map f
( makeParagraph 55 $
yourAugmentedItem
itemInfo
@@ -191,7 +191,6 @@ drawExamineInventory cfig w =
)
)
where
-- itm = yourSelectedItem w
f str =
SelectionItem
{ _siPictures = [str]
src/Dodge/Render/Picture.hs
+35 -18
View File
@@ -20,7 +20,6 @@ fixedCoordPictures :: Universe -> Picture
fixedCoordPictures u =
drawMenuOrHUD cfig u
<> drawConcurrentMessage u
<> drawMouseCursor u
<> ttl (translate hw 0 $ drawList (map text (_uvTestString u u)))
<> ttl
( translate (0.5 * hw) (- hh)
@@ -31,6 +30,7 @@ fixedCoordPictures u =
)
<> displayFrameTicks u
<> aimDelaySweep (u ^. uvWorld)
<> drawMouseCursor u
where
cfig = _uvConfig u
hw = halfWidth cfig
@@ -78,23 +78,17 @@ drawMouseCursor u =
$ mouseCursorType u
mouseCursorType :: Universe -> Picture
mouseCursorType u
| isselect = drawPlus 5
| Just tmid <- u ^? uvWorld . hud . hudElement . subInventory . termID = determineTermCursor tmid u
| Just csel <- u ^? uvWorld . hud . hudElement . subInventory . ciSelection =
if ( csel == u ^? uvWorld . input . mouseContext . mcoCombInv
|| null (u ^? uvWorld . input . mouseContext . mcoCombInv)
)
&& null (u ^? uvWorld . input . mouseContext . mcoInv)
&& fmap fst csel /= Just (-1)
&& fromMaybe True (u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix 0 . ssItems . ix 0 . siIsSelectable) --HACK to check there is something creatable
then drawGapPlus 5
else drawPlus 5
| otherwise = rotate a (drawPlus 5)
mouseCursorType u = case u ^. uvWorld . input . mouseContext of
NoMouseContext -> drawPlus 5
MouseAiming -> rotate a (drawPlus 5)
OverInvSelect {} -> drawSelect 5
OverInvFilt {} -> drawCombFilter 5
OverCombSelect {} -> drawSelect 5
OverCombFilter {} -> drawCombFilterJump 5
OverCombCombine {} -> drawGapPlus 5
OverTerminalReturn -> drawReturn
OverTerminalEscape -> rotate (pi/4) $ drawPlus 5
where
isselect =
not (null $ u ^. uvScreenLayers)
|| not (null $ u ^? uvWorld . input . mouseContext . mcoInv)
w = u ^. uvWorld
a = fromMaybe 0 $ do
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
@@ -107,7 +101,13 @@ determineTermCursor tmid u = fromMaybe (drawPlus 5) $ do
return drawReturn
drawReturn :: Picture
drawReturn = scale 0.1 0.1 . translate (-50) (-100) $ text [toEnum 153]
drawReturn = fold
[line [V2 0 0, V2 3 3]
,line [V2 0 0, V2 3 (-3)]
,line [V2 0 0, V2 6 0]
,line [V2 6 0, V2 6 10]
]
--drawReturn = scale 0.1 0.1 . translate (-50) (-100) $ text [toEnum 153]
drawWireRectCursor :: Picture
drawWireRectCursor = scale 0.1 0.1 $ text [cWireRect]
@@ -116,6 +116,23 @@ drawWireRectCursor = scale 0.1 0.1 $ text [cWireRect]
drawPlus :: Float -> Picture
drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
drawCombFilterJump :: Float -> Picture
drawCombFilterJump x = rotate (0.25*pi)
$ fold [line [V2 0 0, V2 x 0], line [V2 0 0, V2 0 x]]
drawSelect :: Float -> Picture
drawSelect x = line
[ V2 x x
, V2 0 x
, V2 0 (-x)
, V2 x (-x)
] <>
line [V2 (-x) 0, V2 0 0]
drawCombFilter :: Float -> Picture
drawCombFilter x = rotate (0.25*pi)
$ fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 0]]
--drawDoublePlus :: Float -> Picture
--drawDoublePlus x = fold [line [V2 (- (1.5*x)) 0, V2 (1.5*x) 0]
-- , line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
src/Dodge/Update.hs
+24 -7
View File
@@ -389,19 +389,36 @@ shiftInvItemsDown (_, i) x w = fromMaybe w $ do
updateMouseContext :: Configuration -> World -> World
updateMouseContext cfig w =
w & input . mouseContext .~ fromMaybe NoMouseContext
w & input . mouseContext .~ fromMaybe aimcontext
(overinv <|> overcomb <|> overterm)
where
aimcontext
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = NoMouseContext
overinv = do
sss <- w ^? hud . hudElement . diSections
guard $
ButtonRight `M.notMember` (w ^. input . mouseButtons)
|| not (null $ w ^? hud . hudElement . subInventory . ciSelection)
fmap OverInv $ inverseSelNumPos cfig (invDisplayParams w) sss (w ^. input . mousePos)
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss (w ^. input . mousePos)
case w ^? hud . hudElement . subInventory . ciSelection of
Just _ -> return $ OverInvFilt selpos
_ -> do
guard $ ButtonRight `M.notMember` (w ^. input . mouseButtons)
return $ OverInvSelect selpos
overcomb = do
sss <- w ^? hud . hudElement . subInventory . ciSections
fmap OverCombInv $ inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
overterm = Nothing
msel <- w ^? hud . hudElement . subInventory . ciSelection . _Just
let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
case mpossel of
Nothing -> usecsel msel
Just (-1,_) -> return OverCombFilter
Just x | x == msel -> return $ OverCombCombine x
Just x -> return $ OverCombSelect x
-- fmap OverCombCombine $ inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
usecsel (-1,_) = return OverCombFilter
usecsel x = return $ OverCombCombine x
overterm = do
tmid <- w ^? hud . hudElement . subInventory . termID
guard True
return OverTerminalReturn
updateWheelEvents :: World -> World
updateWheelEvents w
src/Dodge/Update/Input/InGame.hs
+17 -9
View File
@@ -108,7 +108,7 @@ updateCombineInvClick ::
World ->
World
updateCombineInvClick msel sss w = fromMaybe trydocombination $ do
(i,j) <- w ^? input . mouseContext . mcoInv
(i,j) <- w ^? input . mouseContext . mcoInvFilt
guard $ i == 0
str <- fmap (take 5) $ w
^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
@@ -118,18 +118,26 @@ updateCombineInvClick msel sss w = fromMaybe trydocombination $ do
& hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
where
trydocombination = case w ^? input . mouseContext . mcoCombInv of
x@(Just (i,_))
| x /= msel -> w & hud . hudElement . subInventory . ciSelection .~ x
trydocombination = case w ^. input . mouseContext of
OverCombSelect x -> w & hud . hudElement . subInventory . ciSelection ?~ x
& worldEventFlags . at CombineInventoryChange ?~ ()
| i == -1 -> w & hud . hudElement . subInventory . ciFilter .~ Nothing
OverCombFilter -> w & hud . hudElement . subInventory . ciFilter .~ Nothing
& worldEventFlags . at CombineInventoryChange ?~ ()
_ | (w ^? hud . hudElement . subInventory . ciSelection . _Just . _1) == Just (-1)
-> w & hud . hudElement . subInventory . ciFilter .~ Nothing
& worldEventFlags . at CombineInventoryChange ?~ ()
_ -> (worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
OverCombCombine (i,j) -> (worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
tryCombine sss msel w
& worldEventFlags . at CombineInventoryChange ?~ ()
-- x@(Just (i,_))
-- | x /= msel -> w & hud . hudElement . subInventory . ciSelection .~ x
-- & worldEventFlags . at CombineInventoryChange ?~ ()
-- | i == -1 -> w & hud . hudElement . subInventory . ciFilter .~ Nothing
-- & worldEventFlags . at CombineInventoryChange ?~ ()
-- _ | (w ^? hud . hudElement . subInventory . ciSelection . _Just . _1) == Just (-1)
-- -> w & hud . hudElement . subInventory . ciFilter .~ Nothing
-- & worldEventFlags . at CombineInventoryChange ?~ ()
-- _ -> (worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
-- tryCombine sss msel w
-- & worldEventFlags . at CombineInventoryChange ?~ ()
updatePressedButtonsCarte :: World -> World
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w