{- | Deals with keyboard events. -} module Dodge.Event.Keyboard ( handleKeyboardEvent , handleTextInput , guardDisconnectedID ) where import Dodge.Terminal import Dodge.InputFocus import Dodge.Base import Dodge.Combine import Dodge.Creature.Action import Dodge.Data import Dodge.Event.Menu import Dodge.Event.Test import Dodge.Inventory import Dodge.Menu import Dodge.Reloading import Dodge.Save import LensHelp --import Color --import Data.List import qualified Data.IntMap.Strict as IM import Data.Maybe import qualified Data.Set as S import SDL --import Data.Text (unpack) import qualified Data.Text as T -- 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 u = u & menuLayers . ix 0 . scInput %~ updateText & updateTerminalText where updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | hasfocus tmid -> uvWorld %~ \w -> guardDisconnectedID tmid w (w & terminals . ix tmid . tmInput . tiText %~ updateText) _ -> id hasfocus tmid = fromMaybe False $ u ^? uvWorld . 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 ^? 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 -> IO (Maybe Universe) handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of Released -> return . Just $ u & uvWorld . keys %~ S.delete scode Pressed -> handlePressedKey (keyboardEventRepeat kev) scode (u & uvWorld . keys %~ S.insert scode) where scode = (keysymScancode . keyboardEventKeysym) kev handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKey True ScancodeBackspace u | _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u <&> _Just . uvWorld . backspaceTimer .~ 0 | otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1 handlePressedKey True _ u = return $ Just u handlePressedKey _ scode u = case scode of ScancodeF5 -> return . Just $ doQuicksave u ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeSemicolon -> return . Just $ gotoTerminal u _ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u _ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u handlePressedKeyInGame :: Scancode -> World -> World handlePressedKeyInGame scode w = case scode of ScancodeEscape -> pauseGame $ escapeMap w ScancodeSpace -> spaceAction w ScancodeP -> pauseGame $ escapeMap w ScancodeF -> youDropItem w ScancodeM -> toggleMap w ScancodeR -> crToggleReloading (you w) w ScancodeT -> testEvent w ScancodeX -> w & hud . hudElement %~ toggleTweakInv ScancodeC -> toggleCombineInv w ScancodeI -> w & hud . hudElement %~ toggleInspectInv _ -> w handlePressedKeyTerminal :: Int -> Scancode -> World -> World handlePressedKeyTerminal tmid scode w = case scode of ScancodeEscape -> w & terminals . ix tmid . tmInput . tiFocus %~ const False ScancodeReturn -> w & terminalReturnEffect (w ^?! terminals . ix tmid) ScancodeBackspace -> w & terminals . ix tmid . tmInput . tiText %~ doBackspace & backspaceTimer .~ 5 _ -> w where doBackspace t = case T.unsnoc t of Nothing -> t Just (t',_) -> t' toggleTweakInv :: HUDElement -> HUDElement toggleTweakInv he = case he of DisplayInventory TweakInventory -> DisplayInventory NoSubInventory _ -> DisplayInventory TweakInventory toggleInspectInv :: HUDElement -> HUDElement toggleInspectInv he = case he of DisplayInventory InspectInventory -> DisplayInventory NoSubInventory _ -> DisplayInventory InspectInventory gotoTerminal :: Universe -> Universe gotoTerminal w = case _menuLayers w of (InputScreen {} : _) -> w _ -> w & menuLayers .:~ InputScreen T.empty "Enter command" spaceAction :: World -> World spaceAction w = case _hudElement $ _hud w of DisplayCarte -> w & hud . carteCenter .~ theLoc DisplayInventory NoSubInventory -> case selectedCloseObject w of Just (_,Left flit) -> pickUpItem 0 flit w Just (_,Right but) -> _btEvent but but w _ -> w DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & hud . hudElement .~ DisplayInventory NoSubInventory where theLoc = fst (_seenLocations w IM.! _selLocation w) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail pauseGame :: World -> World pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu])) toggleMap :: World -> World toggleMap w = case _hudElement $ _hud w of DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & hud . hudElement .~ DisplayCarte escapeMap :: World -> World escapeMap w = case _hudElement $ _hud w of DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory _ -> w