packages feed

LambdaHack 0.4.101.1 → 0.5.0.0

raw patch · 79 files changed

+1045/−826 lines, 79 filesdep ~assert-failuredep ~gtkdep ~randomPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: assert-failure, gtk, random

API changes (from Hackage documentation)

- Game.LambdaHack.Client.State: scurDifficulty :: StateClient -> !Int
- Game.LambdaHack.Common.Actor: timeShiftFromSpeed :: Actor -> [ItemFull] -> Time -> Time
- Game.LambdaHack.Common.ActorState: posToActor :: Point -> LevelId -> State -> Maybe ((ActorId, Actor), [(ItemId, Item)])
- Game.LambdaHack.Common.ClientOptions: instance Selector S1_0_12DebugModeCli
- Game.LambdaHack.Common.ClientOptions: sdifficultyCli :: DebugModeCli -> !Int
- Game.LambdaHack.Common.MonadStateRead: factionLoots :: MonadStateRead m => FactionId -> m Bool
- Game.LambdaHack.Common.Msg: singletonHistory :: Time -> Report -> History
- Game.LambdaHack.Common.Msg: takeHistory :: Int -> History -> History
- Game.LambdaHack.Common.Point: dummyPoint :: Point
- Game.LambdaHack.Server.State: sdifficultySer :: DebugModeSer -> !Int
+ Game.LambdaHack.Atomic: posProjBody :: Actor -> PosAtomic
+ Game.LambdaHack.Atomic.PosAtomicRead: posProjBody :: Actor -> PosAtomic
+ Game.LambdaHack.Client.State: scurDiff :: StateClient -> !Int
+ Game.LambdaHack.Client.State: snxtDiff :: StateClient -> !Int
+ Game.LambdaHack.Common.Ability: blockOnly :: Skills
+ Game.LambdaHack.Common.Ability: ignoreItems :: Skills
+ Game.LambdaHack.Common.Ability: meleeAdjacent :: Skills
+ Game.LambdaHack.Common.Ability: meleeAndRanged :: Skills
+ Game.LambdaHack.Common.ActorState: eqpFreeN :: Actor -> Int
+ Game.LambdaHack.Common.Faction: difficultyInverse :: Int -> Int
+ Game.LambdaHack.Common.Misc: TFollowNoItems :: Tactic
+ Game.LambdaHack.Common.Misc: TMeleeAdjacent :: Tactic
+ Game.LambdaHack.Common.Misc: TMeleeAndRanged :: Tactic
+ Game.LambdaHack.Common.Misc: instance Constructor C1_5Tactic
+ Game.LambdaHack.Common.Misc: instance Constructor C1_6Tactic
+ Game.LambdaHack.Common.Misc: instance Constructor C1_7Tactic
+ Game.LambdaHack.Common.Request: AlterUnskilled :: ReqFailure
+ Game.LambdaHack.Common.Request: EqpStackFull :: ReqFailure
+ Game.LambdaHack.Common.RingBuffer: cons :: a -> RingBuffer a -> RingBuffer a
+ Game.LambdaHack.Common.RingBuffer: data RingBuffer a
+ Game.LambdaHack.Common.RingBuffer: empty :: Int -> a -> RingBuffer a
+ Game.LambdaHack.Common.RingBuffer: instance Binary a => Binary (RingBuffer a)
+ Game.LambdaHack.Common.RingBuffer: instance Constructor C1_0RingBuffer
+ Game.LambdaHack.Common.RingBuffer: instance Datatype D1RingBuffer
+ Game.LambdaHack.Common.RingBuffer: instance Generic (RingBuffer a)
+ Game.LambdaHack.Common.RingBuffer: instance Selector S1_0_0RingBuffer
+ Game.LambdaHack.Common.RingBuffer: instance Selector S1_0_1RingBuffer
+ Game.LambdaHack.Common.RingBuffer: instance Selector S1_0_2RingBuffer
+ Game.LambdaHack.Common.RingBuffer: instance Show a => Show (RingBuffer a)
+ Game.LambdaHack.Common.RingBuffer: toList :: RingBuffer a -> [a]
+ Game.LambdaHack.Common.RingBuffer: uncons :: RingBuffer a -> Maybe (a, RingBuffer a)
+ Game.LambdaHack.Server.HandleRequestServer: reqDisplace :: (MonadAtomic m, MonadServer m) => ActorId -> ActorId -> m ()
+ Game.LambdaHack.Server.State: scurDiffSer :: DebugModeSer -> !Int
- Game.LambdaHack.Atomic: UpdRestart :: !FactionId -> !DiscoveryKind -> !FactionPers -> !State -> !DebugModeCli -> UpdAtomic
+ Game.LambdaHack.Atomic: UpdRestart :: !FactionId -> !DiscoveryKind -> !FactionPers -> !State -> !Int -> !DebugModeCli -> UpdAtomic
- Game.LambdaHack.Atomic.CmdAtomic: UpdRestart :: !FactionId -> !DiscoveryKind -> !FactionPers -> !State -> !DebugModeCli -> UpdAtomic
+ Game.LambdaHack.Atomic.CmdAtomic: UpdRestart :: !FactionId -> !DiscoveryKind -> !FactionPers -> !State -> !Int -> !DebugModeCli -> UpdAtomic
- Game.LambdaHack.Client.Key: KM :: !Key -> !Modifier -> !Point -> KM
+ Game.LambdaHack.Client.Key: KM :: !Key -> !Modifier -> !(Maybe Point) -> KM
- Game.LambdaHack.Client.Key: pointer :: KM -> !Point
+ Game.LambdaHack.Client.Key: pointer :: KM -> !(Maybe Point)
- Game.LambdaHack.Client.State: StateClient :: !(Maybe TgtMode) -> !Target -> !Int -> !(EnumMap ActorId (Target, Maybe PathEtc)) -> !(EnumSet LevelId) -> !(EnumMap ActorId (Bool, Array BfsDistance, Point, Int, Maybe [Point])) -> !(EnumSet ActorId) -> !(Maybe RunParams) -> !Report -> !History -> !(EnumMap LevelId Time) -> ![CmdAtomic] -> !DiscoveryKind -> !DiscoveryEffect -> !FactionPers -> !StdGen -> !KM -> !LastRecord -> ![KM] -> !(EnumSet ActorId) -> !Int -> !(Maybe ActorId) -> !FactionId -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Int -> !ItemSlots -> !SlotChar -> !CStore -> !EscAI -> !DebugModeCli -> StateClient
+ Game.LambdaHack.Client.State: StateClient :: !(Maybe TgtMode) -> !Target -> !Int -> !(EnumMap ActorId (Target, Maybe PathEtc)) -> !(EnumSet LevelId) -> !(EnumMap ActorId (Bool, Array BfsDistance, Point, Int, Maybe [Point])) -> !(EnumSet ActorId) -> !(Maybe RunParams) -> !Report -> !History -> !(EnumMap LevelId Time) -> ![CmdAtomic] -> !DiscoveryKind -> !DiscoveryEffect -> !FactionPers -> !StdGen -> !KM -> !LastRecord -> ![KM] -> !(EnumSet ActorId) -> !Int -> !(Maybe ActorId) -> !FactionId -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Int -> !Int -> !ItemSlots -> !SlotChar -> !CStore -> !EscAI -> !DebugModeCli -> StateClient
- Game.LambdaHack.Client.State: defaultHistory :: IO History
+ Game.LambdaHack.Client.State: defaultHistory :: Int -> IO History
- Game.LambdaHack.Common.Actor: Actor :: !ItemId -> !Char -> !Text -> !Text -> !Color -> !Time -> !Int64 -> !ResDelta -> !Int64 -> !ResDelta -> !Point -> !Point -> !LevelId -> !LevelId -> !FactionId -> !FactionId -> !FactionId -> !(Maybe ([Vector], Speed)) -> !ItemBag -> !ItemBag -> !ItemBag -> !Bool -> !Bool -> Actor
+ Game.LambdaHack.Common.Actor: Actor :: !ItemId -> !Char -> !Text -> !Text -> !Color -> !Time -> !Int64 -> !ResDelta -> !Int64 -> !ResDelta -> !Point -> !(Maybe Point) -> !LevelId -> !LevelId -> !FactionId -> !FactionId -> !FactionId -> !(Maybe ([Vector], Speed)) -> !ItemBag -> !ItemBag -> !ItemBag -> !Bool -> !Bool -> Actor
- Game.LambdaHack.Common.Actor: boldpos :: Actor -> !Point
+ Game.LambdaHack.Common.Actor: boldpos :: Actor -> !(Maybe Point)
- Game.LambdaHack.Common.ActorState: posToActors :: Point -> LevelId -> State -> [((ActorId, Actor), [(ItemId, Item)])]
+ Game.LambdaHack.Common.ActorState: posToActors :: Point -> LevelId -> State -> [(ActorId, Actor)]
- Game.LambdaHack.Common.ClientOptions: DebugModeCli :: !(Maybe String) -> !(Maybe Bool) -> !(Maybe Int) -> !Bool -> !Bool -> !(Maybe Bool) -> !Bool -> !Bool -> !Int -> !(Maybe String) -> !Bool -> !Bool -> !Bool -> DebugModeCli
+ Game.LambdaHack.Common.ClientOptions: DebugModeCli :: !(Maybe String) -> !(Maybe Bool) -> !(Maybe Int) -> !Bool -> !Bool -> !(Maybe Bool) -> !Bool -> !Bool -> !(Maybe String) -> !Bool -> !Bool -> !Bool -> DebugModeCli
- Game.LambdaHack.Common.ItemDescription: itemDesc :: CStore -> LevelId -> Time -> ItemFull -> Overlay
+ Game.LambdaHack.Common.ItemDescription: itemDesc :: CStore -> Time -> ItemFull -> Overlay
- Game.LambdaHack.Common.ItemDescription: partItem :: CStore -> LevelId -> Time -> ItemFull -> (Bool, Part, Part)
+ Game.LambdaHack.Common.ItemDescription: partItem :: CStore -> Time -> ItemFull -> (Bool, Part, Part)
- Game.LambdaHack.Common.ItemDescription: partItemAW :: CStore -> LevelId -> Time -> ItemFull -> Part
+ Game.LambdaHack.Common.ItemDescription: partItemAW :: CStore -> Time -> ItemFull -> Part
- Game.LambdaHack.Common.ItemDescription: partItemMediumAW :: CStore -> LevelId -> Time -> ItemFull -> Part
+ Game.LambdaHack.Common.ItemDescription: partItemMediumAW :: CStore -> Time -> ItemFull -> Part
- Game.LambdaHack.Common.ItemDescription: partItemN :: Int -> Int -> CStore -> LevelId -> Time -> ItemFull -> (Bool, Part, Part)
+ Game.LambdaHack.Common.ItemDescription: partItemN :: Int -> Int -> CStore -> Time -> ItemFull -> (Bool, Part, Part)
- Game.LambdaHack.Common.ItemDescription: partItemWownW :: Part -> CStore -> LevelId -> Time -> ItemFull -> Part
+ Game.LambdaHack.Common.ItemDescription: partItemWownW :: Part -> CStore -> Time -> ItemFull -> Part
- Game.LambdaHack.Common.ItemDescription: partItemWs :: Int -> CStore -> LevelId -> Time -> ItemFull -> Part
+ Game.LambdaHack.Common.ItemDescription: partItemWs :: Int -> CStore -> Time -> ItemFull -> Part
- Game.LambdaHack.Common.Msg: emptyHistory :: History
+ Game.LambdaHack.Common.Msg: emptyHistory :: Int -> History
- Game.LambdaHack.Common.Request: ReqUIGameExit :: !ActorId -> !Int -> RequestUI
+ Game.LambdaHack.Common.Request: ReqUIGameExit :: !ActorId -> RequestUI

Files

