87 lines
3.4 KiB
Haskell
87 lines
3.4 KiB
Haskell
-- | Deals with keyboard events.
|
|
module Dodge.Event.Keyboard (
|
|
handleKeyboardEvent,
|
|
handleTextInput,
|
|
guardDisconnectedID,
|
|
) where
|
|
|
|
--import Data.Maybe
|
|
--import Data.Text (unpack)
|
|
import qualified Data.Text as T
|
|
import Dodge.Data.Universe
|
|
import Dodge.Event.Menu
|
|
import Dodge.InputFocus
|
|
import Dodge.Save
|
|
import Dodge.Terminal.LeftButton
|
|
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 using key presses (handlePressedKey)
|
|
-- also, note that this currently "doubles" the inputs to both terminals if both
|
|
-- are open
|
|
handleTextInput :: T.Text -> Universe -> Universe
|
|
handleTextInput text = uvWorld . input . textInput %~ T.append text
|
|
--handleTextInput text u = u
|
|
-- & uvScreenLayers . ix 0 . scInput %~ updateText
|
|
-- & updateTerminalText
|
|
-- where
|
|
-- updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
|
|
-- Just (DisplayTerminal tmid)
|
|
-- | hasfocus tmid ->
|
|
-- uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
|
|
-- _ -> id
|
|
-- hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
|
|
-- updateText s = case T.unpack text of
|
|
-- ";" -> s
|
|
-- _ -> s `T.append` T.toUpper text
|
|
|
|
guardDisconnectedID :: Int -> World -> World -> World
|
|
guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
|
|
Just TerminalReady -> w'
|
|
_ -> w
|
|
|
|
{- | Handles keyboard press and release.
|
|
On release, remove scancode from the 'Set' of pressed keys.
|
|
On press, adds the scancode, and perhaps applies a direct effect:
|
|
see 'handlePressedKeyInGame'.
|
|
-}
|
|
handleKeyboardEvent :: KeyboardEventData -> Universe -> Universe
|
|
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
|
|
Released -> u & uvWorld . input . pressedKeys . at scode .~ Nothing
|
|
Pressed ->
|
|
handlePressedKey
|
|
(keyboardEventRepeat kev)
|
|
scode
|
|
--(u & uvWorld . input . pressedKeys %~ M.insertWith f scode val)
|
|
(u & uvWorld . input . pressedKeys . at scode ?~ val)
|
|
where
|
|
val | keyboardEventRepeat kev = LongPress
|
|
| otherwise = InitialPress
|
|
scode = (keysymScancode . keyboardEventKeysym) kev
|
|
|
|
handlePressedKey :: Bool -> Scancode -> Universe -> Universe
|
|
handlePressedKey True _ u = u
|
|
handlePressedKey _ scode u = case scode of
|
|
ScancodeF5 -> doQuicksave u
|
|
ScancodeF9 -> loadSaveSlot QuicksaveSlot u
|
|
ScancodeSemicolon -> gotoTerminal u
|
|
_ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
|
|
Just (DisplayTerminal tmid)
|
|
| inTermFocus (_uvWorld u) ->
|
|
over uvWorld (handlePressedKeyTerminal tmid scode) u
|
|
_ -> u
|
|
_ -> handlePressedKeyInMenu (head $ _uvScreenLayers u) scode u
|
|
|
|
handlePressedKeyTerminal :: Int -> Scancode -> World -> World
|
|
handlePressedKeyTerminal tmid scode w = case scode of
|
|
ScancodeEscape -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
|
|
ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid)
|
|
_ -> w
|
|
|
|
gotoTerminal :: Universe -> Universe
|
|
gotoTerminal w = case _uvScreenLayers w of
|
|
(InputScreen{} : _) -> w
|
|
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
|