Permalink
Browse files

heroes can now be selected with number keys (top row of keyboard)

TODO: refactor the hero code
  • Loading branch information...
1 parent a82badc commit 780d11824fee62833433d113e4bf85dc8cd1386e @Mikolaj Mikolaj committed Feb 12, 2011
Showing with 81 additions and 11 deletions.
  1. +33 −3 src/Actions.hs
  2. +1 −1 src/Command.hs
  3. +1 −1 src/Dungeon.hs
  4. +0 −3 src/Level.hs
  5. +37 −3 src/State.hs
  6. +9 −0 src/Turn.hs
View
36 src/Actions.hs
@@ -221,11 +221,14 @@ actorOpenClose actor v o dir =
_ -> -- there is no door here
neverMind isVerbose
--- | Perform a level switch to a given level and location.
+-- | Perform a level switch to a given level and location. If the level
+-- the same as the current, do nothing (disregard location, too).
+-- TODO: in look mode do not take time, otherwise take as much as 1 step.
lvlswitch :: DungeonLoc -> Action ()
lvlswitch (nln, nloc) =
do
state <- get
+ when (nln == lname (slevel state)) $ return ()
-- put back current level
-- (first put back, then get, in case we change to the same level!)
let full = putDungeonLevel (slevel state) (sdungeon state)
@@ -297,7 +300,6 @@ fleeDungeon =
end
-- | Switches current hero to the next hero on the level, if any, wrapping.
--- TODO: extend to number keys switching to heroes on any levels.
cycleHero =
do
hs <- gets (lheroes . slevel)
@@ -315,7 +317,7 @@ cycleHero =
ins = IM.insert i player
pli = updateHeroes ins
del = IM.delete ni
- modify (updateDungeon (updateDungeonLevel pli ln))
+ modify (updateAnyLevel pli ln)
modify (updateLevel (updateHeroes del))
modify (updatePlayer (const np))
modify (updateLook (const (Just $ look { returnLn = nln })))
@@ -327,6 +329,34 @@ cycleHero =
[] -> abortWith "Only one hero on this level."
(ni, np) : _ -> swapCurrentHero (ni, np)
+-- | Selects a hero based on the number. Focuses on the hero if level changed.
+-- Even selecting the already selected hero makes sense when in look mode
+-- it focuses on the level and location of the hero.
+selectHero :: Int -> Action ()
+selectHero ni =
+ do
+ state <- get
+ player <- gets splayer
+ look <- gets slook
+ case findHeroLevel ni state of
+ Nothing -> abortWith $ "No hero number " ++ show ni ++ " in the party."
+ Just (nln, np) -> do
+ let i = heroNumber player
+ ins = IM.insert i player
+ pli = updateHeroes ins
+ del = IM.delete ni
+ -- put the old player back into his original level (look mode!)
+ modify (updateAnyLevel pli (playerLevel state))
+ -- if in look mode, record the original level of the new hero
+ modify (updateLook (fmap (\ lk -> lk { returnLn = nln })))
+ -- switch to the level with the new hero
+ lvlswitch (nln, mloc np)
+ -- make the new hero the player controlled hero
+ modify (updateLevel (updateHeroes del))
+ modify (updatePlayer (const np))
+ -- announce
+ messageAdd $ "Hero number " ++ show ni ++ " selected."
+
swapCurrentHero :: (Int, Hero) -> Action ()
swapCurrentHero (ni, np) =
do
View
2 src/Command.hs
@@ -20,7 +20,7 @@ inventoryCommand = Described "display inventory" inventory
searchCommand = Described "search for secret doors" search
ascendCommand = Described "ascend a level" (lvlchange Up)
descendCommand = Described "descend a level" (lvlchange Down)
-lookCommand = Described "toggle look mode" lookAround
+lookCommand = Described "toggle look mode" lookAround -- TODO: should not take time
drinkCommand = Described "quaff a potion" drinkPotion
waitCommand = Described "wait" (return () :: Action ())
saveCommand = Described "save and quit the game" saveGame
View
2 src/Dungeon.hs
@@ -337,6 +337,6 @@ addHero hp state@(State { splayer = player,
(\ l t -> open t
&& not (l `L.elem` L.map mloc (hs ++ ms)))
(\ l t -> floor t
- && distance (mloc player, l) < 5 + L.length hs `div` 3)
+ && distance (mloc player, l) < 6 + L.length hs `div` 3)
let hero = defaultHero n ploc hp
return (updateLevel (updateHeroes (IM.insert n hero)) state)
View
3 src/Level.hs
@@ -63,9 +63,6 @@ getDungeonLevel ln (Dungeon dng) = (dng ! ln, Dungeon (M.delete ln dng))
putDungeonLevel :: Level -> Dungeon -> Dungeon
putDungeonLevel lvl (Dungeon dng) = Dungeon (M.insert (lname lvl) lvl dng)
-updateDungeonLevel :: (Level -> Level) -> LevelName -> Dungeon -> Dungeon
-updateDungeonLevel f ln (Dungeon dng) = Dungeon (M.adjust f ln dng)
-
sizeDungeon :: Dungeon -> Int
sizeDungeon (Dungeon dng) = M.size dng
View
40 src/State.hs
@@ -56,10 +56,16 @@ defaultState player dng lvl =
updatePlayer :: (Hero -> Hero) -> State -> State
updatePlayer f s = s { splayer = f (splayer s) }
+-- | The level on which the current player resides.
+playerLevel :: State -> LevelName
+playerLevel (State { slevel = level,
+ slook = look }) =
+ maybe (lname level) returnLn look
+
levelHeroAssocs :: State -> [(Int, Hero)]
-levelHeroAssocs (State { splayer = player,
- slook = look,
- slevel = level@Level { lheroes = hs } }) =
+levelHeroAssocs (State { splayer = player,
+ slook = look,
+ slevel = level@Level { lheroes = hs } }) =
case look of
Just (Look { returnLn = ln })
| ln /= lname level ->
@@ -70,6 +76,34 @@ levelHeroAssocs (State { splayer = player,
levelHeroList :: State -> [Hero]
levelHeroList s = snd $ L.unzip $ levelHeroAssocs s
+findHeroLevel :: Int -> State -> Maybe (LevelName, Hero)
+findHeroLevel ni state@(State { splayer = player,
+ slevel = level,
+ sdungeon = dungeon }) =
+ if ni == heroNumber player
+ then Just (playerLevel state, player)
+ else
+ let Dungeon m = putDungeonLevel level dungeon
+ chk ln lvl = fmap (\ p -> (ln, p)) (IM.lookup ni (lheroes lvl))
+ filtered = M.mapMaybeWithKey chk m
+ in fmap fst $ M.minView $ filtered
+
+updateAnyHero :: (Hero -> Hero) -> Int -> State -> State
+updateAnyHero f ni state
+ | ni == heroNumber (splayer state) = updatePlayer f state
+ | otherwise =
+ case findHeroLevel ni state of
+ Just (ln, _hero) ->
+ let upd = IM.adjust f ni
+ in updateAnyLevel (updateHeroes upd) ln state
+ Nothing -> error $ "updateAnyHero: hero " ++ show ni ++ " not found"
+
+updateAnyLevel :: (Level -> Level) -> LevelName -> State -> State
+updateAnyLevel f ln state@(State { slevel = level,
+ sdungeon = Dungeon dng })
+ | ln == lname level = updateLevel f state
+ | otherwise = updateDungeon (const $ Dungeon $ M.adjust f ln dng) state
+
updateLook :: (Maybe Look -> Maybe Look) -> State -> State
updateLook f s = s { slook = f (slook s) }
View
9 src/Turn.hs
@@ -3,6 +3,7 @@ module Turn where
import Control.Monad
import Control.Monad.State hiding (State)
import Data.Map as M
+import qualified Data.Char as Char
import Action
import Actions
@@ -216,11 +217,19 @@ displayHelp = messageOverlayConfirm "Basic keys:" helpString >> abort
where
helpString = keyHelp stdKeybindings
+heroSelection :: [(K.Key, Command)]
+heroSelection =
+ let heroSelect k = (K.Char (Char.intToDigit k),
+ Undescribed $
+ selectHero k >> withPerception playerCommand)
+ in fmap heroSelect [0..9]
+
stdKeybindings :: Keybindings
stdKeybindings = Keybindings
{ kdir = moveDirCommand,
kudir = runDirCommand,
kother = M.fromList $
+ heroSelection ++
[ -- interaction with the dungeon
(K.Char 'o', openCommand),
(K.Char 'c', closeCommand),

0 comments on commit 780d118

Please sign in to comment.