87 lines
3.4 KiB
Haskell
87 lines
3.4 KiB
Haskell
{- | Deals with keyboard events. -}
|
|
module Dodge.Event.Keyboard
|
|
( handleKeyboardEvent
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Save
|
|
import Dodge.Base
|
|
import Dodge.Creature.Action
|
|
import Dodge.Config.KeyConfig
|
|
import Dodge.Event.Test
|
|
import Dodge.Event.Menu
|
|
import Dodge.Menu
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
import SDL
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Control.Lens
|
|
|
|
{- | 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 -> World -> Maybe World
|
|
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
|
|
Released -> Just $ w & keys %~ S.delete kcode
|
|
Pressed -> handlePressedKey (keyboardEventRepeat kev) kcode (w & keys %~ S.insert kcode)
|
|
where
|
|
kcode = (keysymScancode . keyboardEventKeysym) kev
|
|
|
|
handlePressedKey :: Bool -> Scancode -> World -> Maybe World
|
|
handlePressedKey True _ w = Just w
|
|
handlePressedKey _ ScancodeF5 w = Just $ doQuicksave w
|
|
handlePressedKey _ ScancodeF9 w = Just $ maybe w doQuicksave (_quicksaveLevel w)
|
|
handlePressedKey _ ScancodeSemicolon w = Just $ gotoTerminal w
|
|
handlePressedKey _ scode w
|
|
| null (_menuLayers w) = handlePressedKeyInGame scode w
|
|
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
|
|
|
|
handlePressedKeyInGame :: Scancode -> World -> Maybe World
|
|
handlePressedKeyInGame scode w
|
|
| scode == escapeKey (_keyConfig w) = Nothing
|
|
| scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
|
|
| scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
|
|
| scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
|
|
| scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
|
|
| scode == testEventKey (_keyConfig w) = Just $ testEvent w
|
|
| scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
|
|
| scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01
|
|
| scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
|
|
| scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory
|
|
| scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory
|
|
| scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory
|
|
handlePressedKeyInGame _ w = Just w
|
|
|
|
toggleInv :: InventoryMode -> InventoryMode -> InventoryMode
|
|
toggleInv x y
|
|
| x == y = TopInventory
|
|
| otherwise = x
|
|
|
|
gotoTerminal :: World -> World
|
|
gotoTerminal w = case _menuLayers w of
|
|
(InputScreen _ : _ ) -> w
|
|
_ -> w & menuLayers %~ (InputScreen [] :)
|
|
|
|
spaceAction :: World -> World
|
|
spaceAction w = if _carteDisplay w
|
|
then w & carteCenter .~ theLoc
|
|
else case (_inventoryMode w, listToMaybe $ _closeActiveObjects w) of
|
|
(TopInventory,Just (Left flit)) -> pickUpItem 0 flit w
|
|
(TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w
|
|
_ -> w & inventoryMode .~ TopInventory
|
|
where
|
|
theLoc = fst (_seenLocations w IM.! _selLocation w) w
|
|
updateTopCloseObject i w' = w' & closeActiveObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
|
|
|
|
pauseGame :: World -> World
|
|
pauseGame w = w {_menuLayers = [pauseMenu]}
|
|
|
|
toggleMap :: World -> World
|
|
toggleMap w = w & carteDisplay %~ not
|
|
escapeMap :: World -> World
|
|
escapeMap w = w & carteDisplay .~ False
|
|
|