0abcd8c958
Implement the PointOnMap prompt type, which allows the player to move the cursor around and select a position on the map, and use this prompt type to implement a "look" command, describing all entities at the selected position.
53 lines
1.8 KiB
Haskell
53 lines
1.8 KiB
Haskell
{-# LANGUAGE ViewPatterns #-}
|
|
--------------------------------------------------------------------------------
|
|
module Xanthous.Command where
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Prelude hiding (Left, Right, Down)
|
|
--------------------------------------------------------------------------------
|
|
import Graphics.Vty.Input (Key(..), Modifier(..))
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Data (Direction(..))
|
|
--------------------------------------------------------------------------------
|
|
|
|
data Command
|
|
= Quit
|
|
| Move Direction
|
|
| PreviousMessage
|
|
| PickUp
|
|
| Open
|
|
| Wait
|
|
| Eat
|
|
| Look
|
|
| Save
|
|
|
|
-- | TODO replace with `:` commands
|
|
| ToggleRevealAll
|
|
|
|
commandFromKey :: Key -> [Modifier] -> Maybe Command
|
|
commandFromKey (KChar 'q') [] = Just Quit
|
|
commandFromKey (KChar '.') [] = Just Wait
|
|
commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir
|
|
commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage
|
|
commandFromKey (KChar ',') [] = Just PickUp
|
|
commandFromKey (KChar 'o') [] = Just Open
|
|
commandFromKey (KChar ';') [] = Just Look
|
|
commandFromKey (KChar 'e') [] = Just Eat
|
|
commandFromKey (KChar 'S') [] = Just Save
|
|
|
|
commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll
|
|
|
|
commandFromKey _ _ = Nothing
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
directionFromChar :: Char -> Maybe Direction
|
|
directionFromChar 'h' = Just Left
|
|
directionFromChar 'j' = Just Down
|
|
directionFromChar 'k' = Just Up
|
|
directionFromChar 'l' = Just Right
|
|
directionFromChar 'y' = Just UpLeft
|
|
directionFromChar 'u' = Just UpRight
|
|
directionFromChar 'b' = Just DownLeft
|
|
directionFromChar 'n' = Just DownRight
|
|
directionFromChar '.' = Just Here
|
|
directionFromChar _ = Nothing
|