72 lines
2.4 KiB
Haskell
72 lines
2.4 KiB
Haskell
{- | Capture input events, store them in structures for later use.
|
|
-}
|
|
module Dodge.Event.Input (
|
|
handleKeyboardEvent,
|
|
handleTextInput,
|
|
handleMouseMotionEvent,
|
|
handleMouseButtonEvent,
|
|
handleMouseWheelEvent,
|
|
) where
|
|
|
|
import Dodge.Data.Config
|
|
import Dodge.Data.Input
|
|
import LensHelp
|
|
import SDL
|
|
|
|
-- 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
|
|
ScancodeDelete -> textInput .:~ Left TSdelete
|
|
ScancodeTab -> textInput .:~ Left TStab
|
|
ScancodeLeft -> textInput .:~ Left TSleft
|
|
ScancodeRight -> textInput .:~ Left TSright
|
|
ScancodeUp -> textInput .:~ Left TSup
|
|
ScancodeDown -> textInput .:~ Left TSdown
|
|
_ -> 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 theinput = case mouseButtonEventMotion mbev of
|
|
Released -> theinput & mouseButtons . at thebutton .~ Nothing
|
|
Pressed -> theinput
|
|
& mouseButtons . at thebutton ?~ 0
|
|
& clickPos . at thebutton ?~ (theinput ^. mousePos)
|
|
-- note that mouse button down events are NOT repeating
|
|
where
|
|
thebutton = mouseButtonEventButton mbev
|