diff options
author | Griffin Smith <root@gws.fyi> | 2019-09-20T17·14-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-09-20T23·38-0400 |
commit | 4db3a68efec079bdb8723f377929bfa05860bdc2 (patch) | |
tree | 2ed2ef7c8b20f285703a9fb0c1e639faf70a075d /src/Xanthous/Command.hs | |
parent | 7770ed05484a8a7aae4d5d680a069a0886a145dd (diff) |
Add doors and an open command
Add a Door entity and an Open command, which necessitated supporting the direction prompt. Currently nothing actually puts doors on the map, which puts a slight damper on actually testing this out.
Diffstat (limited to 'src/Xanthous/Command.hs')
-rw-r--r-- | src/Xanthous/Command.hs | 39 |
1 files changed, 24 insertions, 15 deletions
diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 94c8075b34ee..19c5e17e0a64 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -1,30 +1,39 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- module Xanthous.Command where - -import Graphics.Vty.Input (Key(..), Modifier(..)) - +-------------------------------------------------------------------------------- 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 commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit - -commandFromKey (KChar 'h') [] = Just $ Move Left -commandFromKey (KChar 'j') [] = Just $ Move Down -commandFromKey (KChar 'k') [] = Just $ Move Up -commandFromKey (KChar 'l') [] = Just $ Move Right -commandFromKey (KChar 'y') [] = Just $ Move UpLeft -commandFromKey (KChar 'u') [] = Just $ Move UpRight -commandFromKey (KChar 'b') [] = Just $ Move DownLeft -commandFromKey (KChar 'n') [] = Just $ Move DownRight - +commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage - commandFromKey (KChar ',') [] = Just PickUp - +commandFromKey (KChar 'o') [] = Just Open 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 |