CHANGELOG.md view
@@ -1,3 +1,14 @@+## [v0.5.0.0, aka 'Halfway through space'](https://github.com/LambdaHack/LambdaHack/compare/v0.4.101.0...v0.5.0.0)++- let AI put excess items in shared stash and use them out of shared stash+- let UI multiple items pickup routine put items that don't fit into equipment into shared stash, if possible, not into inventory pack+- re-enable the ability to hear close, invisible foes+- add a few more AI and autonomous henchmen tactics (CTRL-T)+- keep difficulty setting over session restart+- change some game start keybindings+- replace the Duel game mode with the Raid game mode+- various bugfixes, minor improvements and balancing+ ## [v0.4.101.0, aka 'Officially fun'](https://github.com/LambdaHack/LambdaHack/compare/v0.4.100.0...v0.4.101.0)  - the game is now officially fun to play
Game/LambdaHack/Atomic.hs view
@@ -10,6 +10,7 @@   , CmdAtomic(..), UpdAtomic(..), SfxAtomic(..), HitAtomic(..)     -- * Re-exported from "Game.LambdaHack.Atomic.PosAtomicRead"   , PosAtomic(..), posUpdAtomic, posSfxAtomic, seenAtomicCli, generalMoveItem+  , posProjBody   ) where  import Game.LambdaHack.Atomic.CmdAtomic
Game/LambdaHack/Atomic/BroadcastAtomicWrite.hs view
@@ -160,8 +160,11 @@   let inFov = ES.elems $ totalVisible inPer       lvl = sdungeon s EM.! lid       -- Actors.+      carriedAssocs b = getCarriedAssocs b s       inPrio = concatMap (\p -> posToActors p lid s) inFov-      fActor ((aid, b), ais) = UpdSpotActor aid b ais+      fActor (aid, b) =+        let ais = carriedAssocs b+        in UpdSpotActor aid b ais       inActor = map fActor inPrio       -- Items.       pMaybe p = maybe Nothing (\x -> Just (p, x))
Game/LambdaHack/Atomic/CmdAtomic.hs view
@@ -104,7 +104,7 @@   | UpdDiscoverSeed !Container !ItemId !ItemSeed !AbsDepth   | UpdCoverSeed !Container !ItemId !ItemSeed !AbsDepth   | UpdPerception !LevelId !Perception !Perception-  | UpdRestart !FactionId !DiscoveryKind !FactionPers !State !DebugModeCli+  | UpdRestart !FactionId !DiscoveryKind !FactionPers !State !Int !DebugModeCli   | UpdRestartServer !State   | UpdResume !FactionId !FactionPers   | UpdResumeServer !State
Game/LambdaHack/Atomic/HandleAtomicWrite.hs view
@@ -91,7 +91,7 @@   UpdCoverSeed{} -> return ()   UpdPerception _ outPer inPer ->     assert (not (nullPer outPer && nullPer inPer)) (return ())-  UpdRestart _ _ _ s _ -> updRestart s+  UpdRestart _ _ _ s _ _ -> updRestart s   UpdRestartServer s -> updRestartServer s   UpdResume{} -> return ()   UpdResumeServer s -> updResumeServer s@@ -197,7 +197,7 @@   let !_A = assert (fromP == bpos b                     `blame` "unexpected moved actor position"                     `twith` (aid, fromP, toP, bpos b, b)) ()-  updateActor aid $ \body -> body {bpos = toP, boldpos = fromP}+  updateActor aid $ \body -> body {bpos = toP, boldpos = Just fromP}  updWaitActor :: MonadStateWrite m => ActorId -> Bool -> m () updWaitActor aid toWait = do@@ -211,8 +211,8 @@ updDisplaceActor source target = assert (source /= target) $ do   spos <- getsState $ bpos . getActorBody source   tpos <- getsState $ bpos . getActorBody target-  updateActor source $ \b -> b {bpos = tpos, boldpos = spos}-  updateActor target $ \b -> b {bpos = spos, boldpos = tpos}+  updateActor source $ \b -> b {bpos = tpos, boldpos = Just spos}+  updateActor target $ \b -> b {bpos = spos, boldpos = Just tpos}  updMoveItem :: MonadStateWrite m             => ItemId -> Int -> ActorId -> CStore -> CStore
Game/LambdaHack/Atomic/MonadStateWrite.hs view
@@ -189,7 +189,7 @@         case compare n k of           LT -> assert `failure` "rm more than there is"                        `twith` (n, kit, iid, bag)-          EQ -> Nothing+          EQ -> Nothing  -- TODO: assert as below           GT -> assert (rmIt == take k it                         `blame` (rmIt, take k it, n, kit, iid, bag))                 $ Just (n - k, drop k it)
Game/LambdaHack/Atomic/PosAtomicRead.hs view
@@ -4,7 +4,7 @@ module Game.LambdaHack.Atomic.PosAtomicRead   ( PosAtomic(..), posUpdAtomic, posSfxAtomic   , resetsFovCmdAtomic, breakUpdAtomic, breakSfxAtomic, loudUpdAtomic-  , seenAtomicCli, seenAtomicSer, generalMoveItem+  , seenAtomicCli, seenAtomicSer, generalMoveItem, posProjBody   ) where  import Control.Applicative@@ -69,12 +69,12 @@ -- contradict state) if the visibility is lower. posUpdAtomic :: MonadStateRead m => UpdAtomic -> m PosAtomic posUpdAtomic cmd = case cmd of-  UpdCreateActor _ body _ -> posProjBody body-  UpdDestroyActor _ body _ -> posProjBody body+  UpdCreateActor _ body _ -> return $! posProjBody body+  UpdDestroyActor _ body _ -> return $! posProjBody body   UpdCreateItem _ _ _ c -> singleContainer c   UpdDestroyItem _ _ _ c -> singleContainer c-  UpdSpotActor _ body _ -> posProjBody body-  UpdLoseActor _ body _ -> posProjBody body+  UpdSpotActor _ body _ -> return $! posProjBody body+  UpdLoseActor _ body _ -> return $! posProjBody body   UpdSpotItem _ _ _ c -> singleContainer c   UpdLoseItem _ _ _ c -> singleContainer c   UpdMoveActor aid fromP toP -> do@@ -148,7 +148,7 @@   UpdDiscoverSeed c _ _ _ -> singleContainer c   UpdCoverSeed c _ _ _ -> singleContainer c   UpdPerception{} -> return PosNone-  UpdRestart fid _ _ _ _ -> return $! PosFid fid+  UpdRestart fid _ _ _ _ _ -> return $! PosFid fid   UpdRestartServer _ -> return PosSer   UpdResume fid _ -> return $! PosFid fid   UpdResumeServer _ -> return PosSer@@ -162,16 +162,10 @@ posSfxAtomic cmd = case cmd of   SfxStrike _ _ _ CSha _ ->  -- shared stash is private     return PosNone  -- TODO: PosSerAndFidIfSight; but probably never used-  SfxStrike source target _ _ _ -> do-    (slid, sp) <- posOfAid source-    (tlid, tp) <- posOfAid target-    return $! assert (slid == tlid) $ PosSight slid [sp, tp]+  SfxStrike source target _ _ _ -> doubleAid source target   SfxRecoil _ _ _ CSha _ ->  -- shared stash is private     return PosNone  -- TODO: PosSerAndFidIfSight; but probably never used-  SfxRecoil source target _ _ _ -> do-    (slid, sp) <- posOfAid source-    (tlid, tp) <- posOfAid target-    return $! assert (slid == tlid) $ PosSight slid [sp, tp]+  SfxRecoil source target _ _ _ -> doubleAid source target   SfxProject aid _ cstore -> singleContainer $ CActor aid cstore   SfxCatch aid _ cstore -> singleContainer $ CActor aid cstore   SfxApply aid _ cstore -> singleContainer $ CActor aid cstore@@ -187,8 +181,8 @@   SfxMsgAll _ -> return PosAll   SfxActorStart aid -> singleAid aid -posProjBody :: Monad m => Actor -> m PosAtomic-posProjBody body = return $!+posProjBody :: Actor -> PosAtomic+posProjBody body =   if bproj body   then PosSight (blid body) [bpos body]   else PosFidAndSight [bfid body] (blid body) [bpos body]@@ -203,6 +197,12 @@   (lid, p) <- posOfAid aid   return $! PosSight lid [p] +doubleAid :: MonadStateRead m => ActorId -> ActorId -> m PosAtomic+doubleAid source target = do+  (slid, sp) <- posOfAid source+  (tlid, tp) <- posOfAid target+  return $! assert (slid == tlid) $ PosSight slid [sp, tp]+ singleContainer :: MonadStateRead m => Container -> m PosAtomic singleContainer (CFloor lid p) = return $! PosSight lid [p] singleContainer (CEmbed lid p) = return $! PosSight lid [p]@@ -261,16 +261,16 @@     b <- getsState $ getActorBody aid     ais <- getsState $ getCarriedAssocs b     return [ UpdLoseActor aid b ais-           , UpdSpotActor aid b {bpos = toP, boldpos = bpos b} ais ]+           , UpdSpotActor aid b {bpos = toP, boldpos = Just $ bpos b} ais ]   UpdDisplaceActor source target -> do     sb <- getsState $ getActorBody source     sais <- getsState $ getCarriedAssocs sb     tb <- getsState $ getActorBody target     tais <- getsState $ getCarriedAssocs tb     return [ UpdLoseActor source sb sais-           , UpdSpotActor source sb {bpos = bpos tb, boldpos = bpos sb} sais+           , UpdSpotActor source sb {bpos = bpos tb, boldpos = Just $ bpos sb} sais            , UpdLoseActor target tb tais-           , UpdSpotActor target tb {bpos = bpos sb, boldpos = bpos tb} tais+           , UpdSpotActor target tb {bpos = bpos sb, boldpos = Just $ bpos tb} tais            ]   UpdMoveItem iid k aid cstore1 cstore2 | cstore1 == CSha  -- CSha is private                                           || cstore2 == CSha ->
Game/LambdaHack/Client/AI.hs view
@@ -21,13 +21,12 @@ import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.Faction-import Game.LambdaHack.Common.Misc+import Game.LambdaHack.Common.Frequency import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Msg import Game.LambdaHack.Common.Random import Game.LambdaHack.Common.Request import Game.LambdaHack.Common.State-import Game.LambdaHack.Content.ModeKind  -- | Handle the move of an AI player. queryAI :: MonadClient m => ActorId -> m RequestAI@@ -37,10 +36,7 @@   let mleader = gleader fact       wasLeader = fmap fst mleader == Just oldAid   (aidToMove, bToMove) <- pickActorToMove refreshTarget oldAid-  RequestAnyAbility reqAny <--    if ftactic (gplayer fact) == TBlock && not wasLeader-    then return $! RequestAnyAbility ReqWait-    else pickAction (aidToMove, bToMove)+  RequestAnyAbility reqAny <- pickAction (aidToMove, bToMove)   let req = ReqAITimed reqAny   mtgt2 <- getsClient $ fmap fst . EM.lookup aidToMove . stargetD   if wasLeader && mleader /= Just (aidToMove, mtgt2)@@ -66,7 +62,7 @@                     `twith` (aid, body, side)) ()   stratTarget <- targetStrategy aid   tgtMPath <--    if nullStrategy stratTarget then+    if nullStrategy stratTarget then  -- equiv to nullFreq       -- No sensible target; wipe out the old one.       return Nothing     else do@@ -99,5 +95,9 @@                     `blame` "AI gets to manually move its projectiles"                     `twith` (aid, bfid body, side)) ()   stratAction <- actionStrategy aid+  let bestAction = bestVariant stratAction+      !_A = assert (not (nullFreq bestAction)  -- equiv to nullStrategy+                    `blame` "no AI action for actor"+                    `twith` (stratAction, aid, body)) ()   -- Run the AI: chose an action from those given by the AI strategy.-  rndToAction $ frequency $ bestVariant stratAction+  rndToAction $ frequency bestAction
Game/LambdaHack/Client/AI/ConditionClient.hs view
@@ -55,7 +55,6 @@ import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK-import Game.LambdaHack.Content.ModeKind  -- | Require that the target enemy is visible by the party. condTgtEnemyPresentM :: MonadClient m => ActorId -> m Bool@@ -136,7 +135,7 @@         activeItems <- activeItemsClient aid2         let actorMaxSkE = sumSkills activeItems             nonmoving = EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0-        return $! not $ (hpTooLow b2 activeItems || nonmoving)+        return $! not (hpTooLow b2 activeItems || nonmoving)   allThreats <- filterM strongActor allAtWar   let addDist (aid2, b2) = (chessDist (bpos b) (bpos b2), (aid2, b2))   return $ sortBy (comparing fst) $ map addDist allThreats@@ -235,22 +234,19 @@         condNotCalmEnough  -- perhaps enemies don't have projectiles         body activeItems itemFull =   let itemLit = isJust $ strengthFromEqpSlot IK.EqpSlotAddLight itemFull+      itemLitBad = itemLit && condNotCalmEnough && not condAnyFoeAdj   in -- Fast actors want to hide in darkness to ambush opponents and want      -- to hit hard for the short span they get to survive melee.      bspeed body activeItems > speedNormal-     && (condNotCalmEnough && itemLit+     && (itemLitBad          || 0 > fromMaybe 0 (strengthFromEqpSlot IK.EqpSlotAddHurtMelee-                                                 itemFull)-         || 0 > fromMaybe 0 (strengthFromEqpSlot IK.EqpSlotAddHurtRanged                                                  itemFull))      -- In the presence of enemies (seen, or unseen but distressing)      -- actors want to hide in the dark.      || let heavilyDistressed =  -- actor hit by a proj or similarly distressed               deltaSerious (bcalmDelta body)-        in condNotCalmEnough+        in itemLitBad && condLightBetrays            && (heavilyDistressed || condTgtEnemyPresent)-           && condLightBetrays && not condAnyFoeAdj-           && itemLit   -- TODO:   -- teach AI to turn shields OFF (or stash) when ganging up on an enemy   -- (friends close, only one enemy close)@@ -318,13 +314,7 @@   let condNoUsableWeapon = all (not . isMelee) activeItems       friendlyFid fid = fid == bfid b || isAllied fact fid   friends <- getsState $ actorRegularAssocs friendlyFid (blid b)-  friendlyFacts <--    getsState $ map snd . filter (friendlyFid . fst) . EM.assocs . sfactionD-  Level{lactorFreq} <- getLevel $ blid b-  let freqNames = map fst lactorFreq-      factNames = map (fgroup . gplayer) friendlyFacts-      spawnerOnLvl = any (`elem` freqNames) factNames-      closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)+  let closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)                        in dist > 0 && (dist <= 2 || approaching b2)       -- 3 is the condThreatAtHand distance that AI keeps when alone.       approaching = case mtgtPos of@@ -342,8 +332,7 @@   strongCloseFriends <- filterM strongActor closeFriends   let noFriendlyHelp = length closeFriends < 3                        && null strongCloseFriends-                       && (length friends > 1  -- solo fighters aggresive-                           || spawnerOnLvl)+                       && length friends > 1  -- solo fighters aggresive                        && not (hpHuge b)  -- uniques, etc., aggresive   let actorMaxSk = sumSkills activeItems   return $ condNoUsableWeapon
Game/LambdaHack/Client/AI/HandleAbilityClient.hs view
@@ -268,15 +268,18 @@         let n = oldN + k             (newN, toCStore)               | calmE && goesIntoSha itemFull = (oldN, CSha)-              | not (goesIntoEqp itemFull) || eqpOverfull b n = (oldN, CInv)-              | otherwise = (n, CEqp)+              | goesIntoEqp itemFull && eqpOverfull b n =+                (oldN, if calmE then CSha else CInv)+              | goesIntoEqp itemFull = (n, CEqp)+              | otherwise = (oldN, CInv)         in (newN, (iid, k, CGround, toCStore) : l4)       (_, prepared) = foldl' prepareOne (0, []) $ filterWeapon benItemL   return $! if null prepared             then reject             else returN "pickup" $ ReqMoveItems prepared -equipItems :: MonadClient m => ActorId -> m (Strategy (RequestTimed 'AbMoveItem))+equipItems :: MonadClient m+           => ActorId -> m (Strategy (RequestTimed 'AbMoveItem)) equipItems aid = do   cops <- getsState scops   body <- getsState $ getActorBody aid@@ -422,12 +425,12 @@                        body activeItems fact itemFull       bestThree =         bestByEqpSlot eqpAssocs invAssocs (filter filterNeeded shaAssocs)-      bInvSha = concatMap (improve CInv)-                $ map (\((slot, _), (_, inv, sha)) ->-                        (slot, (sha, inv))) bestThree-      bEqpSha = concatMap (improve CEqp)-                $ map (\((slot, _), (eqp, _, sha)) ->-                        (slot, (sha, eqp))) bestThree+      bInvSha = concatMap+                  (improve CInv . (\((slot, _), (_, inv, sha)) ->+                                    (slot, (sha, inv)))) bestThree+      bEqpSha = concatMap+                  (improve CEqp . (\((slot, _), (eqp, _, sha)) ->+                                    (slot, (sha, eqp)))) bestThree       prepared = if calmE then bInvSha ++ bEqpSha else []   return $! if null prepared             then reject@@ -496,11 +499,11 @@       let maim | adjacent (bpos b) goal = Just goal                | adjacent (bpos b) q = Just q                | otherwise = Nothing  -- MeleeDistant-      mBlocker <- case maim of-        Nothing -> return Nothing-        Just aim -> getsState $ posToActor aim (blid b)-      case mBlocker of-        Just ((aid2, _), _) -> do+      lBlocker <- case maim of+        Nothing -> return []+        Just aim -> getsState $ posToActors aim (blid b)+      case lBlocker of+        (aid2, _) : _ -> do           -- No problem if there are many projectiles at the spot. We just           -- attack the first one.           body2 <- getsState $ getActorBody aid2@@ -515,7 +518,7 @@               mel <- maybeToList <$> pickWeaponClient aid aid2               return $! liftFrequency $ uniformFreq "melee in the way" mel             else return reject-        Nothing -> return reject+        [] -> return reject     _ -> return reject  -- probably no path to the enemy, if any  -- Everybody melees in a pinch, skills and weapons allowing,@@ -581,7 +584,7 @@                 | otherwise = 2  -- no escape, switch levels occasionally               actorsThere = posToActors pos2 lid2 s           return $!-             if boldpos b == bpos b   -- probably used stairs last turn+             if boldpos b == Just (bpos b)   -- probably used stairs last turn                 && boldlid b == lid2  -- in the opposite direction              then 0  -- avoid trivial loops (pushing, being pushed, etc.)              else let eben = case actorsThere of@@ -625,13 +628,16 @@           let q _ itemFull b2 activeItems =                 either (const False) id                 $ permittedProject " " False skill itemFull b2 activeItems-          benList <- benAvailableItems aid q [CEqp, CInv, CGround]+          activeItems <- activeItemsClient aid+          let calmE = calmEnough b activeItems+              stores = [CEqp, CInv, CGround] ++ [CSha | calmE]+          benList <- benAvailableItems aid q stores           localTime <- getsState $ getLocalTime (blid b)           let coeff CGround = 2               coeff COrgan = 3  -- can't give to others               coeff CEqp = 100000  -- must hinder currently               coeff CInv = 1-              coeff CSha = undefined  -- banned+              coeff CSha = 1               fRanged ( (mben, (_, cstore))                       , (iid, itemFull@ItemFull{itemBase}) ) =                 -- We assume if the item has a timeout, most effects are under@@ -684,7 +690,10 @@         in maybe True (<= 0) (lookup "gem" freq)            && either (const False) id                 (permittedApply " " localTime skill itemFull b activeItems)-  benList <- benAvailableItems aid q [CEqp, CInv, CGround]+  activeItems <- activeItemsClient aid+  let calmE = calmEnough b activeItems+      stores = [CEqp, CInv, CGround] ++ [CSha | calmE]+  benList <- benAvailableItems aid q stores   organs <- mapM (getsState . getItemBody) $ EM.keys $ borgan b   let itemLegal itemFull = case applyGroup of         ApplyFirstAid ->@@ -700,7 +709,7 @@       coeff COrgan = 3  -- can't give to others       coeff CEqp = 100000  -- must hinder currently       coeff CInv = 1-      coeff CSha = undefined  -- banned+      coeff CSha = 1       fTool ((mben, (_, cstore)), (iid, itemFull@ItemFull{itemBase})) =         let durableBonus = if IK.Durable `elem` jfeature itemBase                            then 5  -- we keep it after use@@ -794,13 +803,13 @@   b <- getsState $ getActorBody aid   let !_A = assert (source == bpos b && adjacent source target) ()   lvl <- getLevel $ blid b-  if boldpos b /= target -- avoid trivial loops+  if boldpos b /= Just target -- avoid trivial loops      && accessible cops lvl source target then do  -- DisplaceAccess     mleader <- getsClient _sleader     mBlocker <- getsState $ posToActors target (blid b)     case mBlocker of       [] -> return reject-      [((aid2, b2), _)] | Just aid2 /= mleader -> do+      [(aid2, b2)] | Just aid2 /= mleader -> do         mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD         case mtgtMPath of           Just (tgt, Just (p : q : rest, (goal, len)))@@ -843,12 +852,15 @@   -- this is meaningul.   mapStrategyM (moveOrRunAid doDisplace aid) str +-- TODO: rename source here and elsewhere, it's always an ActorId in the code moveTowards :: MonadClient m             => ActorId -> Point -> Point -> Point -> Bool -> m (Strategy Vector) moveTowards aid source target goal relaxed = do   cops@Kind.COps{cotile} <- getsState scops   b <- getsState $ getActorBody aid-  let !_A = assert (source == bpos b+  actorSk <- actorSkillsClient aid+  let alterSkill = EM.findWithDefault 0 AbAlter actorSk+      !_A = assert (source == bpos b                     `blame` (source, bpos b, aid, b, goal)) ()       !_B = assert (adjacent source target                     `blame` (source, target, aid, b, goal)) ()@@ -857,16 +869,19 @@   friends <- getsState $ actorList (not . isAtWar fact) $ blid b   let noFriends = unoccupied friends       accessibleHere = accessible cops lvl source+      -- Only actors with AbAlter can search for hidden doors, etc.       bumpableHere p =         let t = lvl `at` p-        in Tile.isOpenable cotile t-           || Tile.isSuspect cotile t-           || Tile.isChangeable cotile t+        in alterSkill >= 1+           && (Tile.isOpenable cotile t+               || Tile.isSuspect cotile t+               || Tile.isChangeable cotile t)       enterableHere p = accessibleHere p || bumpableHere p   if noFriends target && enterableHere target then     return $! returN "moveTowards adjacent" $ target `vectorToFrom` source   else do-    let goesBack v = v == boldpos b `vectorToFrom` source+    let goesBack v = maybe False (\oldpos -> v == oldpos `vectorToFrom` source)+                           (boldpos b)         nonincreasing p = chessDist source goal >= chessDist p goal         isSensible p = (relaxed || nonincreasing p)                        && noFriends p@@ -886,9 +901,11 @@ moveOrRunAid run source dir = do   cops@Kind.COps{cotile} <- getsState scops   sb <- getsState $ getActorBody source+  actorSk <- actorSkillsClient source   let lid = blid sb   lvl <- getLevel lid-  let spos = bpos sb           -- source position+  let skill = EM.findWithDefault 0 AbAlter actorSk+      spos = bpos sb           -- source position       tpos = spos `shift` dir  -- target position       t = lvl `at` tpos   -- We start by checking actors at the the target position,@@ -897,12 +914,13 @@   -- (tiles can't be invisible).   tgts <- getsState $ posToActors tpos lid   case tgts of-    [((target, b2), _)] | run -> do+    [(target, b2)] | run -> do       -- @target@ can be a foe, as well as a friend.       tfact <- getsState $ (EM.! bfid b2) . sfactionD       activeItems <- activeItemsClient target       dEnemy <- getsState $ dispEnemy source target activeItems-      if boldpos sb == tpos && not (waitedLastTurn sb)  -- avoid Displace loops+      if boldpos sb == Just tpos && not (waitedLastTurn sb)+           -- avoid Displace loops          || not (accessible cops lvl spos tpos) -- DisplaceAccess       then return Nothing       else if isAtWar tfact (bfid sb) && not dEnemy  -- DisplaceDying, etc.@@ -911,9 +929,8 @@         case wps of           Nothing -> return Nothing           Just wp -> return $! Just $ RequestAnyAbility wp-      else do-        return $! Just $ RequestAnyAbility $ ReqDisplace target-    ((target, _), _) : _ -> do  -- can be a foe, as well as friend (e.g., proj.)+      else return $! Just $ RequestAnyAbility $ ReqDisplace target+    (target, _) : _ -> do  -- can be a foe, as well as friend (e.g., proj.)       -- No problem if there are many projectiles at the spot. We just       -- attack the first one.       -- Attacking does not require full access, adjacency is enough.@@ -921,22 +938,25 @@       case wps of         Nothing -> return Nothing         Just wp -> return $! Just $ RequestAnyAbility wp-    [] ->  -- move or search or alter-      if accessible cops lvl spos tpos then-        -- Movement requires full access.-        return $! Just $ RequestAnyAbility $ ReqMove dir-        -- The potential invisible actor is hit.-      else if EM.member tpos $ lfloor lvl then-        -- This is, e.g., inaccessible open door with an item in it.-        assert `failure` "AI causes AlterBlockItem" `twith` (run, source, dir)-      else if not (Tile.isWalkable cotile t)  -- not implied+    [] -- move or search or alter+       | accessible cops lvl spos tpos ->+         -- Movement requires full access.+         return $! Just $ RequestAnyAbility $ ReqMove dir+         -- The potential invisible actor is hit.+       | skill < 1 ->+         assert `failure` "AI causes  AlterUnskilled" `twith` (run, source, dir)+       | EM.member tpos $ lfloor lvl ->+         -- This could be, e.g., inaccessible open door with an item in it,+         -- but for this case to happen, it would also need to be unwalkable.+         assert `failure` "AI causes AlterBlockItem" `twith` (run, source, dir)+       | not (Tile.isWalkable cotile t)  -- not implied               && (Tile.isSuspect cotile t                   || Tile.isOpenable cotile t                   || Tile.isClosable cotile t-                  || Tile.isChangeable cotile t) then-        -- No access, so search and/or alter the tile.-        return $! Just $ RequestAnyAbility $ ReqAlter tpos Nothing-      else-        -- Boring tile, no point bumping into it, do WaitSer if really idle.-        assert `failure` "AI causes MoveNothing or AlterNothing"-               `twith` (run, source, dir)+                  || Tile.isChangeable cotile t) ->+         -- No access, so search and/or alter the tile.+         return $! Just $ RequestAnyAbility $ ReqAlter tpos Nothing+       | otherwise ->+         -- Boring tile, no point bumping into it, do WaitSer if really idle.+         assert `failure` "AI causes MoveNothing or AlterNothing"+                `twith` (run, source, dir)
Game/LambdaHack/Client/AI/PickActorClient.hs view
@@ -52,36 +52,48 @@   mleader <- getsClient _sleader   ours <- getsState $ actorRegularAssocs (== side) arena   let explore = void $ refreshTarget (oldAid, oldBody)+      setPath mtgt = case mtgt of+        Nothing -> return False+        Just (tgtLeader, _) -> do+          mpath <- createPath oldAid tgtLeader+          case mpath of+            Nothing -> return False+            Just path -> do+              let tgtMPath = second Just path+              modifyClient $ \cli ->+                cli {stargetD = EM.alter (const $ Just tgtMPath)+                                         oldAid (stargetD cli)}+              return True+      follow = case mleader of+        -- If no leader at all (forced @TFollow@ tactic on an actor+        -- from a leaderless faction), fall back to @TExplore@.+        Nothing -> explore+        Just leader -> do+          onLevel <- getsState $ memActor leader arena+          -- If leader not on this level, fall back to @TExplore@.+          if not onLevel then explore+          else do+            modifyClient $ \cli ->+              cli { sbfsD = invalidateBfs oldAid (sbfsD cli)+                  , seps = seps cli + 773 }  -- randomize paths+            -- Copy over the leader's target, if any, or follow his bpos.+            mtgt <- getsClient $ EM.lookup leader . stargetD+            tgtPathSet <- setPath mtgt+            let enemyPath = Just (TEnemy leader True, Nothing)+            unless tgtPathSet $ do+               enemyPathSet <- setPath enemyPath+               unless enemyPathSet $+                 -- If no path even to the leader himself, explore.+                 explore       pickOld = do         if mleader == Just oldAid then explore         else case ftactic $ gplayer fact of-          TBlock -> return ()  -- no point refreshing target-          TFollow ->-            case mleader of-              -- If no leader at all (forced @TFollow@ tactic on an actor-              -- from a leaderless faction), fall back to @TExplore@.-              Nothing -> explore-              Just leader -> do-                onLevel <- getsState $ memActor leader arena-                -- If leader not on this level, fall back to @TExplore@.-                if not onLevel then explore-                else do-                  -- Copy over the leader's target, if any, or follow his bpos.-                  tgtLeader <- do-                    mtgt <- getsClient $ EM.lookup leader . stargetD-                    case mtgt of-                      Nothing -> return $! TEnemy leader True-                      Just (tgtLeader, _) -> return tgtLeader-                  modifyClient $ \cli ->-                    cli { sbfsD = invalidateBfs oldAid (sbfsD cli)-                        , seps = seps cli + 773 }  -- randomize paths-                  mpath <- createPath oldAid tgtLeader-                  let tgtMPath =-                        maybe (tgtLeader, Nothing) (second Just) mpath-                  modifyClient $ \cli ->-                    cli {stargetD = EM.alter (const $ Just tgtMPath)-                                             oldAid (stargetD cli)}           TExplore -> explore+          TFollow -> follow+          TFollowNoItems -> follow+          TMeleeAndRanged -> explore  -- needs to find ranged targets+          TMeleeAdjacent -> explore  -- probably not needed, but may change+          TBlock -> return ()  -- no point refreshing target           TRoam -> explore  -- @TRoam@ is checked again inside @explore@           TPatrol -> explore  -- TODO         return (oldAid, oldBody)@@ -128,11 +140,12 @@                 heavilyDistressed =                   -- Actor hit by a projectile or similarly distressed.                   deltaSerious (bcalmDelta body)-            return $! if canMelee && condThreatAdj then False-                      else if condThreatAtHandVeryClose-                      then condCanFlee && condMeleeBad && not condFastThreatAdj-                      else heavilyDistressed  -- shot at-                        -- TODO: modify when reaction fire is possible+            return $! not (canMelee && condThreatAdj)+                      && if condThreatAtHandVeryClose+                         then condCanFlee && condMeleeBad+                              && not condFastThreatAdj+                         else heavilyDistressed  -- shot at+                           -- TODO: modify when reaction fire is possible           actorHearning (_, (TEnemyPos{}, (_, (_, d)))) | d <= 2 =             return False  -- noise probably due to fleeing target           actorHearning ((_aid, b), _) = do
Game/LambdaHack/Client/AI/PickTargetClient.hs view
@@ -150,7 +150,9 @@                       else actorMinSk         in EM.findWithDefault 0 AbMove axtorSk > 0       isStuck = waitedLastTurn b && couldMoveLastTurn-      slackTactic = ftactic (gplayer fact) `elem` [TBlock, TRoam, TPatrol]+      slackTactic =+        ftactic (gplayer fact)+          `elem` [TMeleeAndRanged, TMeleeAdjacent, TBlock, TRoam, TPatrol]       setPath :: Target -> m (Strategy (Target, Maybe PathEtc))       setPath tgt = do         mpath <- createPath aid tgt@@ -207,7 +209,8 @@                               , if length path == 1                                 then Nothing                                 else Just (path, (last path, length path - 1)) )-                          vOld = bpos b `vectorToFrom` boldpos b+                          oldpos = fromMaybe (Point 0 0) (boldpos b)+                          vOld = bpos b `vectorToFrom` oldpos                           pNew = shiftBounded lxsize lysize (bpos b) vOld                       if slackTactic && not isStuck                          && isUnit vOld && bpos b /= pNew@@ -236,7 +239,7 @@                                   case afoes of                                     (_, (aid2, _)) : _ ->                                       setPath $ TEnemy aid2 False-                                    [] -> do+                                    [] ->                                       if nullFreq ctriggers then do                                         furthest <- furthestKnown aid                                         setPath $ TPoint (blid b) furthest
Game/LambdaHack/Client/AI/Preferences.hs view
@@ -27,8 +27,8 @@   let dungeonDweller = not $ fcanEscape $ gplayer fact   in case eff of     IK.NoEffect _ -> 0-    IK.Hurt d -> -(min 100 $ 10 * Dice.meanDice d)-    IK.Burn d -> -(min 150 $ 15 * Dice.meanDice d)+    IK.Hurt d -> -(min 150 $ 10 * Dice.meanDice d)+    IK.Burn d -> -(min 200 $ 15 * Dice.meanDice d)                    -- often splash damage, etc.     IK.Explode _ -> 0  -- depends on explosion     IK.RefillHP p ->@@ -78,11 +78,11 @@          then 1          else -p  -- get rid of the foe     IK.CreateItem COrgan grp _ ->  -- TODO: use the timeout-      let (total, count) = organBenefit grp cops b+      let (total, count) = organBenefit grp cops b activeItems fact       in total `divUp` count  -- average over all matching grp; rarities ignored     IK.CreateItem{} -> 30  -- TODO     IK.DropItem COrgan grp True ->  -- calculated for future use, general pickup-      let (total, _) = organBenefit grp cops b+      let (total, _) = organBenefit grp cops b activeItems fact       in - total  -- sum over all matching grp; simplification: rarities ignored     IK.DropItem _ _ False -> -15     IK.DropItem _ _ True -> -30@@ -96,18 +96,22 @@     IK.ActivateInv _ -> -50     IK.ApplyPerfume -> 0  -- depends on the smell sense of friends and foes     IK.OneOf _ -> 1  -- usually a mixed blessing, but slightly beneficial-    IK.OnSmash _ -> -10+    IK.OnSmash _ -> 0  -- TOOD: can be beneficial or not; analyze explosions     IK.Recharging e ->       -- Used, e.g., in @periodicBens@, which takes timeout into account, too.       effectToBenefit cops b activeItems fact e     IK.Temporary _ -> 0  -- TODO: calculating this for "temporary conditions" takes forever-organBenefit :: GroupName ItemKind -> Kind.COps -> Actor -> (Int, Int)-organBenefit t cops@Kind.COps{coitem=Kind.Ops{ofoldrGroup}} b =+organBenefit :: GroupName ItemKind -> Kind.COps+             -> Actor -> [ItemFull] -> Faction+             -> (Int, Int)+organBenefit t cops@Kind.COps{coitem=Kind.Ops{ofoldrGroup}} b activeItems fact =   let f p _ kind (sacc, pacc) =         let paspect asp = p * aspectToBenefit cops b (Dice.meanDice <$> asp)+            peffect eff = p * effectToBenefit cops b activeItems fact eff         in ( sacc + sum (map paspect $ IK.iaspects kind)+                  + sum (map peffect $ IK.ieffects kind)            , pacc + p )   in ofoldrGroup t f (0, 0) @@ -119,6 +123,7 @@     IK.Periodic{} -> 0     IK.Timeout{} -> 0     IK.AddHurtMelee p -> p+    IK.AddHurtRanged p | p < 0 -> 0  -- TODO: don't ignore for missiles     IK.AddHurtRanged p -> p `divUp` 5  -- TODO: should be summed with damage     IK.AddArmorMelee p -> p `divUp` 5     IK.AddArmorRanged p -> p `divUp` 10
Game/LambdaHack/Client/BfsClient.hs view
@@ -69,6 +69,8 @@                                  (sbfsD cli)}         return (bfs, mpath)   mbfs <- getsClient $ EM.lookup aid . sbfsD+  -- TODO: record past skills too, in case mobility lost; but no great harm,+  -- perhaps the loss is temporary   case mbfs of     Just (True, bfs, targetOld, sepsOld, mpath)       -- TODO: hack: in screensavers this is not always ensured, so check here:@@ -98,6 +100,8 @@   case mbfs of     Just (True, bfs, _, _, _) -> return bfs     _ -> fst <$> getCacheBfsAndPath aid (Point 0 0)+      -- @undefined@ here crashes, because it's used to invalidate cache,+      -- but the paths is not computed, until needed (unlikely at (0, 0))  condBFS :: MonadClient m         => ActorId@@ -114,11 +118,18 @@   -- and leader change is very rare.   activeItems <- activeItemsClient aid   let actorMaxSk = sumSkills activeItems+      alterSkill = EM.findWithDefault 0 Ability.AbAlter actorMaxSk+      canSearchAndOpen = alterSkill >= 1+      canMove = EM.findWithDefault 0 Ability.AbMove actorMaxSk > 0+                || EM.findWithDefault 0 Ability.AbDisplace actorMaxSk > 0+                -- TODO: needed for now, because AI targets enemies+                -- based on the path to them, not LOS to them.+                || EM.findWithDefault 0 Ability.AbProject actorMaxSk > 0   lvl <- getLevel $ blid b   smarkSuspect <- getsClient smarkSuspect   fact <- getsState $ (EM.! bfid b) . sfactionD   let underAI = isAIFact fact-      enterSuspect = smarkSuspect || underAI+      enterSuspect = canSearchAndOpen && (smarkSuspect || underAI)       isPassable | enterSuspect = Tile.isPassable                  | otherwise = Tile.isPassableNoSuspect   -- We treat doors as an open tile and don't add an extra step for opening@@ -126,8 +137,7 @@   -- so it's amortized. We treat unknown tiles specially.   let unknownId = ouniqGroup "unknown space"       chAccess = checkAccess cops lvl-      canOpenDoors = EM.findWithDefault 0 Ability.AbAlter actorMaxSk > 0-      chDoorAccess = [checkDoorAccess cops lvl | canOpenDoors]+      chDoorAccess = [checkDoorAccess cops lvl | canSearchAndOpen]       conditions = catMaybes $ chAccess : chDoorAccess       -- Legality of move from a known tile, assuming doors freely openable.       isEnterable :: Point -> Point -> MoveLegal@@ -154,7 +164,9 @@         Just ch -> \spos tpos -> let tt = lvl `at` tpos                                  in tt == unknownId                                     && ch spos tpos-  return (isEnterable, passUnknown)+  if canMove+    then return (isEnterable, passUnknown)+    else return (\_ _ -> MoveBlocked, \_ _ -> False)  accessCacheBfs :: MonadClient m => ActorId -> Point -> m (Maybe Int) {-# INLINE accessCacheBfs #-}@@ -170,9 +182,8 @@                                      , PointArray.maxLastIndexA ]   let furthestPos = getMaxIndex bfs       dist = bfs PointArray.! furthestPos-  return $! if dist <= apartBfs-            then assert `failure` (aid, furthestPos, dist)-            else furthestPos+  return $! assert (dist > apartBfs `blame` (aid, furthestPos, dist))+                   furthestPos  -- | Closest reachable unknown tile position, if any. closestUnknown :: MonadClient m => ActorId -> m (Maybe Point)@@ -284,7 +295,7 @@                                     then easier                                          || not unexpBack && lidExplored                                     else not unexpBack && lidExplored-                                         && (null $ lescape lvl)+                                         && null (lescape lvl)                        in maybe aiCond (\d -> d == (k > 0)) onlyDir                  in map (,p) (filter g l) ++ acc         else acc@@ -306,10 +317,10 @@       let mix (k, p) dist =             let easier = signum k /= signum (fromEnum lid)                 depthDelta = if easier then 2 else 1-                distDelta = fromEnum (maxBound :: BfsDistance)-                            - fromEnum apartBfs-                            - dist-            in (depthDelta * distDelta * distDelta, p)+                maxd = fromEnum (maxBound :: BfsDistance)+                       - fromEnum apartBfs+                v = (maxd * maxd * maxd) `div` ((dist + 1) * (dist + 1))+            in (depthDelta * v, p)           ds = mapMaybe (\(k, p) -> mix (k, p) <$> accessBfs bfs p) triggers       in toFreq "closestTriggers" ds @@ -320,7 +331,7 @@   let allExplored = ES.size explored == EM.size dungeon       unexploredD p =         let unex lid = allExplored-                       && (not $ null $ lescape $ dungeon EM.! lid)+                       && not (null $ lescape $ dungeon EM.! lid)                        || ES.notMember lid explored                        || unexploredD p lid         in any unex . ascendInBranch dungeon p
Game/LambdaHack/Client/HandleAtomicClient.hs view
@@ -18,7 +18,6 @@ import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind@@ -71,11 +70,9 @@            [ cmd  -- show the message            , UpdAlterTile (blid b) p fromTile toTile  -- reveal tile            ]-      else if t == toTile-           then [cmd]  -- Already knows the tile fully, only confirm.-           else -- Misguided.-                assert `failure` "LoseTile fails to reset memory"-                       `twith` (aid, p, fromTile, toTile, b, t, cmd)+      else assert (t == toTile `blame` "LoseTile fails to reset memory"+                               `twith` (aid, p, fromTile, toTile, b, t, cmd))+                  [cmd]  -- Already knows the tile fully, only confirm.   UpdLearnSecrets aid fromS _toS -> do     b <- getsState $ getActorBody aid     lvl <- getLevel $ blid b@@ -172,20 +169,33 @@     perOld <- getPerFid lid     perception lid outPer inPer     perNew <- getPerFid lid-    s <- getState+    carriedAssocs <- getsState $ flip getCarriedAssocs     fid <- getsClient sside+    s <- getState     -- Wipe out actors that just became invisible due to changed FOV.-    -- TODO: perhaps instead create LoseActor for all actors in lprio,-    -- and keep only those where seenAtomicCli is True; this is even-    -- cheaper than repeated posToActor (until it's optimized).-    let outFov = totalVisible perOld ES.\\ totalVisible perNew+    -- Worst case is many actors O(n) in an open room of large diameter O(m).+    -- Then a step reveals many positions. Iterating over them via @posToActors@+    -- takes O(m * n) and so is more cosly than interating over all actors+    -- and for each checking inclusion in a set of positions O(n * log m).+    -- OTOH, m is bounded by sight radius and n is unbounded, so we have+    -- O(n) in both cases, especially with huge levels. To help there,+    -- we'd need to keep a dictionary from positions to actors, which means+    -- @posToActors@ is the right approach for now.+    let seenNew = seenAtomicCli False fid perNew+        seenOld = seenAtomicCli False fid perOld+        outFov = totalVisible perOld ES.\\ totalVisible perNew         outPrio = concatMap (\p -> posToActors p lid s) $ ES.elems outFov-        fActor ((aid, b), ais) =-          -- TODO: instead of bproj, check that actor sees himself.-          if not (bproj b) && bfid b == fid-          then Nothing  -- optimization: the actor is soon lost anyway,-                        -- e.g., via domination, so don't bother-          else Just $ UpdLoseActor aid b ais+        fActor (aid, b) =+          let ps = posProjBody b+              -- Verify that we forget only previously seen actors.+              !_A = assert (seenOld ps) ()+          in -- We forget only currently invisible actors.+             if seenNew ps+             then Nothing+             else -- Verify that we forget only previously seen actors.+                  let !_A = assert (seenOld ps) ()+                      ais = carriedAssocs b+                  in Just $ UpdLoseActor aid b ais         outActor = mapMaybe fActor outPrio     -- Wipe out remembered items on tiles that now came into view.     lvl <- getLevel lid@@ -205,14 +215,6 @@         inSm = mapMaybe (\p -> pMaybe p $ EM.lookup p (lsmell lvl))                         (ES.elems inSmellFov)         inSmell = if null inSm then [] else [UpdLoseSmell lid inSm]-    let seenNew = seenAtomicCli False fid perNew-        seenOld = seenAtomicCli False fid perOld-    -- TODO: these assertions are probably expensive-    psActor <- mapM posUpdAtomic outActor-    -- Verify that we forget only previously seen actors.-    let !_A = assert (allB seenOld psActor) ()-    -- Verify that we forget only currently invisible actors.-    let !_A = assert (allB (not . seenNew) psActor) ()     let inTileSmell = inFloor ++ inEmbed ++ inSmell     psItemSmell <- mapM posUpdAtomic inTileSmell     -- Verify that we forget only previously invisible items and smell.@@ -266,15 +268,17 @@   UpdDiscoverSeed c iid seed  ldepth -> discoverSeed c iid seed ldepth   UpdCoverSeed c iid seed _ldepth -> coverSeed c iid seed   UpdPerception lid outPer inPer -> perception lid outPer inPer-  UpdRestart side sdiscoKind sfper _ sdebugCli -> do+  UpdRestart side sdiscoKind sfper _ d sdebugCli -> do     shistory <- getsClient shistory     sreport <- getsClient sreport     isAI <- getsClient sisAI+    snxtDiff <- getsClient snxtDiff     let cli = defStateClient shistory sreport side isAI     putClient cli { sdiscoKind                   , sfper                   -- , sundo = [UpdAtomic cmd]-                  , scurDifficulty = sdifficultyCli sdebugCli+                  , scurDiff = d+                  , snxtDiff                   , sdebugCli }   UpdResume _fid sfper -> modifyClient $ \cli -> cli {sfper}   UpdKillExit _fid -> killExit
Game/LambdaHack/Client/ItemSlot.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Item slots for UI and AI item collections. -- TODO: document module Game.LambdaHack.Client.ItemSlot
Game/LambdaHack/Client/Key.hs view
@@ -65,7 +65,7 @@  data KM = KM { key      :: !Key              , modifier :: !Modifier-             , pointer  :: !Point }+             , pointer  :: !(Maybe Point) }   deriving (Read, Ord, Eq, Generic)  instance NFData KM@@ -76,7 +76,7 @@ instance Binary KM  toKM :: Modifier -> Key -> KM-toKM modifier key = KM{pointer=dummyPoint, ..}+toKM modifier key = KM{pointer=Nothing, ..}  -- Common and terse names for keys. showKey :: Key -> Text
Game/LambdaHack/Client/State.hs view
@@ -81,7 +81,8 @@   , smarkVision  :: !Bool          -- ^ mark leader and party FOV   , smarkSmell   :: !Bool          -- ^ mark smell, if the leader can smell   , smarkSuspect :: !Bool          -- ^ mark suspect features-  , scurDifficulty :: !Int         -- ^ current game difficulty level+  , scurDiff     :: !Int           -- ^ current game difficulty level+  , snxtDiff     :: !Int           -- ^ next game difficulty level   , sslots       :: !ItemSlots     -- ^ map from slots to items   , slastSlot    :: !SlotChar      -- ^ last used slot   , slastStore   :: !CStore        -- ^ last used store@@ -149,7 +150,8 @@     , smarkVision = False     , smarkSmell = True     , smarkSuspect = False-    , scurDifficulty = difficultyDefault+    , scurDiff = difficultyDefault+    , snxtDiff = difficultyDefault     , sslots = (EM.empty, EM.empty)     , slastSlot = SlotChar 0 'Z'     , slastStore = CInv@@ -157,11 +159,13 @@     , sdebugCli = defDebugModeCli     } -defaultHistory :: IO History-defaultHistory = do+defaultHistory :: Int -> IO History+defaultHistory configHistoryMax = do   dateTime <- getClockTime   let curDate = MU.Text $ T.pack $ calendarTimeToString $ toUTCTime dateTime-  return $! singletonHistory timeZero $ singletonReport+  let emptyHist = emptyHistory configHistoryMax+  return $! addReport emptyHist timeZero+         $! singletonReport          $! makeSentence ["Human history log started on", curDate]  -- | Update target parameters within client state.@@ -221,7 +225,8 @@     put smarkVision     put smarkSmell     put smarkSuspect-    put scurDifficulty+    put scurDiff+    put snxtDiff     put sslots     put slastSlot     put slastStore@@ -247,7 +252,8 @@     smarkVision <- get     smarkSmell <- get     smarkSuspect <- get-    scurDifficulty <- get+    scurDiff <- get+    snxtDiff <- get     sslots <- get     slastSlot <- get     slastStore <- get
Game/LambdaHack/Client/UI.hs view
@@ -42,7 +42,6 @@ import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Msg-import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Request import Game.LambdaHack.Common.State import Game.LambdaHack.Content.ModeKind@@ -94,7 +93,7 @@         abortOrCmd <- do           -- Look up the key.           Binding{bcmdMap} <- askBinding-          case M.lookup km{K.pointer=dummyPoint} bcmdMap of+          case M.lookup km{K.pointer=Nothing} bcmdMap of             Just (_, _, cmd) -> do               -- Query and clear the last command key.               modifyClient $ \cli -> cli
Game/LambdaHack/Client/UI/DisplayAtomicClient.hs view
@@ -145,11 +145,12 @@       b <- getsState $ getActorBody aid       when (bfid b == side) $ do         fact <- getsState $ (EM.! bfid b) . sfactionD-        allFoes  <- getsState $ actorRegularList (isAtWar fact) (blid b)+        allFoes <- getsState $ actorRegularList (isAtWar fact) (blid b)         let closeFoes = filter ((<= 3) . chessDist (bpos b) . bpos) allFoes         when (null closeFoes) $ do  -- obvious where the feeling comes from           aidVerbMU aid "hear something"           msgDuplicateScrap+          stopPlayBack   UpdFidImpressedActor aid _fidOld fidNew -> do     b <- getsState $ getActorBody aid     actorVerbMU aid b $@@ -239,8 +240,8 @@   UpdDiscoverSeed c iid _ _ -> discover c oldStateClient iid   UpdCoverSeed{} -> return ()  -- don't spam when doing undo   UpdPerception{} -> return ()-  UpdRestart fid _ _ _ _ -> do-    void $ tryTakeMVarSescMVar  -- clear ESC-pressed from end of previous game+  UpdRestart fid _ _ _ _ _ -> do+    void tryTakeMVarSescMVar  -- clear ESC-pressed from end of previous game     mode <- getGameMode     msgAdd $ "New game started in" <+> mname mode <+> "mode." <+> mdesc mode     -- TODO: use a vertical animation instead, e.g., roll down,@@ -303,7 +304,7 @@   lid <- getsState $ lidFromC c   localTime <- getsState $ getLocalTime lid   itemToF <- itemToFullClient-  let subject = partItemWs k (storeFromC c) lid localTime (itemToF iid kit)+  let subject = partItemWs k (storeFromC c) localTime (itemToF iid kit)       msg | k > 1 = makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes subject verb]           | otherwise = makeSentence [MU.SubjectVerbSg subject verb]   msgAdd msg@@ -330,14 +331,14 @@           object = case ek of             Left (Just n) ->               assert (n <= k `blame` (aid, verb, iid, cstore))-              $ partItemWs n cstore lid localTime itemFull+              $ partItemWs n cstore localTime itemFull             Left Nothing ->-              let (_, name, stats) = partItem cstore lid localTime itemFull+              let (_, name, stats) = partItem cstore localTime itemFull               in MU.Phrase [name, stats]             Right n ->               assert (n <= k `blame` (aid, verb, iid, cstore))               $ let itemSecret = itemNoDisco (itemBase itemFull, n)-                    (_, secretName, secretAE) = partItem cstore lid localTime itemSecret+                    (_, secretName, secretAE) = partItem cstore localTime itemSecret                     name = MU.Phrase [secretName, secretAE]                     nameList = if n == 1                                then ["the", name]@@ -406,7 +407,9 @@             && (not actorsAlive || firstDeathEnds)) $       void $ displayMore ColorBW ""   else when verbose $ actorVerbMU aid body verboseVerb-  modifyClient $ \cli -> cli {slastLost = ES.insert aid $ slastLost cli}+  -- If pushed, animate spotting again, to draw attention to pushing.+  when (isNothing $ btrajectory body) $+    modifyClient $ \cli -> cli {slastLost = ES.insert aid $ slastLost cli}  -- TODO: deduplicate wrt Server anyActorsAlive :: MonadClient m => FactionId -> Maybe ActorId -> m Bool@@ -425,9 +428,12 @@   when (bproj body) $ do     let oldpos = case EM.lookup aid $ sactorD oldState of           Nothing -> assert `failure` (sactorD oldState, aid)-          Just b -> boldpos b+          -- If no old position, default to current, which is then overwritten+          -- in the animation.+          Just b -> fromMaybe source $ boldpos b     let ps = (oldpos, source, target)-    animFrs <- animate (blid body) $ moveProj ps (bsymbol body) (bcolor body)+    animFrs <- animate (blid body)+               $ moveProj ps (bsymbol body) (bcolor body)     displayActorStart body animFrs  displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()@@ -470,7 +476,7 @@                    [ "\n"                    , slotLabel l                    , "-"-                   , partItemWs n cstore2 (blid b) localTime (itemToF iid kit)+                   , partItemWs n cstore2 localTime (itemToF iid kit)                    , "\n" ]       else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops         itemAidVerbMU aid (MU.Text verb) iid (Left $ Just k) cstore2@@ -572,12 +578,12 @@   bag <- getsState $ getCBag c   let kit = EM.findWithDefault (1, []) iid bag       itemFull = itemToF iid kit-      knownName = partItemMediumAW cstore lid localTime itemFull+      knownName = partItemMediumAW cstore localTime itemFull       -- Wipe out the whole knowledge of the item to make sure the two names       -- in the message differ even if, e.g., the item is described as       -- "of many effects".       itemSecret = itemNoDisco (itemBase itemFull, itemK itemFull)-      (_, secretName, secretAEText) = partItem cstore lid localTime itemSecret+      (_, secretName, secretAEText) = partItem cstore localTime itemSecret       msg = makeSentence         [ "the", MU.SubjectVerbSg (MU.Phrase [secretName, secretAEText])                                   "turn out to be"@@ -655,7 +661,7 @@                        else animate (blid b) $ deathBody $ bpos b             displayActorStart b animDie     else case effect of-        IK.NoEffect t -> msgAdd $ "Nothing happens." <+> t+        IK.NoEffect{} -> return ()         IK.Hurt{} -> return ()  -- avoid spam; SfxStrike just sent         IK.Burn{} -> do           if fid == side then@@ -755,8 +761,12 @@               [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]           stopPlayBack         IK.Impress -> return ()-        IK.CallFriend{} -> return ()-        IK.Summon{} -> return ()+        IK.CallFriend{} -> do+          let verb = if bproj b then "attract" else "call forth"+          actorVerbMU aid b $ MU.Text $ verb <+> "friends"+        IK.Summon{} -> do  -- TODO: if a singleton, use the freq?+          let verb = if bproj b then "lure" else "summon"+          actorVerbMU aid b $ MU.Text $ verb <+> "nearby beasts"         IK.Ascend k | k > 0 -> actorVerbMU aid b "find a way upstairs"         IK.Ascend k | k < 0 -> actorVerbMU aid b "find a way downstairs"         IK.Ascend{} -> assert `failure` sfx@@ -779,7 +789,7 @@               let itemSecret = itemNoDisco (itemBase, itemK)                   -- TODO: plural form of secretName? only when K > 1?                   -- At this point we don't easily know how many consumed.-                  (_, secretName, secretAEText) = partItem CGround (blid b) localTime itemSecret+                  (_, secretName, secretAEText) = partItem CGround localTime itemSecret                   verb = "repurpose"                   store = MU.Text $ ppCStoreIn CGround               msgAdd $ makeSentence@@ -848,19 +858,18 @@             displayDelay           let ageDisp = EM.insert arena localTime           modifyClient $ \cli -> cli {sdisplayed = ageDisp $ sdisplayed cli}-          when (not (bproj b)) $  -- projectiles display animations instead+          unless (bproj b) $  -- projectiles display animations instead             displayPush ""  setLastSlot :: MonadClientUI m => ActorId -> ItemId -> CStore -> m () setLastSlot aid iid cstore = do-  b <- getsState $ getActorBody aid   mleader <- getsClient _sleader   when (Just aid == mleader) $ do     (itemSlots, _) <- getsClient sslots     case lookup iid $ map swap $ EM.assocs itemSlots of       Just l -> modifyClient $ \cli -> cli { slastSlot = l                                            , slastStore = cstore }-      Nothing -> assert `failure` (iid, cstore, aid, b)+      Nothing -> assert `failure` (iid, cstore, aid)  strike :: MonadClientUI m        => ActorId -> ActorId -> ItemId -> CStore -> HitAtomic -> m ()@@ -881,8 +890,8 @@       isOrgan = iid `EM.member` borgan sb       partItemChoice =         if isOrgan-        then partItemWownW spronoun COrgan (blid sb) localTime-        else partItemAW cstore (blid sb) localTime+        then partItemWownW spronoun COrgan localTime+        else partItemAW cstore localTime       msg HitClear = makeSentence $         [MU.SubjectVerbSg spart verb, tpart]         ++ if bproj sb
Game/LambdaHack/Client/UI/DrawClient.hs view
@@ -369,7 +369,7 @@       addAttr t = map (Color.AttrChar Color.defAttr) (T.unpack t)       -- Don't show anything if the only actor in the dungeon is the leader.       -- He's clearly highlighted on the level map, anyway.-      party = if length allOurs == 1 && length ours == 1 || length ours == 0+      party = if length allOurs == 1 && length ours == 1 || null ours               then []               else [star] ++ viewed ++ addAttr " "   return $! party
Game/LambdaHack/Client/UI/Frontend.hs view
@@ -21,7 +21,6 @@ import Game.LambdaHack.Client.UI.Animation import Game.LambdaHack.Client.UI.Frontend.Chosen import Game.LambdaHack.Common.ClientOptions-import Game.LambdaHack.Common.Point  -- | The instructions sent by clients to the raw frontend over a channel. data FrontReq =@@ -70,7 +69,7 @@ promptGetKey fs [] frame = fpromptGetKey fs frame promptGetKey fs keys frame = do   km <- fpromptGetKey fs frame-  if km{K.pointer=dummyPoint} `elem` keys+  if km{K.pointer=Nothing} `elem` keys     then return km     else promptGetKey fs keys frame 
Game/LambdaHack/Client/UI/Frontend/Gtk.hs view
@@ -129,6 +129,7 @@   aCont <- async $ cont sess `Ex.finally` postGUISync mainQuit   link aCont   -- Fork the thread that periodically draws a frame from a queue, if any.+  -- TODO: mainQuit somehow never called.   aPoll <- async $ pollFramesAct sess `Ex.finally` postGUISync mainQuit   link aPoll   let flushChanKey = do@@ -145,7 +146,7 @@ #endif         !modifier = let md = modifierTranslate mods                     in if md == K.Shift then K.NoModifier else md-        !pointer = dummyPoint+        !pointer = Nothing     liftIO $ do       unless (deadKey n) $ do         -- If ESC, also mark it specially and reset the key channel.@@ -207,7 +208,7 @@               MiddleButton -> K.MiddleButtonPress               RightButton -> K.RightButtonPress               _ -> K.LeftButtonPress-            !pointer = Point cx (cy - 1)+            !pointer = Just $! Point cx (cy - 1)         -- Store the mouse even coords in the keypress channel.         STM.atomically $ STM.writeTQueue schanKey K.KM{..}     return $! but == RightButton  -- not to disable selection@@ -409,6 +410,9 @@         Just frame -> do           -- Comparison is done inside the mvar lock, this time, but it's OK,           -- since we wipe out the queue anyway, not draw it concurrently.+          -- The comparison is very rarely true, because that means+          -- the screen looks the same as a few moves before.+          -- Still, we want the invariant that frames are never repeated.           let lastFrame = fshown               nextFrame = if frame == lastFrame                           then Nothing  -- no sense repeating
Game/LambdaHack/Client/UI/Frontend/Vty.hs view
@@ -23,15 +23,13 @@ import Game.LambdaHack.Common.ClientOptions import qualified Game.LambdaHack.Common.Color as Color import Game.LambdaHack.Common.Msg-import Game.LambdaHack.Common.Point  -- | Session data maintained by the frontend. data FrontendSession = FrontendSession-  { svty      :: !Vty  -- internal vty session+  { svty      :: !Vty  -- ^ internal vty session   , schanKey  :: !(STM.TQueue K.KM)  -- ^ channel for keyboard input   , sescMVar  :: !(Maybe (MVar ()))   , sdebugCli :: !DebugModeCli  -- ^ client configuration-      -- ^ Configuration of the frontend session.   }  -- | The name of the frontend.@@ -56,7 +54,7 @@     EvKey n mods -> do       let !key = keyTranslate n           !modifier = modifierTranslate mods-          !pointer = dummyPoint+          !pointer = Nothing           readAll = do             res <- STM.atomically $ STM.tryReadTQueue schanKey             when (isJust res) readAll@@ -115,9 +113,7 @@   fdisplay sess $ Just frame   nextKeyEvent sess --- TODO: Ctrl-Home and Ctrl-End are the same as Home and End on some terminals--- so we should probably go back to using 0-9 (and Shift) for movement--- but let's wait until vty 5.0 is out and see if it helps.+-- TODO: Ctrl-m is RET keyTranslate :: Key -> K.Key keyTranslate n =   case n of@@ -138,7 +134,12 @@     KBegin        -> K.Begin     KCenter       -> K.Begin     KIns          -> K.Insert-    (KChar c)     -> K.Char c+    -- Ctrl-Home and Ctrl-End are the same in vty as Home and End+    -- on some terminals so we have to use 1--9 for movement instead of+    -- leader change.+    (KChar c)+      | c `elem` ['1'..'9'] -> K.KP c  -- movement, not leader change+      | otherwise           -> K.Char c     _             -> K.Unknown (tshow n)  -- | Translates modifiers to our own encoding.@@ -149,7 +150,6 @@   | MShift `elem` mods = K.Shift   | otherwise = K.NoModifier --- TODO: with vty 5.0 check if bold is still needed. -- A hack to get bright colors via the bold attribute. Depending on terminal -- settings this is needed or not and the characters really get bold or not. -- HSCurses does this by default, but in Vty you have to request the hack.
Game/LambdaHack/Client/UI/HandleHumanGlobalClient.hs view
@@ -42,7 +42,6 @@ import Game.LambdaHack.Common.Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.ItemStrongest@@ -116,14 +115,14 @@             -- Don't check @initialStep@ and @finalGoal@             -- and don't stop going to target: door opening is mundane enough.             return $ Right runCmd-      [((target, _), _)] | run && initialStep ->+      [(target, _)] | run && initialStep ->         -- No @stopPlayBack@: initial displace is benign enough.         -- Displacing requires accessibility, but it's checked later on.         fmap RequestAnyAbility <$> displaceAid target       _ : _ : _ | run && initialStep -> do-        let !_A = assert (all (bproj . snd . fst) tgts) ()+        let !_A = assert (all (bproj . snd) tgts) ()         failSer DisplaceProjectiles-      ((target, tb), _) : _ | initialStep && finalGoal -> do+      (target, tb) : _ | initialStep && finalGoal -> do         stopPlayBack  -- don't ever auto-repeat melee         -- No problem if there are many projectiles at the spot. We just         -- attack the first one.@@ -212,9 +211,10 @@ moveSearchAlterAid source dir = do   cops@Kind.COps{cotile} <- getsState scops   sb <- getsState $ getActorBody source-  let lid = blid sb-  lvl <- getLevel lid-  let spos = bpos sb           -- source position+  actorSk <- actorSkillsClient source+  lvl <- getLevel $ blid sb+  let skill = EM.findWithDefault 0 AbAlter actorSk+      spos = bpos sb           -- source position       tpos = spos `shift` dir  -- target position       t = lvl `at` tpos       runStopOrCmd@@ -225,14 +225,16 @@         -- No access, so search and/or alter the tile. Non-walkability is         -- not implied by the lack of access.         | not (Tile.isWalkable cotile t)-                && (not (knownLsecret lvl)-                    || (isSecretPos lvl tpos  -- possible secrets here-                        && (Tile.isSuspect cotile t  -- not yet searched-                            || Tile.hideAs cotile t /= t))  -- search again-                    || Tile.isOpenable cotile t-                    || Tile.isClosable cotile t-                    || Tile.isChangeable cotile t)-          = if EM.member tpos $ lfloor lvl then+          && (not (knownLsecret lvl)+              || (isSecretPos lvl tpos  -- possible secrets here+                  && (Tile.isSuspect cotile t  -- not yet searched+                      || Tile.hideAs cotile t /= t))  -- search again+              || Tile.isOpenable cotile t+              || Tile.isClosable cotile t+              || Tile.isChangeable cotile t)+          = if skill < 1 then+              Left $ showReqFailure AlterUnskilled+            else if EM.member tpos $ lfloor lvl then               Left $ showReqFailure AlterBlockItem             else               Right $ RequestAnyAbility $ ReqAlter tpos Nothing@@ -299,12 +301,25 @@           CEqp | not $ goesIntoEqp itemFull ->             retRec CInv           CEqp | eqpOverfull b (oldN + k) -> do-            msgAdd $ "Warning:" <+> showReqFailure EqpOverfull <> "."-            retRec CInv+            -- If this stack doesn't fit, we don't equip any part of it,+            -- but we may equip a smaller stack later in the same pickup.+            -- TODO: try to ask for a number of items, thus giving the player+            -- the option of picking up a part.+            let fullWarn = if eqpOverfull b (oldN + 1)+                           then EqpOverfull+                           else EqpStackFull+            msgAdd $ "Warning:" <+> showReqFailure fullWarn <> "."+            retRec $ if calmE then CSha else CInv           _ ->             retRec destCStore         else case destCStore of-          CEqp | eqpOverfull b (oldN + k) -> failSer EqpOverfull+          CEqp | eqpOverfull b (oldN + k) -> do+            -- If the chosen number from the stack doesn't fit,+            -- we don't equip any part of it and we exit item manipulation.+            let fullWarn = if eqpOverfull b (oldN + 1)+                           then EqpOverfull+                           else EqpStackFull+            failSer fullWarn           _ -> retRec destCStore       prompt = makePhrase ["What to", verb]       promptEqp = makePhrase ["What consumable to", verb]@@ -404,8 +419,8 @@       if not $ Tile.isWalkable cotile t         then return $ Just ProjectBlockTerrain         else do-          mab <- getsState $ posToActor pos lid-          if maybe True (bproj . snd . fst) mab+          lab <- getsState $ posToActors pos lid+          if all (bproj . snd) lab           then return Nothing           else return $ Just ProjectBlockActor @@ -418,7 +433,10 @@   activeItems <- activeItemsClient leader   actorSk <- actorSkillsClient leader   let skill = EM.findWithDefault 0 AbProject actorSk-      cLegal = [CGround, CInv, CEqp, CSha]+      calmE = calmEnough b activeItems+      cLegalRaw = [CGround, CInv, CEqp, CSha]+      cLegal | calmE = cLegalRaw+             | otherwise = delete CSha cLegalRaw       (verb1, object1) = case ts of         [] -> ("aim", "item")         tr : _ -> (verb tr, object tr)@@ -449,7 +467,7 @@       prompt = makePhrase ["What", object1, "to", verb1]       promptGeneric = "What to fling"   ggi <- getGroupItem psuit prompt promptGeneric True-                      cLegal cLegal+                      cLegalRaw cLegal   case ggi of     Right ((iid, itemFull), MStore fromCStore) -> do       mpsuitReq <- psuitReq@@ -478,7 +496,10 @@   let skill = EM.findWithDefault 0 AbApply actorSk   activeItems <- activeItemsClient leader   localTime <- getsState $ getLocalTime (blid b)-  let cLegal = [CGround, CInv, CEqp, CSha]+  let calmE = calmEnough b activeItems+      cLegalRaw = [CGround, CInv, CEqp, CSha]+      cLegal | calmE = cLegalRaw+             | otherwise = delete CSha cLegalRaw       (verb1, object1) = case ts of         [] -> ("apply", "item")         tr : _ -> (verb tr, object tr)@@ -488,7 +509,7 @@       prompt = makePhrase ["What", object1, "to", verb1]       promptGeneric = "What to apply"   ggi <- getGroupItem (return $ SuitsSomething $ either (const False) id . p)-                      prompt promptGeneric False cLegal cLegal+                      prompt promptGeneric False cLegalRaw cLegal   case ggi of     Right ((iid, itemFull), MStore fromCStore) ->       case p itemFull of@@ -523,12 +544,15 @@   cops@Kind.COps{cotile} <- getsState scops   leader <- getLeaderUI   b <- getsState $ getActorBody leader+  actorSk <- actorSkillsClient leader   lvl <- getLevel $ blid b   as <- getsState $ actorList (const True) (blid b)-  let tpos = bpos b `shift` dir+  let skill = EM.findWithDefault 0 AbAlter actorSk+      tpos = bpos b `shift` dir       t = lvl `at` tpos       alterFeats = alterFeatures ts   case filter (\feat -> Tile.hasFeature cotile feat t) alterFeats of+    _ | skill < 1 -> failSer AlterUnskilled     [] -> failWith $ guessAlter cops alterFeats t     feat : _ ->       if EM.notMember tpos $ lfloor lvl then@@ -749,7 +773,7 @@               [] -> do                 modifyClient $ \cli -> cli {srunning = Just paramNew}                 return $ Right (finalGoal, dir)-              [((target, _), _)]+              [(target, _)]                 | target `elem` rs || runWaiting <= length rs ->                 -- Let r wait until all others move. Mark it in runWaiting                 -- to avoid cycles. When all wait for each other, fail.@@ -773,10 +797,10 @@ gameRestartHuman t = do   let restart = do         leader <- getLeaderUI-        DebugModeCli{sdifficultyCli} <- getsClient sdebugCli+        snxtDiff <- getsClient snxtDiff         Config{configHeroNames} <- askConfig         return $ Right-               $ ReqUIGameRestart leader t sdifficultyCli configHeroNames+               $ ReqUIGameRestart leader t snxtDiff configHeroNames   escAI <- getsClient sescAI   if escAI == EscAIExited then restart   else do@@ -799,8 +823,7 @@   go <- displayYesNo ColorFull "Really save and exit?"   if go then do     leader <- getLeaderUI-    DebugModeCli{sdifficultyCli} <- getsClient sdebugCli-    return $ Right $ ReqUIGameExit leader sdifficultyCli+    return $ Right $ ReqUIGameExit leader   else failWith "save and exit canceled"  -- * GameSave; does not take time@@ -827,9 +850,9 @@   fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD   let toT = if fromT == maxBound then minBound else succ fromT   go <- displayMore ColorFull-        $ "Switching tactic to"-          <+> tshow toT-          <> ". (This clears targets.)"+        $ "Current tactic is '" <> tshow fromT+          <> "'. Switching tactic to '" <> tshow toT+          <> "'. (This clears targets.)"   if not go     then failWith "tactic change canceled"     else return $ Right $ ReqUITactic toT
Game/LambdaHack/Client/UI/HandleHumanLocalClient.hs view
@@ -48,7 +48,6 @@ import Game.LambdaHack.Client.UI.WidgetClient import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Frequency import qualified Game.LambdaHack.Common.Kind as Kind@@ -68,9 +67,9 @@  gameDifficultyCycle :: MonadClientUI m => m () gameDifficultyCycle = do-  DebugModeCli{sdifficultyCli} <- getsClient sdebugCli-  let d = if sdifficultyCli >= difficultyBound then 1 else sdifficultyCli + 1-  modifyClient $ \cli -> cli {sdebugCli = (sdebugCli cli) {sdifficultyCli = d}}+  snxtDiff <- getsClient snxtDiff+  let d = if snxtDiff >= difficultyBound then 1 else snxtDiff + 1+  modifyClient $ \cli -> cli {snxtDiff = d}   msgAdd $ "Next game difficulty set to" <+> tshow d <> "."  -- * PickLeader@@ -93,10 +92,10 @@   case mchoice of     Nothing -> failMsg "no such member of the party"     Just (aid, b)-      | blid b == arena && autoLvl ->-          failMsg $ showReqFailure NoChangeLvlLeader-      | autoDun ->+      | blid b /= arena && autoDun ->           failMsg $ showReqFailure NoChangeDunLeader+      | autoLvl ->+          failMsg $ showReqFailure NoChangeLvlLeader       | otherwise -> do           void $ pickLeader True aid           return mempty@@ -172,7 +171,6 @@ selectWithPointer:: MonadClientUI m => m () selectWithPointer = do   km <- getsClient slastKM-  let Point{..} = K.pointer km   lidV <- viewedLevel   Level{lysize} <- getLevel lidV   side <- getsClient sside@@ -180,12 +178,14 @@                       . actorAssocs (== side) lidV   -- Select even if no space in status line for the actor's symbol.   let viewed = sortBy (comparing keySelected) ours-  when (py == lysize + 1 && px <= length viewed && px >= 0) $ do-    if px == 0 then-      selectNoneHuman-    else-      selectAidHuman $ fst $ viewed !! (px - 1)-    stopPlayBack+  case K.pointer km of+    Just(Point{..}) | py == lysize + 1 && px <= length viewed && px >= 0 -> do+      if px == 0 then+        selectNoneHuman+      else+        selectAidHuman $ fst $ viewed !! (px - 1)+      stopPlayBack+    _ -> return ()  -- * Repeat @@ -277,8 +277,8 @@   Kind.COps{corule} <- getsState scops   escAI <- getsClient sescAI   Binding{brevMap, bcmdList} <- askBinding-  scurDifficulty <- getsClient scurDifficulty-  DebugModeCli{sdifficultyCli} <- getsClient sdebugCli+  scurDiff <- getsClient scurDiff+  snxtDiff <- getsClient snxtDiff   let stripFrame t = map (T.tail . T.init) $ tail . init $ T.lines t       pasteVersion art =         let pathsVersion = rpathsVersion $ Kind.stdRuleset corule@@ -304,9 +304,9 @@            ++ cmds            ++ [ (fst ( revLookup HumanCmd.GameDifficultyCycle)                      , "next game difficulty"-                       <+> tshow sdifficultyCli+                       <+> tshow snxtDiff                        <+> "(current"-                       <+> tshow scurDifficulty <> ")" ) ]+                       <+> tshow scurDiff <> ")" ) ]       bindingLen = 25       bindings =  -- key bindings to display         let fmt (k, d) = T.justifyLeft bindingLen ' '@@ -432,7 +432,7 @@   leader <- getLeaderUI   b <- getsState $ getActorBody leader   stairs <- closestTriggers (Just up) leader-  case reverse $ sort $ runFrequency stairs of+  case sortBy (flip compare) $ runFrequency stairs of     [] -> failMsg $ "no stairs" <+> if up then "up" else "down"     (_, p) : _ -> do       let tgt = TPoint (blid b) p
Game/LambdaHack/Client/UI/InventoryClient.hs view
@@ -210,9 +210,7 @@       let suitsThisActor store =             let bag = getCStoreBag store             in any (\(iid, kit) -> psuitFun $ itemToF iid kit) $ EM.assocs bag-          cThisActor cDef = case find suitsThisActor haveThis of-            Nothing -> cDef-            Just cSuits -> cSuits+          cThisActor cDef = fromMaybe cDef $ find suitsThisActor haveThis       -- Don't display stores totally empty for all actors.       cLegal <- filterM partyNotEmpty cLegalRaw       let breakStores cInit =@@ -241,7 +239,7 @@                           else cLast       let (modeFirst, modeRest) = breakStores firstStore       getItem psuit prompt promptGeneric cursor modeFirst modeRest-              askWhenLone permitMulitple (map MStore $ cLegal) initalState+              askWhenLone permitMulitple (map MStore cLegal) initalState  -- | Let the human player choose a single, preferably suitable, -- item from a list of items.@@ -602,7 +600,7 @@   case akm of     Left slides -> failSlides slides     Right km ->-      case lookup km{K.pointer=dummyPoint} keyDefs of+      case lookup km{K.pointer=Nothing} keyDefs of         Just keyDef -> defAction keyDef km         Nothing -> defAction lettersDef km @@ -651,13 +649,15 @@   fact <- getsState $ (EM.! side) . sfactionD   leader <- getLeaderUI   hs <- partyAfterLeader leader-  let autoDun = fst $ autoDungeonLevel fact+  let (autoDun, autoLvl) = autoDungeonLevel fact   case reverse hs of     _ | autoDun -> failMsg $ showReqFailure NoChangeDunLeader+    _ | autoLvl -> failMsg $ showReqFailure NoChangeLvlLeader     [] -> failMsg "no other member in the party"     (np, b) : _ -> do       success <- pickLeader verbose np-      let !_A = assert (success `blame` "same leader" `twith` (leader, np, b)) ()+      let !_A = assert (success `blame` "same leader"+                                `twith` (leader, np, b)) ()       return mempty  partyAfterLeader :: MonadStateRead m => ActorId -> m [(ActorId, Actor)]@@ -702,43 +702,45 @@ cursorPointerFloor :: MonadClientUI m => Bool -> Bool -> m Slideshow cursorPointerFloor verbose addMoreMsg = do   km <- getsClient slastKM-  let newPos@Point{..} = K.pointer km   lidV <- viewedLevel   Level{lxsize, lysize} <- getLevel lidV-  if px < 0 || py < 0 || px >= lxsize || py >= lysize then do-    stopPlayBack-    return mempty-  else do-    let scursor = TPoint lidV newPos-    modifyClient $ \cli -> cli {scursor, stgtMode = Just $ TgtMode lidV}-    if verbose then-      doLook addMoreMsg-    else do-      displayPush ""  -- flash the targeting line and path-      displayDelay  -- for a bit longer+  case K.pointer km of+    Just(newPos@Point{..}) | px >= 0 && py >= 0+                             && px < lxsize && py < lysize -> do+      let scursor = TPoint lidV newPos+      modifyClient $ \cli -> cli {scursor, stgtMode = Just $ TgtMode lidV}+      if verbose then+        doLook addMoreMsg+      else do+        displayPush ""  -- flash the targeting line and path+        displayDelay  -- for a bit longer+        return mempty+    _ -> do+      stopPlayBack       return mempty  cursorPointerEnemy :: MonadClientUI m => Bool -> Bool -> m Slideshow cursorPointerEnemy verbose addMoreMsg = do   km <- getsClient slastKM-  let newPos@Point{..} = K.pointer km   lidV <- viewedLevel   Level{lxsize, lysize} <- getLevel lidV-  if px < 0 || py < 0 || px >= lxsize || py >= lysize then do-    stopPlayBack-    return mempty-  else do-    bsAll <- getsState $ actorAssocs (const True) lidV-    let scursor =-          case find (\(_, m) -> bpos m == newPos) bsAll of-            Just (im, _) -> TEnemy im True-            Nothing -> TPoint lidV newPos-    modifyClient $ \cli -> cli {scursor, stgtMode = Just $ TgtMode lidV}-    if verbose then-      doLook addMoreMsg-    else do-      displayPush ""  -- flash the targeting line and path-      displayDelay  -- for a bit longer+  case K.pointer km of+    Just(newPos@Point{..}) | px >= 0 && py >= 0+                             && px < lxsize && py < lysize -> do+      bsAll <- getsState $ actorAssocs (const True) lidV+      let scursor =+            case find (\(_, m) -> bpos m == newPos) bsAll of+              Just (im, _) -> TEnemy im True+              Nothing -> TPoint lidV newPos+      modifyClient $ \cli -> cli {scursor, stgtMode = Just $ TgtMode lidV}+      if verbose then+        doLook addMoreMsg+      else do+        displayPush ""  -- flash the targeting line and path+        displayDelay  -- for a bit longer+        return mempty+    _ -> do+      stopPlayBack       return mempty  -- | Move the cursor. Assumes targeting mode.@@ -804,22 +806,23 @@   bsAll <- getsState $ actorAssocs (const True) lidV   let ordPos (_, b) = (chessDist lpos $ bpos b, bpos b)       dbs = sortBy (comparing ordPos) bsAll-      pickUnderCursor =  -- switch to the enemy under cursor, if any+      pickUnderCursor =  -- switch to the actor under cursor, if any         let i = fromMaybe (-1)                 $ findIndex ((== cursorPos) . Just . bpos . snd) dbs         in splitAt i dbs       (permitAnyActor, (lt, gt)) = case scursor of-            TEnemy a permit | isJust stgtMode ->  -- pick next enemy-              let i = fromMaybe (-1) $ findIndex ((== a) . fst) dbs-              in (permit, splitAt (i + 1) dbs)-            TEnemy a permit ->  -- first key press, retarget old enemy-              let i = fromMaybe (-1) $ findIndex ((== a) . fst) dbs-              in (permit, splitAt i dbs)-            TEnemyPos _ _ _ permit -> (permit, pickUnderCursor)-            _ -> (False, pickUnderCursor)  -- the sensible default is only-foes+        TEnemy a permit | isJust stgtMode ->  -- pick next enemy+          let i = fromMaybe (-1) $ findIndex ((== a) . fst) dbs+          in (permit, splitAt (i + 1) dbs)+        TEnemy a permit ->  -- first key press, retarget old enemy+          let i = fromMaybe (-1) $ findIndex ((== a) . fst) dbs+          in (permit, splitAt i dbs)+        TEnemyPos _ _ _ permit -> (permit, pickUnderCursor)+        _ -> (False, pickUnderCursor)  -- the sensible default is only-foes       gtlt = gt ++ lt       isEnemy b = isAtWar fact (bfid b)                   && not (bproj b)+                  && bhp b > 0       lf = filter (isEnemy . snd) gtlt       tgt | permitAnyActor = case gtlt of         (a, _) : _ -> TEnemy a True@@ -887,16 +890,17 @@       let aims = isJust mnewEps           enemyMsg = case inhabitants of             [] -> ""-            ((_, body), _) : rest ->+            (_, body) : rest ->                  -- Even if it's the leader, give his proper name, not 'you'.-                 let subjects = map (partActor . snd . fst) inhabitants+                 let subjects = map (partActor . snd) inhabitants                      subject = MU.WWandW subjects                      verb = "be here"-                     desc = if not (null rest)  -- many actors-                            then ""-                            else case itemDisco $ itemToF (btrunk body) (1, []) of-                              Nothing -> ""-                              Just ItemDisco{itemKind} -> IK.idesc itemKind+                     desc =+                       if not (null rest)  -- many actors, only list names+                       then ""+                       else case itemDisco $ itemToF (btrunk body) (1, []) of+                         Nothing -> ""  -- no details, only show the name+                         Just ItemDisco{itemKind} -> IK.idesc itemKind                      pdesc = if desc == "" then "" else "(" <> desc <> ")"                  in makeSentence [MU.SubjectVerbSg subject verb] <+> pdesc           vis | lvl `at` p == unknownId = "that is"@@ -973,7 +977,7 @@       activeItems <- activeItemsClient leader       let calmE = calmEnough b activeItems       localTime <- getsState $ getLocalTime (blid b)-      let io = itemDesc (storeFromMode c2) (blid b) localTime itemFull+      let io = itemDesc (storeFromMode c2) localTime itemFull       case c2 of         MStore COrgan -> do           let symbol = jsymbol (itemBase itemFull)@@ -983,15 +987,16 @@           Left <$> overlayToSlideshow ("Can't"                                        <+> blurb                                        <> ", but here's the description.") io-        MStore CSha | not calmE -> do+        MStore CSha | not calmE ->           Left <$> overlayToSlideshow "Not enough calm to take items from the shared stash, but here's the description." io         MStore fromCStore -> do           let prompt2 = "Where to move the item?"+              eqpFree = eqpFreeN b               fstores :: [(K.Key, (CStore, Text))]               fstores =                 filter ((/= fromCStore) . fst . snd) $-                  [ (K.Char 'e', (CEqp, "'e'quipment"))-                  , (K.Char 'p', (CInv, "inventory 'p'ack")) ]+                  [ (K.Char 'p', (CInv, "inventory 'p'ack")) ]+                  ++ [ (K.Char 'e', (CEqp, "'e'quipment")) | eqpFree > 0 ]                   ++ [ (K.Char 's', (CSha, "shared 's'tash")) | calmE ]                   ++ [ (K.Char 'g', (CGround, "'g'round")) ]               choice = "[" <> T.intercalate ", " (map (snd . snd) fstores)@@ -1000,22 +1005,25 @@           case akm of             Left slides -> failSlides slides             Right km -> do-              socK <- pickNumber True $ itemK itemFull-              case socK of-                Left slides -> return $ Left slides-                Right k -> do-                  let lr toCStore = return $ Right $ ReqMoveItems-                                     [(iid, k, fromCStore, toCStore)]-                  case lookup (K.key km) fstores of-                    Just (store, _) -> lr store-                    Nothing -> return $ Left mempty+              case lookup (K.key km) fstores of+                Nothing -> return $ Left mempty  -- canceled+                Just (toCStore, _) -> do+                  let k = itemK itemFull+                      kToPick | toCStore == CEqp = min eqpFree k+                              | otherwise = k+                  socK <- pickNumber True kToPick+                  case socK of+                    Left slides -> return $ Left slides+                    Right kChosen -> return $ Right $ ReqMoveItems+                                       [(iid, kChosen, fromCStore, toCStore)]         MOwned -> do           -- We can't move items from MOwned, because different copies may come           -- from different stores and we can't guess player's intentions.           found <- getsState $ findIid leader (bfid b) iid           let !_A = assert (not (null found) `blame` ggi) ()           let ppLoc (_, CSha) = MU.Text $ ppCStoreIn CSha <+> "of the party"-              ppLoc (b2, store) = MU.Text $ ppCStoreIn store <+> "of" <+> bname b2+              ppLoc (b2, store) = MU.Text $ ppCStoreIn store <+> "of"+                                                             <+> bname b2               foundTexts = map ppLoc found               prompt2 = makeSentence ["The item is", MU.WWandW foundTexts]           Left <$> overlayToSlideshow prompt2 io
Game/LambdaHack/Client/UI/KeyBindings.hs view
@@ -88,7 +88,7 @@       ]     minimalBlurb =       [ "The following minimal command set lets you accomplish anything in the game,"-      , "though not neccessarily with the fewest number of keystrokes."+      , "though not necessarily with the fewest number of keystrokes."       , "Most of the other commands are shorthands, defined as macros"       , "(with the exception of the advanced commands for assigning non-default"       , "tactics and targets to your autonomous henchmen, if you have any)."
Game/LambdaHack/Client/UI/MonadClientUI.hs view
@@ -146,7 +146,7 @@   writeConnFrontend frame  displayDelay :: MonadClientUI m =>  m ()-displayDelay = sequence_ $ replicate 4 $ writeConnFrontend FrontDelay+displayDelay = replicateM_ 4 $ writeConnFrontend FrontDelay  -- | Push frames or delays to the frame queue. Additionally set @sdisplayed@. -- because animations not always happen after @SfxActorStart@ on the leader's@@ -177,6 +177,7 @@   tgtPos <- leaderTgtToPos   cursorPos <- cursorToPos   let anyPos = fromMaybe (Point 0 0) cursorPos+        -- if cursor invalid, e.g., on a wrong level; @draw@ ignores it later on       pathFromLeader leader = Just <$> getCacheBfsAndPath leader anyPos   bfsmpath <- maybe (return Nothing) pathFromLeader mleader   tgtDesc <- maybe (return ("------", Nothing)) targetDescLeader mleader@@ -195,8 +196,8 @@ stopPlayBack = do   modifyClient $ \cli -> cli     { slastPlay = []-    , slastRecord = let (seqCurrent, seqPrevious, _) = slastRecord cli-                    in (seqCurrent, seqPrevious, 0)+    , slastRecord = ([], [], 0)+        -- TODO: not ideal, but needed to cancel macros that contain apostrophes     , swaitTimes = - abs (swaitTimes cli)     }   srunning <- getsClient srunning@@ -256,14 +257,14 @@   gameMode <- getGameMode   time <- getsState stime   date <- liftIO getClockTime-  scurDifficulty <- getsClient scurDifficulty+  scurDiff <- getsClient scurDiff   factionD <- getsState sfactionD   let table = HighScore.getTable gameModeId scoreDict       gameModeName = mname gameMode       showScore (ntable, pos) =         HighScore.highSlideshow ntable pos gameModeName-      diff | not $ fhasUI $ gplayer fact = difficultyDefault-           | otherwise = scurDifficulty+      diff | fhasUI $ gplayer fact = scurDiff+           | otherwise = difficultyInverse scurDiff       theirVic (fi, fa) | isAtWar fact fi                           && not (isHorrorFact fa) = Just $ gvictims fa                         | otherwise = Nothing@@ -335,7 +336,7 @@             [(iid, kit@(k, _))] -> do               localTime <- getsState $ getLocalTime lid               itemToF <- itemToFullClient-              let (_, name, stats) = partItem CGround lid localTime (itemToF iid kit)+              let (_, name, stats) = partItem CGround localTime (itemToF iid kit)               return $! makePhrase $ if k == 1                                      then [name, stats]  -- "a sword" too wordy                                      else [MU.CarWs k name, stats]
Game/LambdaHack/Client/UI/MsgClient.hs view
@@ -20,7 +20,6 @@ import Game.LambdaHack.Client.ItemSlot import Game.LambdaHack.Client.MonadClient hiding (liftIO) import Game.LambdaHack.Client.State-import Game.LambdaHack.Client.UI.Config import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.WidgetClient import Game.LambdaHack.Common.Actor@@ -51,9 +50,8 @@   time <- getsState stime   StateClient{sreport, shistory} <- getClient   unless (nullReport sreport) $ do-    Config{configHistoryMax} <- askConfig     msgReset ""-    let nhistory = takeHistory configHistoryMax $! addReport shistory time sreport+    let nhistory = addReport shistory time sreport     modifyClient $ \cli -> cli {shistory = nhistory}  type SlideOrCmd a = Either Slideshow a@@ -102,13 +100,13 @@   let verb = MU.Text $ if pos == bpos b                        then "stand on"                        else if canSee then "notice" else "remember"-  let nWs (iid, kit@(k, _)) = partItemWs k CGround lidV localTime (itemToF iid kit)+  let nWs (iid, kit@(k, _)) = partItemWs k CGround localTime (itemToF iid kit)       isd = case detailed of               _ | EM.size is == 0 -> ""               _ | EM.size is <= 2 ->                 makeSentence [ MU.SubjectVerbSg subject verb                              , MU.WWandW $ map nWs $ EM.assocs is]--- disabled together with overlay in doLook              True -> "\n"+-- TODO: detailed unused here; disabled together with overlay in doLook              True -> "\n"               _ -> makeSentence [MU.Cardinal (EM.size is), "items here"]       tile = lvl `at` pos       obscured | knownLsecret lvl@@ -146,6 +144,6 @@                 -- with all items visible on the floor or known to player                 -- symbol = jsymbol $ itemBase itemFull             in Just $ makePhrase [ slotLabel l, "-"  -- MU.String [symbol]-                                 , partItemWs k c lid localTime itemFull ]+                                 , partItemWs k c localTime itemFull ]                       <> "  "   return $! toOverlay $ mapMaybe pr $ EM.assocs lSlots
Game/LambdaHack/Client/UI/RunClient.hs view
@@ -76,7 +76,7 @@           paramNew = paramIni { runMembers = runMembersNew                               , runStopMsg = runStopMsgNew }       case mdirOrRunStopMsgCurrent of-        Left _ -> continueRun arena  paramNew+        Left _ -> continueRun arena paramNew                     -- run all others undisturbed; one time         Right dir -> do           s <- getState@@ -117,7 +117,8 @@       cops@Kind.COps{cotile} <- getsState scops       rbody <- getsState $ getActorBody runLeader       let rposHere = bpos rbody-          rposLast = boldpos rbody+          rposLast = fromMaybe (assert `failure` (runLeader, rbody))+                               (boldpos rbody)           -- Match run-leader dir, because we want runners to keep formation.           dir = rposHere `vectorToFrom` rposLast       body <- getsState $ getActorBody aid@@ -152,7 +153,7 @@   let lid = blid body   lvl <- getLevel lid   let posHere = bpos body-      posLast = boldpos body+      posLast = fromMaybe (assert `failure` (aid, body)) (boldpos body)       dirLast = posHere `vectorToFrom` posLast   let openableDir dir = Tile.isOpenable cotile (lvl `at` (posHere `shift` dir))       dirEnterable dir = accessibleDir cops lvl posHere dir || openableDir dir@@ -183,7 +184,7 @@       posHasItems pos = EM.member pos $ lfloor lvl       posThere = posHere `shift` dir   actorsThere <- getsState $ posToActors posThere lid-  let posLast = boldpos body+  let posLast = fromMaybe (assert `failure` (aid, body)) (boldpos body)       dirLast = posHere `vectorToFrom` posLast       -- This is supposed to work on unit vectors --- diagonal, as well as,       -- vertical and horizontal.
Game/LambdaHack/Client/UI/StartupFrontendClient.hs view
@@ -42,7 +42,7 @@   sconfig <- mkConfig cops   let !sbinding = stdBinding copsClient sconfig  -- evaluate to check for errors       sdebugMode = applyConfigToDebug sconfig sdebugCli cops-  defaultHist <- defaultHistory+  defaultHist <- defaultHistory $ configHistoryMax sconfig   let cli = defStateClient defaultHist emptyReport       s = updateCOps (const cops) emptyState       exeClientAI fid =
Game/LambdaHack/Client/UI/WidgetClient.hs view
@@ -191,6 +191,7 @@   tgtPos <- leaderTgtToPos   cursorPos <- cursorToPos   let anyPos = fromMaybe (Point 0 0) cursorPos+        -- if cursor invalid, e.g., on a wrong level; @draw@ ignores it later on       pathFromLeader leader = Just <$> getCacheBfsAndPath leader anyPos   bfsmpath <- maybe (return Nothing) pathFromLeader mleader   tgtDesc <- maybe (return ("------", Nothing)) targetDescLeader mleader
Game/LambdaHack/Common/Ability.hs view
@@ -3,6 +3,7 @@ module Game.LambdaHack.Common.Ability   ( Ability(..), Skills   , zeroSkills, unitSkills, addSkills, scaleSkills+  , blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems   ) where  import Data.Binary@@ -37,6 +38,20 @@  scaleSkills :: Int -> Skills -> Skills scaleSkills n = EM.map (n *)++minusTen, blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems :: Skills++-- To make sure only a lot of weak items can override move-only-leader, etc.+minusTen = EM.fromList $ zip [minBound..maxBound] [-10, -10..]++blockOnly = EM.delete AbWait minusTen++meleeAdjacent = EM.delete AbMelee blockOnly++-- Melee and reaction fire.+meleeAndRanged = EM.delete AbProject meleeAdjacent++ignoreItems = EM.fromList $ zip [AbMoveItem, AbProject, AbApply] [-10, -10..]  instance Show Ability where   show AbMove = "move"
Game/LambdaHack/Common/Actor.hs view
@@ -6,7 +6,7 @@     -- * The@ Acto@r type   , Actor(..), ResDelta(..)   , deltaSerious, deltaMild, xM, minusM, minusTwoM, oneM-  , bspeed, actorTemplate, timeShiftFromSpeed, braced, waitedLastTurn+  , bspeed, actorTemplate, braced, waitedLastTurn   , actorDying, actorNewBorn, unoccupied   , hpTooLow, hpHuge, calmEnough, calmEnough10, hpEnough, hpEnough10     -- * Assorted@@ -18,6 +18,7 @@ import Data.Binary import qualified Data.EnumMap.Strict as EM import Data.Int (Int64)+import Data.Maybe import Data.Ratio import Data.Text (Text) import qualified NLP.Miniutter.English as MU@@ -56,7 +57,7 @@      -- Location   , bpos          :: !Point        -- ^ current position-  , boldpos       :: !Point        -- ^ previous position+  , boldpos       :: !(Maybe Point)  -- ^ previous position, if any   , blid          :: !LevelId      -- ^ current level   , boldlid       :: !LevelId      -- ^ previous level   , bfid          :: !FactionId    -- ^ faction the actor currently belongs to@@ -134,7 +135,7 @@ actorTemplate btrunk bsymbol bname bpronoun bcolor bhp bcalm               bpos blid btime bfid =   let btrajectory = Nothing-      boldpos = Point 0 0  -- make sure /= bpos, to tell it didn't switch level+      boldpos = Nothing       boldlid = blid       beqp    = EM.empty       binv    = EM.empty@@ -154,13 +155,6 @@                $ sumSlotNoFilter IK.EqpSlotAddSpeed activeItems     Just (_, speed) -> speed --- | Add time taken by a single 1m step at the actor's current speed.-timeShiftFromSpeed :: Actor -> [ItemFull] -> Time -> Time-timeShiftFromSpeed b activeItems time =-  let speed = bspeed b activeItems-      delta = ticksPerMeter speed-  in timeShift time delta- -- | Whether an actor is braced for combat this clip. braced :: Actor -> Bool braced = bwait@@ -174,7 +168,7 @@                || bproj b && maybe True (null . fst) (btrajectory b)  actorNewBorn :: Actor -> Bool-actorNewBorn b = boldpos b == Point 0 0+actorNewBorn b = isNothing (boldpos b)                  && not (waitedLastTurn b)                  && btime b >= timeTurn 
Game/LambdaHack/Common/ActorState.hs view
@@ -10,10 +10,10 @@   , mergeItemQuant, sharedAllOwnedFid, findIid   , getCBag, getActorBag, getBodyActorBag, mapActorItems_, getActorAssocs   , nearbyFreePoints, whereTo, getCarriedAssocs, getCarriedIidCStore-  , posToActors, posToActor, getItemBody, memActor, getActorBody+  , posToActors, getItemBody, memActor, getActorBody   , tryFindHeroK, getLocalTime, itemPrice, regenCalmDelta   , actorInAmbient, actorSkills, dispEnemy, fullAssocs, itemToFull-  , goesIntoEqp, goesIntoInv, goesIntoSha, eqpOverfull+  , goesIntoEqp, goesIntoInv, goesIntoSha, eqpOverfull, eqpFreeN   , storeFromC, lidFromC, aidFromC, hasCharge   , strongestMelee, isMelee, isMeleeEqp   ) where@@ -104,22 +104,12 @@   let iidItem (iid, kit) = (iid, (getItemBody iid s, kit))   in map iidItem $ EM.assocs bag --- | Finds an actor at a position on the current level.-posToActor :: Point -> LevelId -> State-           -> Maybe ((ActorId, Actor), [(ItemId, Item)])-posToActor pos lid s = listToMaybe $ posToActors pos lid s--posToActors :: Point -> LevelId -> State-            -> [((ActorId, Actor), [(ItemId, Item)])]+-- | Finds all actors at a position on the current level.+posToActors :: Point -> LevelId -> State -> [(ActorId, Actor)] posToActors pos lid s =   let as = actorAssocs (const True) lid s-      aps = filter (\(_, b) -> bpos b == pos) as-      g (aid, b) = ( (aid, b)-                   , bagAssocs s (binv b)-                     ++ bagAssocs s (beqp b)-                     ++ bagAssocs s (borgan b) )-      l = map g aps-  in assert (length l <= 1 || all (bproj . snd . fst) l+      l = filter (\(_, b) -> bpos b == pos) as+  in assert (length l <= 1 || all (bproj . snd) l              `blame` "many actors at the same position" `twith` l)      l @@ -160,8 +150,7 @@ sharedAllOwned :: Actor -> State -> ItemBag sharedAllOwned body s =   let shaBag = gsha $ sfactionD s EM.! bfid body-  in EM.unionsWith mergeItemQuant-     $ [sharedEqp body s, sharedInv body s, shaBag]+  in EM.unionsWith mergeItemQuant [sharedEqp body s, sharedInv body s, shaBag]  sharedAllOwnedFid :: Bool -> FactionId -> State -> ItemBag sharedAllOwnedFid onlyOrgans fid s =@@ -332,13 +321,24 @@ actorSkills :: Maybe ActorId -> ActorId -> [ItemFull] -> State -> Ability.Skills actorSkills mleader aid activeItems s =   let body = getActorBody aid s-      fact = (EM.! bfid body) . sfactionD $ s+      player = gplayer . (EM.! bfid body) . sfactionD $ s+      skillsFromTactic = tacticSkills $ ftactic player       factionSkills         | Just aid == mleader = Ability.zeroSkills-        | otherwise = fskillsOther $ gplayer fact+        | otherwise = fskillsOther player `Ability.addSkills` skillsFromTactic       itemSkills = sumSkills activeItems   in itemSkills `Ability.addSkills` factionSkills +tacticSkills :: Tactic -> Ability.Skills+tacticSkills TExplore = Ability.zeroSkills+tacticSkills TFollow = Ability.zeroSkills+tacticSkills TFollowNoItems = Ability.ignoreItems+tacticSkills TMeleeAndRanged = Ability.meleeAndRanged+tacticSkills TMeleeAdjacent = Ability.meleeAdjacent+tacticSkills TBlock = Ability.blockOnly+tacticSkills TRoam = Ability.zeroSkills+tacticSkills TPatrol = Ability.zeroSkills+ -- Check whether an actor can displace an enemy. We assume they are adjacent. dispEnemy :: ActorId -> ActorId -> [ItemFull] -> State -> Bool dispEnemy source target activeItems s =@@ -396,6 +396,11 @@ eqpOverfull b n = let size = sum $ map fst $ EM.elems $ beqp b                   in assert (size <= 10 `blame` (b, n, size))                      $ size + n > 10++eqpFreeN :: Actor -> Int+eqpFreeN b = let size = sum $ map fst $ EM.elems $ beqp b+             in assert (size <= 10 `blame` (b, size))+                $ 10 - size  storeFromC :: Container -> CStore storeFromC c = case c of
Game/LambdaHack/Common/ClientOptions.hs view
@@ -7,8 +7,6 @@ import Data.Binary import GHC.Generics (Generic) -import Game.LambdaHack.Common.Faction- data DebugModeCli = DebugModeCli   { sfont           :: !(Maybe String)       -- ^ Font to use for the main game window.@@ -31,8 +29,6 @@       -- ^ Start a new game, overwriting the save file.   , sbenchmark      :: !Bool       -- ^ Don't create directories and files and show time stats.-  , sdifficultyCli  :: !Int-      -- ^ The difficulty level for all UI clients.   , ssavePrefixCli  :: !(Maybe String)       -- ^ Prefix of the save game file.   , sfrontendStd    :: !Bool@@ -56,7 +52,6 @@   , snoAnim = Nothing   , snewGameCli = False   , sbenchmark = False-  , sdifficultyCli = difficultyDefault   , ssavePrefixCli = Nothing   , sfrontendStd = False   , sfrontendNull = False
Game/LambdaHack/Common/Faction.hs view
@@ -7,7 +7,7 @@   , isHorrorFact   , noRunWithMulti, isAIFact, autoDungeonLevel, automatePlayer   , isAtWar, isAllied-  , difficultyBound, difficultyDefault, difficultyCoeff+  , difficultyBound, difficultyDefault, difficultyCoeff, difficultyInverse #ifdef EXPOSE_INTERNAL     -- * Internal operations   , Dipl@@ -79,7 +79,7 @@ -- -- Horror player is special, for summoned actors that don't belong to any -- of the main players of a given game. E.g., animals summoned during--- a duel game between two hero players land in the horror faction.+-- a skirmish game between two hero factions land in the horror faction. -- In every game, either all factions for which summoning items exist -- should be present or a horror player should be added to host them. -- Actors that can be summoned should have "horror" in their @ifreq@ set.@@ -140,6 +140,10 @@ -- The function is its own inverse. difficultyCoeff :: Int -> Int difficultyCoeff n = difficultyDefault - n++-- The function is its own inverse.+difficultyInverse :: Int -> Int+difficultyInverse n = difficultyBound + 1 - n  instance Binary Faction where   put Faction{..} = do
Game/LambdaHack/Common/ItemDescription.hs view
@@ -21,12 +21,11 @@ import Game.LambdaHack.Common.Time import qualified Game.LambdaHack.Content.ItemKind as IK --- TODO: remove _lid if still unused after some time -- | The part of speech describing the item parameterized by the number -- of effects/aspects to show..-partItemN :: Int -> Int -> CStore -> LevelId -> Time -> ItemFull+partItemN :: Int -> Int -> CStore -> Time -> ItemFull           -> (Bool, MU.Part, MU.Part)-partItemN fullInfo n c _lid localTime itemFull =+partItemN fullInfo n c localTime itemFull =   let genericName = jname $ itemBase itemFull   in case itemDisco itemFull of     Nothing ->@@ -63,7 +62,7 @@       in (unique, capName, MU.Phrase $ map MU.Text ts)  -- | The part of speech describing the item.-partItem :: CStore -> LevelId -> Time -> ItemFull -> (Bool, MU.Part, MU.Part)+partItem :: CStore -> Time -> ItemFull -> (Bool, MU.Part, MU.Part) partItem = partItemN 5 4  textAllAE :: Int -> Bool -> CStore -> ItemFull -> [Text]@@ -150,46 +149,45 @@       in aets ++ features  -- TODO: use kit-partItemWs :: Int -> CStore -> LevelId -> Time -> ItemFull -> MU.Part-partItemWs count c lid localTime itemFull =-  let (unique, name, stats) = partItem c lid localTime itemFull+partItemWs :: Int -> CStore -> Time -> ItemFull -> MU.Part+partItemWs count c localTime itemFull =+  let (unique, name, stats) = partItem c localTime itemFull   in if unique && count == 1      then MU.Phrase ["the", name, stats]      else MU.Phrase [MU.CarWs count name, stats] -partItemAW :: CStore -> LevelId -> Time -> ItemFull -> MU.Part-partItemAW c lid localTime itemFull =-  let (unique, name, stats) = partItemN 4 4 c lid localTime itemFull+partItemAW :: CStore -> Time -> ItemFull -> MU.Part+partItemAW c localTime itemFull =+  let (unique, name, stats) = partItemN 4 4 c localTime itemFull   in if unique      then MU.Phrase ["the", name, stats]      else MU.AW $ MU.Phrase [name, stats] -partItemMediumAW :: CStore -> LevelId -> Time -> ItemFull -> MU.Part-partItemMediumAW c lid localTime itemFull =-  let (unique, name, stats) = partItemN 5 100 c lid localTime itemFull+partItemMediumAW :: CStore -> Time -> ItemFull -> MU.Part+partItemMediumAW c localTime itemFull =+  let (unique, name, stats) = partItemN 5 100 c localTime itemFull   in if unique      then MU.Phrase ["the", name, stats]      else MU.AW $ MU.Phrase [name, stats] -partItemWownW :: MU.Part -> CStore -> LevelId -> Time -> ItemFull -> MU.Part-partItemWownW partA c lid localTime itemFull =-  let (_, name, stats) = partItemN 4 4 c lid localTime itemFull+partItemWownW :: MU.Part -> CStore -> Time -> ItemFull -> MU.Part+partItemWownW partA c localTime itemFull =+  let (_, name, stats) = partItemN 4 4 c localTime itemFull   in MU.WownW partA $ MU.Phrase [name, stats] -itemDesc :: CStore -> LevelId -> Time -> ItemFull -> Overlay-itemDesc c lid localTime itemFull =-  let (_, name, stats) = partItemN 10 100 c lid localTime itemFull+itemDesc :: CStore -> Time -> ItemFull -> Overlay+itemDesc c localTime itemFull =+  let (_, name, stats) = partItemN 10 100 c localTime itemFull       nstats = makePhrase [name, stats]       desc = case itemDisco itemFull of         Nothing -> "This item is as unremarkable as can be."         Just ItemDisco{itemKind} -> IK.idesc itemKind       weight = jweight (itemBase itemFull)-      (scaledWeight, unitWeight) =-        if weight > 1000-        then (tshow $ fromIntegral weight / (1000 :: Double), "kg")-        else if weight > 0-        then (tshow weight, "g")-        else ("", "")+      (scaledWeight, unitWeight)+        | weight > 1000 =+          (tshow $ fromIntegral weight / (1000 :: Double), "kg")+        | weight > 0 = (tshow weight, "g")+        | otherwise = ("", "")       ln = abs $ fromEnum $ jlid (itemBase itemFull)       colorSymbol = uncurry (flip Color.AttrChar) (viewItem $ itemBase itemFull)       f = Color.AttrChar Color.defAttr
Game/LambdaHack/Common/ItemStrongest.hs view
@@ -36,7 +36,7 @@       -- Approximation. For some effects lower values are better,       -- so we just offer the mean of the dice. This is also correct       -- for summation, on average.-      concatMap f $ map (fmap Dice.meanDice) iaspects+      concatMap (f . fmap Dice.meanDice) iaspects     Nothing -> []  strengthAspectMaybe :: Show b => (Aspect Int -> [b]) -> ItemFull -> Maybe b
Game/LambdaHack/Common/Kind.hs view
@@ -68,9 +68,9 @@                 in EM.findWithDefault assFail i kindMap       correct a = not (T.null (getName a)) && all ((> 0) . snd) (getFreq a)       singleOffenders = [ (offences, a)-                        | a <- content,-                          let offences = validateSingle a-                          , not (null offences) ]+                        | a <- content+                        , let offences = validateSingle a+                        , not (null offences) ]       allOffences = validateAll content   in assert (allB correct content) $      assert (null singleOffenders `blame` "some content items not valid"
Game/LambdaHack/Common/Level.hs view
@@ -154,7 +154,7 @@  isSecretPos :: Level -> Point -> Bool isSecretPos lvl (Point x y) =-  not (lhidden lvl == 0)+  lhidden lvl /= 0   && (lsecret lvl `Bits.rotateR` x `Bits.xor` y + x) `mod` lhidden lvl == 0  hideTile :: Kind.COps -> Level -> Point -> Kind.Id TileKind
Game/LambdaHack/Common/Misc.hs view
@@ -137,14 +137,22 @@ newtype ActorId = ActorId Int   deriving (Show, Eq, Ord, Enum, Binary) --- TODO: alway shoot, never shoot, etc., but there is too many and this is best--- expressed via skills, and also we risk micromanagement, so let's stop--- and think first; perhaps only have as many tactics as needed for realistic--- AI behaviour in our game modes; perhaps even expose only some of them to UI+-- TODO: there is already too many; express this somehow via skills;+-- also, we risk micromanagement; perhaps only have as many tactics+-- as needed for realistic AI behaviour in our game modes;+-- perhaps even expose only some of them to UI; perhaps define tactics+-- in rules content or in game mode defs; perhaps have skills corresponding+-- to exploration. following, etc.+-- | Tactic of non-leader actors. Apart of determining AI operation,+-- each tactic implies a skill modifier, that is added to the non-leader skills+-- defined in 'fskillsOther' field of 'Player'. data Tactic =-    TBlock    -- ^ always only wait, even if enemy in melee range+    TExplore  -- ^ if enemy nearby, attack, if no items, etc., explore unknown   | TFollow   -- ^ always follow leader's target or his position if no target-  | TExplore  -- ^ if enemy nearby, attack, if no items, etc., explore unknown+  | TFollowNoItems   -- ^ follow but don't do any item management nor use+  | TMeleeAndRanged  -- ^ only melee and do ranged combat+  | TMeleeAdjacent   -- ^ only melee (or wait)+  | TBlock    -- ^ always only wait, even if enemy in melee range   | TRoam     -- ^ if enemy nearby, attack, if no items, etc., roam randomly   | TPatrol   -- ^ find an open and uncrowded area, patrol it according               --   to sight radius and fallback temporarily to @TRoam@@@ -155,9 +163,12 @@   deriving (Eq, Ord, Enum, Bounded, Generic)  instance Show Tactic where-  show TBlock = "block and wait"-  show TFollow = "follow leader's target or position"   show TExplore = "explore unknown, chase targets"+  show TFollow = "follow leader's target or position"+  show TFollowNoItems = "follow leader's target or position, ignore items"+  show TMeleeAndRanged = "only melee and perform ranged combat"+  show TMeleeAdjacent = "only melee"+  show TBlock = "only block and wait"   show TRoam = "roam freely, chase targets"   show TPatrol = "find and patrol an area (TODO)" 
Game/LambdaHack/Common/MonadStateRead.hs view
@@ -2,7 +2,7 @@ -- player actions. Has no access to the the main action type. module Game.LambdaHack.Common.MonadStateRead   ( MonadStateRead(..)-  , getLevel, nUI, posOfAid, factionCanEscape, factionLoots+  , getLevel, nUI, posOfAid, factionCanEscape   , getGameMode, getEntryArena   ) where @@ -41,16 +41,6 @@   dungeon <- getsState sdungeon   let escape = any (not . null . lescape) $ EM.elems dungeon   return $! escape && fcanEscape (gplayer fact)---- TODO: "treasure" is hardwired; tie this code with calculateTotal-factionLoots :: MonadStateRead m => FactionId -> m Bool-factionLoots fid = do-  dungeon <- getsState sdungeon-  let hasTreasure Level{litemFreq} =-        maybe False (> 0) $ lookup "treasure" litemFreq-      loots = any hasTreasure $ EM.elems dungeon-  canEscape <- factionCanEscape fid-  return $! canEscape && loots  getGameMode :: MonadStateRead m => m ModeKind getGameMode = do
Game/LambdaHack/Common/Msg.hs view
@@ -5,14 +5,15 @@   , Msg, (<>), (<+>), tshow, toWidth, moreMsg, endMsg, yesnoMsg, truncateMsg   , Report, emptyReport, nullReport, singletonReport, addMsg, prependMsg   , splitReport, renderReport, findInReport, lastMsgOfReport-  , History, emptyHistory, lengthHistory, singletonHistory-  , addReport, renderHistory, takeHistory, lastReportOfHistory+  , History, emptyHistory, lengthHistory+  , addReport, renderHistory, lastReportOfHistory   , Overlay(overlay), emptyOverlay, truncateToOverlay, toOverlay   , Slideshow(slideshow), splitOverlay, toSlideshow   , encodeLine, encodeOverlay, ScreenLine, toScreenLine, splitText   )   where +import Control.Applicative import Control.Exception.Assert.Sugar import Data.Binary import qualified Data.ByteString.Char8 as BS@@ -30,6 +31,7 @@ import Game.LambdaHack.Common.Color import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Point+import qualified Game.LambdaHack.Common.RingBuffer as RB import Game.LambdaHack.Common.Time  infixr 6 <+>  -- TODO: not needed when we require a very new minimorph@@ -154,40 +156,39 @@          then pre : splitText w post          else T.reverse ppost : splitText w (T.reverse ppre <> post) --- | The history of reports.-newtype History = History [(Time, Report)]+-- | The history of reports. This is a ring buffer of the given length+newtype History = History (RB.RingBuffer (Time, Report))   deriving (Show, Binary) --- | Empty history of reports.-emptyHistory :: History-emptyHistory = History []---- | Construct a singleton history of reports.-singletonHistory :: Time -> Report -> History-singletonHistory = addReport emptyHistory+-- | Empty history of reports of the given maximal length.+emptyHistory :: Int -> History+emptyHistory size = History $ RB.empty size (timeZero, Report [])  -- | Add a report to history, handling repetitions. addReport :: History -> Time -> Report -> History addReport h _ (Report []) = h-addReport (History []) time m = History [(time, m)]-addReport (History oldRs@((oldTime, Report h) : hs)) time (Report m)  =-  case (reverse m, h) of-    ((s1, n1) : rs, (s2, n2) : hhs) | s1 == s2 ->-      let hist = (oldTime, Report ((s2, n1 + n2) : hhs)) : hs-      in History $ if null rs-                   then hist-                   else (time, Report (reverse rs)) : hist-    _ -> History $ (time, Report m) : oldRs+addReport !(History rb) !time !rep@(Report m) =+  case RB.uncons rb of+    Nothing -> History $ RB.cons (time, rep) rb+    Just ((oldTime, Report h), hRest) ->+      case (reverse m, h) of+        ((s1, n1) : rs, (s2, n2) : hhs) | s1 == s2 ->+          let hist = RB.cons (oldTime, Report ((s2, n1 + n2) : hhs)) hRest+          in History $ if null rs+                       then hist+                       else RB.cons (time, Report (reverse rs)) hist+        _ -> History $ RB.cons (time, rep) rb  lengthHistory :: History -> Int-lengthHistory (History rs) = length rs+lengthHistory (History rs) = RB.rbLength rs  -- | Render history as many lines of text, wrapping if necessary. renderHistory :: History -> Overlay-renderHistory (History h) =-  let (x, y) = normalLevelBound+renderHistory (History rb) =+  let l = RB.toList rb+      (x, y) = normalLevelBound       screenLength = y + 2-      reportLines = concatMap (splitReportForHistory (x + 1)) $ reverse h+      reportLines = concatMap (splitReportForHistory (x + 1)) l       padding = screenLength - length reportLines `mod` screenLength   in toOverlay $ replicate padding "" ++ reportLines @@ -201,14 +202,8 @@     [] -> []     hd : tl -> hd : map (T.cons ' ') tl --- | Take the given prefix of reports from a history.-takeHistory :: Int -> History -> History-takeHistory k (History h) = History $ take k h- lastReportOfHistory :: History -> Maybe Report-lastReportOfHistory (History hist) = case hist of-  [] -> Nothing-  (_, rep) : _ -> Just rep+lastReportOfHistory (History rb) = snd . fst <$> RB.uncons rb  type ScreenLine = U.Vector Int32 
Game/LambdaHack/Common/Point.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} -- | Basic operations on 2D points represented as linear offsets. module Game.LambdaHack.Common.Point-  ( X, Y, Point(..), dummyPoint, maxLevelDimExponent+  ( X, Y, Point(..), maxLevelDimExponent   , chessDist, euclidDistSq, adjacent, inside, bla, fromTo   ) where @@ -44,9 +44,6 @@   fromEnum = fromEnumPoint   toEnum = toEnumPoint -dummyPoint :: Point-dummyPoint = Point (-10000) (-10000)- -- | The maximum number of bits for level X and Y dimension (16). -- The value is chosen to support architectures with 32-bit Ints. maxLevelDimExponent :: Int@@ -62,8 +59,9 @@ fromEnumPoint :: Point -> Int {-# INLINE fromEnumPoint #-} fromEnumPoint (Point x y) =-  assert (x >= 0 && y >= 0 `blame` "invalid point coordinates"-                           `twith` (x, y))+  assert (x >= 0 && y >= 0 && x <= maxLevelDim && y <= maxLevelDim+          `blame` "invalid point coordinates"+          `twith` (x, y))   $ x + unsafeShiftL y maxLevelDimExponent  toEnumPoint :: Int -> Point
Game/LambdaHack/Common/PointArray.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | Arrays, based on Data.Vector.Unboxed, indexed by @Point@. module Game.LambdaHack.Common.PointArray   ( Array@@ -12,7 +13,11 @@ import Control.Monad.ST.Strict import Data.Binary import Data.Vector.Binary ()-import qualified Data.Vector.Fusion.Stream as Stream+#if MIN_VERSION_vector(0,11,0)+import qualified Data.Vector.Fusion.Bundle as Bundle+#else+import qualified Data.Vector.Fusion.Stream as Bundle+#endif import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM@@ -165,7 +170,7 @@ {-# INLINE minLastIndexA #-} minLastIndexA Array{..} =   punindex axsize-  $ fst . Stream.foldl1' imin . Stream.indexed . G.stream+  $ fst . Bundle.foldl1' imin . Bundle.indexed . G.stream   $ avector  where   imin (i, x) (j, y) = i `seq` j `seq` if x >= y then (j, y) else (i, x)@@ -176,7 +181,7 @@ {-# INLINE minIndexesA #-} minIndexesA Array{..} =   map (punindex axsize)-  $ Stream.foldl' imin [] . Stream.indexed . G.stream+  $ Bundle.foldl' imin [] . Bundle.indexed . G.stream   $ avector  where   imin acc (i, x) = i `seq` if x == minE then i : acc else acc@@ -194,7 +199,7 @@ {-# INLINE maxLastIndexA #-} maxLastIndexA Array{..} =   punindex axsize-  $ fst . Stream.foldl1' imax . Stream.indexed . G.stream+  $ fst . Bundle.foldl1' imax . Bundle.indexed . G.stream   $ avector  where   imax (i, x) (j, y) = i `seq` j `seq` if x <= y then (j, y) else (i, x)
Game/LambdaHack/Common/Request.hs view
@@ -44,7 +44,7 @@     forall a. ReqUITimed !(RequestTimed a)   | ReqUILeader !ActorId !(Maybe Target) !RequestUI   | ReqUIGameRestart !ActorId !(GroupName ModeKind) !Int ![(Int, (Text, Text))]-  | ReqUIGameExit !ActorId !Int+  | ReqUIGameExit !ActorId   | ReqUIGameSave   | ReqUITactic !Tactic   | ReqUIAutomate@@ -84,11 +84,13 @@   | DisplaceBraced   | DisplaceImmobile   | DisplaceSupported+  | AlterUnskilled   | AlterDistant   | AlterBlockActor   | AlterBlockItem   | AlterNothing   | EqpOverfull+  | EqpStackFull   | ApplyUnskilled   | ApplyRead   | ApplyOutOfReach@@ -96,10 +98,10 @@   | ItemNothing   | ItemNotCalm   | NotCalmPrecious+  | ProjectUnskilled   | ProjectAimOnself   | ProjectBlockTerrain   | ProjectBlockActor-  | ProjectUnskilled   | ProjectNotRanged   | ProjectFragile   | ProjectOutOfReach@@ -119,11 +121,13 @@   DisplaceBraced -> True   DisplaceImmobile -> False  -- unidentified skill items   DisplaceSupported -> True+  AlterUnskilled -> False  -- unidentified skill items   AlterDistant -> True   AlterBlockActor -> True  -- adjacent actor always visible   AlterBlockItem -> True  -- adjacent item always visible   AlterNothing -> True-  EqpOverfull -> True+  EqpOverfull -> False  -- REVERT ME on branches other than 0.5.0+  EqpStackFull -> True   ApplyUnskilled -> False  -- unidentified skill items   ApplyRead -> False  -- unidentified skill items   ApplyOutOfReach -> True@@ -131,10 +135,10 @@   ItemNothing -> True   ItemNotCalm -> False  -- unidentified skill items   NotCalmPrecious -> False  -- unidentified skill items+  ProjectUnskilled -> False  -- unidentified skill items   ProjectAimOnself -> True   ProjectBlockTerrain -> True  -- adjacent terrain always visible   ProjectBlockActor -> True  -- adjacent actor always visible-  ProjectUnskilled -> False  -- unidentified skill items   ProjectNotRanged -> False  -- unidentified skill items   ProjectFragile -> False  -- unidentified skill items   ProjectOutOfReach -> True@@ -154,11 +158,13 @@   DisplaceBraced -> "trying to displace a braced foe"   DisplaceImmobile -> "trying to displace an immobile foe"   DisplaceSupported -> "trying to displace a supported foe"+  AlterUnskilled -> "unskilled actors cannot alter tiles"   AlterDistant -> "trying to alter a distant tile"   AlterBlockActor -> "blocked by an actor"   AlterBlockItem -> "jammed by an item"   AlterNothing -> "wasting time on altering nothing"   EqpOverfull -> "cannot equip any more items"+  EqpStackFull -> "cannot equip the whole item stack"   ApplyUnskilled -> "unskilled actors cannot apply items"   ApplyRead -> "activating this kind of items requires skill level 2"   ApplyOutOfReach -> "cannot apply an item out of reach"@@ -166,10 +172,10 @@   ItemNothing -> "wasting time on void item manipulation"   ItemNotCalm -> "you are too alarmed to sort through the shared stash"   NotCalmPrecious -> "you are too alarmed to handle such an exquisite item"+  ProjectUnskilled -> "unskilled actors cannot aim"   ProjectAimOnself -> "cannot aim at oneself"   ProjectBlockTerrain -> "aiming obstructed by terrain"   ProjectBlockActor -> "aiming blocked by an actor"-  ProjectUnskilled -> "unskilled actors cannot aim"   ProjectNotRanged -> "to fling a non-missile requires fling skill 2"   ProjectFragile -> "to lob a fragile item requires fling skill 3"   ProjectOutOfReach -> "cannot aim an item out of reach"
+ Game/LambdaHack/Common/RingBuffer.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveGeneric #-}+-- | Ring buffers.+module Game.LambdaHack.Common.RingBuffer+  ( RingBuffer(rbLength)+  , empty, cons, uncons, toList+  ) where++import Data.Binary+import qualified Data.Vector as V+import Data.Vector.Binary ()+import GHC.Generics (Generic)++data RingBuffer a = RingBuffer+  { rbCarrier :: !(V.Vector a)+  , rbNext    :: !Int+  , rbLength  :: !Int+  }+  deriving (Show, Generic)++instance Binary a => Binary (RingBuffer a)++empty :: Int -> a -> RingBuffer a+empty size dummy = RingBuffer (V.replicate size dummy) 0 0++cons :: a -> RingBuffer a -> RingBuffer a+cons a RingBuffer{..} =+  let size = V.length rbCarrier+      incNext = (rbNext + 1) `mod` size+      incLength = min size $ rbLength + 1+  in RingBuffer (rbCarrier V.// [(rbNext, a)]) incNext incLength++uncons :: RingBuffer a -> Maybe (a, RingBuffer a)+uncons RingBuffer{..} =+  let size = V.length rbCarrier+      decNext = (rbNext - 1) `mod` size+  in if rbLength == 0+     then Nothing+     else Just ( rbCarrier V.! decNext+               , RingBuffer rbCarrier decNext (rbLength - 1) )++toList :: RingBuffer a -> [a]+toList RingBuffer{..} =+  let l = V.toList rbCarrier+      size = V.length rbCarrier+      start = (rbNext + size - rbLength) `mod` size+  in take rbLength $ drop start $ l ++ l
Game/LambdaHack/Common/State.hs view
@@ -24,7 +24,6 @@ import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.Time-import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.TileKind (TileKind) @@ -48,11 +47,11 @@ -- and when loading regenerate this level. unknownLevel :: Kind.COps -> AbsDepth -> X -> Y              -> Text -> ([Point], [Point]) -> Int-             -> (Freqs ItemKind) -> Int -> Int -> [Point]+             -> Int -> Int -> [Point]              -> Level unknownLevel Kind.COps{cotile=Kind.Ops{ouniqGroup}}              ldepth lxsize lysize ldesc lstair lclear-             litemFreq lsecret lhidden lescape =+             lsecret lhidden lescape =   let unknownId = ouniqGroup "unknown space"       outerId = ouniqGroup "basic outer fence"   in Level { ldepth@@ -71,7 +70,7 @@            , lactorCoeff = 0            , lactorFreq = []            , litemNum = 0-           , litemFreq  -- = []  --- TODO: field needed by factionLoots+           , litemFreq = []            , lsecret            , lhidden            , lescape@@ -127,7 +126,7 @@     { _sdungeon =       EM.map (\Level{..} ->               unknownLevel _scops ldepth lxsize lysize ldesc lstair lclear-                           litemFreq lsecret lhidden lescape)+                           lsecret lhidden lescape)              _sdungeon     , ..     }
Game/LambdaHack/Common/Tile.hs view
@@ -206,8 +206,7 @@     [] -> return t     groups -> do       grp <- oneOf groups-      (fromMaybe $ assert `failure` grp)-        <$> opick grp (const True)+      fromMaybe (assert `failure` grp) <$> opick grp (const True)  closeTo :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind) closeTo Kind.Ops{okind, opick} t = do@@ -217,8 +216,7 @@     [] -> return t     groups -> do       grp <- oneOf groups-      (fromMaybe $ assert `failure` grp)-        <$> opick grp (const True)+      fromMaybe (assert `failure` grp) <$> opick grp (const True)  embedItems :: Kind.Ops TileKind -> Kind.Id TileKind -> [GroupName ItemKind] embedItems Kind.Ops{okind} t =@@ -240,8 +238,7 @@     [] -> return t     groups -> do       grp <- oneOf groups-      (fromMaybe $ assert `failure` grp)-        <$> opick grp (const True)+      fromMaybe (assert `failure` grp) <$> opick grp (const True)  hideAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind hideAs Kind.Ops{okind, ouniqGroup} t =
Game/LambdaHack/Content/ModeKind.hs view
@@ -73,13 +73,16 @@ data Player a = Player   { fname          :: !Text        -- ^ name of the player   , fgroup         :: !(GroupName ItemKind)  -- ^ name of the monster group to control-  , fskillsOther   :: !Skills      -- ^ skills of the other actors+  , fskillsOther   :: !Skills      -- ^ fixed skill modifiers to the non-leader+                                   --   actors; also summed with skills implied+                                   --   by ftactic (which is not fixed)   , fcanEscape     :: !Bool        -- ^ the player can escape the dungeon   , fneverEmpty    :: !Bool        -- ^ the faction declared killed if no actors   , fhiCondPoly    :: !HiCondPoly  -- ^ score polynomial for the player   , fhasNumbers    :: !Bool        -- ^ whether actors have numbers, not symbols   , fhasGender     :: !Bool        -- ^ whether actors have gender-  , ftactic        :: !Tactic      -- ^ members behave according to this tactic+  , ftactic        :: !Tactic      -- ^ non-leader behave according to this+                                   --   tactic; can be changed during the game   , fentryLevel    :: !a           -- ^ level where the initial members start   , finitialActors :: !a           -- ^ number of initial members   , fleaderMode    :: !LeaderMode  -- ^ the mode of switching the leader@@ -102,7 +105,7 @@ data AutoLeader = AutoLeader   { autoDungeon :: !Bool       -- ^ leader switching between levels is automatically done by the server-      --   and client is not permitted to change leaders+      --   and client is not permitted to change to leaders from other levels       --   (the frequency of leader level switching done by the server       --   is controlled by @RuleKind.rleadLevelClips@);       --   if the flag is @False@, server still does a subset
Game/LambdaHack/SampleImplementation/SampleMonadServer.hs view
@@ -113,7 +113,7 @@   -- TODO: send them a message to tell users "server crashed"   -- and then wait for them to exit normally.   Ex.handle (\(ex :: Ex.SomeException) -> do-               threadDelay 100000  -- let clients report their errors+               threadDelay 1000000  -- let clients report their errors                Ex.throw ex)  -- crash eventually, which kills clients             exeWithSaves   waitForChildren childrenServer  -- no crash, wait for clients indefinitely
Game/LambdaHack/Server/Commandline.hs view
@@ -24,8 +24,8 @@         , "  --gameMode m  start next game in the given mode"         , "  --automateAll  give control of all UI teams to computer"         , "  --keepAutomated  keep factions automated after game over"-        , "  --newGame  start a new game, overwriting the save file"-        , "  --difficulty n  set difficulty for all UI players to n"+        , "  --newGame n  start a new game, overwriting the save file,"+        , "               with difficulty for all UI players set to n"         , "  --stopAfter n  exit this game session after around n seconds"         , "  --benchmark  print stats, limit saving and other file operations"         , "  --setDungeonRng s  set dungeon generation RNG seed to string s"@@ -64,15 +64,12 @@         (parseArgs rest) {sautomateAll = True}       parseArgs ("--keepAutomated" : rest) =         (parseArgs rest) {skeepAutomated = True}-      parseArgs ("--newGame" : rest) =+      parseArgs ("--newGame" : s : rest) =         let debugSer = parseArgs rest-        in debugSer { snewGameSer = True+            scurDiffSer = read s+        in debugSer { scurDiffSer+                    , snewGameSer = True                     , sdebugCli = (sdebugCli debugSer) {snewGameCli = True}}-      parseArgs ("--difficulty" : s : rest) =-        let debugSer = parseArgs rest-            diff = read s-        in debugSer { sdifficultySer = diff-                    , sdebugCli = (sdebugCli debugSer) {sdifficultyCli = diff}}       parseArgs ("--stopAfter" : s : rest) =         (parseArgs rest) {sstopAfter = Just $ read s}       parseArgs ("--benchmark" : rest) =
Game/LambdaHack/Server/CommonServer.hs view
@@ -127,8 +127,7 @@           join $ getsState $ mapActorItems_ (discover aid) b   mapDungeonActors_ f dungeon   maybe (return ())-        (\(aid, b) -> do-           join $ getsState $ mapActorItems_ (discover aid) b)+        (\(aid, b) -> join $ getsState $ mapActorItems_ (discover aid) b)         mbody  moveStores :: (MonadAtomic m, MonadServer m)@@ -295,8 +294,8 @@               if not $ Tile.isWalkable cotile t                 then return $ Just ProjectBlockTerrain                 else do-                  mab <- getsState $ posToActor pos lid-                  if not $ maybe True (bproj . snd . fst) mab+                  lab <- getsState $ posToActors pos lid+                  if not $ all (bproj . snd) lab                     then if isBlast && bproj sb then do                            -- Hit the blocking actor.                            projectBla source spos (pos:rest) iid cstore isBlast@@ -348,7 +347,7 @@       adj | trange < 5 = "falling"           | otherwise = "flying"       -- Not much detail about a fast flying item.-      (_, object1, object2) = partItem CInv blid localTime+      (_, object1, object2) = partItem CInv localTime                                        (itemNoDisco (itemBase, 1))       bname = makePhrase [MU.AW $ MU.Text adj, object1, object2]       tweakBody b = b { bsymbol = if isBlast then bsymbol b else '*'@@ -394,12 +393,12 @@   -- Create actor.   factionD <- getsState sfactionD   let factMine = factionD EM.! bfid-  DebugModeSer{sdifficultySer} <- getsServer sdebugSer+  DebugModeSer{scurDiffSer} <- getsServer sdebugSer   nU <- nUI   -- If difficulty is below standard, HP is added to the UI factions,   -- otherwise HP is added to their enemies.   -- If no UI factions, their role is taken by the escapees (for testing).-  let diffBonusCoeff = difficultyCoeff sdifficultySer+  let diffBonusCoeff = difficultyCoeff scurDiffSer       hasUIorEscapes Faction{gplayer} =         fhasUI gplayer || nU == 0 && fcanEscape gplayer       boostFact = not bproj@@ -454,7 +453,7 @@   sb <- getsState $ getActorBody source   localTime <- getsState $ getLocalTime (blid sb)   -- For projectiles we need to accept even items without any effect,-  -- so that the projectile dissapears and NoEffect feedback is produced.+  -- so that the projectile dissapears and "No effect" feedback is produced.   let allAssocs = eqpAssocs ++ bodyAssocs       calm10 = calmEnough10 sb $ map snd allAssocs       forced = bproj sb
Game/LambdaHack/Server/DungeonGen.hs view
@@ -124,14 +124,14 @@       dcond kt = (cpassable                   || not (Tile.kindHasFeature TK.Walkable kt))                  && nightCond kt-      pickDefTile = (fromMaybe $ assert `failure` cdefTile)-                    <$> opick cdefTile dcond+      pickDefTile =+        fromMaybe (assert `failure` cdefTile) <$> opick cdefTile dcond       wcond kt = Tile.kindHasFeature TK.Walkable kt                  && nightCond kt       mpickWalkable =         if cpassable-        then Just $ (fromMaybe $ assert `failure` cdefTile)-                    <$> opick cdefTile wcond+        then Just+             $ fromMaybe (assert `failure` cdefTile) <$> opick cdefTile wcond         else Nothing   cmap <- convertTileMaps cops pickDefTile mpickWalkable cxsize cysize dmap   -- We keep two-way stairs separately, in the last component.@@ -153,8 +153,7 @@               posCur = nub $ sort $ map fst stairsCur           spos <- placeStairs cops cmap kc posCur           let legend = findLegend spos-          stairId <- (fromMaybe $ assert `failure` legend)-                     <$> opick legend cond+          stairId <- fromMaybe (assert `failure` legend) <$> opick legend cond           let st = (spos, stairId)               asc = ascendable $ okind stairId               desc = descendable $ okind stairId@@ -248,8 +247,7 @@ findGenerator cops ln minD maxD totalDepth nstairUp               (genName, escapeFeature) = do   let Kind.COps{cocave=Kind.Ops{opick}} = cops-  ci <- (fromMaybe $ assert `failure` genName)-        <$> opick genName (const True)+  ci <- fromMaybe (assert `failure` genName) <$> opick genName (const True)   -- A simple rule for now: level at level @ln@ has depth (difficulty) @abs ln@.   let ldepth = AbsDepth $ abs $ fromEnum ln   cave <- buildCave cops ldepth totalDepth ci
Game/LambdaHack/Server/HandleEffectServer.hs view
@@ -184,10 +184,11 @@   sb <- getsState $ getActorBody source   -- Announce no effect, which is rare and wastes time, so noteworthy.   unless (triggered  -- some effect triggered, so feedback comes from them-          || null effects  -- no effects present, no feedback needed           || periodic  -- don't spam from fizzled periodic effects           || bproj sb) $  -- don't spam, projectiles can be very numerous-    execSfxAtomic $ SfxEffect (bfid sb) target $ IK.NoEffect ""+    if null effects+    then execSfxAtomic $ SfxMsgFid (bfid sb) "Nothing happens."+    else execSfxAtomic $ SfxMsgFid (bfid sb) "It flashes and fizzles."   return triggered  -- | The source actor affects the target actor, with a given effect and power.@@ -215,8 +216,8 @@     IK.OverfillCalm p -> effectRefillCalm True execSfx p source target     IK.Dominate -> effectDominate recursiveCall source target     IK.Impress -> effectImpress source target-    IK.CallFriend p -> effectCallFriend p source target-    IK.Summon freqs p -> effectSummon freqs p source target+    IK.CallFriend p -> effectCallFriend execSfx p source target+    IK.Summon freqs p -> effectSummon execSfx freqs p source target     IK.Ascend p -> effectAscend recursiveCall execSfx p source target     IK.Escape{} -> effectEscape source target     IK.Paralyze p -> effectParalyze execSfx p target@@ -446,9 +447,9 @@  -- Note that the Calm expended doesn't depend on the number of actors called. effectCallFriend :: (MonadAtomic m, MonadServer m)-                   => Dice.Dice -> ActorId -> ActorId+                   => m () -> Dice.Dice -> ActorId -> ActorId                    -> m Bool-effectCallFriend nDm source target = do+effectCallFriend execSfx nDm source target = do   -- Obvious effect, nothing announced.   Kind.COps{cotile} <- getsState scops   power <- rndToAction $ castDice (AbsDepth 0) (AbsDepth 0) nDm@@ -465,6 +466,7 @@   else do     let deltaHP = - xM 10     execUpdAtomic $ UpdRefillHP target deltaHP+    execSfx     let validTile t = not $ Tile.hasFeature cotile TK.NoActor t     ps <- getsState $ nearbyFreePoints validTile (bpos tb) (blid tb)     time <- getsState $ getLocalTime (blid tb)@@ -477,9 +479,9 @@  -- Note that the Calm expended doesn't depend on the number of actors summoned. effectSummon :: (MonadAtomic m, MonadServer m)-             => Freqs ItemKind -> Dice.Dice -> ActorId -> ActorId+             => m () -> Freqs ItemKind -> Dice.Dice -> ActorId -> ActorId              -> m Bool-effectSummon actorFreq nDm source target = do+effectSummon execSfx actorFreq nDm source target = do   -- Obvious effect, nothing announced.   Kind.COps{cotile} <- getsState scops   power <- rndToAction $ castDice (AbsDepth 0) (AbsDepth 0) nDm@@ -496,6 +498,7 @@   else do     let deltaCalm = - xM 10     unless (bproj tb) $ udpateCalm target deltaCalm+    execSfx     let validTile t = not $ Tile.hasFeature cotile TK.NoActor t     ps <- getsState $ nearbyFreePoints validTile (bpos tb) (blid tb)     localTime <- getsState $ getLocalTime (blid tb)@@ -524,7 +527,6 @@              -> m Bool effectAscend recursiveCall execSfx k source target = do   b1 <- getsState $ getActorBody target-  ais1 <- getsState $ getCarriedAssocs b1   let lid1 = blid b1       pos1 = bpos b1   (lid2, pos2) <- getsState $ whereTo lid1 pos1 k . sdungeon@@ -538,13 +540,13 @@     -- We keep it useful even in shallow dungeons.     recursiveCall $ IK.Teleport 30  -- powerful teleport   else do-    let switch1 = void $ switchLevels1 ((target, b1), ais1)+    let switch1 = void $ switchLevels1 (target, b1)         switch2 = do           -- Make the initiator of the stair move the leader,           -- to let him clear the stairs for others to follow.           let mlead = Just target           -- Move the actor to where the inhabitants were, if any.-          switchLevels2 lid2 pos2 ((target, b1), ais1) mlead+          switchLevels2 lid2 pos2 (target, b1) mlead           -- Verify only one non-projectile actor on every tile.           !_ <- getsState $ posToActors pos1 lid1  -- assertion is inside           !_ <- getsState $ posToActors pos2 lid2  -- assertion is inside@@ -556,9 +558,9 @@       [] -> do         switch1         switch2-      ((_, b2), _) : _ -> do+      (_, b2) : _ -> do         -- Alert about the switch.-        let subjects = map (partActor . snd . fst) inhabitants+        let subjects = map (partActor . snd) inhabitants             subject = MU.WWandW subjects             verb = "be pushed to another level"             msg2 = makeSentence [MU.SubjectVerbSg subject verb]@@ -580,10 +582,8 @@     execSfx     return True -switchLevels1 :: MonadAtomic m-              => ((ActorId, Actor), [(ItemId, Item)])-              -> m (Maybe ActorId)-switchLevels1 ((aid, bOld), ais) = do+switchLevels1 :: MonadAtomic m => (ActorId, Actor) -> m (Maybe ActorId)+switchLevels1 (aid, bOld) = do   let side = bfid bOld   mleader <- getsState $ gleader . (EM.! side) . sfactionD   -- Prevent leader pointing to a non-existing actor.@@ -596,14 +596,14 @@   -- Remove the actor from the old level.   -- Onlookers see somebody disappear suddenly.   -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead.+  ais <- getsState $ getCarriedAssocs bOld   execUpdAtomic $ UpdLoseActor aid bOld ais   return mlead  switchLevels2 ::(MonadAtomic m, MonadServer m)-              => LevelId -> Point-              -> ((ActorId, Actor), [(ItemId, Item)]) -> Maybe ActorId+              => LevelId -> Point -> (ActorId, Actor) -> Maybe ActorId               -> m ()-switchLevels2 lidNew posNew ((aid, bOld), ais) mlead = do+switchLevels2 lidNew posNew (aid, bOld) mlead = do   let lidOld = blid bOld       side = bfid bOld   let !_A = assert (lidNew /= lidOld `blame` "stairs looped" `twith` lidNew) ()@@ -622,13 +622,14 @@       bNew = bOld { blid = lidNew                   , btime = shiftByDelta $ btime bOld                   , bpos = posNew-                  , boldpos = posNew  -- new level, new direction+                  , boldpos = Just posNew  -- new level, new direction                   , boldlid = lidOld  -- record old level                   , borgan = setTimeout $ borgan bOld                   , beqp = setTimeout $ beqp bOld }   -- Materialize the actor at the new location.   -- Onlookers see somebody appear suddenly. The actor himself   -- sees new surroundings and has to reset his perception.+  ais <- getsState $ getCarriedAssocs bOld   execUpdAtomic $ UpdCreateActor aid bNew ais   case mlead of     Nothing -> return ()@@ -869,7 +870,7 @@             <+> "pieces of this item, not by" <+> tshow itemK <> "."           return False         else if IK.Unique `elem` aspects then do-          execSfxAtomic $ SfxMsgFid (bfid sb) $+          execSfxAtomic $ SfxMsgFid (bfid sb)             "Unique items can't be repurposed."           return False         else do@@ -988,18 +989,19 @@                  => ActorId -> ActorId -> Maybe Bool -> m Vector sendFlyingVector source target modePush = do   sb <- getsState $ getActorBody source+  let boldpos_sb = fromMaybe (Point 0 0) (boldpos sb)   if source == target then-    if boldpos sb == bpos sb then rndToAction $ do+    if boldpos_sb == bpos sb then rndToAction $ do       z <- randomR (-10, 10)       oneOf [Vector 10 z, Vector (-10) z, Vector z 10, Vector z (-10)]     else-      return $! vectorToFrom (bpos sb) (boldpos sb)+      return $! vectorToFrom (bpos sb) boldpos_sb   else do     tb <- getsState $ getActorBody target     let (sp, tp) = if adjacent (bpos sb) (bpos tb)-                   then let pos = if chessDist (boldpos sb) (bpos tb)+                   then let pos = if chessDist boldpos_sb (bpos tb)                                      > chessDist (bpos sb) (bpos tb)-                                  then boldpos sb  -- avoid cardinal dir+                                  then boldpos_sb  -- avoid cardinal dir                                   else bpos sb                         in (pos, bpos tb)                    else (bpos sb, bpos tb)
Game/LambdaHack/Server/HandleRequestServer.hs view
@@ -9,7 +9,7 @@ -- influence the outcome of the evaluation. -- TODO: document module Game.LambdaHack.Server.HandleRequestServer-  ( handleRequestAI, handleRequestUI, reqMove+  ( handleRequestAI, handleRequestUI, reqMove, reqDisplace   ) where  import Control.Applicative@@ -23,7 +23,6 @@ import qualified Game.LambdaHack.Common.Ability as Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind@@ -72,7 +71,7 @@     handleRequestUI fid cmd2   ReqUIGameRestart aid t d names ->     return (Nothing, reqGameRestart aid t d names)-  ReqUIGameExit aid d -> return (Nothing, reqGameExit aid d)+  ReqUIGameExit aid -> return (Nothing, reqGameExit aid)   ReqUIGameSave -> return (Nothing, reqGameSave)   ReqUITactic toT -> return (Nothing, reqTactic fid toT)   ReqUIAutomate -> return (Nothing, reqAutomate fid)@@ -158,9 +157,9 @@   let spos = bpos sb           -- source position       tpos = spos `shift` dir  -- target position   -- We start by checking actors at the the target position.-  tgt <- getsState $ posToActor tpos lid+  tgt <- getsState $ posToActors tpos lid   case tgt of-    Just ((target, tb), _) | not (bproj sb && bproj tb) -> do  -- visible or not+    (target, tb) : _ | not (bproj sb && bproj tb) -> do  -- visible or not       -- Projectiles are too small to hit each other.       -- Attacking does not require full access, adjacency is enough.       -- Here the only weapon of projectiles is picked, too.@@ -261,8 +260,7 @@       tgts <- getsState $ posToActors tpos lid       case tgts of         [] -> assert `failure` (source, sb, target, tb)-        [_] -> do-          execUpdAtomic $ UpdDisplaceActor source target+        [_] -> execUpdAtomic $ UpdDisplaceActor source target         _ -> execFailure source req DisplaceProjectiles     else       -- Client foolishly tries to displace an actor without access.@@ -279,17 +277,21 @@ reqAlter source tpos mfeat = do   cops@Kind.COps{cotile=cotile@Kind.Ops{okind, opick}} <- getsState scops   sb <- getsState $ getActorBody source-  let lid = blid sb+  actorSk <- actorSkillsServer source+  let skill = EM.findWithDefault 0 Ability.AbAlter actorSk+      lid = blid sb       spos = bpos sb       req = ReqAlter tpos mfeat-  if not $ adjacent spos tpos then execFailure source req AlterDistant+  -- Only actors with AbAlter can search for hidden doors, etc.+  if skill < 1 then execFailure source req AlterUnskilled+  else if not $ adjacent spos tpos then execFailure source req AlterDistant   else do     lvl <- getLevel lid     let serverTile = lvl `at` tpos         freshClientTile = hideTile cops lvl tpos         changeTo tgroup = do           -- No @SfxAlter@, because the effect is obvious (e.g., opened door).-          toTile <- rndToAction $ (fromMaybe $ assert `failure` tgroup)+          toTile <- rndToAction $ fromMaybe (assert `failure` tgroup)                                   <$> opick tgroup (const True)           unless (toTile == serverTile) $ do             execUpdAtomic $ UpdAlterTile lid tpos serverTile toTile@@ -419,9 +421,14 @@            -> CStore     -- ^ whether the items comes from floor or inventory            -> m () reqProject source tpxy eps iid cstore = do-  mfail <- projectFail source tpxy eps iid cstore False   let req = ReqProject tpxy eps iid cstore-  maybe (return ()) (execFailure source req) mfail+  b <- getsState $ getActorBody source+  activeItems <- activeItemsServer source+  let calmE = calmEnough b activeItems+  if cstore == CSha && not calmE then execFailure source req ItemNotCalm+  else do+    mfail <- projectFail source tpxy eps iid cstore False+    maybe (return ()) (execFailure source req) mfail  -- * ReqApply @@ -432,21 +439,24 @@          -> m () reqApply aid iid cstore = do   let req = ReqApply iid cstore-  bag <- getsState $ getActorBag aid cstore-  case EM.lookup iid bag of-    Nothing -> execFailure aid req ApplyOutOfReach-    Just kit -> do-      itemToF <- itemToFullServer-      b <- getsState $ getActorBody aid-      activeItems <- activeItemsServer aid-      actorSk <- actorSkillsServer aid-      localTime <- getsState $ getLocalTime (blid b)-      let skill = EM.findWithDefault 0 Ability.AbApply actorSk-          itemFull = itemToF iid kit-          legal = permittedApply " " localTime skill itemFull b activeItems-      case legal of-        Left reqFail -> execFailure aid req reqFail-        Right _ -> applyItem aid iid cstore+  b <- getsState $ getActorBody aid+  activeItems <- activeItemsServer aid+  let calmE = calmEnough b activeItems+  if cstore == CSha && not calmE then execFailure aid req ItemNotCalm+  else do+    bag <- getsState $ getActorBag aid cstore+    case EM.lookup iid bag of+      Nothing -> execFailure aid req ApplyOutOfReach+      Just kit -> do+        itemToF <- itemToFullServer+        actorSk <- actorSkillsServer aid+        localTime <- getsState $ getLocalTime (blid b)+        let skill = EM.findWithDefault 0 Ability.AbApply actorSk+            itemFull = itemToF iid kit+            legal = permittedApply " " localTime skill itemFull b activeItems+        case legal of+          Left reqFail -> execFailure aid req reqFail+          Right _ -> applyItem aid iid cstore  -- * ReqTrigger @@ -487,11 +497,7 @@                => ActorId -> GroupName ModeKind -> Int -> [(Int, (Text, Text))]                -> m () reqGameRestart aid groupName d configHeroNames = do-  modifyServer $ \ser ->-    ser {sdebugNxt = (sdebugNxt ser) { sdifficultySer = d-                                     , sdebugCli = (sdebugCli (sdebugNxt ser))-                                                     {sdifficultyCli = d}-                                     }}+  modifyServer $ \ser -> ser {sdebugNxt = (sdebugNxt ser) {scurDiffSer = d}}   b <- getsState $ getActorBody aid   let fid = bfid b   oldSt <- getsState $ gquit . (EM.! fid) . sfactionD@@ -504,13 +510,8 @@  -- * ReqGameExit -reqGameExit :: (MonadAtomic m, MonadServer m) => ActorId -> Int -> m ()-reqGameExit aid d = do-  modifyServer $ \ser ->-    ser {sdebugNxt = (sdebugNxt ser) { sdifficultySer = d-                                     , sdebugCli = (sdebugCli (sdebugNxt ser))-                                                     {sdifficultyCli = d}-                                     }}+reqGameExit :: (MonadAtomic m, MonadServer m) => ActorId -> m ()+reqGameExit aid  = do   b <- getsState $ getActorBody aid   let fid = bfid b   oldSt <- getsState $ gquit . (EM.! fid) . sfactionD
Game/LambdaHack/Server/LoopServer.hs view
@@ -31,6 +31,7 @@ import Game.LambdaHack.Common.Response import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time+import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind@@ -95,18 +96,13 @@       reinitGame       writeSaveAll False   resetSessionStart-  -- Start a clip (a part of a turn for which one or more frames-  -- will be generated). Do whatever has to be done-  -- every fixed number of time units, e.g., monster generation.-  -- Run the leader and other actors moves. Eventually advance the time-  -- and repeat.-  let loop = do-        -- Note that if a faction enters dungeon on a level with no spawners,-        -- the faction won't cause spawning on its active arena-        -- as long as it has no leader. This may cause regeneration items-        -- of its opponents become overpowered and lead to micromanagement-        -- (make sure to kill all actors of the faction, go to a no-spawn-        -- level and heal fully with no risk nor cost).+  -- Note that if a faction enters dungeon on a level with no spawners,+  -- the faction won't cause spawning on its active arena+  -- as long as it has no leader. This may cause regeneration items+  -- of its opponents become overpowered and lead to micromanagement+  -- (make sure to kill all actors of the faction, go to a no-spawn+  -- level and heal fully with no risk nor cost).+  let arenasForLoop = do         let factionArena fact =               case gleader fact of                -- Even spawners need an active arena for their leader,@@ -122,17 +118,32 @@         marenas <- mapM factionArena $ EM.elems factionD         let arenas = ES.toList $ ES.fromList $ catMaybes marenas         let !_A = assert (not $ null arenas) ()  -- game over not caught earlier-        mapM_ handleActors arenas+        return $! arenas+  -- Start a clip (a part of a turn for which one or more frames+  -- will be generated). Do whatever has to be done+  -- every fixed number of time units, e.g., monster generation.+  -- Run the leader and other actors moves. Eventually advance the time+  -- and repeat.+  let loop arenasStart [] = do+        arenas <- arenasForLoop+        continue <- endClip arenasStart+        when continue (loop arenas arenas)+      loop arenasStart (arena : rest) = do+        handleActors arena         quit <- getsServer squit         if quit then do           -- In case of game save+exit or restart, don't age levels (endClip)           -- since possibly not all actors have moved yet.           modifyServer $ \ser -> ser {squit = False}-          endOrLoop loop (restartGame updConn loop) gameExit (writeSaveAll True)-        else do-          continue <- endClip arenas-          when continue loop-  loop+          let loopAgain = loop arenasStart (arena : rest)+          endOrLoop loopAgain+                    (restartGame updConn loopNew) gameExit (writeSaveAll True)+        else+          loop arenasStart rest+      loopNew = do+        arenas <- arenasForLoop+        loop arenas arenas+  loopNew  endClip :: (MonadAtomic m, MonadServer m, MonadServerReadRequest m)         => [LevelId] -> m Bool@@ -412,7 +423,14 @@           let toColor = Color.BrBlack           when (bcolor b /= toColor) $             execUpdAtomic $ UpdColorActor aid (bcolor b) toColor-        reqMove aid d  -- hit clears trajectory of non-projectiles in reqMelee+        -- Hit clears trajectory of non-projectiles in reqMelee so no need here.+        -- Non-projectiles displace, to make pushing in crowds less lethal+        -- and chaotic and to avoid hitting harpoons when pulled by them.+        let tpos = bpos b `shift` d  -- target position+        tgt <- getsState $ posToActors tpos (blid b)+        case tgt of+          [(target, _)] | not (bproj b) -> reqDisplace aid target+          _ -> reqMove aid d         b2 <- getsState $ getActorBody aid         unless (btrajectory b2 == Just (lv, speed)) $  -- cleared in reqMelee           execUpdAtomic $ UpdTrajectory aid (btrajectory b2) (Just (lv, speed))
Game/LambdaHack/Server/MonadServer.hs view
@@ -146,7 +146,7 @@   gameModeId <- getsState sgameModeId   time <- getsState stime   date <- liftIO getClockTime-  DebugModeSer{sdifficultySer} <- getsServer sdebugSer+  DebugModeSer{scurDiffSer} <- getsServer sdebugSer   factionD <- getsState sfactionD   bench <- getsServer $ sbenchmark . sdebugCli . sdebugSer   let path = dataDir </> scoresFile@@ -157,10 +157,10 @@           $ HighScore.showScore (pos, HighScore.getRecord pos ntable)         else           let nScoreDict = EM.insert gameModeId ntable scoreDict-          in when (worthMentioning) $+          in when worthMentioning $                liftIO $ encodeEOF path (nScoreDict :: HighScore.ScoreDict)-      diff | not $ fhasUI $ gplayer fact = difficultyDefault-           | otherwise = sdifficultySer+      diff | fhasUI $ gplayer fact = scurDiffSer+           | otherwise = difficultyInverse scurDiffSer       theirVic (fi, fa) | isAtWar fact fi                           && not (isHorrorFact fa) = Just $ gvictims fa                         | otherwise = Nothing
Game/LambdaHack/Server/PeriodicServer.hs view
@@ -206,8 +206,18 @@ advanceTime aid = do   b <- getsState $ getActorBody aid   activeItems <- activeItemsServer aid-  let t = ticksPerMeter $ bspeed b activeItems-  execUpdAtomic $ UpdAgeActor aid t+  localTime <- getsState $ getLocalTime (blid b)+  let halfActorTurn = timeDeltaDiv (ticksPerMeter $ bspeed b activeItems) 2+      -- Dead bodies stay around for only a half of standard turn,+      -- even if paralyzed.+      -- Projectiles that hit actors or are hit by actors vanish at once+      -- not to block actor's path, e.g., for Pull effect.+      t | bhp b <= 0 =+        let delta = Delta $ if bproj b then timeZero else timeTurn+            localPlusDelta = localTime `timeShift` delta+        in localPlusDelta `timeDeltaToFrom` btime b+        | otherwise = halfActorTurn+  execUpdAtomic $ UpdAgeActor aid t  -- @t@ may be negative; that's OK  -- | Swap the relative move times of two actors (e.g., when switching -- a UI leader).@@ -262,7 +272,7 @@     unless dominated $ do       newCalmDelta <- getsState $ regenCalmDelta b activeItems       let clearMark = 0-      unless (newCalmDelta <= 0) $+      unless (newCalmDelta == 0) $         -- Update delta for the current player turn.         udpateCalm aid newCalmDelta       unless (bcalmDelta b == ResDelta 0 0) $
Game/LambdaHack/Server/ProtocolServer.hs view
@@ -31,6 +31,7 @@ import Control.Monad import qualified Data.EnumMap.Strict as EM import Data.Key (mapWithKeyM, mapWithKeyM_)+import Data.Maybe import Game.LambdaHack.Common.Thread import System.IO.Unsafe (unsafePerformIO) @@ -164,9 +165,9 @@ killAllClients :: (MonadAtomic m, MonadServerReadRequest m) => m () killAllClients = do   d <- getDict-  let sendKill fid _ = do+  let sendKill fid cs = do         -- We can't check in sfactionD, because client can be from an old game.-        when (fromEnum fid > 0) $+        when (isJust $ fst cs) $           sendUpdateUI fid $ RespUpdAtomicUI $ UpdKillExit fid         sendUpdateAI fid $ RespUpdAtomicAI $ UpdKillExit fid   mapWithKeyM_ sendKill d
Game/LambdaHack/Server/StartServer.hs view
@@ -62,19 +62,18 @@ reinitGame = do   Kind.COps{coitem=Kind.Ops{okind}} <- getsState scops   pers <- getsServer sper-  knowMap <- getsServer $ sknowMap . sdebugSer-  sdebugCli <- getsServer $ sdebugCli . sdebugSer+  DebugModeSer{scurDiffSer, sknowMap, sdebugCli} <- getsServer sdebugSer   -- This state is quite small, fit for transmition to the client.   -- The biggest part is content, which needs to be updated   -- at this point to keep clients in sync with server improvements.   s <- getState-  let defLocal | knowMap = s+  let defLocal | sknowMap = s                | otherwise = localFromGlobal s   discoS <- getsServer sdiscoKind   let sdiscoKind = let f ik = IK.Identified `elem` IK.ifeature (okind ik)                in EM.filter f discoS   broadcastUpdAtomic-    $ \fid -> UpdRestart fid sdiscoKind (pers EM.! fid) defLocal sdebugCli+    $ \fid -> UpdRestart fid sdiscoKind (pers EM.! fid) defLocal scurDiffSer sdebugCli   populateDungeon  mapFromFuns :: (Bounded a, Enum a, Ord b) => [a -> b] -> M.Map b a@@ -288,7 +287,7 @@ addHero bfid ppos lid heroNames mNumber time = do   Faction{gcolor, gplayer} <- getsState $ (EM.! bfid) . sfactionD   let groupName = fgroup gplayer-  mhs <- mapM (\n -> getsState $ tryFindHeroK bfid n) [0..9]+  mhs <- mapM (getsState . tryFindHeroK bfid) [0..9]   let freeHeroK = elemIndex Nothing mhs       n = fromMaybe (fromMaybe 100 freeHeroK) mNumber       bsymbol = if n < 1 || n > 9 then '@' else Char.intToDigit n
Game/LambdaHack/Server/State.hs view
@@ -84,7 +84,7 @@   , smainRng       :: !(Maybe R.StdGen)   , sfovMode       :: !(Maybe FovMode)   , snewGameSer    :: !Bool-  , sdifficultySer :: !Int+  , scurDiffSer    :: !Int   , sdumpInitRngs  :: !Bool   , ssavePrefixSer :: !(Maybe String)   , sdbgMsgSer     :: !Bool@@ -150,7 +150,7 @@                                , smainRng = Nothing                                , sfovMode = Nothing                                , snewGameSer = False-                               , sdifficultySer = difficultyDefault+                               , scurDiffSer = difficultyDefault                                , sdumpInitRngs = False                                , ssavePrefixSer = Nothing                                , sdbgMsgSer = False@@ -225,7 +225,7 @@     put sgameMode     put sautomateAll     put skeepAutomated-    put sdifficultySer+    put scurDiffSer     put sfovMode     put ssavePrefixSer     put sdbgMsgSer@@ -239,7 +239,7 @@     sgameMode <- get     sautomateAll <- get     skeepAutomated <- get-    sdifficultySer <- get+    scurDiffSer <- get     sfovMode <- get     ssavePrefixSer <- get     sdbgMsgSer <- get
GameDefinition/Client/UI/Content/KeyKind.hs view
@@ -1,4 +1,4 @@--- | The default game key-command mapping to be used for UI. Can be overriden+-- | The default game key-command mapping to be used for UI. Can be overridden -- via macros in the config file. module Client.UI.Content.KeyKind ( standardKeys ) where @@ -23,11 +23,16 @@        -- Main Menu, which apart of these includes a few extra commands       [ ("CTRL-x", ([CmdMenu], GameExit))-      , ("CTRL-u", ([CmdMenu], GameRestart "duel"))+      , ("CTRL-r", ([CmdMenu], GameRestart "raid"))       , ("CTRL-k", ([CmdMenu], GameRestart "skirmish"))       , ("CTRL-m", ([CmdMenu], GameRestart "ambush"))       , ("CTRL-b", ([CmdMenu], GameRestart "battle"))-      , ("CTRL-n", ([CmdMenu], GameRestart "campaign"))+      , ("CTRL-c", ([CmdMenu], GameRestart "campaign"))+      , ("CTRL-i", ([CmdDebug], GameRestart "battle survival"))+      , ("CTRL-f", ([CmdDebug], GameRestart "safari"))+      , ("CTRL-u", ([CmdDebug], GameRestart "safari survival"))+      , ("CTRL-e", ([CmdDebug], GameRestart "defense"))+      , ("CTRL-g", ([CmdDebug], GameRestart "boardgame"))       , ("CTRL-d", ([CmdMenu], GameDifficultyCycle))        -- Movement and terrain alteration@@ -188,12 +193,7 @@       , ("RightButtonPress", ([CmdMouse], TgtPointerEnemy))        -- Debug and others not to display in help screens-      , ("CTRL-s", ([CmdDebug], GameSave))-      , ("CTRL-i", ([CmdDebug], GameRestart "battle survival"))-      , ("CTRL-f", ([CmdDebug], GameRestart "safari"))-      , ("CTRL-r", ([CmdDebug], GameRestart "safari survival"))-      , ("CTRL-e", ([CmdDebug], GameRestart "defense"))-      , ("CTRL-g", ([CmdDebug], GameRestart "boardgame"))+      , ("CTRL-S", ([CmdDebug], GameSave))       , ("CTRL-semicolon", ([CmdInternal], MoveOnceToCursor))       , ("CTRL-colon", ([CmdInternal], RunOnceToCursor))       , ("CTRL-period", ([CmdInternal], ContinueToCursor))
GameDefinition/Content/CaveKind.hs view
@@ -16,9 +16,9 @@   , validateSingle = validateSingleCaveKind   , validateAll = validateAllCaveKind   , content =-      [rogue, arena, empty, noise, shallow1rogue, battle, skirmish, ambush, safari1, safari2, safari3, boardgame]+      [rogue, arena, empty, noise, shallow1rogue, battle, skirmish, ambush, safari1, safari2, safari3, rogueLit, boardgame]   }-rogue,        arena, empty, noise, shallow1rogue, battle, skirmish, ambush, safari1, safari2, safari3, boardgame :: CaveKind+rogue,        arena, empty, noise, shallow1rogue, battle, skirmish, ambush, safari1, safari2, safari3, rogueLit, boardgame :: CaveKind  rogue = CaveKind   { csymbol       = 'R'@@ -87,12 +87,12 @@   , chidden       = 1000   , cactorCoeff   = 3   , cactorFreq    = [("monster", 2), ("animal", 8), ("immobile vents", 90)]-      -- The geysers on lvl 3 act like HP resets. They are needed to avoid+      -- The healing geysers on lvl 3 act like HP resets. They are needed to avoid       -- cascading failure, if the particular starting conditions were       -- very hard. The items are not reset, even if the are bad, which provides       -- enough of a continuity. Gyesers on lvl 3 are not OP and can't be-      -- abused, because they spawn less and less often, they don't heal over-      -- max HP and they expire naturally.+      -- abused, because they spawn less and less often and they don't heal over+      -- max HP.   , citemNum      = 7 * d 2  -- few rooms   , cpassable     = True   , cdefTile      = "emptySet"@@ -199,6 +199,17 @@ safari1 = ambush {cfreq = [("caveSafari1", 1)]} safari2 = battle {cfreq = [("caveSafari2", 1)]} safari3 = skirmish {cfreq = [("caveSafari3", 1)]}+rogueLit = rogue+  { csymbol       = 'S'+  , cname         = "Typing den"+  , cfreq         = [("caveRogueLit", 1)]+  , cdarkChance   = 0+  , cmaxVoid      = 1%10+  , cactorCoeff   = 1000  -- deep level with no eqp, so slow spawning+  , cactorFreq    = [("animal", 100)]+  , citemNum      = 30 * d 2  -- just one level, hard enemies, treasure+  , citemFreq     = [("useful", 33), ("gem", 33), ("currency", 33)]+  } boardgame = CaveKind   { csymbol       = 'B'   , cname         = "A boardgame"
GameDefinition/Content/ItemKind.hs view
@@ -121,7 +121,7 @@   , iweight  = 4000   , iaspects = [AddHurtRanged (d 2 + dl 5 |*| 20)]   , ieffects = [Hurt (4 * d 1), PullActor (ThrowMod 200 50)]-  , ifeature = []+  , ifeature = [Identified]   , idesc    = "The cruel, barbed head lodges in its victim so painfully that the weakest tug of the thin line sends the victim flying."   , ikit     = []   }@@ -256,7 +256,7 @@   , iweight  = 30   , iaspects = [ Unique                , Periodic-               , Timeout $ d 3 + 3 - dl 3 |*| 10+               , Timeout $ 1 + d 2                , AddArmorMelee $ 2 + d 3                , AddArmorRanged $ 2 + d 3 ]   , ieffects = [Recharging (RefillCalm 1)]@@ -373,26 +373,28 @@   } ring1 = ring   { irarity  = [(10, 2)]-  , iaspects = [AddSpeed $ d 2, AddMaxHP $ dl 5 - 5 - d 5]+  , iaspects = [AddSpeed $ 1 + d 2, AddMaxHP $ dl 7 - 7 - d 7]   , ieffects = [Explode "distortion"]  -- strong magic   , ifeature = ifeature ring ++ [EqpSlot EqpSlotAddSpeed ""]   } ring2 = ring-  { iaspects = [AddMaxHP $ 10 + dl 10, AddMaxCalm $ dl 5 - 20 - d 5]+  { irarity  = [(10, 5)]+  , iaspects = [AddMaxHP $ 10 + dl 10, AddMaxCalm $ dl 5 - 20 - d 5]   , ifeature = ifeature ring ++ [EqpSlot EqpSlotAddMaxHP ""]   } ring3 = ring-  { iaspects = [AddMaxCalm $ 15 + dl 15]+  { irarity  = [(10, 5)]+  , iaspects = [AddMaxCalm $ 29 + dl 10]   , ifeature = ifeature ring ++ [EqpSlot EqpSlotAddMaxCalm ""]   , idesc    = "Cold, solid to the touch, perfectly round, engraved with solemn, strangely comforting, worn out words."   } ring4 = ring-  { irarity  = [(3, 6), (10, 6)]+  { irarity  = [(3, 3), (10, 5)]   , iaspects = [AddHurtMelee $ d 5 + dl 5 |*| 3, AddMaxHP $ dl 3 - 5 - d 3]   , ifeature = ifeature ring ++ [EqpSlot EqpSlotAddHurtMelee ""]   } ring5 = ring  -- by the time it's found, probably no space in eqp-  { irarity  = [(5, 0), (10, 1)]+  { irarity  = [(5, 0), (10, 2)]   , iaspects = [AddLight $ d 2]   , ieffects = [Explode "distortion"]  -- strong magic   , ifeature = ifeature ring ++ [EqpSlot EqpSlotAddLight ""]@@ -945,7 +947,7 @@ gem = ItemKind   { isymbol  = symbolGem   , iname    = "gem"-  , ifreq    = [("treasure", 100), ("gem", 1)]+  , ifreq    = [("treasure", 100), ("gem", 100)]   , iflavour = zipPlain $ delete BrYellow brightCol  -- natural, so not fancy   , icount   = 1   , irarity  = []@@ -980,7 +982,7 @@ currency = ItemKind   { isymbol  = symbolGold   , iname    = "gold piece"-  , ifreq    = [("treasure", 100), ("currency", 1)]+  , ifreq    = [("treasure", 100), ("currency", 100)]   , iflavour = zipPlain [BrYellow]   , icount   = 10 + d 20 + dl 20   , irarity  = [(1, 25), (10, 10)]
GameDefinition/Content/ItemKindActor.hs view
@@ -54,9 +54,9 @@   , ifreq    = [("sniper", 100), ("mobile", 1)]   , ikit     = ikit warrior                ++ [ ("ring of opportunity sniper", CEqp)-                  , ("any arrow", CInv), ("any arrow", CInv)+                  , ("any arrow", CSha), ("any arrow", CInv)                   , ("any arrow", CInv), ("any arrow", CInv)-                  , ("flask", CInv), ("light source", CInv)+                  , ("flask", CInv), ("light source", CSha)                   , ("light source", CInv), ("light source", CInv) ]   } @@ -142,7 +142,7 @@   , idesc    = "An arm strung like a bow. A few edges, but none keen enough. A few points, but none piercing. Deadly objects zip out of the void."   , ikit     = [ ("speed gland 4", COrgan), ("armored skin", COrgan)                , ("vision 14", COrgan)-               , ("any arrow", CInv), ("any arrow", CInv)+               , ("any arrow", CSha), ("any arrow", CInv)                , ("any arrow", CInv), ("any arrow", CInv)                , ("sapient brain", COrgan) ]   }@@ -207,7 +207,7 @@   , ifeature = [Durable, Identified]   , idesc    = ""   , ikit     = [ ("screeching beak", COrgan)  -- in reality it grunts and hisses-               , ("claw", COrgan), ("eye 6", COrgan)+               , ("small claw", COrgan), ("eye 6", COrgan)                , ("animal brain", COrgan) ]   } skunk = ItemKind@@ -238,7 +238,7 @@   , irarity  = [(1, 5)]   , iverbHit = "thud"   , iweight  = 80000-  , iaspects = [ AddMaxHP 30, AddMaxCalm 30, AddSpeed 18+  , iaspects = [ AddMaxHP 20, AddMaxCalm 30, AddSpeed 17                , AddSkills $ EM.singleton AbAlter (-1) ]   , ieffects = []   , ifeature = [Durable, Identified]@@ -262,7 +262,7 @@   , ifeature = [Durable, Identified]   , idesc    = ""   , ikit     = [ ("venom tooth", COrgan), ("small claw", COrgan)-               , ("eye 5", COrgan), ("nostril", COrgan)+               , ("eye 2", COrgan), ("nostril", COrgan)                , ("animal brain", COrgan) ]   } rattlesnake = ItemKind@@ -271,7 +271,7 @@   , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Brown]   , icount   = 1-  , irarity  = [(3, 3), (10, 5)]+  , irarity  = [(4, 1), (10, 7)]   , iverbHit = "thud"   , iweight  = 80000   , iaspects = [ AddMaxHP 25, AddMaxCalm 60, AddSpeed 15@@ -280,7 +280,7 @@   , ifeature = [Durable, Identified]   , idesc    = ""   , ikit     = [ ("venom fang", COrgan)-               , ("eye 5", COrgan), ("nostril", COrgan)+               , ("eye 3", COrgan), ("nostril", COrgan)                , ("animal brain", COrgan) ]   } komodoDragon = ItemKind  -- bad hearing; regeneration makes it very powerful@@ -363,7 +363,7 @@   , ifreq    = [("animal", 100), ("horror", 100)]   , iflavour = zipPlain [Brown]   , icount   = 1-  , irarity  = [(1, 3), (10, 6)]+  , irarity  = [(1, 2), (10, 4)]   , iverbHit = "thud"   , iweight  = 1000   , iaspects = [ AddMaxHP 8, AddMaxCalm 60, AddSpeed 30@@ -380,7 +380,7 @@   , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Magenta]   , icount   = 1-  , irarity  = [(5, 1), (10, 10)]+  , irarity  = [(5, 1), (10, 8)]   , iverbHit = "thud"   , iweight  = 1000   , iaspects = [ AddMaxHP 8, AddMaxCalm 60, AddSpeed 30
GameDefinition/Content/ItemKindOrgan.hs view
@@ -127,8 +127,8 @@   , ifreq    = [("lash", 100)]   , icount   = 1   , iverbHit = "lash"-  , iaspects = [Timeout $ 3 + d 3]-  , ieffects = [Hurt (3 * d 1), Recharging $ DropItem COrgan "far-sighted" True]+  , iaspects = []+  , ieffects = [Hurt (3 * d 1)]   , idesc    = ""   } noseTip = fist@@ -142,11 +142,11 @@ lip = fist   { iname    = "lip"   , ifreq    = [("lip", 10)]-  , icount   = 2+  , icount   = 1   , iverbHit = "lap"   , iaspects = [Timeout $ 3 + d 3]   , ieffects = [ Hurt (1 * d 1)-               , Recharging $ DropItem COrgan "keen-smelling" True ]+               , Recharging (toOrganGameTurn "weakened" (2 + d 2)) ]   , idesc    = ""   } torsionRight = fist@@ -208,7 +208,7 @@   , icount   = 1   , iverbHit = "sting"   , iaspects = [AddArmorMelee 90, AddArmorRanged 90]-  , ieffects = [Burn $ 2 * d 1, Paralyze 10, RefillHP 5]+  , ieffects = [Burn $ 2 * d 1, Paralyze 3, RefillHP 5]   , ifeature = [Identified]  -- not Durable   , idesc    = "Painful, but beneficial."   }@@ -218,7 +218,7 @@   , icount   = 1   , iverbHit = "sting"   , iaspects = [Timeout $ 1 + d 5]-  , ieffects = [Burn $ 1 * d 1, Recharging (Paralyze 3)]+  , ieffects = [Burn $ 2 * d 1, Recharging (Paralyze 2)]   , idesc    = "Painful, debilitating and harmful."   } venomTooth = fist@@ -334,7 +334,7 @@   , ifreq    = [("nostril", 100)]   , icount   = 2   , iverbHit = "snuff"-  , iaspects = [AddSmell 2]+  , iaspects = [AddSmell 1]  -- times 2, from icount   , idesc    = ""   } @@ -387,7 +387,7 @@ scentGland = armoredSkin  -- TODO: cone attack, 3m away, project? apply?   { iname    = "scent gland"   , ifreq    = [("scent gland", 100)]-  , icount   = 2+  , icount   = 1   , iverbHit = "spray at"   , iaspects = [Periodic, Timeout $ 10 + d 2 |*| 5 ]   , ieffects = [ Recharging (Explode "distressing odor")
GameDefinition/Content/ModeKind.hs view
@@ -17,12 +17,12 @@   , validateSingle = validateSingleModeKind   , validateAll = validateAllModeKind   , content =-      [campaign, duel, skirmish, ambush, battle, battleSurvival, safari, safariSurvival, pvp, coop, defense, screensaver, boardgame]+      [campaign, raid, skirmish, ambush, battle, battleSurvival, safari, safariSurvival, pvp, coop, defense, screensaver, boardgame]   }-campaign,        duel, skirmish, ambush, battle, battleSurvival, safari, safariSurvival, pvp, coop, defense, screensaver, boardgame :: ModeKind+campaign,        raid, skirmish, ambush, battle, battleSurvival, safari, safariSurvival, pvp, coop, defense, screensaver, boardgame :: ModeKind  campaign = ModeKind-  { msymbol = 'n'+  { msymbol = 'c'   , mname   = "campaign"   , mfreq   = [("campaign", 1)]   , mroster = rosterCampaign@@ -30,13 +30,13 @@   , mdesc   = "Don't let wanton curiosity, greed and the creeping abstraction madness keep you down there in the darkness for too long!"   } -duel = ModeKind-  { msymbol = 'u'-  , mname   = "duel"-  , mfreq   = [("duel", 1)]-  , mroster = rosterDuel-  , mcaves  = cavesSkirmish-  , mdesc   = "You disagreed about the premises of a relative completeness theorem and there's only one way to settle that."+raid = ModeKind+  { msymbol = 'r'+  , mname   = "raid"+  , mfreq   = [("raid", 1)]+  , mroster = rosterRaid+  , mcaves  = cavesRaid+  , mdesc   = "An incredibly advanced typing machine worth 100 gold is buried at the other end of this maze. Be the first to claim it and fund a research team that will make typing accurate and dependable forever."   }  skirmish = ModeKind@@ -45,7 +45,7 @@   , mfreq   = [("skirmish", 1)]   , mroster = rosterSkirmish   , mcaves  = cavesSkirmish-  , mdesc   = "The scoring system of a programming contest fails to determine the winning team and participants take matters into their own hands."+  , mdesc   = "Your type theory research teams disagreed about the premises of a relative completeness theorem and there's only one way to settle that."   }  ambush = ModeKind@@ -85,7 +85,7 @@   }  safariSurvival = ModeKind-  { msymbol = 'n'+  { msymbol = 'u'   , mname   = "safari survival"   , mfreq   = [("safari survival", 1)]   , mroster = rosterSafariSurvival@@ -122,11 +122,12 @@  screensaver = safari   { mname   = "safari screensaver"-  , mfreq   = [("screensaver", 1), ("starting", 1)]+  , mfreq   = [("starting", 1)]   , mroster = rosterSafari       { rosterList = (head (rosterList rosterSafari))                        -- changing leader by client needed, because of TFollow-                       {fleaderMode = LeaderAI $ AutoLeader True False}+                       -- changing level by client enabled for UI+                       {fleaderMode = LeaderAI $ AutoLeader False False}                      : tail (rosterList rosterSafari)       }   }@@ -141,7 +142,7 @@   }  -rosterCampaign, rosterDuel, rosterSkirmish, rosterAmbush, rosterBattle, rosterBattleSurvival, rosterSafari, rosterSafariSurvival, rosterPvP, rosterCoop, rosterDefense, rosterBoardgame:: Roster+rosterCampaign, rosterRaid, rosterSkirmish, rosterAmbush, rosterBattle, rosterBattleSurvival, rosterSafari, rosterSafariSurvival, rosterPvP, rosterCoop, rosterDefense, rosterBoardgame:: Roster  rosterCampaign = Roster   { rosterList = [ playerHero@@ -151,22 +152,22 @@                   , ("Adventurer Party", "Animal Kingdom") ]   , rosterAlly = [("Monster Hive", "Animal Kingdom")] } -rosterDuel = Roster+rosterRaid = Roster   { rosterList = [ playerHero { fname = "White Recursive"-                              , fhiCondPoly = hiDweller-                              , fentryLevel = -3+                              , fhiCondPoly = hiRaid+                              , fentryLevel = -4                               , finitialActors = 1 }                  , playerAntiHero { fname = "Red Iterative"-                                  , fhiCondPoly = hiDweller-                                  , fentryLevel = -3+                                  , fhiCondPoly = hiRaid+                                  , fentryLevel = -4                                   , finitialActors = 1 }-                 , playerHorror ]-  , rosterEnemy = [ ("White Recursive", "Red Iterative")-                  , ("White Recursive", "Horror Den")-                  , ("Red Iterative", "Horror Den") ]+                 , playerAnimal { fentryLevel = -4+                                , finitialActors = 2 } ]+  , rosterEnemy = [ ("White Recursive", "Animal Kingdom")+                  , ("Red Iterative", "Animal Kingdom") ]   , rosterAlly = [] } -rosterSkirmish = rosterDuel+rosterSkirmish = Roster   { rosterList = [ playerHero { fname = "White Haskell"                               , fhiCondPoly = hiDweller                               , fentryLevel = -3 }@@ -176,9 +177,10 @@                  , playerHorror ]   , rosterEnemy = [ ("White Haskell", "Purple Agda")                   , ("White Haskell", "Horror Den")-                  , ("Purple Agda", "Horror Den") ] }+                  , ("Purple Agda", "Horror Den") ]+  , rosterAlly = [] } -rosterAmbush = rosterDuel+rosterAmbush = Roster   { rosterList = [ playerSniper { fname = "Yellow Idris"                                 , fhiCondPoly = hiDweller                                 , fentryLevel = -5@@ -190,7 +192,8 @@                  , playerHorror {fentryLevel = -5} ]   , rosterEnemy = [ ("Yellow Idris", "Blue Epigram")                   , ("Yellow Idris", "Horror Den")-                  , ("Blue Epigram", "Horror Den") ] }+                  , ("Blue Epigram", "Horror Den") ]+  , rosterAlly = [] }  rosterBattle = Roster   { rosterList = [ playerSoldier { fhiCondPoly = hiDweller@@ -259,10 +262,10 @@                  , playerAnimalExquisite                  ]   , rosterEnemy = [ ("Monster Tourist Office", "Hunam Convict Pack")-                  , ("Monster Tourist Office",-                     "Animal Magnificent Specimen Variety")-                  , ("Monster Tourist Office",-                     "Animal Exquisite Herds and Packs") ]+                  , ( "Monster Tourist Office"+                    , "Animal Magnificent Specimen Variety")+                  , ( "Monster Tourist Office"+                    , "Animal Exquisite Herds and Packs") ]   , rosterAlly = [ ( "Animal Magnificent Specimen Variety"                    , "Animal Exquisite Herds and Packs" )                  , ( "Animal Magnificent Specimen Variety"@@ -298,20 +301,14 @@   { rosterList = [ playerAntiHero { fname = "Coral" }                  , playerAntiHero { fname = "Amber"                                   , fleaderMode = LeaderNull }-                 , playerAntiHero { fname = "Green" }                  , playerAnimal { fhasUI = True }+                 , playerAnimal                  , playerMonster                  , playerMonster { fname = "Leaderless Monster Hive"                                  , fleaderMode = LeaderNull } ]   , rosterEnemy = [ ("Coral", "Monster Hive")-                  , ("Amber", "Monster Hive")-                  , ("Animal Kingdom", "Leaderless Monster Hive") ]-  , rosterAlly = [ ("Coral", "Amber")-                 , ("Coral", "Green")-                 , ("Amber", "Green")-                 , ("Green", "Animal Kingdom")-                 , ("Green", "Monster Hive")-                 , ("Green", "Leaderless Monster Hive") ] }+                  , ("Amber", "Monster Hive") ]+  , rosterAlly = [ ("Coral", "Amber") ] }  rosterDefense = rosterCampaign   { rosterList = [ playerAntiHero@@ -333,7 +330,7 @@                   , ("Red", "Horror Den") ]   , rosterAlly = [] } -cavesCampaign, cavesSkirmish, cavesAmbush, cavesBattle, cavesSafari, cavesBoardgame :: Caves+cavesCampaign, cavesRaid, cavesSkirmish, cavesAmbush, cavesBattle, cavesSafari, cavesBoardgame :: Caves  cavesCampaign = IM.fromList                 $ [ (-1, ("shallow random 1", Just True))@@ -341,6 +338,8 @@                   , (-3, ("caveEmpty", Nothing)) ]                   ++ zip [-4, -5..(-9)] (repeat ("campaign random", Nothing))                   ++ [(-10, ("caveNoise", Nothing))]++cavesRaid = IM.fromList [(-4, ("caveRogueLit", Just True))]  cavesSkirmish = IM.fromList [(-3, ("caveSkirmish", Nothing))] 
GameDefinition/Content/ModeKindPlayer.hs view
@@ -5,10 +5,9 @@   , playerMonster, playerMobileMonster, playerAntiMonster   , playerAnimal, playerMobileAnimal   , playerHorror-  , hiHero, hiDweller+  , hiHero, hiDweller, hiRaid   ) where -import qualified Data.EnumMap.Strict as EM import Data.List  import Game.LambdaHack.Common.Ability@@ -117,7 +116,7 @@  -- | A special player, for summoned actors that don't belong to any -- of the main players of a given game. E.g., animals summoned during--- a duel game between two hero players land in the horror faction.+-- a skirmish game between two hero factions land in the horror faction. -- In every game, either all factions for which summoning items exist -- should be present or a horror player should be added to host them. -- Actors that can be summoned should have "horror" in their @ifreq@ set.@@ -140,7 +139,7 @@ victoryOutcomes :: [Outcome] victoryOutcomes = [Conquer, Escape] -hiHero, hiDweller :: HiCondPoly+hiHero, hiDweller, hiRaid :: HiCondPoly  -- Heroes rejoice in loot. hiHero = [ ( [(HiLoot, 1)]@@ -161,12 +160,8 @@               , [minBound..maxBound] \\ victoryOutcomes )             ] -minusTen, meleeAdjacent, _meleeAndRanged :: Skills---- To make sure only a lot of weak items can override move-only-leader, etc.-minusTen = EM.fromList $ zip [minBound..maxBound] [-10, -10..]--meleeAdjacent = EM.delete AbWait $ EM.delete AbMelee minusTen---- Melee and reaction fire.-_meleeAndRanged = EM.delete AbProject $ meleeAdjacent+hiRaid = [ ( [(HiLoot, 1)]+           , [minBound..maxBound] )+         , ( [(HiConst, 100)]+           , victoryOutcomes )+         ]
GameDefinition/Main.hs view
@@ -1,4 +1,5 @@ -- | The main source code file of LambdaHack the game.+-- Module "TieKnot" is separated to make it usable in tests. module Main ( main ) where  import System.Environment (getArgs)
GameDefinition/PLAYING.md view
@@ -28,7 +28,7 @@ and his attributes are displayed at the bottommost status line, which in its most complex form may look as follows. -    *@12 Adventurer  4d1+5% Calm: 20/60 HP: 33/50 Target: basilisk  [**___]+    *@12 Adventurer  4d1+5% Calm: 20/60 HP: 33/50 Target: basilisk  [**__]  The line starts with the list of party members (unless there's only one member) and the shortened name of the team. Clicking on the list selects heroes and@@ -61,7 +61,7 @@ Dungeon ------- -The dungeon of any particular scenario may consists of one or many+The dungeon of any particular scenario may consist of one or many levels and each level consists of a large number of tiles. The basic tile kinds are as follows. @@ -95,7 +95,7 @@                  /|\            /|\            /|\                 1 2 3          j k l          b j n -In aiming mode (KEYPAD_* or \) the same keys (or the middle and right+In aiming mode (`KEYPAD_*` or `\`) the same keys (or the middle and right mouse buttons) move the crosshair (the white box). In normal mode, `SHIFT` (or `CTRL`) and a movement key make the current party leader run in the indicated direction, until anything of interest is spotted.@@ -109,8 +109,8 @@ Few commands other than movement, 'g'etting an item from the floor, 'a'pplying an item and 'f'linging an item are necessary for casual play. Some are provided only as specialized versions of the more general-commands or as building blocks for more complex convenience macros,-e.g., the autoexplore command (key `X`) could be defined+commands or as building blocks for more complex convenience macros.+E.g., the autoexplore command (key `X`) could be defined by the player as a macro using `CTRL-?`, `CTRL-.` and `V`.  The following minimal command set lets you accomplish almost anything@@ -133,12 +133,11 @@         ESC             cancel action, open Main Menu  The only activity not possible with the commands above is the management-of non-leader party members. The defaults should usually suffice,-especially if your non-leader heroes can only melee or wait-and none have found the equipment that enables opportunity fire.-If there's a need, you can manually set party tactics with `CTRL-T`-and you can assign individual targets to party members-using the aiming and targeting commands listed below.+of non-leader party members. You don't need it, unless your non-leader actors+can move or fire opportunistically (via innate skills or rare equipment).+If really needed, you can manually set party tactics with `CTRL-T`+and you can assign individual targets to party members using the aiming+and targeting commands listed below.          keys            command         KEYPAD_* or \   aim at an enemy@@ -167,7 +166,7 @@ Commands for saving and exiting the current game, starting a new game, etc., are listed in the Main Menu, brought up by the `ESC` key. Game difficulty setting affects hitpoints at birth for any actors-of any UI-using faction. For a person new to roguelikes, the Duel scenario+of any UI-using faction. For a person new to roguelikes, the Raid scenario offers a gentle introduction. The subsequent game modes gradually introduce squad combat, stealth, opportunity fire, asymmetric battles and more. @@ -222,10 +221,11 @@ your score is based on the gold and precious gems you've plundered. In the latter case, your score is based on the number of turns you spent overcoming your foes (the quicker the victory, the better; the slower-the demise, the better). Bonus points, based on the number of heroes-that were lost, are awarded if you win.+the demise, the better). Bonus points, based on the number of heroes lost,+are awarded if you win. -If all your heroes fall, you will invariably see a new foolhardy party-of adventurers clamoring to be led into the dungeon. They start+When all your heroes fall, you are going to invariably see a new foolhardy+party of adventurers clamoring to be led into the dungeon. They start their conquest from a new entrance, with no experience and no equipment,-and new, undaunted enemies bar their way. Lead them with fortitude!+and new, undaunted enemies bar their way. Lead the new hopeful explorers+with wisdom and fortitude!
GameDefinition/config.ui.default view
@@ -31,9 +31,10 @@ movementViKeys_hjklyubn = False movementLaptopKeys_uk8o79jl = True ; Monospace fonts that have fixed size regardless of boldness (on some OSes)-font = "Terminus,DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace normal normal normal normal 16"-;font = "Terminus,DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace normal normal normal normal 20"+font = "Terminus,DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace normal normal normal normal 14"+;font = "Terminus,DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace normal normal normal normal 18" colorIsBold = True+; New historyMax takes effect after removal of savefiles. historyMax = 5000 maxFps = 30 noAnim = False
GameDefinition/scores view

