Add a drop command, bound to 'd', which prompts the character for an item in their inventory, removes it from the inventory, and places it on the ground. Along the way I had to fix a bug in the `EntityMap.atPosition` lens, which was always appending to the existing entities at the position on set, without removing the entities that were already there - the rabbit hole of quickchecking the lens laws here also lead to replacing the target of this lens with a newtype called `VectorBag`, which ignores order (since the entitymap makes no guarantees about order of entities at a given position).
62 lines
2 KiB
Haskell
62 lines
2 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
|
|
| Drop
|
|
| Open
|
|
| Wait
|
|
| Eat
|
|
| Look
|
|
| Save
|
|
| Read
|
|
| ShowInventory
|
|
| Wield
|
|
|
|
-- | 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 'd') [] = Just Drop
|
|
commandFromKey (KChar 'o') [] = Just Open
|
|
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
|
|
|
|
-- 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
|