64 lines
2.2 KiB
Haskell
64 lines
2.2 KiB
Haskell
-- | Capture input events, store them in structures for later use.
|
|
-- Should not update the world other than this.
|
|
module Dodge.Event.Input (
|
|
handleKeyboardEvent,
|
|
handleTextInput,
|
|
handleMouseMotionEvent,
|
|
handleMouseButtonEvent,
|
|
handleMouseWheelEvent,
|
|
) where
|
|
|
|
import Dodge.Data.Config
|
|
import Dodge.Data.Input
|
|
import LensHelp
|
|
import SDL
|
|
--import qualified Data.Map.Strict as M
|
|
|
|
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
|
|
-- dealt with separately
|
|
handleTextInput :: String -> Input -> Input
|
|
handleTextInput text = textInput %~ (++ map Right text)
|
|
|
|
-- | Handles keyboard press and release.
|
|
handleKeyboardEvent :: KeyboardEventData -> Input -> Input
|
|
handleKeyboardEvent kev = case keyboardEventKeyMotion kev of
|
|
Released -> pressedKeys . at scode .~ Nothing
|
|
Pressed -> (pressedKeys . at scode ?~ val)
|
|
. addTermSignal scode
|
|
where
|
|
val
|
|
| keyboardEventRepeat kev = LongPress
|
|
| otherwise = InitialPress
|
|
scode = (keysymScancode . keyboardEventKeysym) kev
|
|
|
|
addTermSignal :: Scancode -> Input -> Input
|
|
addTermSignal sc = case sc of
|
|
ScancodeBackspace -> textInput .:~ Left TSbackspace
|
|
ScancodeEscape -> textInput .:~ Left TSescape
|
|
ScancodeReturn -> textInput .:~ Left TSreturn
|
|
_ -> id
|
|
|
|
handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
|
|
handleMouseMotionEvent mmev cfig =
|
|
set mousePos themousepos
|
|
. set mouseMoving True
|
|
where
|
|
P (V2 x y) = mouseMotionEventPos mmev
|
|
themousepos =
|
|
V2
|
|
(fromIntegral x - 0.5 * windowXFloat cfig)
|
|
(0.5 * windowYFloat cfig - fromIntegral y)
|
|
|
|
handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input
|
|
handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y
|
|
where
|
|
V2 _ y = mouseWheelEventPos mwev
|
|
|
|
handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input
|
|
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
|
|
Released -> mouseButtons . at thebutton .~ Nothing
|
|
Pressed -> mouseButtons . at thebutton ?~ 1 -- note that mouse button events are NOT repeating
|
|
where
|
|
-- pointtothebutton = mouseButtons . at thebutton
|
|
thebutton = mouseButtonEventButton mbev
|