Permalink
Browse files

drastically simplify targeting mode; no more accept/cancel

KISS above all.
  • Loading branch information...
1 parent b73debe commit 8164ccb8d73593a76298a56b17285ab00bcb7cbc @Mikolaj Mikolaj committed Mar 6, 2011
Showing with 121 additions and 124 deletions.
  1. +9 −9 src/Action.hs
  2. +81 −85 src/Actions.hs
  3. +5 −5 src/Command.hs
  4. +2 −2 src/Display2.hs
  5. +1 −1 src/LevelState.hs
  6. +23 −22 src/State.hs
View
@@ -223,15 +223,15 @@ withPerception h = Action (\ s e _ k a st ms ->
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
+-- | If in targeting mode, check if the current level is the same
+-- as player level and refuse performing the action otherwise.
+checkCursor :: Action () -> Action ()
+checkCursor h = do
+ cursor <- gets scursor
+ level <- gets slevel
+ case cursor of
+ Just cur ->
+ if creturn cur == lname level
then h
else abortWith "this command does not work on remote levels"
Nothing -> h
View
@@ -69,56 +69,50 @@ quitGame =
then end -- TODO: why no highscore? no display, because the user may be in a hurry, since he quits the game instead of getting himself killed properly? no score recording, not to polute the scores list with games that the player didn't even want to end honourably?
else abortWith "Game resumed."
--- | Cancel targetting mode.
+-- | Cancel something, e.g., targetting mode. Chosen target is not invalidated.
cancelCurrent :: Action ()
cancelCurrent = do
- state <- get
- case slook state of
- Just lk -> do
- cancelLook lk
- messageAdd "Targeting mode canceled."
+ cursor <- gets scursor
+ player <- gets splayer
+ case cursor of
+ Just cur -> do
+ cancelCursor cur
+ let kind = if isFloorTarget (mtarget player) then "Floor" else "Monster"
+ messageAdd $ kind ++ " targeting finished."
Nothing -> abortWith "Press Q to quit."
--- | Accept target and cancel targetting mode, or perform a default action.
+-- | Accept something, or perform a default action.
acceptCurrent :: Action () -> Action ()
-acceptCurrent h = do
- state <- get
- case slook state of
- Just lk@(Look _ tgt _) -> do
- modify (updatePlayer (\ p -> p { mtarget = tgt }))
- cancelLook lk
- let kind = if isFloorTarget tgt then "Floor" else "Monster"
- messageAdd $ kind ++ " target selected."
- Nothing -> h -- nothing to accept; perform the default action
+acceptCurrent h = h -- nothing to accept right now; perform the default action
-moveCursor :: Look -> Dir -> Int -> Action () -- TODO: do not take time!!!
-moveCursor lk@(Look { cursorLoc = loc }) dir n =
+moveCursor :: Cursor -> Dir -> Int -> Action () -- TODO: do not take time!!!
+moveCursor cur@(Cursor { clocation = loc }) dir n =
do
(sy, sx) <- gets (lsize . slevel)
let iter :: Int -> (a -> a) -> a -> a -- not in base libs???
iter 0 _ x = x
iter k f x = f (iter (k-1) f x)
(ny, nx) = iter n (`shift` dir) loc
nloc = (max 1 $ min ny (sy-1), max 1 $ min nx (sx-1))
- nlk = lk { cursorLoc = nloc }
- modify (updateLook (const $ Just nlk))
- doLook nlk
+ ncur = cur { clocation = nloc }
+ modify (updateCursor (const $ Just ncur))
+ doLook ncur
move :: Dir -> Action ()
move dir =
do
state <- get
- case slook state of
- Just lk -> moveCursor lk dir 1
- Nothing -> moveOrAttack True True APlayer dir
+ case scursor state of
+ Just cur -> moveCursor cur dir 1
+ Nothing -> moveOrAttack True True APlayer dir
run :: Dir -> Action ()
run dir =
do
state <- get
- case slook state of
- Just lk -> moveCursor lk dir 10
- Nothing -> do
+ case scursor state of
+ Just cur -> moveCursor cur dir 10
+ Nothing -> do
modify (updatePlayer (\ p -> p { mdir = Just dir }))
-- attacks and opening doors disallowed while running
moveOrAttack False False APlayer dir
@@ -282,7 +276,7 @@ actorOpenClose actor v o dir =
neverMind isVerbose
-- | Perform a level switch to a given level. False, if nothing to do.
--- TODO: in look mode do not take time, otherwise take as much as 1 step.
+-- TODO: in targeting mode do not take time, otherwise take as much as 1 step.
lvlswitch :: LevelName -> Action Bool
lvlswitch nln =
do
@@ -316,19 +310,19 @@ lvldescend k =
lvlchange :: VDir -> Action ()
lvlchange vdir =
do
- state <- get
- look <- gets slook
+ state <- get
+ cursor <- gets scursor
let map = lmap (slevel state)
- loc = case look of
+ loc = case cursor of
Nothing -> mloc (splayer state)
- Just (Look { cursorLoc = loc }) -> loc
+ Just (Cursor { clocation = loc }) -> loc
case map `at` loc of
Tile (Stairs _ vdir' next) is
| vdir == vdir' -> -- stairs are in the right direction
case next of
Nothing ->
-- we are at the "end" of the dungeon
- case look of -- lvlswitch does not modify look
+ case cursor of -- lvlswitch does not modify cursor
Nothing -> do
b <- messageYesNo "Really escape the dungeon?"
if b
@@ -338,24 +332,24 @@ lvlchange vdir =
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
- Nothing ->
+ case cursor of
+ Nothing ->
-- land the player at the other end of the stairs
modify (updatePlayer (\ p -> p { mloc = nloc }))
- Just lk -> do
+ Just cur -> do
-- do not freely reveal the other end of the stairs
map <- gets (lmap . slevel) -- lvlswitch modifies map
let destinationLoc = if isUnknown (rememberAt map nloc)
then loc
else nloc
- nlk = lk { cursorLoc = destinationLoc }
- modify (updateLook (const $ Just nlk))
- doLook nlk
+ ncur = cur { clocation = destinationLoc }
+ modify (updateCursor (const $ Just ncur))
+ doLook ncur
_ -> -- no stairs
- case look of
- Just lk -> do
+ case cursor of
+ Just cur -> do
lvldescend (if vdir == Up then -1 else 1)
- doLook lk -- lvldescend does not change lk
+ doLook cur -- lvldescend does not change cur
Nothing -> do
let txt = if vdir == Up then "up" else "down"
abortWith ("no stairs " ++ txt)
@@ -439,11 +433,11 @@ promotePlayer ni (nln, np) =
-- make the new hero the player controlled hero
modify (updateLevel (updateHeroes $ IM.delete ni))
modify (updatePlayer (const np))
- -- if in look mode, record the original level of the new hero
+ -- if in targeting mode, record the original level of the new hero
-- and focus on him, if level changed
- let upd lk = let loc = if lvlChanged then mloc np else cursorLoc lk
- in lk { returnLn = nln, cursorLoc = loc }
- modify (updateLook (fmap upd))
+ let upd cur = let loc = if lvlChanged then mloc np else clocation cur
+ in cur { creturn = nln, clocation = loc }
+ modify (updateCursor (fmap upd))
-- | Calculate loot's worth. TODO: move to another module, and refine significantly.
calculateTotal :: State -> Int
@@ -486,43 +480,44 @@ search =
-- | Start the floor targetting mode.
targetFloor :: Action ()
targetFloor = do
- state <- get
- case slook state of
- Just lk@(Look _ tgt _) ->
- case tgt of
- TEnemy i -> do
- let ms = lmonsters (slevel state)
- t = if i >= L.length ms
- then TCursor -- the targeted monster is dead
- else TLoc $ mloc $ ms !! i
- lk <- setLook t
- doLook lk
- _ ->
- doLook lk -- stick to the previous floor target
- Nothing -> do
- lk <- setLook TCursor
- doLook lk
+ player <- gets splayer
+ level <- gets slevel
+ case mtarget player of
+ TEnemy i -> do
+ let ms = lmonsters level
+ t = if i >= L.length ms
+ then TCursor -- the targeted monster is dead
+ else TLoc $ mloc $ ms !! i
+ cur <- setTarget t
+ doLook cur
+ tgt -> do
+ cur <- setTarget tgt
+ doLook cur
+
-- | Start the monster targetting mode. Cycle between monster targets.
-- TODO: also target a monster by moving the cursor, if in target monster mode.
-- TODO: generally streamline and extend when the commands do not take time,
-- when firing at targets is implemented. when monsters use targets.
+-- TODO: sort monsters by distance to the player.
+-- TODO: when each hero has his own perception, only target monsters
+-- visible by the current player.
targetMonster :: Action ()
targetMonster = do
- state <- get
- per <- currentPerception
- let (i1, tgt) = case slook state of
- Just (Look _ tgt@(TEnemy i) _) -> (i + 1, tgt)
- Just (Look _ tgt _) -> (0, tgt)
- _ -> (0, TCursor)
- ms = L.zip (lmonsters (slevel state)) [0..]
+ per <- currentPerception
+ player <- gets splayer
+ level <- gets slevel
+ let i1 = case mtarget player of
+ TEnemy i -> i + 1
+ _ -> 0
+ ms = L.zip (lmonsters level) [0..]
(lt, gt) = L.splitAt i1 ms
lf = L.filter (\ (m, _) -> S.member (mloc m) (pvisible per)) (gt ++ lt)
t = case lf of
- [] -> tgt -- no monsters in sight, stick to the previous target
+ [] -> mtarget player -- no monsters in sight, stick to last
(_, ni) : _ -> TEnemy ni -- pick the next (or first) monster
- lk <- setLook t
- doLook lk
+ cur <- setTarget t
+ doLook cur
-- | Calculate the location of player's target.
-- TODO: no idea in which file to put this function.
@@ -535,29 +530,30 @@ targetToLoc (TEnemy i) s per =
targetToLoc (TLoc loc) s _ = loc
targetToLoc TCursor s _ = mloc (splayer s) -- TODO: when targeting cursor is permanently stored, use it instead
--- | Set look mode.
-setLook :: Target -> Action Look
-setLook tgt =
+-- | Set and activate cursor and set player's target.
+setTarget :: Target -> Action Cursor
+setTarget tgt =
do
state <- get
per <- currentPerception
let loc = targetToLoc tgt state per
ln = lname (slevel state)
- lk = Look loc tgt ln
- modify (updateLook (const $ Just lk))
- return lk
-
--- | Cancel look mode.
-cancelLook :: Look -> Action ()
-cancelLook (Look _ _ ln) = do
+ cur = Cursor True loc ln
+ modify (updateCursor (const $ Just cur))
+ modify (updatePlayer (\ p -> p { mtarget = tgt }))
+ return cur
+
+-- | Cancel targeting mode.
+cancelCursor :: Cursor -> Action ()
+cancelCursor (Cursor _ _ ln) = do
lvlswitch ln
- modify (updateLook (const Nothing))
+ modify (updateCursor (const Nothing))
-- | Perform look around in the current location of the cursor.
-- TODO: depending on tgt or an extra flag, show tile, monster or both
-- TODO: do not take time
-doLook :: Look -> Action ()
-doLook (Look { cursorLoc = loc }) =
+doLook :: Cursor -> Action ()
+doLook (Cursor { clocation = loc }) =
do
state <- get
lmap <- gets (lmap . slevel)
View
@@ -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" (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)
+closeCommand = Described "close a door" (checkCursor (openclose False))
+openCommand = Described "open a door" (checkCursor (openclose True))
+pickupCommand = Described "pick up an object" (checkCursor pickupItem)
+dropCommand = Described "drop an object" (checkCursor dropItem)
inventoryCommand = Described "display inventory" inventory
-searchCommand = Described "search for secret doors" (checkLook search)
+searchCommand = Described "search for secret doors" (checkCursor search)
ascendCommand = Described "ascend a level" (lvlchange Up)
descendCommand = Described "descend a level" (lvlchange Down)
floorCommand = Described "target floors" targetFloor -- TODO: should not take time
View
@@ -177,8 +177,8 @@ displayLevel session per
_ | sSml && sml >= 0 -> viewSmell sml
| otherwise -> viewTile vis tile assocs
vision =
- case slook state of
- Just (Look { cursorLoc = cloc })
+ case scursor state of
+ Just (Cursor { clocation = cloc })
| loc == cloc -> setBG white
_ -> lVision vis rea
in
View
@@ -14,7 +14,7 @@ viewTile b (Tile t (i:_)) a = viewItem (itype i) a
-- | Produces a textual description of the terrain and items at an already
-- explored location. Mute for unknown locations.
--- The "detailed" variant is for use in the look mode.
+-- The "detailed" variant is for use in the targeting mode.
lookAt :: Bool -> State -> LMap -> Loc -> String -> String
lookAt detailed s lmap loc msg
| detailed =
Oops, something went wrong.

0 comments on commit 8164ccb

Please sign in to comment.