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

Improve control over floor items and buttons

Browse Source
This commit is contained in:
jgk
2021-03-09 01:18:44 +01:00
parent 13cc9501a7
commit 2310bd1b09
7 changed files with 72 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/KeyEvents.hs
+5 -3
View File
@@ -104,7 +104,8 @@ wheelUpEvent :: World -> World
wheelUpEvent w
= case _mapDisplay w of
(True,z) -> w & mapDisplay . _2 .~ min 0.3 (z+(0.1*z))
_ | rbPressed -> fromMaybe w $ (yourItem w ^? itScrollUp) <*> pure (_crInvSel (you w))
_ | rbPressed -> fromMaybe (closeObjScrollUp w)
$ (yourItem w ^? itScrollUp) <*> pure (_crInvSel (you w))
<*> pure w
| lbPressed -> w {_cameraZoom = _cameraZoom w + 0.1}
| otherwise -> upInvPos w
@@ -115,7 +116,8 @@ wheelDownEvent :: World -> World
wheelDownEvent w
= case _mapDisplay w of
(True,z) -> w & mapDisplay . _2 .~ max 0.05 (z-(0.1*z))
_ | rbPressed -> fromMaybe w $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w))
_ | rbPressed -> fromMaybe (closeObjScrollDown w)
$ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w))
<*> pure w
| lbPressed -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
| otherwise -> downInvPos w
@@ -172,7 +174,7 @@ mouseActionsWorld keys w
rotation = angleBetween (_mousePos w) (_lbClickMousePos w)
spaceAction :: World -> World
spaceAction w = case closestActiveObject w of
spaceAction w = case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem' flit w
Just (Right but) -> _btEvent but but w
Nothing -> w