loop/src/Dodge/Event/Keyboard.hs

{- | 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