diff options
| author | Vincent Ambo <mail@tazj.in> | 2020-06-16T00·05+0100 |
|---|---|---|
| committer | Vincent Ambo <mail@tazj.in> | 2020-06-16T00·05+0100 |
| commit | 2edb963b97867b27f68efac8d05bf966077b0b01 (patch) | |
| tree | c3bb279dfd4330e09a0af6ef4e84ff8a9a3bc7ad /users/glittershark/xanthous/src/Xanthous/Command.hs | |
| parent | 91f53f02d8479303910abfd3f3690d3ef27e6c4b (diff) | |
| parent | 53b56744f4335c038724a1bcffc27a7eb8cf6a6d (diff) | |
Add 'users/glittershark/xanthous/' from commit '53b56744f4335c038724a1bcffc27a7eb8cf6a6d' r/978
git-subtree-dir: users/glittershark/xanthous git-subtree-mainline: 91f53f02d8479303910abfd3f3690d3ef27e6c4b git-subtree-split: 53b56744f4335c038724a1bcffc27a7eb8cf6a6d
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous/Command.hs')
| -rw-r--r-- | users/glittershark/xanthous/src/Xanthous/Command.hs | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Command.hs b/users/glittershark/xanthous/src/Xanthous/Command.hs new file mode 100644 index 000000000000..37025dd37ad2 --- /dev/null +++ b/users/glittershark/xanthous/src/Xanthous/Command.hs @@ -0,0 +1,73 @@ +-------------------------------------------------------------------------------- +module Xanthous.Command where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (Left, Right, Down) +-------------------------------------------------------------------------------- +import Graphics.Vty.Input (Key(..), Modifier(..)) +import qualified Data.Char as Char +-------------------------------------------------------------------------------- +import Xanthous.Data (Direction(..)) +-------------------------------------------------------------------------------- + +data Command + = Quit + | Move Direction + | StartAutoMove Direction + | PreviousMessage + | PickUp + | Drop + | Open + | Close + | Wait + | Eat + | Look + | Save + | Read + | ShowInventory + | Wield + | GoUp + | GoDown + + -- | 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 c) [] + | Char.isUpper c + , Just dir <- directionFromChar $ Char.toLower c + = Just $ StartAutoMove dir +commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage +commandFromKey (KChar ',') [] = Just PickUp +commandFromKey (KChar 'd') [] = Just Drop +commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar 'c') [] = Just Close +commandFromKey (KChar ';') [] = Just Look +commandFromKey (KChar 'e') [] = Just Eat +commandFromKey (KChar 'S') [] = Just Save +commandFromKey (KChar 'r') [] = Just Read +commandFromKey (KChar 'i') [] = Just ShowInventory +commandFromKey (KChar 'w') [] = Just Wield +commandFromKey (KChar '<') [] = Just GoUp +commandFromKey (KChar '>') [] = Just GoDown + +-- DEBUG COMMANDS -- +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 |