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

Refactor map, add location arrows

Browse Source
This commit is contained in:
justin
2021-03-26 03:13:18 +01:00
parent d79a8a862e
commit b46adf9898
8 changed files with 192 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Event.hs
+10 -7
View File
@@ -56,8 +56,8 @@ handlePressedMouseButton ButtonMiddle w = Just $ set lbClickMousePos (_mousePos
handlePressedMouseButton _ w = Just w
wheelUpEvent :: World -> World
wheelUpEvent w = case _mapDisplay w of
(True,z) -> w & mapDisplay . _2 .~ min 0.3 (z+(0.1*z))
wheelUpEvent w = case _carteDisplay w of
True -> w & carteZoom .~ min 0.5 (z+(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollUp w)
$ (yourItem w ^? itScrollUp)
<*> pure (_crInvSel (you w))
@@ -68,18 +68,21 @@ wheelUpEvent w = case _mapDisplay w of
lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
z = _carteZoom w
wheelDownEvent :: World -> World
wheelDownEvent w = case _mapDisplay w of
(True,z) -> w & mapDisplay . _2 .~ max 0.05 (z-(0.1*z))
wheelDownEvent w = case _carteDisplay w of
True -> w & carteZoom .~ max 0.05 (z-(0.1*z))
_ | 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
where lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
where
lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
z = _carteZoom w
upInvPos :: World -> World
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w