Add a close command
Add a close command, to close doors, that works basically the same as the open command.
This commit is contained in:
parent
9256c976ed
commit
308c7eb4f6
4 changed files with 33 additions and 2 deletions
|
@ -52,7 +52,7 @@ import qualified Xanthous.Entities.Item as Item
|
||||||
import Xanthous.Entities.Creature (Creature)
|
import Xanthous.Entities.Creature (Creature)
|
||||||
import qualified Xanthous.Entities.Creature as Creature
|
import qualified Xanthous.Entities.Creature as Creature
|
||||||
import Xanthous.Entities.Environment
|
import Xanthous.Entities.Environment
|
||||||
(Door, open, locked, GroundMessage(..), Staircase(..))
|
(Door, open, closed, locked, GroundMessage(..), Staircase(..))
|
||||||
import Xanthous.Entities.RawTypes
|
import Xanthous.Entities.RawTypes
|
||||||
( edible, eatMessage, hitpointsHealed
|
( edible, eatMessage, hitpointsHealed
|
||||||
, attackMessage
|
, attackMessage
|
||||||
|
@ -182,6 +182,7 @@ handleCommand Open = do
|
||||||
doors <- uses entities $ entitiesAtPositionWithType @Door pos
|
doors <- uses entities $ entitiesAtPositionWithType @Door pos
|
||||||
if | null doors -> say_ ["open", "nothingToOpen"]
|
if | null doors -> say_ ["open", "nothingToOpen"]
|
||||||
| any (view $ _2 . locked) doors -> say_ ["open", "locked"]
|
| any (view $ _2 . locked) doors -> say_ ["open", "locked"]
|
||||||
|
| all (view $ _2 . open) doors -> say_ ["open", "alreadyOpen"]
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
for_ doors $ \(eid, _) ->
|
for_ doors $ \(eid, _) ->
|
||||||
entities . ix eid . positioned . _SomeEntity . open .= True
|
entities . ix eid . positioned . _SomeEntity . open .= True
|
||||||
|
@ -190,6 +191,21 @@ handleCommand Open = do
|
||||||
stepGame -- TODO
|
stepGame -- TODO
|
||||||
continue
|
continue
|
||||||
|
|
||||||
|
handleCommand Close = do
|
||||||
|
prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable
|
||||||
|
$ \(DirectionResult dir) -> do
|
||||||
|
pos <- move dir <$> use characterPosition
|
||||||
|
doors <- uses entities $ entitiesAtPositionWithType @Door pos
|
||||||
|
if | null doors -> say_ ["close", "nothingToClose"]
|
||||||
|
| all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"]
|
||||||
|
| otherwise -> do
|
||||||
|
for_ doors $ \(eid, _) ->
|
||||||
|
entities . ix eid . positioned . _SomeEntity . closed .= True
|
||||||
|
say_ ["close", "success"]
|
||||||
|
pure ()
|
||||||
|
stepGame -- TODO
|
||||||
|
continue
|
||||||
|
|
||||||
handleCommand Look = do
|
handleCommand Look = do
|
||||||
prompt_ @'PointOnMap ["look", "prompt"] Cancellable
|
prompt_ @'PointOnMap ["look", "prompt"] Cancellable
|
||||||
$ \(PointOnMapResult pos) ->
|
$ \(PointOnMapResult pos) ->
|
||||||
|
|
|
@ -16,6 +16,7 @@ data Command
|
||||||
| PickUp
|
| PickUp
|
||||||
| Drop
|
| Drop
|
||||||
| Open
|
| Open
|
||||||
|
| Close
|
||||||
| Wait
|
| Wait
|
||||||
| Eat
|
| Eat
|
||||||
| Look
|
| Look
|
||||||
|
@ -37,6 +38,7 @@ commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage
|
||||||
commandFromKey (KChar ',') [] = Just PickUp
|
commandFromKey (KChar ',') [] = Just PickUp
|
||||||
commandFromKey (KChar 'd') [] = Just Drop
|
commandFromKey (KChar 'd') [] = Just Drop
|
||||||
commandFromKey (KChar 'o') [] = Just Open
|
commandFromKey (KChar 'o') [] = Just Open
|
||||||
|
commandFromKey (KChar 'c') [] = Just Close
|
||||||
commandFromKey (KChar ';') [] = Just Look
|
commandFromKey (KChar ';') [] = Just Look
|
||||||
commandFromKey (KChar 'e') [] = Just Eat
|
commandFromKey (KChar 'e') [] = Just Eat
|
||||||
commandFromKey (KChar 'S') [] = Just Save
|
commandFromKey (KChar 'S') [] = Just Save
|
||||||
|
|
|
@ -7,6 +7,7 @@ module Xanthous.Entities.Environment
|
||||||
-- * Doors
|
-- * Doors
|
||||||
, Door(..)
|
, Door(..)
|
||||||
, open
|
, open
|
||||||
|
, closed
|
||||||
, locked
|
, locked
|
||||||
, unlockedDoor
|
, unlockedDoor
|
||||||
|
|
||||||
|
@ -99,6 +100,9 @@ instance Entity Door where
|
||||||
entityCollision door | door ^. open = Nothing
|
entityCollision door | door ^. open = Nothing
|
||||||
| otherwise = Just Stop
|
| otherwise = Just Stop
|
||||||
|
|
||||||
|
closed :: Lens' Door Bool
|
||||||
|
closed = open . involuted not
|
||||||
|
|
||||||
-- | A closed, unlocked door
|
-- | A closed, unlocked door
|
||||||
unlockedDoor :: Door
|
unlockedDoor :: Door
|
||||||
unlockedDoor = Door
|
unlockedDoor = Door
|
||||||
|
|
|
@ -35,7 +35,16 @@ open:
|
||||||
prompt: Direction to open (hjklybnu.)?
|
prompt: Direction to open (hjklybnu.)?
|
||||||
success: "You open the door."
|
success: "You open the door."
|
||||||
locked: "That door is locked"
|
locked: "That door is locked"
|
||||||
nothingToOpen: "There's nothing to open there"
|
nothingToOpen: "There's nothing to open there."
|
||||||
|
alreadyOpen: "That door is already open."
|
||||||
|
|
||||||
|
close:
|
||||||
|
prompt: Direction to close (hjklybnu.)?
|
||||||
|
success:
|
||||||
|
- You close the door.
|
||||||
|
- You shut the door.
|
||||||
|
nothingToClose: "There's nothing to close there."
|
||||||
|
alreadyClosed: "That door is already closed."
|
||||||
|
|
||||||
look:
|
look:
|
||||||
prompt: Select a position on the map to describe (use Enter to confirm)
|
prompt: Select a position on the map to describe (use Enter to confirm)
|
||||||
|
|
Loading…
Reference in a new issue