72 lines
2.4 KiB
Haskell
72 lines
2.4 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{- | 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 | keyboardEventRepeat kev -> addTermSignal scode
|
|
Pressed -> (pressedKeys . at scode ?~ 0) . addTermSignal scode
|
|
where
|
|
scode = (keysymScancode . keyboardEventKeysym) kev
|
|
|
|
addTermSignal :: Scancode -> Input -> Input
|
|
addTermSignal = maybe id (\ts -> textInput .:~ Left ts) . scToTS
|
|
|
|
scToTS :: Scancode -> Maybe TermSignal
|
|
scToTS = \case
|
|
ScancodeBackspace -> Just TSbackspace
|
|
ScancodeEscape -> Just TSescape
|
|
ScancodeReturn -> Just TSreturn
|
|
ScancodeDelete -> Just TSdelete
|
|
ScancodeTab -> Just TStab
|
|
ScancodeLeft -> Just TSleft
|
|
ScancodeRight -> Just TSright
|
|
ScancodeUp -> Just TSup
|
|
ScancodeDown -> Just TSdown
|
|
_ -> Nothing
|
|
|
|
handleMouseMotionEvent :: MouseMotionEventData -> Config -> 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 inp = case mouseButtonEventMotion mbev of
|
|
Released -> inp & mouseButtons . at but .~ Nothing
|
|
& mouseButtonsReleased . at but ?~ 0
|
|
Pressed -> inp
|
|
& mouseButtons . at but ?~ 0
|
|
& mouseButtonsReleased . at but .~ Nothing
|
|
& clickPos . at but ?~ (inp ^. mousePos)
|
|
-- note that mouse button down events are NOT repeating
|
|
where
|
|
but = mouseButtonEventButton mbev
|