{- | Deals with keyboard events. -} module Dodge.Event.Keyboard ( handleKeyboardEvent , handleTextInput , guardDisconnectedID ) where import Dodge.Terminal.LeftButton import Dodge.WorldPos import Dodge.Button.Event 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 IntMapHelp 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 . cWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | hasfocus tmid -> uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . terminals . ix tmid . tmInput . tiText %~ updateText) _ -> id hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . 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 . 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 . cWorld . keys %~ S.delete scode Pressed -> handlePressedKey (keyboardEventRepeat kev) scode (u & uvWorld . cWorld . keys %~ S.insert scode) where scode = (keysymScancode . keyboardEventKeysym) kev handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKey True ScancodeBackspace u | _backspaceTimer (_cWorld $ _uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u <&> _Just . uvWorld . cWorld . backspaceTimer .~ 0 | otherwise = return $ Just $ u & uvWorld . cWorld . 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 . cWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u _ -> return $ (Just . handlePressedKeyInGame scode) u _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u handlePressedKeyInGame :: Scancode -> Universe -> Universe handlePressedKeyInGame scode uv = case scode of ScancodeEscape -> pauseGame $ over uvWorld escapeMap uv ScancodeSpace -> over uvWorld spaceAction uv ScancodeP -> pauseGame $ over uvWorld escapeMap uv ScancodeF -> over uvWorld youDropItem uv ScancodeM -> over uvWorld toggleMap uv ScancodeR -> over uvWorld (crToggleReloading (you w)) uv ScancodeT -> over uvWorld testEvent uv ScancodeX -> uv & uvWorld . cWorld . hud . hudElement %~ toggleTweakInv ScancodeC -> over uvWorld toggleCombineInv uv ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv _ -> uv where w = _uvWorld uv handlePressedKeyTerminal :: Int -> Scancode -> World -> World handlePressedKeyTerminal tmid scode w = case scode of ScancodeEscape -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid) ScancodeBackspace -> w & cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace & cWorld . 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 (_cWorld w) of DisplayCarte -> w & cWorld . hud . carteCenter .~ theLoc DisplayInventory NoSubInventory -> case selectedCloseObject w of Just (_,Left flit) -> pickUpItem 0 flit w Just (_,Right but) -> doButtonEvent (_btEvent but) but w _ -> w DisplayInventory DisplayTerminal {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory where theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail pauseGame :: Universe -> Universe pauseGame = menuLayers .~ [pauseMenu] toggleMap :: World -> World toggleMap w = case _hudElement $ _hud (_cWorld w) of DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & cWorld . hud . hudElement .~ DisplayCarte escapeMap :: World -> World escapeMap w = case _hudElement $ _hud (_cWorld w) of DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w