Add basic prompt
This commit is contained in:
+25
-20
@@ -37,32 +37,37 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
|
||||
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 $ startReloadingWeapon (_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 _ ScancodeSemicolon w | not (inTerminal w) = Just $ gotoTerminal w
|
||||
handlePressedKey _ scode w
|
||||
| null (_menuLayers w) = handlePressedKeyInGame scode w
|
||||
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
|
||||
|
||||
debugKey :: Scancode -> World -> Maybe World
|
||||
debugKey scancode w
|
||||
| scancode == ScancodeF5 = Just $ dropLight w
|
||||
| scancode == ScancodeF6 = Just $ dropLight' w
|
||||
debugKey _ w = Just 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 (_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 == ScancodeF5 = Just $ dropLight w
|
||||
| scode == ScancodeF6 = Just $ dropLight' w
|
||||
handlePressedKeyInGame _ w = Just w
|
||||
|
||||
|
||||
inTerminal :: World -> Bool
|
||||
inTerminal w = case _menuLayers w of
|
||||
(Terminal _ : _) -> True
|
||||
_ -> False
|
||||
gotoTerminal :: World -> World
|
||||
gotoTerminal w = case _menuLayers w of
|
||||
(Terminal _ : _ ) -> w
|
||||
_ -> w & menuLayers %~ (Terminal [] :)
|
||||
|
||||
spaceAction :: World -> World
|
||||
spaceAction w = if _carteDisplay w
|
||||
|
||||
Reference in New Issue
Block a user