112 lines
4.0 KiB
Haskell
112 lines
4.0 KiB
Haskell
{- |
|
|
Deals with keyboard events.
|
|
-}
|
|
module Dodge.Event.Keyboard
|
|
( handleKeyboardEvent
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Creature.Action
|
|
import Dodge.Config.KeyConfig
|
|
import Dodge.Room.Placement
|
|
import Dodge.LightSources
|
|
import Dodge.LevelGen
|
|
import Dodge.Creature.Inanimate
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Dodge.Event.Test
|
|
import Dodge.Event.Menu
|
|
|
|
import SDL
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Control.Lens
|
|
|
|
import Picture
|
|
|
|
{- | 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
|
|
|
|
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 $ reloadWeapon (_yourID 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 == ScancodeF11 = Just $ w {_debugMode = not $ _debugMode w}
|
|
| _debugMode w = debugKey scode w
|
|
handlePressedKeyInGame _ w = Just w
|
|
|
|
handlePressedKey :: Bool -> Scancode -> World -> Maybe World
|
|
handlePressedKey True _ w = Just w
|
|
handlePressedKey _ scode w
|
|
| _menuLayers w == []
|
|
= handlePressedKeyInGame scode w
|
|
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
|
|
handlePressedKey _ _ w = Just w
|
|
|
|
debugKey :: Scancode -> World -> Maybe World
|
|
debugKey scancode w
|
|
| scancode == ScancodeF7 = Just $ w & varMovementSpeedModifier -~ 1
|
|
| scancode == ScancodeF8 = Just $ w & varMovementSpeedModifier +~ 1
|
|
| scancode == ScancodeF5 = Just $ dropLight w
|
|
| scancode == ScancodeF6 = Just $ dropLight' w
|
|
debugKey _ w = Just w
|
|
|
|
spaceAction :: World -> World
|
|
spaceAction w = if _carteDisplay w
|
|
then
|
|
w & carteCenter .~ theLoc
|
|
else
|
|
case listToMaybe $ _closeActiveObjects w of
|
|
Just (Left flit) -> pickUpItem' flit w
|
|
Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
|
|
Nothing -> w
|
|
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 w = w & carteDisplay %~ not
|
|
escapeMap w = w & carteDisplay .~ False
|
|
|
|
dropLight :: World -> World
|
|
dropLight w = placeLS ls dec pos 0
|
|
-- $ over creatures IM.insert i (lamp)
|
|
$ w
|
|
--case yourItem w of
|
|
--NoItem -> w
|
|
--it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
|
|
-- gg $ updateLocation
|
|
-- $ soundOnce putDownSound
|
|
-- $ set randGen g w
|
|
where --(rot, g) = randomR (-pi,pi) $ _randGen w
|
|
i = newCrKey w -- to give different lights different keys
|
|
pos = _crPos(you w)
|
|
ls = lightAt pos 0
|
|
dec = onLayer PtLayer $ color white $ circleSolid 8
|
|
|
|
dropLight' :: World -> World
|
|
dropLight' w = placeCr lamp pos 0 w
|
|
where
|
|
pos = _crPos(you w)
|