Ross
86 lines
3.3 KiB
Haskell
86 lines
3.3 KiB
Haskell
module Dodge.Event.Keyboard
|
|
( handleKeyboardEvent
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.CreatureAction
|
|
import Dodge.LoadConfig
|
|
import Dodge.Room.Placement
|
|
import Dodge.LightSources
|
|
import Dodge.LevelGen
|
|
import Dodge.Creature.Inanimate
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
import SDL
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Control.Lens
|
|
|
|
import Picture
|
|
|
|
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 _ scancode w
|
|
| scancode == escapeKey (_keyConfig w) = Nothing
|
|
| scancode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
|
|
| scancode == dropItemKey (_keyConfig w) = Just $ dropItem w
|
|
| scancode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
|
|
| scancode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w
|
|
| scancode == testEventKey (_keyConfig w) = Just $ testEvent w
|
|
| scancode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
|
|
-- Rotation seems to be duplicated here and in Camera.hs ? why
|
|
| scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
|
|
| scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01}
|
|
| scancode == ScancodeF11 = Just $ w {_debugMode = not $ _debugMode w}
|
|
| _debugMode w && scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1}
|
|
| _debugMode w && scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1}
|
|
| _debugMode w && scancode == ScancodeF5 = Just $ dropLight w
|
|
| _debugMode w && scancode == ScancodeF6 = Just $ dropLight' w
|
|
handlePressedKey _ _ w = Just w
|
|
|
|
spaceAction :: World -> World
|
|
spaceAction w = case listToMaybe $ _closeActiveObjects w of
|
|
Just (Left flit) -> pickUpItem' flit w
|
|
Just (Right but) -> _btEvent but but w
|
|
Nothing -> w
|
|
|
|
testEvent :: World -> World
|
|
testEvent w = w
|
|
|
|
pauseGame :: World -> World
|
|
pauseGame w = w {_menuState = 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) |