diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 27142201a..993a2dada 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -60,9 +60,9 @@ handleResizeEvent sev = Just . set windowX (fromIntegral x) handlePressedMouseButton :: MouseButton -> World -> Maybe World handlePressedMouseButton but w - | (but == ButtonRight && _carteDisplay w) || (but == ButtonMiddle && not (_carteDisplay w)) - = Just $ w & clickMousePos .~ _mousePos w -handlePressedMouseButton _ w = Just w + | but == ButtonMiddle || _carteDisplay w + = Just $ w & clickMousePos .~ _mousePos w + | otherwise = Just w wheelUpEvent :: World -> World wheelUpEvent w = case _carteDisplay w of diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 4f66f4f35..41727e19b 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -12,18 +12,38 @@ import qualified Data.Set as S import Control.Lens 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 keys w | lbPressed && rbPressed - = useItem (_yourID w) w - | mbPressed - = set clickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w - | otherwise - = w - where lbPressed = ButtonLeft `S.member` keys - rbPressed = ButtonRight `S.member` keys - mbPressed = ButtonMiddle `S.member` keys - rotation = angleBetween (_mousePos w) (_clickMousePos w) + = useItem (_yourID w) w + | mbPressed = w & clickMousePos .~ _mousePos w + & cameraRot -~ rotation + | otherwise = w + where + lbPressed = ButtonLeft `S.member` keys + rbPressed = ButtonRight `S.member` keys + mbPressed = ButtonMiddle `S.member` keys + 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) +