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

Improve map

Browse Source
This commit is contained in:
justin
2021-03-26 15:17:47 +01:00
parent 07d84cc1c6
commit 9f6d1442b3
2 changed files with 33 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Event.hs
+3 -3
View File
@@ -60,9 +60,9 @@ handleResizeEvent sev = Just . set windowX (fromIntegral x)
handlePressedMouseButton :: MouseButton -> World -> Maybe World handlePressedMouseButton :: MouseButton -> World -> Maybe World
handlePressedMouseButton but w handlePressedMouseButton but w
| (but == ButtonRight && _carteDisplay w) || (but == ButtonMiddle && not (_carteDisplay w)) | but == ButtonMiddle || _carteDisplay w
= Just $ w & clickMousePos .~ _mousePos w = Just $ w & clickMousePos .~ _mousePos w
handlePressedMouseButton _ w = Just w | otherwise = Just w
wheelUpEvent :: World -> World wheelUpEvent :: World -> World
wheelUpEvent w = case _carteDisplay w of wheelUpEvent w = case _carteDisplay w of
src/Dodge/Update/UsingInput.hs
+30 -10
View File
@@ -12,18 +12,38 @@ import qualified Data.Set as S
import Control.Lens import Control.Lens
updateUsingInput :: World -> World updateUsingInput :: World -> World
updateUsingInput w = updatePressedButtons (_mouseButtons w) w updateUsingInput w =
if _carteDisplay w
then updatePressedButtonsCarte (_mouseButtons w) w
else updatePressedButtons (_mouseButtons w) w
updatePressedButtons :: S.Set MouseButton -> World -> World updatePressedButtons :: S.Set MouseButton -> World -> World
updatePressedButtons keys w updatePressedButtons keys w
| lbPressed && rbPressed | lbPressed && rbPressed
= useItem (_yourID w) w = useItem (_yourID w) w
| mbPressed | mbPressed = w & clickMousePos .~ _mousePos w
= set clickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w & cameraRot -~ rotation
| otherwise | otherwise = w
= w where
where lbPressed = ButtonLeft `S.member` keys lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys mbPressed = ButtonMiddle `S.member` keys
rotation = angleBetween (_mousePos w) (_clickMousePos w) rotation = angleBetween (_mousePos w) (_clickMousePos w)
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte keys w
| rbPressed = w & clickMousePos .~ _mousePos w
& carteCenter %~ (-.- trans)
| lbPressed = w & clickMousePos .~ _mousePos w
& carteRot -~ rot
& carteZoom *~ zoom
| otherwise = w
where
lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys
rot = angleBetween (_mousePos w) (_clickMousePos w)
zoom = magV (_mousePos w) / magV (_clickMousePos w)
trans = rotateV (_carteRot w) $ (1 / _carteZoom w) *.* (_mousePos w -.- _clickMousePos w)