binary file changed (80 → 903 bytes)

LambdaHack.cabal view
@@ -2,16 +2,16 @@ -- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy--- PVP summary: +-+------- breaking API changes---              | | +----- non-breaking API additions---              | | |   +--- code changes with no API change-version:        0.4.101.1-synopsis:       A game engine library for roguelike dungeon crawlers+-- PVP summary:+-+------- breaking API changes+--             | | +----- non-breaking API additions+--             | | | +--- code changes with no API change+version:       0.5.0.0+synopsis:      A game engine library for roguelike dungeon crawlers description:   LambdaHack is a game engine library for roguelike games                of arbitrary theme, size and complexity,                packaged together with a small example dungeon crawler.                .-               <<https://raw.githubusercontent.com/LambdaHack/media/master/screenshot/skirmish1.png>>+               <<https://raw.githubusercontent.com/LambdaHack/media/master/screenshot/safari1.png>>                .                When completed, the engine will let you specify content                to be procedurally generated, define the AI behaviour@@ -52,12 +52,11 @@ bug-reports:   http://github.com/LambdaHack/LambdaHack/issues license:       BSD3 license-file:  LICENSE-tested-with:   GHC == 7.6, GHC == 7.8+tested-with:   GHC == 7.6, GHC == 7.8, GHC == 7.10 data-files:    GameDefinition/config.ui.default, GameDefinition/scores                GameDefinition/PLAYING.md, README.md, LICENSE, CREDITS,                CHANGELOG.md extra-source-files: GameDefinition/MainMenu.ascii, Makefile--- extra-doc-files: GameDefinition/screenshot.png author:        Andres Loeh, Mikolaj Konarski maintainer:    Mikolaj Konarski <mikolaj.konarski@funktory.com> category:      Game Engine, Game@@ -166,6 +165,7 @@                       Game.LambdaHack.Common.PointArray,                       Game.LambdaHack.Common.Point,                       Game.LambdaHack.Common.Random,+                      Game.LambdaHack.Common.RingBuffer,                       Game.LambdaHack.Common.Save,                       Game.LambdaHack.Common.Request,                       Game.LambdaHack.Common.Response,
Makefile view
@@ -1,5 +1,5 @@ # All xc* tests assume a profiling build (for stack traces).-# See the install-debug target below or .travis.yml.prof.+# See the install-debug target below.  install-debug: 	cabal install --enable-library-profiling --enable-executable-profiling --ghc-options="-fprof-auto-calls" --disable-optimization@@ -12,68 +12,74 @@ 	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --dumpInitRngs  xcfrontendCampaign:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode campaign --difficulty 2+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 1 --maxFps 60 --dumpInitRngs --automateAll --gameMode campaign +xcfrontendRaid:+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 5 --maxFps 60 --dumpInitRngs --automateAll --gameMode raid+ xcfrontendSkirmish:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode skirmish+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 5 --maxFps 60 --dumpInitRngs --automateAll --gameMode skirmish  xcfrontendAmbush:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode ambush+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 5 --maxFps 60 --dumpInitRngs --automateAll --gameMode ambush  xcfrontendBattle:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode battle --difficulty 2+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 2 --maxFps 60 --dumpInitRngs --automateAll --gameMode battle  xcfrontendBattleSurvival:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode "battle survival" --difficulty 8+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 8 --maxFps 60 --dumpInitRngs --automateAll --gameMode "battle survival"  xcfrontendSafari:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode safari --difficulty 2+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 2 --maxFps 60 --dumpInitRngs --automateAll --gameMode safari  xcfrontendSafariSurvival:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode "safari survival" --difficulty 8+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 8 --maxFps 60 --dumpInitRngs --automateAll --gameMode "safari survival"  xcfrontendDefense:-	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode defense --difficulty 8+	dist/build/LambdaHack/LambdaHack +RTS -xc -RTS --dbgMsgSer --savePrefix test --newGame 9 --maxFps 60 --dumpInitRngs --automateAll --gameMode defense   play: 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --dumpInitRngs  frontendCampaign:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode campaign --difficulty 2+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 1 --maxFps 60 --dumpInitRngs --automateAll --gameMode campaign +frontendRaid:+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 60 --dumpInitRngs --automateAll --gameMode raid+ frontendSkirmish:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode skirmish+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 60 --dumpInitRngs --automateAll --gameMode skirmish  frontendAmbush:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode ambush+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 60 --dumpInitRngs --automateAll --gameMode ambush  frontendBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode battle --difficulty 2+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --maxFps 60 --dumpInitRngs --automateAll --gameMode battle  frontendBattleSurvival:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode "battle survival" --difficulty 8+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 8 --maxFps 60 --dumpInitRngs --automateAll --gameMode "battle survival"  frontendSafari:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode safari --difficulty 2+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --maxFps 60 --dumpInitRngs --automateAll --gameMode safari  frontendSafariSurvival:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode "safari survival" --difficulty 8+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 8 --maxFps 60 --dumpInitRngs --automateAll --gameMode "safari survival"  frontendDefense:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 60 --dumpInitRngs --automateAll --gameMode defense --difficulty 8+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 9 --maxFps 60 --dumpInitRngs --automateAll --gameMode defense  benchCampaign:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode campaign --difficulty 2 --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 1 --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode campaign --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS  benchBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode battle --difficulty 2 --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode battle --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS  benchFrontendCampaign:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 100000 --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode campaign --difficulty 2 --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 1 --maxFps 100000 --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode campaign --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS  benchFrontendBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 100000 --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode battle --difficulty 2 --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --maxFps 100000 --benchmark --stopAfter 60 --automateAll --keepAutomated --gameMode battle --setDungeonRng 42 --setMainRng 42 +RTS -N1 -RTS  benchNull: benchCampaign benchBattle @@ -94,89 +100,97 @@  test-short: test-short-new test-short-load -test-medium: testCampaign-medium testSkirmish-medium testAmbush-medium testBattle-medium testBattleSurvival-medium testSafari-medium testSafariSurvival-medium testPvP-medium testCoop-medium testDefense-medium+test-medium: testCampaign-medium testRaid-medium testSkirmish-medium testAmbush-medium testBattle-medium testBattleSurvival-medium testSafari-medium testSafariSurvival-medium testPvP-medium testCoop-medium testDefense-medium -test-medium-no-safari: testCampaign-medium testSkirmish-medium testAmbush-medium testBattle-medium testBattleSurvival-medium testPvP-medium testCoop-medium testDefense-medium+test-medium-no-safari: testCampaign-medium testRaid-medium testSkirmish-medium testAmbush-medium testBattle-medium testBattleSurvival-medium testPvP-medium testCoop-medium testDefense-medium -test-long: testCampaign-long testSkirmish-medium testAmbush-medium testBattle-long testBattleSurvival-long testSafari-long testSafariSurvival-long testPvP-medium testDefense-long+test-long: testCampaign-long testRaid-medium testSkirmish-medium testAmbush-medium testBattle-long testBattleSurvival-long testSafari-long testSafariSurvival-long testPvP-medium testDefense-long -test-long-no-safari: testCampaign-long testSkirmish-medium testAmbush-medium testBattle-long testBattleSurvival-long testPvP-medium testDefense-long+test-long-no-safari: testCampaign-long testRaid-medium testSkirmish-medium testAmbush-medium testBattle-long testBattleSurvival-long testPvP-medium testDefense-long  testCampaign-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 500 --dumpInitRngs --automateAll --keepAutomated --gameMode campaign --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 1 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 500 --dumpInitRngs --automateAll --keepAutomated --gameMode campaign > /tmp/stdtest.log  testCampaign-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 400 --dumpInitRngs --automateAll --keepAutomated --gameMode campaign --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 1 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 400 --dumpInitRngs --automateAll --keepAutomated --gameMode campaign > /tmp/stdtest.log +testRaid-long:+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode raid > /tmp/stdtest.log++testRaid-medium:+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode raid > /tmp/stdtest.log+ testSkirmish-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish > /tmp/stdtest.log  testSkirmish-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish > /tmp/stdtest.log  testAmbush-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush > /tmp/stdtest.log  testAmbush-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush > /tmp/stdtest.log  testBattle-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 100 --dumpInitRngs --automateAll --keepAutomated --gameMode battle --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 100 --dumpInitRngs --automateAll --keepAutomated --gameMode battle > /tmp/stdtest.log  testBattle-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 50 --dumpInitRngs --automateAll --keepAutomated --gameMode battle --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 50 --dumpInitRngs --automateAll --keepAutomated --gameMode battle > /tmp/stdtest.log  testBattleSurvival-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 100 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --difficulty 8 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 8 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 100 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" > /tmp/stdtest.log  testBattleSurvival-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 50 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --difficulty 8 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 8 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 50 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" > /tmp/stdtest.log  testSafari-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 250 --dumpInitRngs --automateAll --keepAutomated --gameMode safari --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 250 --dumpInitRngs --automateAll --keepAutomated --gameMode safari > /tmp/stdtest.log  testSafari-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 200 --dumpInitRngs --automateAll --keepAutomated --gameMode safari --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 200 --dumpInitRngs --automateAll --keepAutomated --gameMode safari > /tmp/stdtest.log  testSafariSurvival-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 250 --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --difficulty 8 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 8 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 250 --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" > /tmp/stdtest.log  testSafariSurvival-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 200 --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --difficulty 8 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 8 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 200 --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" > /tmp/stdtest.log   testPvP-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode PvP > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 60 --dumpInitRngs --automateAll --keepAutomated --gameMode PvP > /tmp/stdtest.log  testPvP-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode PvP > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 5 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 30 --dumpInitRngs --automateAll --keepAutomated --gameMode PvP > /tmp/stdtest.log  testCoop-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 500 --dumpInitRngs --automateAll --keepAutomated --gameMode Coop --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 500 --dumpInitRngs --automateAll --keepAutomated --gameMode Coop > /tmp/stdtest.log  testCoop-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 300 --dumpInitRngs --automateAll --keepAutomated --gameMode Coop --difficulty 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 300 --dumpInitRngs --automateAll --keepAutomated --gameMode Coop > /tmp/stdtest.log  testDefense-long:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 500 --dumpInitRngs --automateAll --keepAutomated --gameMode defense --difficulty 8 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 9 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 500 --dumpInitRngs --automateAll --keepAutomated --gameMode defense > /tmp/stdtest.log  testDefense-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 300 --dumpInitRngs --automateAll --keepAutomated --gameMode defense --difficulty 8 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 9 --noDelay --noAnim --maxFps 100000 --frontendStd --benchmark --stopAfter 300 --dumpInitRngs --automateAll --keepAutomated --gameMode defense > /tmp/stdtest.log  test-short-new:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix campaign --dumpInitRngs --automateAll --keepAutomated --gameMode campaign --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix skirmish --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix battle --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix PvP --dumpInitRngs --automateAll --keepAutomated --gameMode PvP --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix Coop --dumpInitRngs --automateAll --keepAutomated --gameMode Coop --frontendStd --stopAfter 2 > /tmp/stdtest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame --savePrefix defense --dumpInitRngs --automateAll --keepAutomated --gameMode defense --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix campaign --dumpInitRngs --automateAll --keepAutomated --gameMode campaign --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix skirmish --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix battle --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix PvP --dumpInitRngs --automateAll --keepAutomated --gameMode PvP --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix Coop --dumpInitRngs --automateAll --keepAutomated --gameMode Coop --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --newGame 5 --savePrefix defense --dumpInitRngs --automateAll --keepAutomated --gameMode defense --frontendStd --stopAfter 2 > /tmp/stdtest.log  test-short-load: 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix campaign --dumpInitRngs --automateAll --keepAutomated --gameMode campaign --frontendStd --stopAfter 2 > /tmp/stdtest.log+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendStd --stopAfter 2 > /tmp/stdtest.log 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix skirmish --dumpInitRngs --automateAll --keepAutomated --gameMode skirmish --frontendStd --stopAfter 2 > /tmp/stdtest.log 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendStd --stopAfter 2 > /tmp/stdtest.log 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix battle --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendStd --stopAfter 2 > /tmp/stdtest.log
README.md view
@@ -16,7 +16,7 @@ The engine comes with a sample code for a little dungeon crawler, called LambdaHack and described in [PLAYING.md](GameDefinition/PLAYING.md). -![gameplay screenshot](GameDefinition/screenshot.png?raw=true)+![gameplay screenshot](https://raw.githubusercontent.com/LambdaHack/media/master/screenshot/raid1.png)  Other games known to use the LambdaHack library: @@ -96,6 +96,7 @@ The latest official version of the library can be downloaded, compiled and installed automatically by Cabal from [Hackage] [3] as follows +    cabal update     cabal install gtk2hs-buildtools     cabal install LambdaHack --force-reinstalls @@ -144,15 +145,16 @@ though they mostly overlap with commandline options (and will be totally merged at some point). -You can use HPC with the game as follows (a quick manual playing session+You can use HPC with the game as follows (details vary according+to HPC version). A quick manual playing session after the automated tests would be in order, as well, since the tests don't-touch the topmost UI layer).+touch the topmost UI layer.      cabal clean-    cabal install --enable-library-coverage+    cabal install --enable-coverage     make test-    hpc report --hpcdir=dist/hpc/mix/LambdaHack-xxx/ LambdaHack-    hpc markup --hpcdir=dist/hpc/mix/LambdaHack-xxx/ LambdaHack+    hpc report --hpcdir=dist/hpc/dyn/mix/LambdaHack --hpcdir=dist/hpc/dyn/mix/LambdaHack-xxx/ LambdaHack+    hpc markup --hpcdir=dist/hpc/dyn/mix/LambdaHack --hpcdir=dist/hpc/dyn/mix/LambdaHack-xxx/ LambdaHack  Note that debug option `--stopAfter` is required to cleanly terminate any automated test. This is needed to gather any HPC info, because HPC
test/test.hs view
@@ -2,5 +2,5 @@  main :: IO () main =-  tieKnot $ tail $ words "dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 6 --automateAll --gameMode campaign --setDungeonRng 42 --setMainRng 42"-  -- tieKnot $ tail $ words "dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 6 --automateAll --gameMode battle --setDungeonRng 42 --setMainRng 42"+  tieKnot $ tail $ words "dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 6 --automateAll --keepAutomated --gameMode campaign --setDungeonRng 42 --setMainRng 42"+  -- tieKnot $ tail $ words "dist/build/LambdaHack/LambdaHack --dbgMsgSer --savePrefix test --newGame 2 --noDelay --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfter 6 --automateAll --keepAutomated --gameMode battle --setDungeonRng 42 --setMainRng 42"