Permalink
Browse files

various UI tweaks

  • Loading branch information...
1 parent 98af482 commit a3454063840194c6a4fc14ce7500e6b1c78740d7 @Mikolaj Mikolaj committed Mar 29, 2011
Showing with 65 additions and 47 deletions.
  1. +1 −1 src/Actions.hs
  2. +5 −5 src/Command.hs
  3. +12 −4 src/EffectAction.hs
  4. +3 −1 src/Grammar.hs
  5. +32 −26 src/ItemAction.hs
  6. +3 −3 src/Keys.hs
  7. +9 −7 src/Turn.hs
View
@@ -557,7 +557,7 @@ actorAttackActor source target = do
Just weapon ->
itemEffectAction weapon source target
Nothing ->
- effectToAction (Effect.Wound 3) source target 0 "" >> return ()
+ effectToAction (Effect.Wound 3) source target 0 ""
advanceTime source
-- | Resolves the result of an actor running into another.
View
@@ -22,15 +22,15 @@ ascendCommand = Described "ascend a level" (lvlChange Up)
descendCommand = Described "descend a level" (lvlChange Down)
floorCommand = Described "target location" targetFloor
monsterCommand = Described "target monster" (checkCursor targetMonster)
-drinkCommand = Described "quaff a potion" drinkPotion
+quaffCommand = Described "quaff a potion" quaffPotion
readCommand = Described "read a scroll" readScroll
-fireCommand = Described "fire an item" (checkCursor fireItem)
-zapCommand = Described "zap an item" (checkCursor zapItem)
+throwCommand = Described "throw a weapon" (checkCursor throwItem)
+aimCommand = Described "aim a wand" (checkCursor aimItem)
waitCommand = Described "wait" playerAdvanceTime
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)
+cancelCommand = Described "cancel action" cancelCurrent
+acceptCommand h = Described "accept choice" (acceptCurrent h)
historyCommand = Described "display previous messages" displayHistory
dumpCommand = Described "dump current configuration" dumpConfig
heroCommand = Described "cycle among heroes on level" cycleHero
View
@@ -42,7 +42,10 @@ import qualified Effect
-- The bool result indicates if the actors identify the effect.
effectToAction :: Effect.Effect -> Actor -> Actor -> Int -> String ->
Action Bool
-effectToAction Effect.NoEffect source target power msg = return False
+effectToAction Effect.NoEffect source target power msg = do
+ pl <- gets splayer
+ when (source == pl) $ messageAdd "Nothing happens."
+ return False
effectToAction (Effect.Heal n) source target power msg = do
m <- gets (getActor target)
if mhp m >= nhpMax (mkind m) || n + power <= 0
@@ -91,7 +94,11 @@ effectToAction (Effect.Wound n) source target power msg =
return True
effectToAction Effect.Dominate source target power msg =
if isAHero source -- Monsters are not strong-willed enough.
- then selectPlayer target
+ then do
+ b <- selectPlayer target
+ -- Prevent AI from getting a few free moves until new player ready.
+ updatePlayerBody (\ m -> m { mtime = 0})
+ return b
else return False
effectToAction Effect.SummonFriend source target power msg = do
tm <- gets (getActor target)
@@ -114,15 +121,16 @@ effectToAction Effect.ApplyWater _ target _ _ =
else return False
-- | The source actor affects the target actor, with a given item.
--- If either actor is a hero, the item may get identified (domination ignored).
-itemEffectAction :: Item -> Actor -> Actor -> Action ()
+-- If either actor is a hero, the item may get identified.
+itemEffectAction :: Item -> Actor -> Actor -> Action Bool
itemEffectAction item source target = do
state <- get
let effect = ItemKind.jeffect $ ItemKind.getIK $ ikind item
msg = " with " ++ objectItem state item
b <- effectToAction effect source target (ipower item) msg
-- If something happens, the item gets identified.
when (b && (isAHero source || isAHero target)) $ discover item
+ return b
-- | Given item is now known to the player.
discover :: Item -> Action ()
View
@@ -14,7 +14,9 @@ import Effect
suffixS :: String -> String
-suffixS word = word ++ "s"
+suffixS word = if last word == 'y'
+ then init word ++ "ies"
+ else word ++ "s"
capitalize :: String -> String
capitalize [] = []
View
@@ -60,7 +60,7 @@ getGroupItem :: [Item] -> -- all objects in question
String -> -- how to refer to the collection of objects
Action (Maybe Item)
getGroupItem is groupName prompt packName =
- let choice i = ItemKind.jname (ItemKind.getIK (ikind i)) == groupName
+ let choice i = packName == ItemKind.jname (ItemKind.getIK (ikind i))
header = capitalize $ suffixS groupName
in getItem prompt choice header is packName
@@ -77,23 +77,23 @@ applyGroupItem groupName verb = do
iOpt <- getGroupItem is groupName
("What to " ++ verb ++ "?") "in your inventory"
case iOpt of
- Just item@(Item { ikind = ik })
- | ItemKind.jname (ItemKind.getIK ik) == groupName ->
- do
- -- only one item consumed, even if several in inventory
- let consumed = item { icount = 1 }
- removeFromInventory consumed
- message (subjectVerbIObject state pbody verb consumed "")
- pl <- gets splayer
- itemEffectAction consumed pl pl
- Just _ -> abortWith $ "you cannot " ++ verb ++ " that"
+ Just item@(Item { ikind = ik }) -> do
+ -- only one item consumed, even if several in inventory
+ let v = if ItemKind.jname (ItemKind.getIK ik) == groupName
+ then verb
+ else "somehow apply"
+ consumed = item { icount = 1 }
+ message (subjectVerbIObject state pbody v consumed "")
+ pl <- gets splayer
+ b <- itemEffectAction consumed pl pl
+ when b $ removeFromInventory consumed
Nothing -> neverMind True
playerAdvanceTime
-fireGroupItem :: String -> -- name of the group
- String -> -- how the "applying" is called
- Action ()
-fireGroupItem groupName verb = do
+zapGroupItem :: String -> -- name of the group
+ String -> -- how the "applying" is called
+ Action ()
+zapGroupItem groupName verb = do
state <- get
per <- currentPerception
pbody <- gets getPlayerBody
@@ -106,35 +106,41 @@ fireGroupItem groupName verb = do
iOpt <- getGroupItem is groupName
("What to " ++ verb ++ "?") "in your inventory"
case iOpt of
- Just item -> do
+ Just item@(Item { ikind = ik }) -> do
-- only one item consumed, even if several in inventory
- let consumed = item { icount = 1 }
+ let v = if ItemKind.jname (ItemKind.getIK ik) == groupName
+ then verb
+ else "somehow zap"
+ consumed = item { icount = 1 }
removeFromInventory consumed
case targetToLoc (ptvisible per) state of
Nothing -> abortWith "target invalid"
Just loc ->
-- TODO: draw digital line and see if obstacles prevent firing
if actorReachesLoc pl loc per pl
then case locToActor loc state of
- Just ta -> itemEffectAction consumed pl ta
+ Just ta -> do
+ b <- itemEffectAction consumed pl ta
+ when (not b) $
+ modify (updateLevel (scatterItems [consumed] loc))
Nothing -> do
message (subjectVerbIObject state pbody verb consumed "")
modify (updateLevel (scatterItems [consumed] loc))
else abortWith "target not reachable"
Nothing -> neverMind True
playerAdvanceTime
-drinkPotion :: Action ()
-drinkPotion = applyGroupItem "potion" "drink"
+quaffPotion :: Action ()
+quaffPotion = applyGroupItem "potion" "quaff"
readScroll :: Action ()
readScroll = applyGroupItem "scroll" "read"
-fireItem :: Action ()
-fireItem = fireGroupItem "dart" "fire"
+aimItem :: Action ()
+aimItem = zapGroupItem "wand" "aim"
-zapItem :: Action ()
-zapItem = fireGroupItem "wand" "zap"
+throwItem :: Action ()
+throwItem = zapGroupItem "dart" "throw"
dropItem :: Action ()
dropItem =
@@ -229,8 +235,8 @@ getItem :: String -> -- prompt message
Action (Maybe Item)
getItem prompt p ptext is0 isn =
let is = L.filter p is0
- choice | L.null is = "[*]"
- | otherwise = "[" ++ letterRange (concatMap (maybeToList . iletter) is) ++ " or ?* or " ++ K.showKey K.Return ++ "]"
+ choice | L.null is = "[*, ESC]"
+ | otherwise = "[" ++ letterRange (concatMap (maybeToList . iletter) is) ++ ", ?, *, RET, ESC]"
r = do
message (prompt ++ " " ++ choice)
display
View
@@ -26,9 +26,9 @@ data Key =
showKey :: Key -> String
showKey (Char ' ') = "<space>" -- warnings about "command ( )" look wrong
showKey (Char c) = [c]
-showKey Esc = "<escape>"
-showKey Return = "<return>"
-showKey Tab = "<tab>"
+showKey Esc = "ESC" -- these three are common and terse abbreviations
+showKey Return = "RET"
+showKey Tab = "TAB"
showKey PgUp = "<page-up>"
showKey PgDn = "<page-down>"
showKey Left = "<left>"
View
@@ -213,9 +213,10 @@ helpCommand = Described "display help" displayHelp
-- | Display command help. TODO: Should be defined in Actions module.
displayHelp :: Action ()
-displayHelp = messageOverlayConfirm "Basic keys:" helpString >> abort
- where
- helpString = keyHelp stdKeybindings
+displayHelp =
+ messageOverlayConfirm "Basic keys:" helpString >> abort
+ where
+ helpString = keyHelp stdKeybindings
heroSelection :: [(K.Key, Command)]
heroSelection =
@@ -244,13 +245,14 @@ stdKeybindings = Keybindings
(K.Tab , heroCommand),
-- items
- (K.Char ',', pickupCommand),
+ (K.Char 'g', pickupCommand),
+ (K.Char ',', pickupCommand), -- synonym for backward compat.
(K.Char 'd', dropCommand),
(K.Char 'i', inventoryCommand),
- (K.Char 'q', drinkCommand),
+ (K.Char 'q', quaffCommand),
(K.Char 'r', readCommand),
- (K.Char 'f', fireCommand),
- (K.Char 'z', zapCommand),
+ (K.Char 't', throwCommand),
+ (K.Char 'a', aimCommand),
-- wait
-- (K.Char ' ', waitCommand),

0 comments on commit a345406

Please sign in to comment.