Permalink
Browse files

a mock-up of all the commands of the targeting mode

  • Loading branch information...
Mikolaj committed Mar 4, 2011
1 parent 4288992 commit e1082a43789773258d5fdb40a20e216463d53bd4
Showing with 52 additions and 28 deletions.
  1. +1 −1 PLAYING.markdown
  2. +39 −23 src/Actions.hs
  3. +3 −1 src/Command.hs
  4. +5 −1 src/Display/Gtk.hs
  5. +4 −2 src/Turn.hs
View
@@ -47,7 +47,7 @@ Below are the default key bindings in the game.
Q quit without saving
. wait
, pick up an object
- : toggle look mode
+ : target floors
< ascend a level
> descend a level
TAB cycle among heroes on the level
View
@@ -70,12 +70,22 @@ quitGame =
else abortWith "Game resumed."
cancelCurrent :: Action ()
-cancelCurrent =
- do
- state <- get
- case slook state of
- Just lk -> cancelLook lk
- Nothing -> abortWith "Press Q to quit."
+cancelCurrent = do
+ state <- get
+ case slook state of
+ Just lk -> do
+ cancelLook lk
+ messageAdd "Targeting mode canceled."
+ Nothing -> abortWith "Press Q to quit."
+
+acceptCurrent :: Action () -> Action ()
+acceptCurrent h = do
+ state <- get
+ case slook state of
+ Just lk -> do
+ acceptLook lk
+ messageAdd "Floor target selected." -- TODO
+ Nothing -> h -- nothing to accept; perform the default action
moveCursor :: Look -> Dir -> Int -> Action () -- TODO: do not take time!!!
moveCursor lk@(Look { cursorLoc = loc }) dir n =
@@ -321,7 +331,7 @@ lvlchange vdir =
then fleeDungeon
else abortWith "Game resumed."
Just _ ->
- abortWith "cannot escape dungeon in look mode"
+ abortWith "cannot escape dungeon in targeting mode"
Just (nln, nloc) -> do
assertTrue $ lvlswitch nln -- no stairs go back to the same level
case look of
@@ -469,16 +479,19 @@ search =
slmap = foldl (\ l m -> update searchTile (shift ploc m) l) lmap moves
modify (updateLevel (updateLMap (const slmap)))
--- | Toggle look mode.
-lookAround :: Action ()
-lookAround =
- do
- state <- get
- case slook state of
- Just lk -> cancelLook lk
- Nothing -> do
- lk <- setLook
- doLook lk
+-- | Start the floor targetting mode.
+targetFloor :: Action ()
+targetFloor = do
+ state <- get
+ case slook state of
+ Just lk -> return () -- TODO: switch target mode to floor
+ Nothing -> do
+ lk <- setLook
+ doLook lk
+
+-- | Start the monster targetting mode.
+targetMonster :: Action ()
+targetMonster = targetFloor -- TODO
-- | Set look mode.
setLook :: Action Look
@@ -494,12 +507,15 @@ setLook =
-- | Cancel look mode.
cancelLook :: Look -> Action ()
-cancelLook (Look _ tgt ln) =
- do
- lvlswitch ln
- modify (updatePlayer (\ p -> p { mtarget = tgt }))
- modify (updateLook (const Nothing))
- messageAdd "Look mode canceled."
+cancelLook (Look _ _ ln) = do
+ lvlswitch ln
+ modify (updateLook (const Nothing))
+
+-- | Accept target and cancel look mode.
+acceptLook :: Look -> Action ()
+acceptLook lk@(Look _ tgt _) = do
+ modify (updatePlayer (\ p -> p { mtarget = tgt }))
+ cancelLook lk
-- | Perform look around in the current location of the cursor.
-- TODO: depending on tgt or an extra flag, show tile, monster or both
View
@@ -20,12 +20,14 @@ inventoryCommand = Described "display inventory" inventory
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
+floorCommand = Described "target floors" targetFloor -- TODO: should not take time
+monsterCommand = Described "target monsters" targetMonster
drinkCommand = Described "quaff a potion" drinkPotion
waitCommand = Described "wait" (return () :: Action ())
saveCommand = Described "save and quit the game" saveGame
quitCommand = Described "quit without saving" quitGame
cancelCommand = Described "cancel current action" cancelCurrent
+acceptCommand h = Described "accept current choice" (acceptCurrent h)
historyCommand = Described "display previous messages" displayHistory
dumpCommand = Described "dump current configuration" dumpConfig
heroCommand = Described "cycle among heroes on level" cycleHero -- TODO: should take 0 turns! When it does, use in Turn.hs.
View
@@ -159,8 +159,11 @@ keyTranslate "colon" = Just (K.Char ':')
keyTranslate "comma" = Just (K.Char ',')
keyTranslate "space" = Just (K.Char ' ')
keyTranslate "question" = Just (K.Char '?')
-keyTranslate "asterisk" = Just (K.Char '*')
keyTranslate "dollar" = Just (K.Char '$')
+keyTranslate "asterisk" = Just (K.Char '*')
+keyTranslate "KP_Multiply" = Just (K.Char '*')
+keyTranslate "slash" = Just (K.Char '/')
+keyTranslate "KP_Divide" = Just (K.Char '/')
keyTranslate "Escape" = Just K.Esc
keyTranslate "Return" = Just K.Return
keyTranslate "Tab" = Just K.Tab
@@ -177,6 +180,7 @@ keyTranslate "KP_Enter" = Just K.Return
keyTranslate ['K','P','_',c] = Just (K.KP c)
keyTranslate [c] = Just (K.Char c)
keyTranslate _ = Nothing
+-- keyTranslate e = Just (K.Dbg $ show e)
nextEvent :: Session -> IO K.Key
nextEvent session =
View
@@ -238,7 +238,9 @@ stdKeybindings = Keybindings
(K.Char '<', ascendCommand),
(K.Char '>', descendCommand),
- (K.Char ':', lookCommand),
+ (K.Char '*', monsterCommand),
+ (K.Char '/', floorCommand),
+ (K.Char ':', floorCommand), -- synonym for backward compat.
(K.Tab , Described "cycle among heroes on level" $ cycleHero >> playerCommand),
-- items
@@ -268,6 +270,6 @@ stdKeybindings = Keybindings
(K.Char 'M', historyCommand),
(K.Char 'D', dumpCommand),
(K.Char '?', helpCommand),
- (K.Return , helpCommand)
+ (K.Return , acceptCommand displayHelp)
]
}

0 comments on commit e1082a4

Please sign in to comment.