107 lines
4.4 KiB
Haskell
107 lines
4.4 KiB
Haskell
{- | Deals with keyboard events. -}
|
|
module Dodge.Event.Keyboard
|
|
( handleKeyboardEvent
|
|
, handleTextInputEvent
|
|
) where
|
|
import qualified Data.IntMap.Strict as IM
|
|
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 Data.Maybe
|
|
import qualified Data.Set as S
|
|
import SDL
|
|
import Data.Text (unpack)
|
|
|
|
handleTextInputEvent :: TextInputEventData -> Universe -> IO (Maybe Universe)
|
|
handleTextInputEvent = handleTextInput . unpack . textInputEventText
|
|
|
|
handleTextInput :: String -> Universe -> IO (Maybe Universe)
|
|
handleTextInput text w
|
|
| null (_menuLayers w) = return $ Just w
|
|
| otherwise = handleTextInMenu (head $ _menuLayers w) text 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 _ w = return $ Just w
|
|
handlePressedKey _ scode w = case scode of
|
|
ScancodeF5 -> return . Just $ doQuicksave w
|
|
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot w
|
|
ScancodeSemicolon -> return . Just $ gotoTerminal w
|
|
_ | null (_menuLayers w) -> return $ uvWorld (handlePressedKeyInGame scode) w
|
|
_ -> handlePressedKeyInMenu (head $ _menuLayers w) scode w
|
|
|
|
handlePressedKeyInGame :: Scancode -> World -> Maybe World
|
|
handlePressedKeyInGame scode w = case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeSpace -> Just $ spaceAction w
|
|
ScancodeP -> Just $ pauseGame $ escapeMap w
|
|
ScancodeF -> Just $ youDropItem w
|
|
ScancodeM -> Just $ toggleMap w
|
|
ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
|
|
ScancodeT -> Just $ testEvent w
|
|
ScancodeX -> Just $ w & hud . hudElement %~ toggleTweakInv
|
|
ScancodeC -> Just $ toggleCombineInv w
|
|
ScancodeI -> Just $ w & hud . hudElement %~ toggleInspectInv
|
|
_ -> Just w
|
|
|
|
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 [] "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
|