Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

disallow use of some commands when in look mode on a remote level

  • Loading branch information...
commit 42889925894387f689224621d5e84f97f58cf4db 1 parent b524686
@Mikolaj Mikolaj authored
Showing with 19 additions and 5 deletions.
  1. +14 −0 src/Action.hs
  2. +5 −5 src/Command.hs
View
14 src/Action.hs
@@ -10,6 +10,7 @@ import Perception
import Display2 hiding (display)
import Message
import State
+import Level
newtype Action a = Action
{ runAction ::
@@ -221,3 +222,16 @@ withPerception h = Action (\ s e _ k a st ms ->
-- | Get the current perception.
currentPerception :: Action Perception
currentPerception = Action (\ s e p k a st ms -> k st ms p)
+
+-- | If in look mode, check if the current level is the same as player level
+-- and refuse performing the action otherwise.
+checkLook :: Action () -> Action ()
+checkLook h = do
+ look <- gets slook
+ level <- gets slevel
+ case look of
+ Just lk ->
+ if returnLn lk == lname level
+ then h
+ else abortWith "this command does not work on remote levels"
+ Nothing -> h
View
10 src/Command.hs
@@ -12,12 +12,12 @@ data Described a = Described { chelp :: String, caction :: a }
type Command = Described (Action ())
type DirCommand = Described (Dir -> Action ())
-closeCommand = Described "close a door" (openclose False)
-openCommand = Described "open a door" (openclose True)
-pickupCommand = Described "pick up an object" pickupItem
-dropCommand = Described "drop an object" dropItem
+closeCommand = Described "close a door" (checkLook (openclose False))
+openCommand = Described "open a door" (checkLook (openclose True))
+pickupCommand = Described "pick up an object" (checkLook pickupItem)
+dropCommand = Described "drop an object" (checkLook dropItem)
inventoryCommand = Described "display inventory" inventory
-searchCommand = Described "search for secret doors" search
+searchCommand = Described "search for secret doors" (checkLook search)
ascendCommand = Described "ascend a level" (lvlchange Up)
descendCommand = Described "descend a level" (lvlchange Down)
lookCommand = Described "toggle look mode" lookAround -- TODO: should not take time
Please sign in to comment.
Something went wrong with that request. Please try again.