Add basic prompt

This commit is contained in:
jgk
2021-05-23 16:24:11 +02:00
parent afafc245ef
commit b337fbdab9
12 changed files with 82 additions and 27 deletions
+25 -20
View File
@@ -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