58 lines
2.1 KiB
Haskell
58 lines
2.1 KiB
Haskell
{- |
|
|
Module : Dodge.Event
|
|
Description : Direct event handling
|
|
|
|
Deals with direct events.
|
|
This could include individual key or mouse presses.
|
|
However, we cannot handle multiple keys held down at once here,
|
|
(eg left mouse button + right mouse button)
|
|
because these are separate events.
|
|
Nor could we handle continuous mouse button input.
|
|
Instead we store button presses (in a Map) and deal with the combinations in
|
|
the simulation step; in particular see 'updatePressedButtons'.
|
|
-}
|
|
module Dodge.Event (
|
|
handleEvent,
|
|
) where
|
|
|
|
import Control.Monad
|
|
import qualified Data.Text as T
|
|
import Dodge.Concurrent
|
|
import Dodge.Data.Universe
|
|
import Dodge.Event.Input
|
|
import LensHelp
|
|
import Preload.Update
|
|
import SDL
|
|
|
|
handleEvent :: Event -> Universe -> Universe
|
|
handleEvent e u = case eventPayload e of
|
|
TextInputEvent tev -> inputpoint (handleTextInput (T.unpack $ textInputEventText tev)) u
|
|
KeyboardEvent kev -> inputpoint (handleKeyboardEvent kev) u
|
|
MouseMotionEvent mmev -> inputpoint (handleMouseMotionEvent mmev cfig) u
|
|
MouseButtonEvent mbev -> inputpoint (handleMouseButtonEvent mbev) u
|
|
MouseWheelEvent mwev -> inputpoint (handleMouseWheelEvent mwev) u
|
|
WindowSizeChangedEvent sev -> handleResizeEvent sev u
|
|
WindowMovedEvent mev -> handleWindowMoveEvent mev u
|
|
QuitEvent -> hardQuit u
|
|
WindowClosedEvent _ -> hardQuit u
|
|
_ -> u
|
|
where
|
|
inputpoint = over (uvWorld . input)
|
|
cfig = _uvConfig u
|
|
|
|
-- | Sets window position in config.
|
|
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Universe
|
|
handleWindowMoveEvent mev =
|
|
(uvConfig . windowPosX .~ fromIntegral x)
|
|
. (uvConfig . windowPosY .~ fromIntegral y)
|
|
where
|
|
P (V2 x y) = windowMovedEventPosition mev
|
|
|
|
-- using a sideeffect here for the io change seems to work better, more testing
|
|
-- later may be a good idea
|
|
handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Universe
|
|
handleResizeEvent sev = uvIOEffects %~ ((updatePreload . updateconfig) >=>)
|
|
where
|
|
updateconfig = (uvConfig . windowX .~ fromIntegral x) . (uvConfig . windowY .~ fromIntegral y)
|
|
V2 x y = windowSizeChangedEventSize sev
|