LambdaHack 0.2.14 → 0.4.9.0

raw patch · 101 files changed

+2085/−1508 lines, 101 filesdep ~gtkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: gtk

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• CREDITS +1/−0
• Game/LambdaHack/Atomic/BroadcastAtomicWrite.hs +3/−5
• Game/LambdaHack/Atomic/CmdAtomic.hs +11/−7
• Game/LambdaHack/Atomic/HandleAtomicWrite.hs +40/−15
• Game/LambdaHack/Atomic/PosAtomicRead.hs +32/−26
• Game/LambdaHack/Client/AI.hs +18/−4
• Game/LambdaHack/Client/AI/ConditionClient.hs +5/−5
• Game/LambdaHack/Client/AI/HandleAbilityClient.hs +23/−16
• Game/LambdaHack/Client/AI/PickActorClient.hs +36/−6
• Game/LambdaHack/Client/AI/PickTargetClient.hs +53/−41
• Game/LambdaHack/Client/AI/Preferences.hs +4/−3
• Game/LambdaHack/Client/Bfs.hs +3/−2
• Game/LambdaHack/Client/BfsClient.hs +9/−5
• Game/LambdaHack/Client/CommonClient.hs +18/−7
• Game/LambdaHack/Client/HandleAtomicClient.hs +52/−33
• Game/LambdaHack/Client/LoopClient.hs +1/−1
• Game/LambdaHack/Client/MonadClient.hs +14/−11
• Game/LambdaHack/Client/State.hs +11/−36
• Game/LambdaHack/Client/UI.hs +11/−9
• Game/LambdaHack/Client/UI/Config.hs +4/−4
• Game/LambdaHack/Client/UI/DisplayAtomicClient.hs +15/−13
• Game/LambdaHack/Client/UI/DrawClient.hs +2/−2
• Game/LambdaHack/Client/UI/Frontend/Gtk.hs +13/−6
• Game/LambdaHack/Client/UI/HandleHumanClient.hs +3/−2
• Game/LambdaHack/Client/UI/HandleHumanGlobalClient.hs +43/−24
• Game/LambdaHack/Client/UI/HandleHumanLocalClient.hs +11/−5
• Game/LambdaHack/Client/UI/HumanCmd.hs +8/−4
• Game/LambdaHack/Client/UI/InventoryClient.hs +13/−10
• Game/LambdaHack/Client/UI/KeyBindings.hs +1/−1
• Game/LambdaHack/Client/UI/MonadClientUI.hs +10/−10
• Game/LambdaHack/Client/UI/MsgClient.hs +2/−2
• Game/LambdaHack/Client/UI/StartupFrontendClient.hs +3/−3
• Game/LambdaHack/Client/UI/WidgetClient.hs +1/−2
• Game/LambdaHack/Common/Ability.hs +5/−1
• Game/LambdaHack/Common/Actor.hs +5/−3
• Game/LambdaHack/Common/ActorState.hs +13/−14
• Game/LambdaHack/Common/ClientOptions.hs +3/−0
• Game/LambdaHack/Common/ContentDef.hs +8/−5
• Game/LambdaHack/Common/Dice.hs +4/−1
• Game/LambdaHack/Common/Effect.hs +12/−10
• Game/LambdaHack/Common/EffectDescription.hs +2/−1
• Game/LambdaHack/Common/Faction.hs +97/−56
• Game/LambdaHack/Common/Feature.hs +6/−6
• Game/LambdaHack/Common/File.hs +11/−6
• Game/LambdaHack/Common/HighScore.hs +8/−5
• Game/LambdaHack/Common/Item.hs +12/−7
• Game/LambdaHack/Common/ItemDescription.hs +1/−1
• Game/LambdaHack/Common/Kind.hs +25/−44
• Game/LambdaHack/Common/Level.hs +24/−21
• Game/LambdaHack/Common/Misc.hs +40/−8
• Game/LambdaHack/Common/MonadStateRead.hs +15/−6
• Game/LambdaHack/Common/Request.hs +10/−3
• Game/LambdaHack/Common/Save.hs +1/−1
• Game/LambdaHack/Common/State.hs +6/−4
• Game/LambdaHack/Common/Tile.hs +67/−38
• Game/LambdaHack/Content/CaveKind.hs +34/−25
• Game/LambdaHack/Content/FactionKind.hs +0/−23
• Game/LambdaHack/Content/ItemKind.hs +19/−19
• Game/LambdaHack/Content/ModeKind.hs +125/−57
• Game/LambdaHack/Content/PlaceKind.hs +32/−24
• Game/LambdaHack/Content/RuleKind.hs +17/−11
• Game/LambdaHack/Content/TileKind.hs +16/−9
• Game/LambdaHack/SampleImplementation/SampleMonadClient.hs +4/−1
• Game/LambdaHack/SampleImplementation/SampleMonadServer.hs +4/−1
• Game/LambdaHack/Server/Commandline.hs +4/−2
• Game/LambdaHack/Server/CommonServer.hs +35/−16
• Game/LambdaHack/Server/DungeonGen.hs +18/−15
• Game/LambdaHack/Server/DungeonGen/Cave.hs +4/−3
• Game/LambdaHack/Server/DungeonGen/Place.hs +33/−28
• Game/LambdaHack/Server/EndServer.hs +5/−5
• Game/LambdaHack/Server/Fov.hs +16/−13
• Game/LambdaHack/Server/HandleEffectServer.hs +17/−10
• Game/LambdaHack/Server/HandleRequestServer.hs +48/−25
• Game/LambdaHack/Server/ItemRev.hs +12/−14
• Game/LambdaHack/Server/ItemServer.hs +14/−14
• Game/LambdaHack/Server/LoopServer.hs +25/−24
• Game/LambdaHack/Server/MonadServer.hs +25/−20
• Game/LambdaHack/Server/PeriodicServer.hs +26/−20
• Game/LambdaHack/Server/ProtocolServer.hs +5/−1
• Game/LambdaHack/Server/StartServer.hs +47/−47
• Game/LambdaHack/Server/State.hs +36/−38
• GameDefinition/Client/UI/Content/KeyKind.hs +2/−1
• GameDefinition/Content/CaveKind.hs +28/−22
• GameDefinition/Content/FactionKind.hs +0/−73
• GameDefinition/Content/ItemKind.hs +81/−75
• GameDefinition/Content/ItemKindActor.hs +14/−8
• GameDefinition/Content/ItemKindOrgan.hs +4/−3
• GameDefinition/Content/ItemKindShrapnel.hs +23/−6
• GameDefinition/Content/ModeKind.hs +180/−232
• GameDefinition/Content/ModeKindPlayer.hs +123/−0
• GameDefinition/Content/PlaceKind.hs +51/−19
• GameDefinition/Content/RuleKind.hs +5/−3
• GameDefinition/Content/TileKind.hs +8/−6
• GameDefinition/PLAYING.md +2/−1
• GameDefinition/TieKnot.hs +0/−2
• GameDefinition/scores binary
• GameDefinition/screenshot.png binary
• LambdaHack.cabal +41/−18
• Makefile +8/−0
• README.md +32/−13

@@ -1,3 +1,16 @@+## [v0.4.9.0, aka 'Player escapes'](https://github.com/LambdaHack/LambdaHack/compare/v0.2.14...v0.4.9.0)++- balance the example game content a bit (campaign still unbalanced)+- various code and documentation tweaks and fixes+- add cabal flag expose_internal that reveals internal library operations+- merge FactionKind into ModeKind and rework completely the semantics+- compatibility tweaks for Nixpkgs+- define AI tactics, expose them to UI and add one more: follow-the-leader+- share leader target between the UI and AI client of each faction+- specify monster spawn rate per-cave+- extend content validation and make it more user friendly+- freeze v0.5.0.0 of LambdaHack content API+ ## [v0.2.14, aka 'Out of balance'](https://github.com/LambdaHack/LambdaHack/compare/v0.2.12...v0.2.14)  - tons of new (unbalanced) content, content fields, effects and descriptions

@@ -3,3 +3,4 @@  Andres Loeh Mikolaj Konarski+Tuukka Turto

@@ -19,7 +19,6 @@ import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction-import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead@@ -85,7 +84,7 @@   persLit <- doResetLitInDungeon   -- Send some actions to the clients, one faction at a time.   let sendUI fid cmdUI =-        when (playerUI $ gplayer $ factionD EM.! fid) $ doSendUpdateUI fid cmdUI+        when (fhasUI $ gplayer $ factionD EM.! fid) $ doSendUpdateUI fid cmdUI       sendAI fid cmdAI = doSendUpdateAI fid cmdAI       sendA fid cmd = do         sendUI fid $ RespUpdAtomicUI cmd@@ -99,7 +98,7 @@                 else do                   mleader <- getsState $ gleader . (EM.! fid) . sfactionD                   case (atomic2, mleader) of-                    (UpdAtomic cmd, Just leader) -> do+                    (UpdAtomic cmd, Just (leader, _)) -> do                       body <- getsState $ getActorBody leader                       loud <- loudUpdAtomic (blid body == lid) fid cmd                       case loud of@@ -173,8 +172,7 @@       fBag (p, bag) = map (fItem p) $ EM.assocs bag       inItem = concatMap fBag inFloor       -- Tiles.-      cotile = Kind.cotile (scops s)-      inTileMap = map (\p -> (p, hideTile cotile lvl p)) inFov+      inTileMap = map (\p -> (p, hideTile (scops s) lvl p)) inFov       atomicTile = if null inTileMap then [] else [UpdSpotTile lid inTileMap]       -- Smells.       inSmellFov = ES.elems $ smellVisible inPer

@@ -19,7 +19,6 @@  import Data.Binary import Data.Int (Int64)-import Data.Text (Text) import GHC.Generics (Generic)  import Game.LambdaHack.Common.Actor@@ -38,8 +37,9 @@ import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Vector-import Game.LambdaHack.Content.ItemKind as ItemKind-import Game.LambdaHack.Content.TileKind as TileKind+import Game.LambdaHack.Content.ItemKind+import Game.LambdaHack.Content.ModeKind+import Game.LambdaHack.Content.TileKind  data CmdAtomic =     UpdAtomic !UpdAtomic@@ -75,8 +75,10 @@   | UpdColorActor !ActorId !Color.Color !Color.Color   -- Change faction attributes.   | UpdQuitFaction !FactionId !(Maybe Actor) !(Maybe Status) !(Maybe Status)-  | UpdLeadFaction !FactionId !(Maybe ActorId) !(Maybe ActorId)+  | UpdLeadFaction !FactionId !(Maybe (ActorId, Maybe Target))+                              !(Maybe (ActorId, Maybe Target))   | UpdDiplFaction !FactionId !FactionId !Diplomacy !Diplomacy+  | UpdTacticFaction !FactionId !Tactic !Tactic   | UpdAutoFaction !FactionId !Bool   | UpdRecordKill !ActorId !(Kind.Id ItemKind) !Int   -- Alter map.@@ -98,12 +100,13 @@   | UpdDiscoverSeed !LevelId !Point !ItemId !ItemSeed   | UpdCoverSeed !LevelId !Point !ItemId !ItemSeed   | UpdPerception !LevelId !Perception !Perception-  | UpdRestart !FactionId !Discovery !FactionPers !State !DebugModeCli !Text+  | UpdRestart+      !FactionId !DiscoveryKind !FactionPers !State !DebugModeCli !GroupName   | UpdRestartServer !State   | UpdResume !FactionId !FactionPers   | UpdResumeServer !State   | UpdKillExit !FactionId-  | UpdSaveBkp+  | UpdWriteSave   | UpdMsgAll !Msg   | UpdRecordHistory !FactionId   deriving (Show, Eq, Generic)@@ -157,6 +160,7 @@   UpdLeadFaction fid source target -> Just $ UpdLeadFaction fid target source   UpdDiplFaction fid1 fid2 fromDipl toDipl ->     Just $ UpdDiplFaction fid1 fid2 toDipl fromDipl+  UpdTacticFaction fid toT fromT -> Just $ UpdTacticFaction fid fromT toT   UpdAutoFaction fid st -> Just $ UpdAutoFaction fid (not st)   UpdRecordKill aid ikind k -> Just $ UpdRecordKill aid ikind (-k)   UpdAlterTile lid p fromTile toTile ->@@ -183,7 +187,7 @@   UpdResume{} -> Nothing   UpdResumeServer{} -> Nothing   UpdKillExit{} -> Nothing-  UpdSaveBkp -> Nothing+  UpdWriteSave -> Nothing   UpdMsgAll{} -> Nothing  -- only generated by @cmdAtomicFilterCli@   UpdRecordHistory{} -> Just cmd 

@@ -5,6 +5,7 @@   ( handleCmdAtomic   ) where +import Control.Applicative import Control.Arrow (second) import Control.Exception.Assert.Sugar import Control.Monad@@ -66,6 +67,7 @@   UpdLeadFaction fid source target -> updLeadFaction fid source target   UpdDiplFaction fid1 fid2 fromDipl toDipl ->     updDiplFaction fid1 fid2 fromDipl toDipl+  UpdTacticFaction fid toT fromT -> updTacticFaction fid toT fromT   UpdAutoFaction fid st -> updAutoFaction fid st   UpdRecordKill aid ikind k -> updRecordKill aid ikind k   UpdAlterTile lid p fromTile toTile -> updAlterTile lid p fromTile toTile@@ -92,7 +94,7 @@   UpdResume{} -> return ()   UpdResumeServer s -> updResumeServer s   UpdKillExit{} -> return ()-  UpdSaveBkp -> return ()+  UpdWriteSave -> return ()   UpdMsgAll{} -> return ()   UpdRecordHistory{} -> return () @@ -117,10 +119,19 @@   -- We re-add them all to save time determining which really need it.   forM_ ais $ \(iid, item) -> do     let h item1 item2 =-          assert (item1 == item2 `blame` "inconsistent created actor items"-                                 `twith` (aid, body, iid, item1, item2)) item1+          assert (itemsMatch item1 item2+                  `blame` "inconsistent created actor items"+                  `twith` (aid, body, iid, item1, item2))+                 item2 -- keep the first found level     modifyState $ updateItemD $ EM.insertWith h iid item +itemsMatch :: Item -> Item -> Bool+itemsMatch item1 item2 =+  jkindIx item1 == jkindIx item2+  -- && aspects and effects are the same, but too much writing;+  -- Note that nothing else needs to be the same, since items are merged+  -- and clients have different views on dungeon items than the server.+ -- | Kills an actor. updDestroyActor :: MonadStateWrite m                 => ActorId -> Actor -> [(ItemId, Item)] -> m ()@@ -133,7 +144,7 @@   -- Assert that actor's items belong to @sitemD@. Do not remove those   -- that do not appear anywhere else, for simplicity and speed.   itemD <- getsState sitemD-  let match (iid, item) = itemD EM.! iid == item+  let match (iid, item) = itemsMatch (itemD EM.! iid) item   assert (allB match ais `blame` "destroyed actor items not found"                          `twith` (aid, body, ais, itemD)) skip   -- Remove actor from @sactorD@.@@ -156,9 +167,10 @@ updCreateItem iid item k c = assert (k > 0) $ do   -- The item may or may not be already present in @sitemD@,   -- regardless if it's actually present in the dungeon.-  let f item1 item2 = assert (item1 == item2-                              `blame` "inconsistent created item"-                              `twith` (iid, item, k, c)) item1+  -- If items equivalent, pick the one found on easier level.+  let f item1 item2 =+        assert (itemsMatch item1 item2)+               item2 -- keep the first found level   modifyState $ updateItemD $ EM.insertWith f iid item   insertItemContainer iid k c @@ -170,8 +182,11 @@   -- It's incredibly costly and not noticeable for the player.   -- However, assert the item is registered in @sitemD@.   itemD <- getsState sitemD-  assert (iid `EM.lookup` itemD == Just item `blame` "item already removed"-                                             `twith` (iid, item, itemD)) skip+  assert ((case iid `EM.lookup` itemD of+             Nothing -> False+             Just item0 -> itemsMatch item0 item)+           `blame` "item already removed"+           `twith` (iid, item, itemD)) skip   deleteItemContainer iid k c  updMoveActor :: MonadStateWrite m => ActorId -> Point -> Point -> m ()@@ -272,11 +287,15 @@  -- The previous leader is assumed to be alive. updLeadFaction :: MonadStateWrite m-               => FactionId -> Maybe ActorId -> Maybe ActorId -> m ()+               => FactionId+               -> Maybe (ActorId, Maybe Target)+               -> Maybe (ActorId, Maybe Target)+               -> m () updLeadFaction fid source target = assert (source /= target) $ do   fact <- getsState $ (EM.! fid) . sfactionD-  assert (playerLeader $ gplayer fact) skip  -- @PosNone@ ensure this-  mtb <- getsState $ \s -> fmap (flip getActorBody s) target+  assert (fleaderMode (gplayer fact) /= LeaderNull) skip+    -- @PosNone@ ensures this+  mtb <- getsState $ \s -> flip getActorBody s . fst <$> target   assert (maybe True (not . bproj) mtb           `blame` (fid, source, target, mtb, fact)) skip   assert (source == gleader fact@@ -300,11 +319,17 @@     updateFaction fid2 (adj fid1)  updAutoFaction :: MonadStateWrite m => FactionId -> Bool -> m ()-updAutoFaction fid st = do+updAutoFaction fid st =+  updateFaction fid (\fact ->+    assert (isAIFact fact == not st)+    $ fact {gplayer = automatePlayer st (gplayer fact)})++updTacticFaction :: MonadStateWrite m => FactionId -> Tactic -> Tactic -> m ()+updTacticFaction fid toT fromT = do   let adj fact =         let player = gplayer fact-        in assert (playerAI player == not st)-           $ fact {gplayer = player {playerAI = st}}+        in assert (ftactic player == fromT)+           $ fact {gplayer = player {ftactic = toT}}   updateFaction fid adj  -- | Record a given number (usually just 1, or -1 for undo) of actor kills

@@ -37,7 +37,7 @@ -- based on the position of the action, etc. data PosAtomic =     PosSight !LevelId ![Point]  -- ^ whomever sees all the positions, notices-  | PosFidAndSight !FactionId !LevelId ![Point]+  | PosFidAndSight ![FactionId] !LevelId ![Point]                                 -- ^ observers and the faction notice   | PosSmell !LevelId ![Point]  -- ^ whomever smells all the positions, notices   | PosFid !FactionId           -- ^ only the faction notices@@ -47,11 +47,7 @@   | PosNone                     -- ^ never broadcasted, but sent manually   deriving (Show, Eq) --- | Produce the positions where the action takes place. If a faction--- is returned, the action is visible only for that faction, if Nothing--- is returned, it's never visible. Empty list of positions implies--- the action is visible always.---+-- | Produce the positions where the action takes place. -- The goal of the mechanics: client should not get significantly -- more information by looking at the atomic commands he is able to see -- than by looking at the state changes they enact. E.g., @UpdDisplaceActor@@@ -74,13 +70,25 @@   UpdSpotItem _ _ _ c -> singleContainer c   UpdLoseItem _ _ _ c -> singleContainer c   UpdMoveActor aid fromP toP -> do-    (lid, _) <- posOfAid aid-    return $! PosSight lid [fromP, toP]+    b <- getsState $ getActorBody aid+    -- Non-projectile actors are never totally isolated from envirnoment;+    -- they hear, feel air movement, etc.+    return $! if bproj b+              then PosSight (blid b) [fromP, toP]+              else PosFidAndSight [bfid b] (blid b) [fromP, toP]   UpdWaitActor aid _ -> singleAid aid   UpdDisplaceActor source target -> do-    (slid, sp) <- posOfAid source-    (tlid, tp) <- posOfAid target-    return $! assert (slid == tlid) $ PosSight slid [sp, tp]+    sb <- getsState $ getActorBody source+    tb <- getsState $ getActorBody target+    let ps = [bpos sb, bpos tb]+        lid = assert (blid sb == blid tb) $ blid sb+    return $! if bproj sb && bproj tb+              then PosSight lid ps+              else if bproj sb+              then PosFidAndSight [bfid tb] lid ps+              else if bproj tb+              then PosFidAndSight [bfid sb] lid ps+              else PosFidAndSight [bfid sb, bfid tb] lid ps   UpdMoveItem _ _ aid _ CSha -> do  -- shared stash is private     b <- getsState $ getActorBody aid     return $! PosFidAndSer (Just $ blid b) (bfid b)@@ -97,10 +105,11 @@   UpdQuitFaction{} -> return PosAll   UpdLeadFaction fid _ _ -> do     fact <- getsState $ (EM.! fid) . sfactionD-    return $! if playerLeader $ gplayer fact+    return $! if fleaderMode (gplayer fact) /= LeaderNull               then PosFidAndSer Nothing fid               else PosNone   UpdDiplFaction{} -> return PosAll+  UpdTacticFaction fid _ _ -> return $! PosFidAndSer Nothing fid   UpdAutoFaction{} -> return PosAll   UpdRecordKill aid _ _ -> singleFidAndAid aid   UpdAlterTile lid p _ _ -> return $! PosSight lid [p]@@ -135,7 +144,7 @@   UpdResume fid _ -> return $! PosFid fid   UpdResumeServer _ -> return PosSer   UpdKillExit fid -> return $! PosFid fid-  UpdSaveBkp -> return PosAll+  UpdWriteSave -> return PosAll   UpdMsgAll{} -> return PosAll   UpdRecordHistory fid -> return $! PosFid fid @@ -169,12 +178,12 @@ posProjBody body = return $!   if bproj body   then PosSight (blid body) [bpos body]-  else PosFidAndSight (bfid body) (blid body) [bpos body]+  else PosFidAndSight [bfid body] (blid body) [bpos body]  singleFidAndAid :: MonadStateRead m => ActorId -> m PosAtomic singleFidAndAid aid = do   body <- getsState $ getActorBody aid-  return $! PosFidAndSight (bfid body) (blid body) [bpos body]+  return $! PosFidAndSight [bfid body] (blid body) [bpos body]  singleAid :: MonadStateRead m => ActorId -> m PosAtomic singleAid aid = do@@ -189,7 +198,7 @@ singleContainer (CActor aid _) = do   (lid, p) <- posOfAid aid   return $! PosSight lid [p]-singleContainer (CTrunk fid lid p) = return $! PosFidAndSight fid lid [p]+singleContainer (CTrunk fid lid p) = return $! PosFidAndSight [fid] lid [p]  -- | Determines if a command resets FOV. --@@ -232,16 +241,13 @@ breakUpdAtomic :: MonadStateRead m => UpdAtomic -> m [UpdAtomic] breakUpdAtomic cmd = case cmd of   UpdMoveActor aid _ toP -> do+    -- We assume other factions don't see leaders and we know the actor's+    -- faction always sees the atomic command, so the leader doesn't+    -- need to be updated (or the actor is a projectile, hence not a leader).     b <- getsState $ getActorBody aid     ais <- getsState $ getCarriedAssocs b-    let loseSpot = [ UpdLoseActor aid b ais-                   , UpdSpotActor aid b {bpos = toP, boldpos = bpos b} ais ]-    fact <- getsState $ (EM.! bfid b) . sfactionD-    if gleader fact == Just aid-      then return $ [UpdLeadFaction (bfid b) (Just aid) Nothing]-                    ++ loseSpot-                    ++ [UpdLeadFaction (bfid b) Nothing (Just aid)]-      else return loseSpot+    return [ UpdLoseActor aid b ais+           , UpdSpotActor aid b {bpos = toP, boldpos = bpos b} ais ]   UpdDisplaceActor source target -> do     sb <- getsState $ getActorBody source     sais <- getsState $ getCarriedAssocs sb@@ -300,8 +306,8 @@ seenAtomicCli knowEvents fid per posAtomic =   case posAtomic of     PosSight _ ps -> all (`ES.member` totalVisible per) ps || knowEvents-    PosFidAndSight fid2 _ ps ->-      fid == fid2 || all (`ES.member` totalVisible per) ps || knowEvents+    PosFidAndSight fids _ ps ->+      fid `elem` fids || all (`ES.member` totalVisible per) ps || knowEvents     PosSmell _ ps -> all (`ES.member` smellVisible per) ps || knowEvents     PosFid fid2 -> fid == fid2     PosFidAndSer _ fid2 -> fid == fid2

@@ -1,10 +1,12 @@+{-# LANGUAGE CPP #-} -- | Ways for the client to use AI to produce server requests, based on -- the client's view of the game state. module Game.LambdaHack.Client.AI   ( -- * Public API     queryAI, pongAI-    -- * Internal functions+#ifdef EXPOSE_INTERNAL   , refreshTarget, pickAction+#endif   ) where  import Control.Exception.Assert.Sugar@@ -18,18 +20,30 @@ import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor+import Game.LambdaHack.Common.Faction+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 queryAI oldAid = do+  side <- getsClient sside+  fact <- getsState $ (EM.! side) . sfactionD+  let mleader = gleader fact+      wasLeader = fmap fst mleader == Just oldAid   (aidToMove, bToMove) <- pickActorToMove refreshTarget oldAid-  RequestAnyAbility reqAny <- pickAction (aidToMove, bToMove)+  RequestAnyAbility reqAny <-+    if ftactic (gplayer fact) == TBlock && not wasLeader+    then return $! RequestAnyAbility ReqWait+    else pickAction (aidToMove, bToMove)   let req = ReqAITimed reqAny-  if aidToMove /= oldAid-    then return $! ReqAILeader aidToMove req+  mtgt2 <- getsClient $ fmap fst . EM.lookup aidToMove . stargetD+  if wasLeader && mleader /= Just (aidToMove, mtgt2)+    then return $! ReqAILeader aidToMove mtgt2 req     else return $! req  -- | Client signals to the server that it's still online.

@@ -53,7 +53,7 @@ condTgtEnemyPresentM aid = do   btarget <- getsClient $ getTarget aid   return $! case btarget of-    Just TEnemy{} -> True+    Just (TEnemy _ permit) -> not permit     _ -> False  -- | Require that the target enemy is remembered on the actor's level.@@ -62,7 +62,7 @@   b <- getsState $ getActorBody aid   btarget <- getsClient $ getTarget aid   return $! case btarget of-    Just (TEnemyPos _ lid _ _) | lid == blid b -> True+    Just (TEnemyPos _ lid _ permit) | lid == blid b -> not permit     _ -> False  -- | Require that any non-dying foe is adjacent.@@ -189,10 +189,10 @@                      , (Int, CStore)), (ItemId, ItemFull) )] benGroundItems aid = do   b <- getsState $ getActorBody aid-  fightsSpawners <- fightsAgainstSpawners (bfid b)+  canEscape <- factionCanEscape (bfid b)   let desirableItem ItemFull{itemBase} use-        | fightsSpawners = use /= Just 0-                           || Effect.Precious `elem` jfeature itemBase+        | canEscape = use /= Just 0+                      || Effect.Precious `elem` jfeature itemBase         | otherwise = use /= Just 0   benAvailableItems aid desirableItem [CGround] 

@@ -60,6 +60,9 @@ actionStrategy :: forall m. MonadClient m                => ActorId -> m (Strategy RequestAnyAbility) actionStrategy aid = do+  Kind.COps{corule} <- getsState scops+  let stdRuleset = Kind.stdRuleset corule+      nearby = rnearby stdRuleset   body <- getsState $ getActorBody aid   activeItems <- activeItemsClient aid   fact <- getsState $ (EM.! bfid body) . sfactionD@@ -123,7 +126,7 @@           , condAnyFoeAdj             || EM.findWithDefault 0 AbDisplace actorSk <= 0                  -- melee friends, not displace-               && not (playerLeader $ gplayer fact)  -- not restrained+               && fleaderMode (gplayer fact) == LeaderNull  -- not restrained                && (condTgtEnemyPresent || condTgtEnemyRemembered) )  -- excited         , ( [AbTrigger], (toAny :: ToAny AbTrigger)             <$> trigger aid False@@ -436,7 +439,7 @@              && (not (bproj body2)  -- displacing saves a move                  && isAtWar fact (bfid body2)  -- they at war with us                  || EM.findWithDefault 0 AbDisplace actorSk <= 0  -- not disp.-                    && not (playerLeader $ gplayer fact)  -- not restrained+                    && fleaderMode (gplayer fact) == LeaderNull  -- no restrain                     && EM.findWithDefault 0 AbMove actorSk > 0  -- blocked move                     && bhp body2 < bhp b)  -- respect power             then do@@ -480,9 +483,10 @@       feats = TileKind.tfeature $ okind t       ben feat = case feat of         F.Cause (Effect.Ascend k) ->  -- change levels sensibly, in teams-          let expBenefit =-                if not (playerLeader (gplayer fact))-                then 100  -- not-exploring faction, switch at will+          let aimless = ftactic (gplayer fact) `elem` [TRoam, TPatrol]+              expBenefit =+                if aimless+                then 100  -- faction is not exploring, so switch at will                 else if unexploredCurrent                 then 0  -- don't leave the level until explored                 else if unexploredD (signum k) (blid b)@@ -494,11 +498,11 @@                 else 2  -- no escape anywhere, switch levels occasionally               (lid2, pos2) = whereTo (blid b) (bpos b) k dungeon               actorsThere = posToActors pos2 lid2 s-              leaderless = not $ playerLeader $ gplayer fact           in if boldpos b == 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+             else let leaderless = fleaderMode (gplayer fact) == LeaderNull+                      eben = case actorsThere of                         [] | canSee -> expBenefit                         _ | leaderless -> 0  -- leaderless clog stairs easily                         _ -> min 1 expBenefit  -- risk pushing@@ -508,7 +512,7 @@         F.Cause ef@Effect.Escape{} -> do  -- flee via this way, too           -- Only some factions try to escape but they first explore all           -- for high score.-          if not (keepArenaFact fact) || not allExplored+          if not (fcanEscape $ gplayer fact) || not allExplored           then 0           else effectToBenefit cops b activeItems fact ef         F.Cause ef | not fleeViaStairs ->@@ -629,6 +633,7 @@   b <- getsState $ getActorBody aid   lvl <- getLevel $ blid b   fact <- getsState $ (EM.! bfid b) . sfactionD+  mleader <- getsClient _sleader   let friendlyFid fid = fid == bfid b || isAllied fact fid   friends <- getsState $ actorRegularList friendlyFid (blid b)   allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)@@ -640,7 +645,7 @@       nFrHere = nFriends b + 1       qualifyActor (aid2, body2) = do         activeItems <- activeItemsClient aid2-        dEnemy <- getsState $ dispEnemy aid aid2 activeItems+        dEnemy <- getsState $ dispEnemy aid mleader aid2 activeItems         let nFr = nFriends body2         return $! if displaceable body2 && dEnemy && nFr < nFrHere           then Just (nFr * nFr, bpos body2 `vectorToFrom` bpos b)@@ -668,10 +673,11 @@   lvl <- getLevel $ blid b   if boldpos b /= 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), _)] -> do+      [((aid2, b2), _)] | Just aid2 /= mleader -> do         mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD         case mtgtMPath of           Just (tgt, Just (p : q : rest, (goal, len)))@@ -684,11 +690,11 @@           Nothing -> do             tfact <- getsState $ (EM.! bfid b2) . sfactionD             activeItems <- activeItemsClient aid2-            dEnemy <- getsState $ dispEnemy aid aid2 activeItems+            dEnemy <- getsState $ dispEnemy aid mleader aid2 activeItems             if not (isAtWar tfact (bfid b)) || dEnemy then               return $! returN "displace other" $ target `vectorToFrom` source             else return reject  -- DisplaceDying, DisplaceSupported-      _ -> return reject  -- DisplaceProjectiles+      _ -> return reject  -- DisplaceProjectiles or trying to displace leader   else return reject  chase :: MonadClient m => ActorId -> Bool -> m (Strategy RequestAnyAbility)@@ -699,7 +705,7 @@   str <- case mtgtMPath of     Just (_, Just (p : q : _, (goal, _))) ->       -- With no leader, the goal is vague, so permit arbitrary detours.-      moveTowards aid p q goal (not $ playerLeader (gplayer fact))+      moveTowards aid p q goal (fleaderMode (gplayer fact) == LeaderNull)     _ -> return reject  -- goal reached   -- If @doDisplace@: don't pick fights, assuming the target is more important.   -- We'd normally melee the target earlier on via @AbMelee@, but for@@ -752,16 +758,18 @@   let spos = bpos sb           -- source position       tpos = spos `shift` dir  -- target position       t = lvl `at` tpos+  mleader <- getsClient _sleader   -- We start by checking actors at the the target position,   -- which gives a partial information (actors can be invisible),   -- as opposed to accessibility (and items) which are always accurate   -- (tiles can't be invisible).   tgts <- getsState $ posToActors tpos lid   case tgts of-    [((target, b2), _)] | run ->  do -- can be a foe, as well as a friend+    [((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+      dEnemy <- getsState $ dispEnemy source mleader target activeItems       if boldpos sb /= tpos -- avoid trivial Displace loops          && accessible cops lvl spos tpos -- DisplaceAccess          && (not (isAtWar tfact (bfid sb))@@ -769,7 +777,6 @@       then         return $! Just $ RequestAnyAbility $ ReqDisplace target       else do-        -- If cannot displace, hit. TODO: unless melee or wait not permitted.         wps <- pickWeaponClient source target         case wps of           [] -> return Nothing

@@ -11,6 +11,7 @@ import Data.Ord  import Game.LambdaHack.Client.AI.ConditionClient+import Game.LambdaHack.Client.AI.PickTargetClient import Game.LambdaHack.Client.CommonClient import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State@@ -26,6 +27,7 @@ import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Vector+import Game.LambdaHack.Content.ModeKind  pickActorToMove :: MonadClient m                 => (ActorId -> (ActorId, Actor)@@ -33,7 +35,7 @@                 -> ActorId                 -> m (ActorId, Actor) pickActorToMove refreshTarget oldAid = do-  cops@Kind.COps{cotile} <- getsState scops+  Kind.COps{cotile} <- getsState scops   oldBody <- getsState $ getActorBody oldAid   let side = bfid oldBody       arena = blid oldBody@@ -43,15 +45,43 @@       t = lvl `at` bpos oldBody   mleader <- getsClient _sleader   ours <- getsState $ actorRegularAssocs (== side) arena-  let pickOld = do-        void $ refreshTarget oldAid (oldAid, oldBody)+  let explore = void $ refreshTarget oldAid (oldAid, oldBody)+      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 = EM.delete oldAid (sbfsD cli)+                        , seps = seps cli + 773 }  -- randomize paths+                  mpath <- createPath oldAid tgtLeader+                  let tgtMPath = maybe (tgtLeader, Nothing)+                                       (\(tgt, p) -> (tgt, Just p)) mpath+                  modifyClient $ \cli ->+                    cli {stargetD = EM.alter (const $ Just tgtMPath)+                                             oldAid (stargetD cli)}+          TExplore -> explore+          TRoam -> explore  -- @TRoam@ is checked again inside @explore@+          TPatrol -> explore  -- TODO         return (oldAid, oldBody)   case ours of     _ | -- Keep the leader: only a leader is allowed to pick another leader.         mleader /= Just oldAid-        -- Keep the leader: all can move. TODO: check not accurate,-        -- instead define 'movesThisTurn' and use elsehwere.-        || isAllMoveFact cops fact         -- Keep the leader: he is on stairs and not stuck         -- and we don't want to clog stairs or get pushed to another level.         || not leaderStuck && Tile.isStair cotile t

@@ -1,6 +1,6 @@ -- | Let AI pick the best target for an actor. module Game.LambdaHack.Client.AI.PickTargetClient-  ( targetStrategy+  ( targetStrategy, createPath   ) where  import Control.Exception.Assert.Sugar@@ -24,7 +24,6 @@ import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.Level-import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Random@@ -33,12 +32,15 @@ import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ModeKind+import Game.LambdaHack.Content.RuleKind  -- | AI proposes possible targets for the actor. Never empty. targetStrategy :: forall m. MonadClient m                => ActorId -> ActorId -> m (Strategy (Target, Maybe PathEtc)) targetStrategy oldLeader aid = do-  cops@Kind.COps{cotile=cotile@Kind.Ops{ouniqGroup}} <- getsState scops+  cops@Kind.COps{corule, cotile=cotile@Kind.Ops{ouniqGroup}} <- getsState scops+  let stdRuleset = Kind.stdRuleset corule+      nearby = rnearby stdRuleset   itemToF <- itemToFullClient   modifyClient $ \cli -> cli { sbfsD = EM.delete aid (sbfsD cli)                              , seps = seps cli + 773 }  -- randomize paths@@ -48,20 +50,14 @@   let stepAccesible mtgt@(Just (_, (p : q : _ : _, _))) = -- goal not adjacent         if accessible cops lvl p q then mtgt else Nothing       stepAccesible mtgt = mtgt  -- goal can be inaccessible, e.g., suspect-      createPath :: Target -> m (Maybe (Target, PathEtc))-      createPath tgt = do-        mpos <- aidTgtToPos aid (blid b) (Just tgt)-        case mpos of-          Nothing -> return Nothing-          Just p -> do-            (bfs, mpath) <- getCacheBfsAndPath aid p-            return $! case mpath of-              Nothing -> Nothing-              Just path -> Just (tgt, ( bpos b : path-                                      , (p, fromMaybe (assert `failure` mpath)-                                            $ accessBfs bfs p) ))   mtgtMPath <- getsClient $ EM.lookup aid . stargetD   oldTgtUpdatedPath <- case mtgtMPath of+    Just (tgt, Nothing) ->+      -- This case is especially for TEnemyPos that would be lost otherwise.+      -- This is also triggered by @UpdLeadFaction@. The recreated path can be+      -- different than on the other client (AI or UI), but we don't care+      -- as long as the target stays the same at least for a moment.+      createPath aid tgt     Just (tgt, Just path) -> do       mvalidPos <- aidTgtToPos aid (blid b) (Just tgt)       if isNothing mvalidPos then return Nothing  -- wrong level@@ -79,19 +75,15 @@           else             Nothing  -- somebody pushed us off the goal; let's target again         ([], _) -> assert `failure` (aid, b, mtgtMPath)-    Just (tgt@TEnemyPos{}, Nothing) ->-      -- special case, TEnemyPos would be lost otherwise-      createPath tgt-    Just (_, Nothing) -> return Nothing  -- path invalidated, e.g. UpdSpotActor     Nothing -> return Nothing  -- no target assigned yet   assert (not $ bproj b) skip  -- would work, but is probably a bug   fact <- getsState $ (EM.! bfid b) . sfactionD   allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)   dungeon <- getsState sdungeon   itemD <- getsState sitemD-  -- TODO: we assume the actor eventually becomes a leader (or has the same+  -- We assume the actor eventually becomes a leader (or has the same   -- set of abilities as the leader, anyway) and set his target accordingly.-  actorSk <- actorSkillsClient aid (Just aid)+  actorSk <- maxActorSkillsClient aid   condCanProject <- condCanProjectM aid   condMeleeBad <- condMeleeBadM aid   condHpTooLow <- condHpTooLowM aid@@ -101,11 +93,11 @@   -- (then we have to target, but keep the distance, we can do similarly for   -- wounded or alone actors, perhaps only until they are shot first time,   -- and only if they can shoot at the moment)-  fightsSpawners <- fightsAgainstSpawners (bfid b)+  canEscape <- factionCanEscape (bfid b)   explored <- getsClient sexplored   smellRadius <- sumOrganEqpClient Effect.EqpSlotAddSmell aid   let canSmell = smellRadius > 0-      meleeNearby | fightsSpawners = nearby `div` 2  -- not aggresive+      meleeNearby | canEscape = nearby `div` 2  -- not aggresive                   | otherwise = nearby       rangedNearby = 2 * meleeNearby       targetableMelee body =@@ -125,7 +117,7 @@           Just (v, _) -> v           Nothing -> 30  -- experimenting is fun       desirableItem iid item k-        | fightsSpawners = itemUsefulness iid k /= 0+        | canEscape = itemUsefulness iid k /= 0                            || Effect.Precious `elem` jfeature item         | otherwise = itemUsefulness iid k /= 0       desirableBag bag = any (\(iid, k) ->@@ -137,7 +129,7 @@       focused = bspeed b activeItems < speedNormal || condHpTooLow       setPath :: Target -> m (Strategy (Target, Maybe PathEtc))       setPath tgt = do-        mpath <- createPath tgt+        mpath <- createPath aid tgt         return $! returN "pickNewTarget"                $ maybe (tgt, Nothing) (\(t, p) -> (t, Just p)) mpath       pickNewTarget :: m (Strategy (Target, Maybe PathEtc))@@ -159,7 +151,7 @@                           then closestItems aid                           else return []                 case filter desirable citems of-                  [] | not (playerLeader (gplayer fact)) -> do+                  [] | ftactic (gplayer fact) == TRoam -> do                     mtgtPrev <- getsClient $ getTarget aid                     let vOld = bpos b `vectorToFrom` boldpos b                         v = case (mtgtPrev, isUnit vOld) of@@ -224,12 +216,13 @@       updateTgt :: Target -> PathEtc                 -> m (Strategy (Target, Maybe PathEtc))       updateTgt oldTgt updatedPath@(_, (_, len)) = case oldTgt of-        TEnemy a _ -> do+        TEnemy a permit -> do           body <- getsState $ getActorBody a           if not focused  -- prefers closer foes              && a `notElem` map fst nearbyFoes  -- old one not close enough              || blid body /= blid b  -- wrong level              || actorDying body  -- foe already dying+             || permit  -- never follow a friend more than 1 step           then pickNewTarget           else if bpos body == fst (snd updatedPath)                then return $! returN "TEnemy" (oldTgt, Just updatedPath)@@ -247,11 +240,12 @@                         (oldTgt, Just ( bpos b : path                                       , (p, fromMaybe (assert `failure` mpath)                                             $ accessBfs bfs p) ))-        TEnemyPos _ lid p _ ->+        TEnemyPos _ lid p permit ->           -- Chase last position even if foe hides or dies,           -- to find his companions, loot, etc.           if lid /= blid b  -- wrong level              || chessDist (bpos b) p >= nearby  -- too far and not visible+             || permit  -- never follow a friend more than 1 step           then pickNewTarget           else if p == bpos b                then tellOthersNothingHere p@@ -271,9 +265,8 @@                  || not (desirableBag (lvl `atI` pos)))                 && (not canSmell  -- closestSmell                     || pos == bpos b  -- in case server resends deleted smell-                    || let sml =-                             EM.findWithDefault timeZero pos (lsmell lvl)-                       in sml `timeDeltaToFrom` ltime lvl <= Delta timeZero)+                    || let sml = EM.findWithDefault timeZero pos (lsmell lvl)+                       in sml <= ltime lvl)                 && let t = lvl `at` pos                    in if ES.notMember lid explored                       then t /= unknownId  -- closestUnknown@@ -283,23 +276,27 @@                         -- leaving the level or dungeon.                         not (null allFoes)                         || -- If all explored, escape/block escapes.-                           (EM.findWithDefault 0 AbTrigger actorSk <= 0-                            || not (Tile.isEscape cotile t && allExplored))+                           (not (Tile.isEscape cotile t)+                            || not allExplored)                            -- The next case is stairs in closestTriggers.                            -- We don't determine if the stairs are interesting                            -- (this changes with time), but allow the actor-                           -- to reach them and then retarget.-                           && not (pos /= bpos b && Tile.isStair cotile t)+                           -- to reach them and then retarget, unless he can't+                           -- trigger them in the first place.+                           && (EM.findWithDefault 0 AbTrigger actorSk <= 0+                               || pos == bpos b+                               || not (Tile.isStair cotile t))                            -- The remaining case is furthestKnown. This is                            -- always an unimportant target, so we forget it-                           -- if the actor is stuck (could move, but waits).+                           -- if the actor is stuck (waits, though could move;+                           -- or has zeroed individual moving skill,+                           -- but then should change targets often anyway).                            && let isStuck =                                     waitedLastTurn b-                                    && (oldLeader == aid-                                        || isAllMoveFact cops fact)-                              in not (pos /= bpos b-                                      && not isStuck-                                      && allExplored)+                                    && canMoveFact fact (oldLeader == aid)+                              in pos == bpos b+                                 || isStuck+                                 || not allExplored           then pickNewTarget           else return $! returN "TPoint" (oldTgt, Just updatedPath)         TVector{} | len > 1 ->@@ -308,3 +305,18 @@   case oldTgtUpdatedPath of     Just (oldTgt, updatedPath) -> updateTgt oldTgt updatedPath     Nothing -> pickNewTarget++createPath :: MonadClient m+           => ActorId -> Target -> m (Maybe (Target, PathEtc))+createPath aid tgt = do+  b <- getsState $ getActorBody aid+  mpos <- aidTgtToPos aid (blid b) (Just tgt)+  case mpos of+    Nothing -> return Nothing+    Just p -> do+      (bfs, mpath) <- getCacheBfsAndPath aid p+      return $! case mpath of+        Nothing -> Nothing+        Just path -> Just (tgt, ( bpos b : path+                                , (p, fromMaybe (assert `failure` mpath)+                                      $ accessBfs bfs p) ))

@@ -17,6 +17,7 @@ import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Content.ItemKind+import Game.LambdaHack.Content.ModeKind  -- | How much AI benefits from applying the effect. Multipllied by item p. -- Negative means harm to the enemy when thrown at him. Effects with zero@@ -24,7 +25,7 @@ effectToBenefit :: Kind.COps -> Actor -> [ItemFull] -> Faction                 -> Effect.Effect Int -> Int effectToBenefit cops b activeItems fact eff =-  let isHorror = isHorrorFact cops fact+  let dungeonDweller = not $ fcanEscape $ gplayer fact   in case eff of     Effect.NoEffect _ -> 0     Effect.RefillHP p ->@@ -41,8 +42,8 @@     Effect.Dominate -> -200     Effect.Impress -> -10     Effect.CallFriend p -> 20 * p-    Effect.Summon{} | isHorror -> 1    -- probably generates friends or crazies-    Effect.Summon{} -> 0               -- probably generates enemies+    Effect.Summon{} | dungeonDweller -> 1 -- probably summons friends or crazies+    Effect.Summon{} -> 0                  -- probably generates enemies     Effect.CreateItem p -> 20 * p     Effect.ApplyPerfume -> -10     Effect.Burn p -> -15 * p           -- usually splash damage, etc.

@@ -1,11 +1,12 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} -- | Breadth first search algorithms. module Game.LambdaHack.Client.Bfs   ( -- * Public API     BfsDistance, MoveLegal(..), apartBfs   , fillBfs, findPathBfs, accessBfs-    -- * Internal functions+#ifdef EXPOSE_INTERNAL   , minKnownBfs+#endif   ) where  import Control.Arrow (second)

@@ -1,4 +1,4 @@-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE CPP, TupleSections #-} -- | Breadth first search and realted algorithms using the client monad. module Game.LambdaHack.Client.BfsClient   ( getCacheBfsAndPath, getCacheBfs, accessCacheBfs@@ -97,8 +97,12 @@ computeAnythingBFS fAnything aid = do   cops@Kind.COps{cotile=cotile@Kind.Ops{ouniqGroup}} <- getsState scops   b <- getsState $ getActorBody aid-  mleader <- getsClient _sleader-  actorSk <- actorSkillsClient aid mleader  -- TODO: reset BFS at leader change?+  -- We assume the actor eventually becomes a leader (or has the same+  -- set of abilities as the leader, anyway). Otherwise we'd have+  -- to reset BFS after leader changes, but it would still lead to+  -- wasted movement if, e.g., non-leaders move but only leaders open doors+  -- and leader change is very rare.+  actorSk <- maxActorSkillsClient aid   lvl <- getLevel $ blid b   -- We treat doors as an open tile and don't add an extra step for opening   -- the doors, because other actors open and use them, too,@@ -182,8 +186,8 @@ closestSmell :: MonadClient m => ActorId -> m [(Int, (Point, Tile.SmellTime))] closestSmell aid = do   body <- getsState $ getActorBody aid-  Level{lsmell} <- getLevel $ blid body-  let smells = EM.assocs lsmell+  Level{lsmell, ltime} <- getLevel $ blid body+  let smells = filter ((> ltime) . snd) $ EM.assocs lsmell   case smells of     [] -> return []     _ -> do

@@ -3,7 +3,8 @@ module Game.LambdaHack.Client.CommonClient   ( getPerFid, aidTgtToPos, aidTgtAims, makeLine   , partAidLeader, partActorLeader, partPronounLeader-  , actorSkillsClient, updateItemSlot, fullAssocsClient, activeItemsClient+  , actorSkillsClient, maxActorSkillsClient+  , updateItemSlot, fullAssocsClient, activeItemsClient   , itemToFullClient, pickWeaponClient, sumOrganEqpClient, getModeClient   ) where @@ -22,6 +23,7 @@ import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import qualified Game.LambdaHack.Common.Effect as Effect+import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.ItemStrongest import qualified Game.LambdaHack.Common.Kind as Kind@@ -165,6 +167,14 @@   activeItems <- activeItemsClient aid   getsState $ actorSkills aid mleader activeItems +maxActorSkillsClient :: MonadClient m+                     => ActorId -> m Ability.Skills+maxActorSkillsClient aid = do+  activeItems <- activeItemsClient aid+  skOther <- getsState $ actorSkills aid Nothing activeItems+  skLeader <- getsState $ actorSkills aid (Just aid) activeItems+  return $! Ability.maxSkills skOther skLeader+ updateItemSlot :: MonadClient m => Maybe ActorId -> ItemId -> m () updateItemSlot maid iid = do   slots@(letterSlots, numberSlots) <- getsClient sslots@@ -190,9 +200,9 @@                  => ActorId -> [CStore] -> m [(ItemId, ItemFull)] fullAssocsClient aid cstores = do   cops <- getsState scops-  disco <- getsClient sdisco-  discoAE <- getsClient sdiscoAE-  getsState $ fullAssocs cops disco discoAE aid cstores+  discoKind <- getsClient sdiscoKind+  discoEffect <- getsClient sdiscoEffect+  getsState $ fullAssocs cops discoKind discoEffect aid cstores  activeItemsClient :: MonadClient m => ActorId -> m [ItemFull] activeItemsClient aid = do@@ -202,10 +212,11 @@ itemToFullClient :: MonadClient m => m (ItemId -> Int -> ItemFull) itemToFullClient = do   cops <- getsState scops-  disco <- getsClient sdisco-  discoAE <- getsClient sdiscoAE+  discoKind <- getsClient sdiscoKind+  discoEffect <- getsClient sdiscoEffect   s <- getState-  let itemToF iid = itemToFull cops disco discoAE iid (getItemBody iid s)+  let itemToF iid = itemToFull cops discoKind discoEffect iid+                               (getItemBody iid s)   return itemToF  -- Client has to choose the weapon based on its partial knowledge,

@@ -1,8 +1,10 @@+{-# LANGUAGE TupleSections #-} -- | Handle atomic commands received by the client. module Game.LambdaHack.Client.HandleAtomicClient   ( cmdAtomicSemCli, cmdAtomicFilterCli   ) where +import Control.Applicative import Control.Exception.Assert.Sugar import Control.Monad import qualified Data.EnumMap.Strict as EM@@ -18,6 +20,7 @@ import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.ClientOptions import qualified Game.LambdaHack.Common.Effect as Effect+import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.Level@@ -118,11 +121,11 @@     case EM.lookup iid itemD of       Nothing -> return []       Just item -> do-        disco <- getsClient sdisco-        if jkindIx item `EM.member` disco+        discoKind <- getsClient sdiscoKind+        if jkindIx item `EM.member` discoKind           then do-            discoAE <- getsClient sdiscoAE-            if iid `EM.member` discoAE+            discoEffect <- getsClient sdiscoEffect+            if iid `EM.member` discoEffect               then return []               else return [UpdDiscoverSeed lid p iid seed]           else return [cmd]@@ -131,12 +134,12 @@     case EM.lookup iid itemD of       Nothing -> return []       Just item -> do-        disco <- getsClient sdisco-        if jkindIx item `EM.notMember` disco+        discoKind <- getsClient sdiscoKind+        if jkindIx item `EM.notMember` discoKind           then return []           else do-            discoAE <- getsClient sdiscoAE-            if iid `EM.notMember` discoAE+            discoEffect <- getsClient sdiscoEffect+            if iid `EM.notMember` discoEffect               then return [cmd]               else return [UpdCoverKind lid p iid ik]   UpdDiscoverKind _ _ iid _ -> do@@ -144,8 +147,8 @@     case EM.lookup iid itemD of       Nothing -> return []       Just item -> do-        disco <- getsClient sdisco-        if jkindIx item `EM.notMember` disco+        discoKind <- getsClient sdiscoKind+        if jkindIx item `EM.notMember` discoKind         then return []         else return [cmd]   UpdCoverKind _ _ iid _ -> do@@ -153,8 +156,8 @@     case EM.lookup iid itemD of       Nothing -> return []       Just item -> do-        disco <- getsClient sdisco-        if jkindIx item `EM.notMember` disco+        discoKind <- getsClient sdiscoKind+        if jkindIx item `EM.notMember` discoKind         then return []         else return [cmd]   UpdDiscoverSeed _ _ iid _ -> do@@ -162,12 +165,12 @@     case EM.lookup iid itemD of       Nothing -> return []       Just item -> do-        disco <- getsClient sdisco-        if jkindIx item `EM.notMember` disco+        discoKind <- getsClient sdiscoKind+        if jkindIx item `EM.notMember` discoKind         then return []         else do-          discoAE <- getsClient sdiscoAE-          if iid `EM.member` discoAE+          discoEffect <- getsClient sdiscoEffect+          if iid `EM.member` discoEffect             then return []             else return [cmd]   UpdCoverSeed _ _ iid _ -> do@@ -175,12 +178,12 @@     case EM.lookup iid itemD of       Nothing -> return []       Just item -> do-        disco <- getsClient sdisco-        if jkindIx item `EM.notMember` disco+        discoKind <- getsClient sdiscoKind+        if jkindIx item `EM.notMember` discoKind         then return []         else do-          discoAE <- getsClient sdiscoAE-          if iid `EM.notMember` discoAE+          discoEffect <- getsClient sdiscoEffect+          if iid `EM.notMember` discoEffect             then return []             else return [cmd]   UpdPerception lid outPer inPer -> do@@ -261,10 +264,26 @@     side <- getsClient sside     when (side == fid) $ do       mleader <- getsClient _sleader-      assert (mleader == source     -- somebody changed the leader for us-              || mleader == target  -- we changed the leader originally+      assert (mleader == fmap fst source  -- somebody changed the leader for us+              || mleader == fmap fst target  -- we changed the leader ourselves               `blame` "unexpected leader" `twith` (cmd, mleader)) skip-      modifyClient $ \cli -> cli {_sleader = target}+      modifyClient $ \cli -> cli {_sleader = fmap fst target}+      case target of+        Nothing -> return ()+        Just (aid, mtgt) ->+          modifyClient $ \cli ->+            cli {stargetD = EM.alter (const $ (,Nothing) <$> mtgt)+                                     aid (stargetD cli)}+  UpdAutoFaction{} -> do+    -- Clear all targets except the leader's.+    mleader <- getsClient _sleader+    mtgt <- case mleader of+      Nothing -> return Nothing+      Just leader -> getsClient $ EM.lookup leader . stargetD+    modifyClient $ \cli ->+      cli { stargetD = case (mtgt, mleader) of+              (Just tgt, Just leader) -> EM.singleton leader tgt+              _ -> EM.empty }   UpdDiscover lid p iid ik seed -> do     discoverKind lid p iid ik     discoverSeed lid p iid seed@@ -276,12 +295,12 @@   UpdDiscoverSeed lid p iid seed -> discoverSeed lid p iid seed   UpdCoverSeed lid p iid seed -> coverSeed lid p iid seed   UpdPerception lid outPer inPer -> perception lid outPer inPer-  UpdRestart side sdisco sfper _ sdebugCli sgameMode -> do+  UpdRestart side sdiscoKind sfper _ sdebugCli sgameMode -> do     shistory <- getsClient shistory     sreport <- getsClient sreport     isAI <- getsClient sisAI     let cli = defStateClient shistory sreport side isAI-    putClient cli { sdisco+    putClient cli { sdiscoKind                   , sfper                   -- , sundo = [UpdAtomic cmd]                   , scurDifficulty = sdifficultyCli sdebugCli@@ -289,7 +308,7 @@                   , sdebugCli }   UpdResume _fid sfper -> modifyClient $ \cli -> cli {sfper}   UpdKillExit _fid -> killExit-  UpdSaveBkp -> saveClient+  UpdWriteSave -> saveClient   _ -> return ()  createActor :: MonadClient m => ActorId -> Actor -> m ()@@ -309,7 +328,7 @@   modifyClient $ \cli -> cli {sbfsD = EM.delete aid $ sbfsD cli}  -- gc   let affect tgt = case tgt of         TEnemy a permit | a == aid -> TEnemyPos a (blid b) (bpos b) permit-          -- Don't consider @destroy@, because even if actor dead, it makes+          -- Don't heed @destroy@, because even if actor dead, it makes           -- sense to go to last known location to loot or find others.         _ -> tgt       affect3 (tgt, mpath) =@@ -350,7 +369,7 @@   let f Nothing = Just ik       f Just{} = assert `failure` "already discovered"                         `twith` (lid, p, iid, ik)-  modifyClient $ \cli -> cli {sdisco = EM.alter f (jkindIx item) (sdisco cli)}+  modifyClient $ \cli -> cli {sdiscoKind = EM.alter f (jkindIx item) (sdiscoKind cli)}  coverKind :: MonadClient m           => LevelId -> Point -> ItemId -> Kind.Id ItemKind -> m ()@@ -359,17 +378,17 @@   let f Nothing = assert `failure` "already covered" `twith` (lid, p, iid, ik)       f (Just ik2) = assert (ik == ik2 `blame` "unexpected covered item kind"                                        `twith` (ik, ik2)) Nothing-  modifyClient $ \cli -> cli {sdisco = EM.alter f (jkindIx item) (sdisco cli)}+  modifyClient $ \cli -> cli {sdiscoKind = EM.alter f (jkindIx item) (sdiscoKind cli)}  discoverSeed :: MonadClient m              => LevelId -> Point -> ItemId -> ItemSeed -> m () discoverSeed lid p iid seed = do   Kind.COps{coitem=Kind.Ops{okind}} <- getsState scops-  disco <- getsClient sdisco+  discoKind <- getsClient sdiscoKind   item <- getsState $ getItemBody iid   Level{ldepth} <- getLevel (jlid item)   totalDepth <- getsState stotalDepth-  case EM.lookup (jkindIx item) disco of+  case EM.lookup (jkindIx item) discoKind of     Nothing -> assert `failure` "kind not known"                       `twith` (lid, p, iid, seed)     Just ik -> do@@ -377,14 +396,14 @@           f Nothing = Just $ seedToAspectsEffects seed kind ldepth totalDepth           f Just{} = assert `failure` "already discovered"                             `twith` (lid, p, iid, seed)-      modifyClient $ \cli -> cli {sdiscoAE = EM.alter f iid (sdiscoAE cli)}+      modifyClient $ \cli -> cli {sdiscoEffect = EM.alter f iid (sdiscoEffect cli)}  coverSeed :: MonadClient m           => LevelId -> Point -> ItemId -> ItemSeed -> m () coverSeed lid p iid ik = do   let f Nothing = assert `failure` "already covered" `twith` (lid, p, iid, ik)       f Just{} = Nothing  -- checking that old and new agree is too much work-  modifyClient $ \cli -> cli {sdiscoAE = EM.alter f iid (sdiscoAE cli)}+  modifyClient $ \cli -> cli {sdiscoEffect = EM.alter f iid (sdiscoEffect cli)}  killExit :: MonadClient m => m () killExit = modifyClient $ \cli -> cli {squit = True}

@@ -108,7 +108,7 @@       handleResponseUI cmd1     _ -> assert `failure` "unexpected command" `twith` (side, restored, cmd1)   fact <- getsState $ (EM.! side) . sfactionD-  when (playerAI $ gplayer fact) $+  when (isAIFact fact) $     -- Prod the frontend to flush frames and start showing then continuously.     void $ displayMore ColorFull "The team is under AI control (ESC to stop)."   -- State and client state now valid.

@@ -60,17 +60,20 @@  restoreGame :: MonadClient m => m (Maybe (State, StateClient)) restoreGame = do-  Kind.COps{corule} <- getsState scops-  let stdRuleset = Kind.stdRuleset corule-      pathsDataFile = rpathsDataFile stdRuleset-      cfgUIName = rcfgUIName stdRuleset-  side <- getsClient sside-  isAI <- getsClient sisAI-  prefix <- getsClient $ ssavePrefixCli . sdebugCli-  let copies = [( "GameDefinition" </> cfgUIName <.> "default"-                , cfgUIName <.> "ini" )]-      name = fromMaybe "save" prefix <.> saveName side isAI-  liftIO $ Save.restoreGame name copies pathsDataFile+  bench <- getsClient $ sbenchmark . sdebugCli+  if bench then return Nothing+  else do+    Kind.COps{corule} <- getsState scops+    let stdRuleset = Kind.stdRuleset corule+        pathsDataFile = rpathsDataFile stdRuleset+        cfgUIName = rcfgUIName stdRuleset+    side <- getsClient sside+    isAI <- getsClient sisAI+    prefix <- getsClient $ ssavePrefixCli . sdebugCli+    let copies = [( "GameDefinition" </> cfgUIName <.> "default"+                  , cfgUIName <.> "ini" )]+        name = fromMaybe "save" prefix <.> saveName side isAI+    liftIO $ Save.restoreGame name copies pathsDataFile  -- | Assuming the client runs on the same machine and for the same -- user as the server, move the server savegame out of the way.

@@ -3,12 +3,11 @@ module Game.LambdaHack.Client.State   ( StateClient(..), defStateClient, defaultHistory   , updateTarget, getTarget, updateLeader, sside-  , PathEtc, TgtMode(..), Target(..), RunParams(..), LastRecord+  , PathEtc, TgtMode(..), RunParams(..), LastRecord   , toggleMarkVision, toggleMarkSmell, toggleMarkSuspect   ) where  import Control.Exception.Assert.Sugar-import Control.Monad import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES@@ -29,6 +28,7 @@ import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Level+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Msg import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point@@ -64,8 +64,8 @@   , sdisplayed   :: !(EM.EnumMap LevelId Time)                                    -- ^ moves are displayed up to this time   , sundo        :: ![CmdAtomic]   -- ^ atomic commands performed to date-  , sdisco       :: !Discovery     -- ^ remembered item discoveries-  , sdiscoAE     :: !DiscoAE       -- ^ remembered aspects and effects of items+  , sdiscoKind   :: !DiscoveryKind    -- ^ remembered item discoveries+  , sdiscoEffect :: !DiscoveryEffect  -- ^ remembered effects&Co of items   , sfper        :: !FactionPers   -- ^ faction perception indexed by levels   , srandom      :: !R.StdGen      -- ^ current random generator   , slastRecord  :: !LastRecord    -- ^ state of key sequence recording@@ -82,7 +82,7 @@   , scurDifficulty :: !Int         -- ^ current game difficulty level   , sslots       :: !ItemSlots     -- ^ map from slots to items   , slastSlot    :: !SlotChar      -- ^ last used slot-  , sgameMode    :: !Text          -- ^ current game mode+  , sgameMode    :: !GroupName     -- ^ current game mode   , sdebugCli    :: !DebugModeCli  -- ^ client debugging mode   }   deriving Show@@ -93,16 +93,6 @@ newtype TgtMode = TgtMode { tgtLevelId :: LevelId }   deriving (Show, Eq, Binary) --- | The type of na actor target.-data Target =-    TEnemy !ActorId !Bool-    -- ^ target an actor; cycle only trough seen foes, unless the flag is set-  | TEnemyPos !ActorId !LevelId !Point !Bool-    -- ^ last seen position of the targeted actor-  | TPoint !LevelId !Point              -- ^ target a concrete spot-  | TVector !Vector                     -- ^ target position relative to actor-  deriving (Show, Eq)- -- | Parameters of the current run. data RunParams = RunParams   { runLeader  :: !ActorId         -- ^ the original leader from run start@@ -137,8 +127,8 @@     , shistory     , sdisplayed = EM.empty     , sundo = []-    , sdisco = EM.empty-    , sdiscoAE = EM.empty+    , sdiscoKind = EM.empty+    , sdiscoEffect = EM.empty     , sfper = EM.empty     , srandom = R.mkStdGen 42  -- will be set later     , slastRecord = ([], [], 0)@@ -213,8 +203,8 @@     put shistory     put sundo     put sdisplayed-    put sdisco-    put sdiscoAE+    put sdiscoKind+    put sdiscoEffect     put (show srandom)     put _sleader     put _sside@@ -239,8 +229,8 @@     shistory <- get     sundo <- get     sdisplayed <- get-    sdisco <- get-    sdiscoAE <- get+    sdiscoKind <- get+    sdiscoEffect <- get     g <- get     _sleader <- get     _sside <- get@@ -276,18 +266,3 @@     runStopMsg <- get     runInitDir <- get     return $! RunParams{..}--instance Binary Target where-  put (TEnemy a permit) = putWord8 0 >> put a >> put permit-  put (TEnemyPos a lid p permit) =-    putWord8 1 >> put a >> put lid >> put p >> put permit-  put (TPoint lid p) = putWord8 2 >> put lid >> put p-  put (TVector v) = putWord8 3 >> put v-  get = do-    tag <- getWord8-    case tag of-      0 -> liftM2 TEnemy get get-      1 -> liftM4 TEnemyPos get get get get-      2 -> liftM2 TPoint get get-      3 -> liftM TVector get-      _ -> fail "no parse (Target)"

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | Ways for the client to use player input via UI to produce server -- requests, based on the client's view (visualized for the player) -- of the game state.@@ -11,8 +12,9 @@   , srtFrontend, KeyKind, SessionUI     -- * Operations exposed for LoopClient   , ColorMode(..), displayMore, msgAdd-    -- * Internal functions+#ifdef EXPOSE_INTERNAL   , humanCommand+#endif   ) where  import Control.Exception.Assert.Sugar@@ -46,21 +48,20 @@ -- | Handle the move of a UI player. queryUI :: MonadClientUI m => m RequestUI queryUI = do-  cops <- getsState scops   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD-  let leader = fromMaybe (assert `failure` fact) $ gleader fact+  let (leader, mtgt) = fromMaybe (assert `failure` fact) $ gleader fact   srunning <- getsClient srunning   -- When running, stop if disturbed. If not running, let the human   -- player issue commands, until any command takes time.   req <- case srunning of     Nothing -> humanCommand Nothing     Just RunParams{runMembers}-      | isAllMoveFact cops fact && runMembers /= [leader] -> do+      | noRunWithMulti fact && runMembers /= [leader] -> do       stopRunning       Config{configRunStopMsgs} <- askConfig       let msg = if configRunStopMsgs-                then Just $ "Run stop: all-mover leader change"+                then Just $ "Run stop: automatic leader change"                 else Nothing       humanCommand msg     Just runParams -> do@@ -78,8 +79,9 @@           displayPush           return $! anyToUI $ runCmd   leader2 <- getLeaderUI-  if leader2 /= leader-    then return $! ReqUILeader leader2 req+  mtgt2 <- getsClient $ fmap fst . EM.lookup leader2 . stargetD+  if (leader2, mtgt2) /= (leader, mtgt)+    then return $! ReqUILeader leader2 mtgt2 req     else return $! req  -- | Determine and process the next human player command. The argument is@@ -166,8 +168,8 @@   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD   let pong ats = return $ ReqUIPong ats-      underAI = playerAI $ gplayer fact-  if escPressed && underAI && playerLeader (gplayer fact) then do+      underAI = isAIFact fact+  if escPressed && underAI && fleaderMode (gplayer fact) /= LeaderNull then do     -- Ask server to turn off AI for the faction's leader.     let atomicCmd = UpdAtomic $ UpdAutoFaction side False     pong [atomicCmd]

@@ -84,8 +84,8 @@   in Config{..}  -- | Read and parse UI config file.-mkConfig :: Kind.Ops RuleKind -> IO Config-mkConfig corule = do+mkConfig :: Kind.COps -> IO Config+mkConfig Kind.COps{corule} = do   let stdRuleset = Kind.stdRuleset corule       cfgUIName = rcfgUIName stdRuleset       commentsUIDefault = init $ map (drop 2) $ lines $ rcfgUIDefault stdRuleset  -- TODO: init is a hack until Ini accepts empty files@@ -105,9 +105,9 @@   -- Catch syntax errors in complex expressions ASAP,   return $! deepseq conf conf -applyConfigToDebug :: Config -> DebugModeCli -> Kind.Ops RuleKind+applyConfigToDebug :: Config -> DebugModeCli -> Kind.COps                    -> DebugModeCli-applyConfigToDebug sconfig sdebugCli corule =+applyConfigToDebug sconfig sdebugCli Kind.COps{corule} =   let stdRuleset = Kind.stdRuleset corule   in (\dbg -> dbg {sfont =         sfont dbg `mplus` Just (configFont sconfig)}) .

@@ -129,15 +129,14 @@   UpdColorActor{} -> skip   -- Change faction attributes.   UpdQuitFaction fid mbody _ toSt -> quitFactionUI fid mbody toSt-  UpdLeadFaction fid (Just source) (Just target) -> do-    cops <- getsState scops+  UpdLeadFaction fid (Just (source, _)) (Just (target, _)) -> do     side <- getsClient sside     when (fid == side) $ do       fact <- getsState $ (EM.! side) . sfactionD-      -- All-movers can't run with multiple actors, so the following is not+      -- This faction can't run with multiple actors, so this is not       -- a leader change while running, but rather server changing       -- their leader, which the player should be alerted to.-      when (isAllMoveFact cops fact) stopPlayBack+      when (noRunWithMulti fact) stopPlayBack       actorD <- getsState sactorD       case EM.lookup source actorD of         Just sb | bhp sb <= 0 -> assert (not $ bproj sb) $ do@@ -161,6 +160,7 @@         showDipl Alliance = "allied"         showDipl War = "at war"     msgAdd $ name1 <+> "and" <+> name2 <+> "are now" <+> showDipl toDipl <> "."+  UpdTacticFaction{} -> skip   UpdAutoFaction{} -> skip   UpdRecordKill{} -> skip   -- Alter map.@@ -210,7 +210,7 @@   UpdResume{} -> skip   UpdResumeServer{} -> skip   UpdKillExit{} -> skip-  UpdSaveBkp -> when verbose $ msgAdd "Saving backup."+  UpdWriteSave -> when verbose $ msgAdd "Saving backup."   UpdMsgAll msg -> msgAdd msg   UpdRecordHistory _ -> recordHistory @@ -309,7 +309,7 @@     (_, _) | c1 == CGround -> do       when (bfid b == side) $ updateItemSlot (Just aid) iid       fact <- getsState $ (EM.! bfid b) . sfactionD-      let underAI = playerAI $ gplayer fact+      let underAI = isAIFact fact       mleader <- getsClient _sleader       if Just aid == mleader && not underAI then do         itemToF <- itemToFullClient@@ -351,10 +351,10 @@ quitFactionUI :: MonadClientUI m               => FactionId -> Maybe Actor -> Maybe Status -> m () quitFactionUI fid mbody toSt = do-  cops@Kind.COps{coitem=Kind.Ops{okind, ouniqGroup}} <- getsState scops+  Kind.COps{coitem=Kind.Ops{okind, ouniqGroup}} <- getsState scops   fact <- getsState $ (EM.! fid) . sfactionD   let fidName = MU.Text $ gname fact-      horror = isHorrorFact cops fact+      horror = isHorrorFact fact   side <- getsClient sside   let msgIfSide _ | fid /= side = Nothing       msgIfSide s = Just s@@ -378,11 +378,13 @@         Just Status{stOutcome=Escape} ->           ( Just "achieve victory"           , msgIfSide "Can it be done better, though?" )-        Just Status{stOutcome=Restart, stInfo} ->-          ( Just $ MU.Text $ "order mission restart in" <+> stInfo <+> "mode"+        Just Status{stOutcome=Restart, stNewGame=Just gn} ->+          ( Just $ MU.Text $ "order mission restart in" <+> tshow gn <+> "mode"           , Just $ if fid == side                    then "This time for real."                    else "Somebody couldn't stand the heat." )+        Just Status{stOutcome=Restart, stNewGame=Nothing} ->+          assert `failure` (fid, mbody, toSt)         Nothing ->           (Nothing, Nothing)  -- Wipe out the quit flag for the savegame files.   case startingPart of@@ -396,7 +398,7 @@         Just body | fid == side -> getsState $ calculateTotal body         _ -> case gleader fact of           Nothing -> return (EM.empty, 0)-          Just aid -> do+          Just (aid, _) -> do             b <- getsState $ getActorBody aid             getsState $ calculateTotal b       let currencyName = MU.Text $ iname $ okind $ ouniqGroup "currency"@@ -442,7 +444,7 @@                                   "turn out to be"         , MU.AW $ MU.Phrase [knownName, knownAEText] ]       oldItemFull =-        itemToFull cops (sdisco oldcli) (sdiscoAE oldcli)+        itemToFull cops (sdiscoKind oldcli) (sdiscoEffect oldcli)                    iid (itemBase itemFull) 1   -- Compare descriptions of all aspects and effects to determine   -- if the discovery was meaningful to the player.@@ -648,7 +650,7 @@         -- the request extra message may be shown, so the other frame is better.         mleader <- getsClient _sleader         fact <- getsState $ (EM.! bfid b) . sfactionD-        let underAI = playerAI $ gplayer fact+        let underAI = isAIFact fact         unless (Just aid == mleader && not underAI) $           -- Something new is gonna happen on this level (otherwise we'd send           -- @UpdAgeLevel@ later on, with a larger time increment),

@@ -137,7 +137,7 @@                     && (maybe False (elem pos0) mpath) ->                   (';', Color.defAttr {Color.fg = fgOnPathOrLine})                 Just (aid, m) -> viewActor aid m-                _ | smarkSmell && smlt > Delta timeZero ->+                _ | smarkSmell && sml > ltime ->                   (timeDeltaToDigit smellTimeout smlt, rainbow pos0)                   | otherwise ->                   case floorIids of@@ -378,7 +378,7 @@                                     then fitWords rest                                     else l         in T.unwords $ reverse $ fitWords $ reverse $ T.words t-      ourName = nameN (width - 1) $ playerName $ gplayer fact+      ourName = nameN (width - 1) $ fname $ gplayer fact   return $! if T.null ourName || T.length ourName >= width             then []             else addAttr $ ourName <> " "

@@ -1,5 +1,6 @@--- | Text frontend based on Gtk.+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+-- | Text frontend based on Gtk. module Game.LambdaHack.Client.UI.Frontend.Gtk   ( -- * Session data type for the frontend     FrontendSession(sescMVar)@@ -20,6 +21,8 @@ import Data.List import qualified Data.Map.Strict as M import Data.Maybe+import Data.String (IsString (..))+import qualified Data.Text as T import Graphics.UI.Gtk hiding (Point) import System.Time @@ -130,7 +133,11 @@   sview `on` keyPressEvent $ do     n <- eventKeyName     mods <- eventModifier+#if MIN_VERSION_gtk(0,13,0)+    let !key = K.keyTranslate $ T.unpack n+#else     let !key = K.keyTranslate n+#endif         !modifier = modifierTranslate mods     liftIO $ do       unless (deadKey n) $ do@@ -149,15 +156,15 @@     but <- eventButton     liftIO $ case but of       RightButton -> do-        fsd <- fontSelectionDialogNew "Choose font"+        fsd <- fontSelectionDialogNew ("Choose font" :: String)         cf  <- readIORef currentfont  -- TODO: "Terminus,Monospace" fails         fds <- fontDescriptionToString cf-        fontSelectionDialogSetFontName fsd fds-        fontSelectionDialogSetPreviewText fsd "eee...@.##+##"+        fontSelectionDialogSetFontName fsd (fds :: String)+        fontSelectionDialogSetPreviewText fsd ("eee...@.##+##" :: String)         resp <- dialogRun fsd         when (resp == ResponseOk) $ do           fn <- fontSelectionDialogGetFontName fsd-          case fn of+          case fn :: Maybe String of             Just fn' -> do               fd <- fontDescriptionFromString fn'               writeIORef currentfont fd@@ -431,7 +438,7 @@   return km  -- | Tells a dead key.-deadKey :: String -> Bool+deadKey :: (Eq t, IsString t) => t -> Bool deadKey x = case x of   "Shift_L"          -> True   "Shift_R"          -> True

@@ -37,8 +37,8 @@   Move v -> fmap anyToUI <$> moveRunHuman False v   Run v -> fmap anyToUI <$> moveRunHuman True v   Wait -> Right <$> fmap ReqUITimed waitHuman-  MoveItem cLegalRaw toCStore verbRaw _ auto ->-    fmap ReqUITimed <$> moveItemHuman cLegalRaw toCStore verbRaw auto+  MoveItem cLegalRaw toCStore verb _ auto ->+    fmap ReqUITimed <$> moveItemHuman cLegalRaw toCStore verb auto   Project ts -> fmap ReqUITimed <$> projectHuman ts   Apply ts -> fmap ReqUITimed <$> applyHuman ts   AlterDir ts -> fmap ReqUITimed <$> alterDirHuman ts@@ -48,6 +48,7 @@   GameRestart t -> gameRestartHuman t   GameExit -> gameExitHuman   GameSave -> fmap Right gameSaveHuman+  Tactic -> tacticHuman   Automate -> automateHuman    -- Local.

@@ -8,7 +8,7 @@   , projectHuman, applyHuman, alterDirHuman, triggerTileHuman   , stepToTargetHuman     -- * Commands that never take time-  , gameRestartHuman, gameExitHuman, gameSaveHuman, automateHuman+  , gameRestartHuman, gameExitHuman, gameSaveHuman, tacticHuman, automateHuman   ) where  import Control.Applicative@@ -19,7 +19,7 @@ import Data.List import Data.Maybe import Data.Monoid-import Data.Text (Text)+import qualified Data.Text as T import qualified NLP.Miniutter.English as MU  import Game.LambdaHack.Client.BfsClient@@ -56,6 +56,7 @@ import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Vector+import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.TileKind  -- * Move and Run@@ -87,9 +88,8 @@         case runStopOrCmd of           Left stopMsg -> failWith stopMsg           Right runCmd -> do-            cops <- getsState scops             sel <- getsClient sselected-            let runMembers = if isAllMoveFact cops fact+            let runMembers = if noRunWithMulti fact                              then [leader]  -- TODO: warn?                              else ES.toList (ES.delete leader sel) ++ [leader]                 runParams = RunParams { runLeader = leader@@ -115,8 +115,8 @@         -- attack the first one.         -- We always see actors from our own faction.         if bfid tb == bfid sb && not (bproj tb) then do-          cops <- getsState scops-          if isAllMoveFact cops fact then failWith msgCannotChangeLeader+          let autoLvl = snd $ autoDungeonLevel fact+          if autoLvl then failWith msgNoChangeLvlLeader           else do             -- Select adjacent actor by bumping into him. Takes no time.             success <- pickLeader True target@@ -164,7 +164,7 @@   tb <- getsState $ getActorBody target   tfact <- getsState $ (EM.! bfid tb) . sfactionD   activeItems <- activeItemsClient target-  disp <- getsState $ dispEnemy leader target activeItems+  disp <- getsState $ dispEnemy leader (Just leader) target activeItems   let spos = bpos sb       tpos = bpos tb       adj = checkAdjacent sb tb@@ -199,9 +199,9 @@ -- * MoveItem  moveItemHuman :: MonadClientUI m-              => [CStore] -> CStore -> Text -> Bool+              => [CStore] -> CStore -> MU.Part -> Bool               -> m (SlideOrCmd (RequestTimed AbMoveItem))-moveItemHuman cLegalRaw destCStore verbRaw auto = do+moveItemHuman cLegalRaw destCStore verb auto = do   assert (destCStore `notElem` cLegalRaw) skip   leader <- getLeaderUI   b <- getsState $ getActorBody leader@@ -211,7 +211,6 @@                else if destCStore == CSha                     then []                     else delete CSha cLegalRaw-      verb = MU.Text verbRaw   ggi <- if auto          then getAnyItem verb cLegalRaw cLegal False False          else getAnyItem verb cLegalRaw cLegal True True@@ -229,7 +228,7 @@           updateItemSlot (Just leader) iid  -- slot not yet assigned           msgAndSer CInv         CEqp | eqpOverfull b k -> do-          msgAdd $ "Warning:" <+> showReqFailure EqpOverfull+          msgAdd $ "Warning:" <+> showReqFailure EqpOverfull <> "."           updateItemSlot (Just leader) iid  -- slot not yet assigned           msgAndSer CInv         _ -> msgAndSer destCStore@@ -389,7 +388,7 @@ alterTile :: MonadClientUI m           => Vector -> [Trigger] -> m (SlideOrCmd (RequestTimed AbAlter)) alterTile dir ts = do-  Kind.COps{cotile} <- getsState scops+  cops@Kind.COps{cotile} <- getsState scops   leader <- getLeaderUI   b <- getsState $ getActorBody leader   lvl <- getLevel $ blid b@@ -397,7 +396,7 @@       t = lvl `at` tpos       alterFeats = alterFeatures ts   case filter (\feat -> Tile.hasFeature cotile feat t) alterFeats of-    [] -> failWith $ guessAlter cotile alterFeats t+    [] -> failWith $ guessAlter cops alterFeats t     feat : _ -> return $ Right $ ReqAlter tpos $ Just feat  alterFeatures :: [Trigger] -> [F.Feature]@@ -406,11 +405,11 @@ alterFeatures (_ : ts) = alterFeatures ts  -- | Guess and report why the bump command failed.-guessAlter :: Kind.Ops TileKind -> [F.Feature] -> Kind.Id TileKind -> Msg-guessAlter cotile (F.OpenTo _ : _) t+guessAlter :: Kind.COps -> [F.Feature] -> Kind.Id TileKind -> Msg+guessAlter Kind.COps{cotile} (F.OpenTo _ : _) t   | Tile.isClosable cotile t = "already open" guessAlter _ (F.OpenTo _ : _) _ = "cannot be opened"-guessAlter cotile (F.CloseTo _ : _) t+guessAlter Kind.COps{cotile} (F.CloseTo _ : _) t   | Tile.isOpenable cotile t = "already closed" guessAlter _ (F.CloseTo _ : _) _ = "cannot be closed" guessAlter _ _ _ = "never mind"@@ -437,14 +436,14 @@ triggerTile :: MonadClientUI m             => [Trigger] -> m (SlideOrCmd (RequestTimed AbTrigger)) triggerTile ts = do-  Kind.COps{cotile} <- getsState scops+  cops@Kind.COps{cotile} <- getsState scops   leader <- getLeaderUI   b <- getsState $ getActorBody leader   lvl <- getLevel $ blid b   let t = lvl `at` bpos b       triggerFeats = triggerFeatures ts   case filter (\feat -> Tile.hasFeature cotile feat t) triggerFeats of-    [] -> failWith $ guessTrigger cotile triggerFeats t+    [] -> failWith $ guessTrigger cops triggerFeats t     feat : _ -> do       go <- verifyTrigger leader feat       case go of@@ -464,7 +463,7 @@     b <- getsState $ getActorBody leader     side <- getsClient sside     fact <- getsState $ (EM.! side) . sfactionD-    if isSpawnFact fact then failWith+    if not (fcanEscape $ gplayer fact) then failWith       "This is the way out, but where would you go in this alien world?"     else do       go <- displayYesNo ColorFull "This is the way out. Really leave now?"@@ -485,8 +484,8 @@   _ -> return $ Right ()  -- | Guess and report why the bump command failed.-guessTrigger :: Kind.Ops TileKind -> [F.Feature] -> Kind.Id TileKind -> Msg-guessTrigger cotile fs@(F.Cause (Effect.Ascend k) : _) t+guessTrigger :: Kind.COps -> [F.Feature] -> Kind.Id TileKind -> Msg+guessTrigger Kind.COps{cotile} fs@(F.Cause (Effect.Ascend k) : _) t   | Tile.hasFeature cotile (F.Cause (Effect.Ascend (-k))) t =     if k > 0 then "the way goes down, not up"     else if k < 0 then "the way goes up, not down"@@ -526,9 +525,9 @@  -- * GameRestart; does not take time -gameRestartHuman :: MonadClientUI m => Text -> m (SlideOrCmd RequestUI)+gameRestartHuman :: MonadClientUI m => GroupName -> m (SlideOrCmd RequestUI) gameRestartHuman t = do-  let msg = "You just requested a new" <+> t <+> "game."+  let msg = "You just requested a new" <+> tshow t <+> "game."   b1 <- displayMore ColorFull msg   if not b1 then failWith "never mind"   else do@@ -563,13 +562,33 @@   msgAdd "Saving game backup."   return ReqUIGameSave +-- * Tactic; does not take time++-- Note that the difference between seek-target and follow-the-leader tactic+-- can influence even a faction with passive actors. E.g., if a passive actor+-- has an extra active skill from equipment, he moves every turn.+-- TODO: set tactic for allied passive factions, too or all allied factions+-- and perhaps even factions with a leader should follow our leader+-- and his target, not their leader.+tacticHuman :: MonadClientUI m => m (SlideOrCmd RequestUI)+tacticHuman = do+  fid <- getsClient sside+  fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD+  let toT = if fromT == maxBound then minBound else succ fromT+  go <- displayMore ColorFull+        $ "Switching tactic to"+          <+> T.pack (show toT)  -- tshow eats up parens+          <> ". (This clears targets.)"+  if not go+    then failWith "Tactic change canceled."+    else return $ Right $ ReqUITactic toT+ -- * Automate; does not take time  automateHuman :: MonadClientUI m => m (SlideOrCmd RequestUI) automateHuman = do   -- BFS is not updated while automated, which would lead to corruption.   modifyClient $ \cli -> cli {stgtMode = Nothing}-  -- TODO: do not save to history:   go <- displayMore ColorBW "Ceding control to AI (ESC to regain)."   if not go     then failWith "Automation canceled."

@@ -58,6 +58,7 @@ import Game.LambdaHack.Common.Msg import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point+import Game.LambdaHack.Common.Request import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time@@ -79,16 +80,21 @@  pickLeaderHuman :: MonadClientUI m => Int -> m Slideshow pickLeaderHuman k = do-  cops <- getsState scops   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD+  arena <- getArenaUI+  let (autoDun, autoLvl) = autoDungeonLevel fact   s <- getState   case tryFindHeroK s side k of-    _ | isAllMoveFact cops fact -> failMsg msgCannotChangeLeader     Nothing -> failMsg "No such member of the party."-    Just (aid, _) -> do-      void $ pickLeader True aid-      return mempty+    Just (aid, b) ->+      if blid b == arena && autoLvl+      then failMsg $ showReqFailure NoChangeLvlLeader+      else if autoDun+      then failMsg $ showReqFailure NoChangeDunLeader+      else do+        void $ pickLeader True aid+        return mempty  -- * MemberCycle 

@@ -35,16 +35,17 @@     Move !Vector   | Run !Vector   | Wait-  | MoveItem ![CStore] !CStore !Text !Text !Bool+  | MoveItem ![CStore] !CStore !MU.Part !MU.Part !Bool   | Project     ![Trigger]   | Apply       ![Trigger]   | AlterDir    ![Trigger]   | TriggerTile ![Trigger]   | StepToTarget     -- Below this line, commands do not take time.-  | GameRestart !Text+  | GameRestart !GroupName   | GameExit   | GameSave+  | Tactic   | Automate     -- Local.     -- Below this line, commands do not notify the server.@@ -105,16 +106,19 @@   Move v      -> "move" <+> compassText v   Run v       -> "run" <+> compassText v   Wait        -> "wait"-  MoveItem _ _ verb object _ -> verb <+> object+  MoveItem _ _ verb object _ -> makePhrase [verb, object]   Project ts  -> triggerDescription ts   Apply ts    -> triggerDescription ts   AlterDir ts -> triggerDescription ts   TriggerTile ts -> triggerDescription ts   StepToTarget -> "make one step towards the target" -  GameRestart t -> makePhrase ["new", MU.Capitalize $ MU.Text t, "game"]+  GameRestart t ->+    -- TODO: use mname for the game mode instead of t+    makePhrase ["new", MU.Capitalize $ MU.Text $ tshow t, "game"]   GameExit    -> "save and exit"   GameSave    -> "save game"+  Tactic      -> "cycle tactic of non-leader team members (WIP)"   Automate    -> "automate faction (ESC to retake control)"    GameDifficultyCycle -> "cycle difficulty of the next game"

@@ -1,7 +1,7 @@ -- | Inventory management and party cycling. -- TODO: document module Game.LambdaHack.Client.UI.InventoryClient-  ( failMsg, msgCannotChangeLeader+  ( failMsg, msgNoChangeDunLeader, msgNoChangeLvlLeader   , getGroupItem, getAnyItem, getStoreItem   , memberCycle, memberBack, pickLeader   ) where@@ -161,7 +161,6 @@ transition _ _ _ verb [] iDS = assert `failure` (verb, iDS) transition psuit tshaSuit tsuitable verb            cLegal@(cCur:cRest) itemDialogState = do-  cops <- getsState scops   (letterSlots, numberSlots) <- getsClient sslots   leader <- getLeaderUI   body <- getsState $ getActorBody leader@@ -177,6 +176,7 @@   let bagLetterSlots = EM.filter (`EM.member` bag) letterSlots       bagNumberSlots = IM.filter (`EM.member` bag) numberSlots       suitableLetterSlots = EM.filter (`EM.member` bagSuit) letterSlots+      (autoDun, autoLvl) = autoDungeonLevel fact       keyDefs :: [(K.Key, DefItemKey m)]       keyDefs = filter (defCond . snd)         [ (K.Char '?', DefItemKey@@ -222,7 +222,7 @@            })         , (K.Tab, DefItemKey            { defLabel = "TAB"-           , defCond = not (isAllMoveFact cops fact+           , defCond = not (autoLvl                             || null (filter (\(_, b) ->                                                blid b == blid body) hs))            , defAction = \_ -> do@@ -237,7 +237,7 @@            })         , (K.BackTab, DefItemKey            { defLabel = "SHIFT-TAB"-           , defCond = not (isAllMoveFact cops fact || null hs)+           , defCond = not (autoDun || null hs)            , defAction = \_ -> do                err <- memberBack False                assert (err == mempty `blame` err) skip@@ -328,14 +328,14 @@ -- | Switches current member to the next on the level, if any, wrapping. memberCycle :: MonadClientUI m => Bool -> m Slideshow memberCycle verbose = do-  cops <- getsState scops   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD   leader <- getLeaderUI   body <- getsState $ getActorBody leader   hs <- partyAfterLeader leader+  let autoLvl = snd $ autoDungeonLevel fact   case filter (\(_, b) -> blid b == blid body) hs of-    _ | isAllMoveFact cops fact -> failMsg msgCannotChangeLeader+    _ | autoLvl -> failMsg $ showReqFailure NoChangeLvlLeader     [] -> failMsg "Cannot pick any other member on this level."     (np, b) : _ -> do       success <- pickLeader verbose np@@ -345,21 +345,24 @@ -- | Switches current member to the previous in the whole dungeon, wrapping. memberBack :: MonadClientUI m => Bool -> m Slideshow memberBack verbose = do-  cops <- getsState scops   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD   leader <- getLeaderUI   hs <- partyAfterLeader leader+  let autoDun = fst $ autoDungeonLevel fact   case reverse hs of-    _ | isAllMoveFact cops fact -> failMsg msgCannotChangeLeader+    _ | autoDun -> failMsg $ showReqFailure NoChangeDunLeader     [] -> failMsg "No other member in the party."     (np, b) : _ -> do       success <- pickLeader verbose np       assert (success `blame` "same leader" `twith` (leader, np, b)) skip       return mempty -msgCannotChangeLeader :: Msg-msgCannotChangeLeader = "leader change is automatic for your team"+msgNoChangeDunLeader :: Msg+msgNoChangeDunLeader = "level change is automatic for your team"++msgNoChangeLvlLeader :: Msg+msgNoChangeLvlLeader = "leader change is automatic for your team"  partyAfterLeader :: MonadStateRead m => ActorId -> m [(ActorId, Actor)] partyAfterLeader leader = do

@@ -106,7 +106,7 @@       ]     fmt k h = T.justifyRight 72 ' '               $ T.justifyLeft 15 ' ' k-                <> T.justifyLeft 41 ' ' h+                <> T.justifyLeft 48 ' ' h     fmts s = " " <> T.justifyLeft 71 ' ' s     minimalText = map fmts minimalBlurb     movText = map fmts movBlurb

@@ -193,13 +193,14 @@   case srunning of     Nothing -> return ()     Just RunParams{runLeader} -> do-      -- Switch to the original leader, from before the run start, unless dead.-      cops <- getsState scops+      -- Switch to the original leader, from before the run start,+      -- unless dead or unless the faction never runs with multiple+      -- (but could have the leader changed automatically meanwhile).       side <- getsClient sside       fact <- getsState $ (EM.! side) . sfactionD       arena <- getArenaUI       s <- getState-      when (memActor runLeader arena s && not (isAllMoveFact cops fact)) $+      when (memActor runLeader arena s && not (noRunWithMulti fact)) $         modifyClient $ updateLeader runLeader s       modifyClient (\cli -> cli { srunning = Nothing }) @@ -229,7 +230,6 @@  scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow scoreToSlideshow total status = do-  cops <- getsState scops   fid <- getsClient sside   fact <- getsState $ (EM.! fid) . sfactionD   -- TODO: Re-read the table in case it's changed by a concurrent game.@@ -241,12 +241,12 @@   date <- liftIO getClockTime   scurDifficulty <- getsClient scurDifficulty   factionD <- getsState sfactionD-  fightsSpawners <- fightsAgainstSpawners fid+  loots <- factionLoots fid   let showScore (ntable, pos) = HighScore.highSlideshow ntable pos-      diff | not $ playerUI $ gplayer fact = difficultyDefault+      diff | not $ fhasUI $ gplayer fact = difficultyDefault            | otherwise = scurDifficulty       theirVic (fi, fa) | isAtWar fact fi-                          && not (isHorrorFact cops fa) = Just $ gvictims fa+                          && not (isHorrorFact fa) = Just $ gvictims fa                         | otherwise = Nothing       theirVictims = EM.unionsWith (+) $ mapMaybe theirVic $ EM.assocs factionD       ourVic (fi, fa) | isAllied fact fi || fi == fid = Just $ gvictims fa@@ -254,8 +254,8 @@       ourVictims = EM.unionsWith (+) $ mapMaybe ourVic $ EM.assocs factionD       (worthMentioning, rScore) =         HighScore.register table total time status date diff-                           (playerName $ gplayer fact)-                           ourVictims theirVictims fightsSpawners+                           (fname $ gplayer fact)+                           ourVictims theirVictims loots   return $! if worthMentioning then showScore rScore else mempty  getLeaderUI :: MonadClientUI m => m ActorId@@ -281,7 +281,7 @@                 case (EM.minViewWithKey dungeon, EM.maxViewWithKey dungeon) of                   (Just ((s, _), _), Just ((e, _), _)) -> (s, e)                   _ -> assert `failure` "empty dungeon" `twith` dungeon-          return $! max minD $ min maxD $ toEnum $ playerEntry $ gplayer fact+          return $! max minD $ min maxD $ toEnum $ fentryLevel $ gplayer fact  viewedLevel :: MonadClientUI m => m LevelId viewedLevel = do

@@ -83,7 +83,7 @@        -> Text       -- ^ an extra sentence to print        -> m Text lookAt detailed tilePrefix canSee pos aid msg = do-  Kind.COps{cotile=cotile@Kind.Ops{okind}} <- getsState scops+  cops@Kind.COps{cotile=cotile@Kind.Ops{okind}} <- getsState scops   itemToF <- itemToFullClient   lidV <- viewedLevel   lvl <- getLevel lidV@@ -103,7 +103,7 @@               _ -> "Items here."       tile = lvl `at` pos       obscured | knownLsecret lvl-                 && tile /= hideTile cotile lvl pos = "partially obscured"+                 && tile /= hideTile cops lvl pos = "partially obscured"                | otherwise = ""       tileText = obscured <+> tname (okind tile)       tilePart | T.null tilePrefix = MU.Text tileText

@@ -35,11 +35,11 @@                -> IO ())             -> IO () srtFrontend executorUI executorAI-            copsClient cops@Kind.COps{corule} sdebugCli exeServer = do+            copsClient cops sdebugCli exeServer = do   -- UI config reloaded at each client start.-  sconfig <- mkConfig corule+  sconfig <- mkConfig cops   let !sbinding = stdBinding copsClient sconfig  -- evaluate to check for errors-      sdebugMode = applyConfigToDebug sconfig sdebugCli corule+      sdebugMode = applyConfigToDebug sconfig sdebugCli cops   defaultHist <- defaultHistory   let cli = defStateClient defaultHist emptyReport       s = updateCOps (const cops) emptyState

@@ -24,7 +24,6 @@ import Game.LambdaHack.Common.Msg import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State-import Game.LambdaHack.Content.ModeKind  -- | A yes-no confirmation. getYesNo :: MonadClientUI m => SingleFrame -> m Bool@@ -85,7 +84,7 @@   fact <- getsState $ (EM.! side) . sfactionD   sls <- promptToSlideshow ""   let slide = head . snd $ slideshow sls-      underAI = playerAI $ gplayer fact+      underAI = isAIFact fact   frame <- drawOverlay False ColorFull slide   -- Visually speed up (by remving all empty frames) the show of the sequence   -- of the move frames if the player is running.

@@ -1,7 +1,8 @@ {-# LANGUAGE DeriveGeneric #-} -- | AI strategy abilities. module Game.LambdaHack.Common.Ability-  ( Ability(..), Skills, zeroSkills, unitSkills, addSkills, scaleSkills+  ( Ability(..), Skills+  , zeroSkills, unitSkills, addSkills, maxSkills, scaleSkills   ) where  import Data.Binary@@ -33,6 +34,9 @@  addSkills :: Skills -> Skills -> Skills addSkills = EM.unionWith (+)++maxSkills :: Skills -> Skills -> Skills+maxSkills = EM.unionWith max  scaleSkills :: Int -> Skills -> Skills scaleSkills n = EM.map (n *)

@@ -96,12 +96,14 @@ -- could further influence the chance, and the chance could also affect -- which monster is generated. How many and which monsters are generated -- will also depend on the cave kind used to build the level.-monsterGenChance :: AbsDepth -> AbsDepth -> Int -> Rnd Bool-monsterGenChance (AbsDepth n) (AbsDepth depth) numMonsters =+monsterGenChance :: AbsDepth -> AbsDepth -> Int -> Int -> Rnd Bool+monsterGenChance (AbsDepth n) (AbsDepth depth) numMonsters actorCoeff =   assert (depth > 0)   -- Mimics @castDice@. On level 1, First 2 monsters appear fast.   $ let scaledDepth = 5 * n `div` depth-    in chance $ 1%(fromIntegral (300 * (numMonsters - scaledDepth)) `max` 20)+    in chance $ 1%(fromIntegral+                   $ (10 * actorCoeff * (numMonsters - scaledDepth))+                     `max` actorCoeff)  -- | The part of speech describing the actor. partActor :: Actor -> MU.Part

@@ -37,7 +37,7 @@ import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Vector-import Game.LambdaHack.Content.FactionKind+import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.TileKind  fidActorNotProjAssocs :: FactionId -> State -> [(ActorId, Actor)]@@ -290,24 +290,23 @@  actorSkills :: ActorId -> Maybe ActorId -> [ItemFull] -> State -> Ability.Skills actorSkills aid mleader activeItems s =-  let Kind.COps{cofaction=Kind.Ops{okind}} = scops s-      body = getActorBody aid s+  let body = getActorBody aid s       fact = (EM.! bfid body) . sfactionD $ s       factionSkills-        | Just aid == mleader = fSkillsLeader $ okind $ gkind fact-        | otherwise = fSkillsOther $ okind $ gkind fact+        | Just aid == mleader = Ability.unitSkills+        | otherwise = fskillsOther $ gplayer fact       itemSkills = sumSkills activeItems   in itemSkills `Ability.addSkills` factionSkills  -- Check whether an actor can displace an enemy. We assume they are adjacent.-dispEnemy :: ActorId -> ActorId -> [ItemFull] -> State -> Bool-dispEnemy source target activeItems s =+dispEnemy :: ActorId -> Maybe ActorId -> ActorId -> [ItemFull] -> State -> Bool+dispEnemy source mleader target activeItems s =   let hasSupport b =         let fact = (EM.! bfid b) . sfactionD $ s             friendlyFid fid = fid == bfid b || isAllied fact fid             sup = actorRegularList friendlyFid (blid b) s         in any (adjacent (bpos b) . bpos) sup-      actorSk = actorSkills target (Just target) activeItems s+      actorSk = actorSkills target mleader activeItems s       sb = getActorBody source s       tb = getActorBody target s   in bproj tb@@ -324,24 +323,24 @@ radiusBlind :: Int -> Bool radiusBlind radius = radius < 4 -fullAssocs :: Kind.COps -> Discovery -> DiscoAE+fullAssocs :: Kind.COps -> DiscoveryKind -> DiscoveryEffect            -> ActorId -> [CStore] -> State            -> [(ItemId, ItemFull)]-fullAssocs cops disco discoAE aid cstores s =+fullAssocs cops disco discoEffect aid cstores s =   let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores       iToFull (iid, (item, k)) =-        (iid, itemToFull cops disco discoAE iid item k)+        (iid, itemToFull cops disco discoEffect iid item k)   in map iToFull allAssocs -itemToFull :: Kind.COps -> Discovery -> DiscoAE -> ItemId -> Item -> Int+itemToFull :: Kind.COps -> DiscoveryKind -> DiscoveryEffect -> ItemId -> Item -> Int            -> ItemFull itemToFull Kind.COps{coitem=Kind.Ops{okind}}-           disco discoAE iid itemBase itemK =+           disco discoEffect iid itemBase itemK =   let itemDisco = case EM.lookup (jkindIx itemBase) disco of         Nothing -> Nothing         Just itemKindId -> Just ItemDisco{ itemKindId                                          , itemKind = okind itemKindId-                                         , itemAE = EM.lookup iid discoAE }+                                         , itemAE = EM.lookup iid discoEffect }   in ItemFull {..}  goesIntoInv :: Item -> Bool

@@ -27,6 +27,8 @@       -- ^ Don't show any animations.   , snewGameCli    :: !Bool       -- ^ 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)@@ -50,6 +52,7 @@   , snoMore = False   , snoAnim = Nothing   , snewGameCli = False+  , sbenchmark = False   , sdifficultyCli = difficultyDefault   , ssavePrefixCli = Nothing   , sfrontendStd = False

@@ -15,9 +15,12 @@  -- | The general type of a particular game content, e.g., item kinds. data ContentDef a = ContentDef-  { getSymbol :: a -> Char    -- ^ symbol, e.g., to print on the map-  , getName   :: a -> Text    -- ^ name, e.g., to show to the player-  , getFreq   :: a -> Freqs   -- ^ frequency within groups-  , validate  :: [a] -> [a]   -- ^ validate and catch some offenders, if any-  , content   :: [a]          -- ^ all the defined content of this type+  { getSymbol      :: a -> Char    -- ^ symbol, e.g., to print on the map+  , getName        :: a -> Text    -- ^ name, e.g., to show to the player+  , getFreq        :: a -> Freqs   -- ^ frequency within groups+  , validateSingle :: a -> [Text]+      -- ^ validate a content item and list all offences+  , validateAll    :: [a] -> [Text]+      -- ^ validate the whole defined content of this type and list all offences+  , content        :: [a]          -- ^ all the defined content of this type   }

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE CPP, DeriveGeneric, FlexibleInstances, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Representation of dice for parameters scaled with current level depth. module Game.LambdaHack.Common.Dice@@ -8,6 +8,9 @@   , maxDice, minDice, meanDice, reduceDice     -- * Dice for rolling a pair of integer parameters representing coordinates.   , DiceXY(..), maxDiceXY, minDiceXY, meanDiceXY+#ifdef EXPOSE_INTERNAL+  , SimpleDice+#endif   ) where  import Control.Applicative

@@ -15,6 +15,7 @@ import qualified Game.LambdaHack.Common.Ability as Ability import qualified Game.LambdaHack.Common.Dice as Dice import Game.LambdaHack.Common.Misc+import Game.LambdaHack.Content.ModeKind  -- TODO: document each constructor -- | Effects of items. Can be invoked by the item wielder to affect@@ -24,7 +25,7 @@     NoEffect !Text   | Hurt !Dice.Dice   | Burn !Int-  | Explode !Text         -- ^ explode, producing this group of shrapnel+  | Explode !GroupName    -- ^ explode, producing this group of shrapnel   | RefillHP !Int   | RefillCalm !Int   | Dominate@@ -80,15 +81,16 @@ -- | Features of item. Affect only the item in question, not the actor, -- and so not additive in any sense. data Feature =-    ChangeTo !Text           -- ^ change to this group when altered-  | Fragile                  -- ^ break even when not hitting an enemy-  | Durable                  -- ^ don't break even hitting or applying-  | ToThrow !ThrowMod        -- ^ parameters modifying a throw-  | Identified               -- ^ the item starts identified-  | Applicable               -- ^ AI and uI flag: consider applying-  | EqpSlot !EqpSlot !Text   -- ^ AI and uI flag: goes to inventory-  | Precious                 -- ^ AI and UI flag: careful, can be precious;-                             --   don't risk identifying by use+    ChangeTo !GroupName     -- ^ change to this group when altered+  | Fragile                 -- ^ break even when not hitting an enemy+  | Durable                 -- ^ don't break even hitting or applying+  | ToThrow !ThrowMod       -- ^ parameters modifying a throw+  | Identified              -- ^ the item starts identified+  | Applicable              -- ^ AI and uI flag: consider applying+  | EqpSlot !EqpSlot !Text  -- ^ AI and uI flag: goes to inventory+  | Precious                -- ^ AI and UI flag: careful, can be precious;+                            --   don't risk identifying by use+  | Tactic !Tactic          -- ^ overrides actor's tactic (TODO)   deriving (Show, Eq, Ord, Generic)  data EqpSlot =

@@ -120,7 +120,7 @@ featureToSuff :: Feature -> Text featureToSuff feat =   case feat of-    ChangeTo t -> wrapInChevrons $ "changes to" <+> t+    ChangeTo t -> wrapInChevrons $ "changes to" <+> tshow t     Fragile -> wrapInChevrons $ "fragile"     Durable -> wrapInChevrons $ "durable"     ToThrow tmod -> wrapInChevrons $ tmodToSuff "flies" tmod@@ -128,6 +128,7 @@     Applicable -> ""     EqpSlot{} -> ""     Precious -> ""+    Tactic tactics -> "overrides tactics to" <+> tshow tactics  dropPlus :: Text -> Text dropPlus = T.dropWhile (`elem` ['+', '-'])

@@ -1,12 +1,19 @@+{-# LANGUAGE CPP #-} -- | Factions taking part in the game: e.g., two human players controlling -- the hero faction battling the monster and the animal factions. module Game.LambdaHack.Common.Faction   ( FactionId, FactionDict, Faction(..), Diplomacy(..), Outcome(..), Status(..)-  , isHeroFact, isCivilianFact, isHorrorFact, isSpawnFact, isSummonFact-  , isAllMoveFact, keepArenaFact, isAtWar, isAllied+  , Target(..)+  , isHorrorFact+  , canMoveFact, noRunWithMulti, isAIFact, autoDungeonLevel, automatePlayer+  , isAtWar, isAllied   , difficultyBound, difficultyDefault, difficultyCoeff+#ifdef EXPOSE_INTERNAL+  , Dipl+#endif   ) where +import Control.Monad import Data.Binary import qualified Data.EnumMap.Strict as EM import Data.Text (Text)@@ -17,7 +24,8 @@ import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.Misc-import Game.LambdaHack.Content.FactionKind+import Game.LambdaHack.Common.Point+import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Content.ModeKind @@ -25,14 +33,14 @@ type FactionDict = EM.EnumMap FactionId Faction  data Faction = Faction-  { gkind    :: !(Kind.Id FactionKind)  -- ^ the kind of the faction-  , gname    :: !Text                   -- ^ individual name-  , gcolor   :: !Color.Color            -- ^ color of actors or their frames-  , gplayer  :: !Player                 -- ^ the player spec for this faction-  , gdipl    :: !Dipl                   -- ^ diplomatic mode-  , gquit    :: !(Maybe Status)         -- ^ cause of game end/exit-  , gleader  :: !(Maybe ActorId)        -- ^ the leader of the faction, if any-  , gsha     :: !ItemBag                -- ^ faction's shared inventory+  { gname    :: !Text            -- ^ individual name+  , gcolor   :: !Color.Color     -- ^ color of actors or their frames+  , gplayer  :: !Player          -- ^ the player spec for this faction+  , gdipl    :: !Dipl            -- ^ diplomatic mode+  , gquit    :: !(Maybe Status)  -- ^ cause of game end/exit+  , gleader  :: !(Maybe (ActorId, Maybe Target))+                                 -- ^ the leader of the faction and his target+  , gsha     :: !ItemBag         -- ^ faction's shared inventory   , gvictims :: !(EM.EnumMap (Kind.Id ItemKind) Int)  -- ^ members killed   }   deriving (Show, Eq)@@ -59,57 +67,77 @@  -- | Current game status. data Status = Status-  { stOutcome :: !Outcome  -- ^ current game outcome-  , stDepth   :: !Int      -- ^ depth of the final encounter-  , stInfo    :: !Text     -- ^ extra information+  { stOutcome :: !Outcome            -- ^ current game outcome+  , stDepth   :: !Int                -- ^ depth of the final encounter+  , stNewGame :: !(Maybe GroupName)  -- ^ new game group to start, if any   }   deriving (Show, Eq, Ord) --- | Tell whether the faction consists of heroes.-isHeroFact :: Faction -> Bool-isHeroFact fact = playerIsHero (gplayer fact)---- | Tell whether the faction consists of human civilians.-isCivilianFact :: Kind.COps -> Faction -> Bool-isCivilianFact Kind.COps{cofaction=Kind.Ops{okind}} fact =-  let kind = okind (gkind fact)-  in maybe False (> 0) $ lookup "civilian" $ ffreq kind+-- | The type of na actor target.+data Target =+    TEnemy !ActorId !Bool+    -- ^ target an actor; cycle only trough seen foes, unless the flag is set+  | TEnemyPos !ActorId !LevelId !Point !Bool+    -- ^ last seen position of the targeted actor+  | TPoint !LevelId !Point  -- ^ target a concrete spot+  | TVector !Vector         -- ^ target position relative to actor+  deriving (Show, Eq)  -- | Tell whether the faction consists of summoned horrors only.-isHorrorFact :: Kind.COps -> Faction -> Bool-isHorrorFact Kind.COps{cofaction=Kind.Ops{okind}} fact =-  let kind = okind (gkind fact)-  in maybe False (> 0) $ lookup "horror" $ ffreq kind+--+-- 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.+-- 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.+isHorrorFact :: Faction -> Bool+isHorrorFact fact = fgroup (gplayer fact) == "horror" --- | Tell whether the faction is considered permanent dungeon dwellers--- (normally these are just spawning factions, but there are exceptions).-isSpawnFact :: Faction -> Bool-isSpawnFact fact = playerIsSpawn (gplayer fact)+canMoveFact :: Faction -> Bool -> Bool+canMoveFact fact isLeader =+  let skillsOther = fskillsOther $ gplayer fact+  in if isLeader+     then True+     else EM.findWithDefault 0 Ability.AbMove skillsOther > 0 --- | Tell whether actors of the faction can be summoned by items, etc.-isSummonFact :: Kind.COps -> Faction -> Bool-isSummonFact Kind.COps{cofaction=Kind.Ops{okind}} fact =-  let kind = okind (gkind fact)-  in maybe False (> 0) $ lookup "summon" $ ffreq kind+-- A faction where other actors move at once or where some of leader change+-- is automatic can't run with multiple actors at once. That would be+-- overpowered or too complex to keep correct.+--+-- Note that this doesn't take into account individual actor skills,+-- so this is overly restrictive and, OTOH, sometimes running will fail+-- or behave wierdly regardless. But it's simple and easy to understand+-- by the UI user.+noRunWithMulti :: Faction -> Bool+noRunWithMulti fact =+  let skillsOther = fskillsOther $ gplayer fact+  in EM.findWithDefault 0 Ability.AbMove skillsOther > 0+     || case fleaderMode (gplayer fact) of+          LeaderNull -> True+          LeaderAI AutoLeader{} -> True+          LeaderUI AutoLeader{..} -> autoDungeon || autoLevel --- | Tell whether all moving actors of the factions can move at once.-isAllMoveFact :: Kind.COps -> Faction -> Bool-isAllMoveFact Kind.COps{cofaction=Kind.Ops{okind}} fact =-  let kind = okind (gkind fact)-      skillsLeader = fSkillsLeader kind-      skillsOther = fSkillsOther kind-  in EM.findWithDefault 0 Ability.AbMove skillsLeader > 0-     && EM.findWithDefault 0 Ability.AbMove skillsOther > 0+isAIFact :: Faction -> Bool+isAIFact fact =+  case fleaderMode (gplayer fact) of+    LeaderNull -> True+    LeaderAI _ -> True+    LeaderUI _ -> False --- | Tell whether a faction that we know is still in game, keeps arena.--- Such factions win if they can escape the dungeon.--- Keeping arena means, if the faction is still in game,--- it always has a leader in the dungeon somewhere.--- So, leaderless factions and spawner factions do not keep an arena,--- even though the latter usually has a leader for most of the game.-keepArenaFact :: Faction -> Bool-keepArenaFact fact = playerLeader (gplayer fact) && not (isSpawnFact fact)+autoDungeonLevel :: Faction -> (Bool, Bool)+autoDungeonLevel fact = case fleaderMode (gplayer fact) of+                          LeaderNull -> (False, False)+                          LeaderAI AutoLeader{..} -> (autoDungeon, autoLevel)+                          LeaderUI AutoLeader{..} -> (autoDungeon, autoLevel) +automatePlayer :: Bool -> Player -> Player+automatePlayer st pl =+  let autoLeader False Player{fleaderMode=LeaderAI auto} = LeaderUI auto+      autoLeader True Player{fleaderMode=LeaderUI auto} = LeaderAI auto+      autoLeader _ Player{fleaderMode} = fleaderMode+  in pl {fleaderMode = autoLeader st pl}+ -- | Check if factions are at war. Assumes symmetry. isAtWar :: Faction -> FactionId -> Bool isAtWar fact fid = War == EM.findWithDefault Unknown fid (gdipl fact)@@ -130,7 +158,6 @@  instance Binary Faction where   put Faction{..} = do-    put gkind     put gname     put gcolor     put gplayer@@ -140,7 +167,6 @@     put gsha     put gvictims   get = do-    gkind <- get     gname <- get     gcolor <- get     gplayer <- get@@ -163,9 +189,24 @@   put Status{..} = do     put stOutcome     put stDepth-    put stInfo+    put stNewGame   get = do     stOutcome <- get     stDepth <- get-    stInfo <- get+    stNewGame <- get     return $! Status{..}++instance Binary Target where+  put (TEnemy a permit) = putWord8 0 >> put a >> put permit+  put (TEnemyPos a lid p permit) =+    putWord8 1 >> put a >> put lid >> put p >> put permit+  put (TPoint lid p) = putWord8 2 >> put lid >> put p+  put (TVector v) = putWord8 3 >> put v+  get = do+    tag <- getWord8+    case tag of+      0 -> liftM2 TEnemy get get+      1 -> liftM4 TEnemyPos get get get get+      2 -> liftM2 TPoint get get+      3 -> liftM TVector get+      _ -> fail "no parse (Target)"

@@ -6,19 +6,19 @@  import Data.Binary import Data.Hashable (Hashable)-import Data.Text (Text) import GHC.Generics (Generic)  import qualified Game.LambdaHack.Common.Effect as Effect+import Game.LambdaHack.Common.Misc  -- | All possible terrain tile features. data Feature =     Cause !(Effect.Effect Int)  -- ^ causes the effect when triggered-  | OpenTo !Text         -- ^ goes from a closed to an open tile when altered-  | CloseTo !Text        -- ^ goes from an open to a closed tile when altered-  | ChangeTo !Text       -- ^ alters tile, but does not change walkability-  | HideAs !Text         -- ^ when hidden, looks as a tile of the group-  | RevealAs !Text       -- ^ if secret, can be revealed to belong to the group+  | OpenTo !GroupName    -- ^ goes from a closed to an open tile when altered+  | CloseTo !GroupName   -- ^ goes from an open to a closed tile when altered+  | ChangeTo !GroupName  -- ^ alters tile, but does not change walkability+  | HideAs !GroupName    -- ^ when hidden, looks as a tile of the group+  | RevealAs !GroupName  -- ^ if secret, can be revealed to belong to the group    | Walkable             -- ^ actors can walk through   | Clear                -- ^ actors can see through

@@ -4,7 +4,7 @@   ) where  import qualified Codec.Compression.Zlib as Z-import qualified Control.Exception as Ex hiding (handle)+import qualified Control.Exception as Ex import Control.Monad import Data.Binary import qualified Data.ByteString.Lazy as LBS@@ -56,14 +56,17 @@     then return $! a     else error $ "Fatal error: corrupted file " ++ f --- | Try to create a directory, if it doesn't exist. Terminate the program--- with an exception if the directory does not exist, but can't be created.+-- | Try to create a directory, if it doesn't exist. We catch exceptions+-- in case many clients try to do the same thing at the same time. tryCreateDir :: FilePath -> IO () tryCreateDir dir = do   dirExists <- doesDirectoryExist dir-  unless dirExists $ createDirectory dir+  unless dirExists $+    Ex.handle (\(_ :: Ex.IOException) -> return ())+              (createDirectory dir) --- | Try to copy over data files, if not already there.+-- | Try to copy over data files, if not already there. We catch exceptions+-- in case many clients try to do the same thing at the same time. tryCopyDataFiles :: FilePath                  -> (FilePath -> IO FilePath)                  -> [(FilePath, FilePath)]@@ -74,7 +77,9 @@         bIn <- doesFileExist pathsDataIn         let pathsDataOut = dataDir </> fout         bOut <- doesFileExist pathsDataOut-        when (not bOut && bIn) $ copyFile pathsDataIn pathsDataOut+        when (not bOut && bIn) $+          Ex.handle (\(_ :: Ex.IOException) -> return ())+                    (copyFile pathsDataIn pathsDataOut)   in mapM_ cpFile files  -- | Personal data directory for the game. Depends on the OS and the game,

@@ -1,8 +1,11 @@-{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, DeriveGeneric, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | High score table operations. module Game.LambdaHack.Common.HighScore   ( ScoreTable, empty, register, showScore, getRecord, highSlideshow+#ifdef EXPOSE_INTERNAL+  , ScoreRecord+#endif   ) where  import Control.Exception.Assert.Sugar@@ -70,7 +73,7 @@       diffText | diff == difficultyDefault = ""                | otherwise = "difficulty" <+> tshow diff <> ", "       tturns = makePhrase $ [MU.CarWs turns "turn"]-  in [ tpos <> "." <+> tscore <+> "The" <+> gplayerName score <+> "team"+  in [ tpos <> "." <+> tscore <+> gplayerName score        <+> died <> "," <+> victims <> ","      , "            "        <> diffText <> "after" <+> tturns <+> "on" <+> curDate <> "."@@ -113,9 +116,9 @@          -> Bool        -- ^ whether the faction fights against spawners          -> (Bool, (ScoreTable, Int)) register table total time status@Status{stOutcome} date difficulty gplayerName-         ourVictims theirVictims fightsSpawners =+         ourVictims theirVictims loots =   let pBase =-        if fightsSpawners+        if loots         -- Heroes rejoice in loot and mourn their victims.         then fromIntegral total         -- Spawners or skirmishers get no bonus from loot and no malus@@ -131,7 +134,7 @@                 else min 1000                      $ sqrt $ fromIntegral survival       pBonus =-        if fightsSpawners+        if loots         then max 0 (1000 - 100 * sum (EM.elems ourVictims))         else 1000 + 100 * sum (EM.elems theirVictims)       pSum :: Double

@@ -5,7 +5,7 @@   ( -- * The @Item@ type     ItemId, Item(..), seedToAspectsEffects     -- * Item discovery types-  , ItemKindIx, Discovery, ItemSeed, ItemAspectEffect(..), DiscoAE+  , ItemKindIx, DiscoveryKind, ItemSeed, ItemAspectEffect(..), DiscoveryEffect   , ItemFull(..), ItemDisco(..), itemNoDisco, itemNoAE     -- * Inventory management types   , ItemBag, ItemDict, ItemKnown@@ -38,7 +38,7 @@  -- | The map of item kind indexes to item kind ids. -- The full map, as known by the server, is a bijection.-type Discovery = EM.EnumMap ItemKindIx (Kind.Id ItemKind)+type DiscoveryKind = EM.EnumMap ItemKindIx (Kind.Id ItemKind)  -- | A seed for rolling aspects and effects of an item -- Clients have partial knowledge of how item ids map to the seeds.@@ -58,7 +58,7 @@  -- | The map of item ids to item aspects and effects. -- The full map is known by the server.-type DiscoAE = EM.EnumMap ItemId ItemAspectEffect+type DiscoveryEffect = EM.EnumMap ItemId ItemAspectEffect  data ItemDisco = ItemDisco   { itemKindId :: Kind.Id ItemKind@@ -91,9 +91,9 @@ data Item = Item   { jkindIx  :: !ItemKindIx    -- ^ index pointing to the kind of the item   , jlid     :: !LevelId       -- ^ the level on which item was created-  , jsymbol  :: !Char          -- ^ individual map symbol-  , jname    :: !Text          -- ^ individual generic name-  , jflavour :: !Flavour       -- ^ individual flavour+  , jsymbol  :: !Char          -- ^ map symbol+  , jname    :: !Text          -- ^ generic name+  , jflavour :: !Flavour       -- ^ flavour   , jfeature :: ![Feature]     -- ^ public properties   , jweight  :: !Int           -- ^ weight in grams, obvious enough   }@@ -120,4 +120,9 @@ -- indexed by item identifier. type ItemDict = EM.EnumMap ItemId Item -type ItemKnown = (Item, ItemAspectEffect)+-- | The essential item properties, used for the @ItemRev@ hash table+-- from items to their ids, needed to assign ids to newly generated items.+-- All the other meaningul properties can be derived from the two.+-- Note that @jlid@ is not meaningful; it gets forgotten if items from+-- different levels roll the same random properties and so are merged.+type ItemKnown = (ItemKindIx, ItemAspectEffect)

@@ -108,7 +108,7 @@         <+> nstats         <+> desc         <+> makeSentence ["Weighs", MU.Text scaledWeight <> unitWeight]-        <+> makeSentence ["Found on level", MU.Text $ tshow ln]+        <+> makeSentence ["First found on level", MU.Text $ tshow ln]       splitBlurb = splitText lxsize blurb       attrBlurb = map (map f . T.unpack) splitBlurb   in encodeOverlay $ (colorSymbol : tail (head attrBlurb)) : tail attrBlurb

@@ -1,19 +1,16 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes, TypeFamilies #-} -- | General content types and operations. module Game.LambdaHack.Common.Kind-  ( Id, Speedup(..), Ops(..), COps(..), createOps, stdRuleset-  , Tab, createTab, accessTab+  ( Id, Speedup, Ops(..), COps(..), createOps, stdRuleset   ) where  import Control.Exception.Assert.Sugar-import qualified Data.Array.Unboxed as A import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.Ix as Ix import Data.List import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe)-import Data.Text (Text) import qualified Data.Text as T  import Game.LambdaHack.Common.ContentDef@@ -22,7 +19,6 @@ import Game.LambdaHack.Common.Msg import Game.LambdaHack.Common.Random import Game.LambdaHack.Content.CaveKind-import Game.LambdaHack.Content.FactionKind import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.PlaceKind@@ -35,41 +31,20 @@  -- | Type family for auxiliary data structures for speeding up -- content operations.-data family Speedup a--data instance Speedup TileKind = TileSpeedup-  { isClearTab :: !Tab-  , isLitTab   :: !Tab-  , isWalkableTab :: !Tab-  , isPassableTab :: !Tab-  , isDoorTab :: !Tab-  , isSuspectTab :: !Tab-  , isChangeableTab :: !Tab-  }--newtype Tab = Tab (A.UArray (Id TileKind) Bool)--createTab :: Ops TileKind -> (TileKind -> Bool) -> Tab-createTab Ops{ofoldrWithKey, obounds} p =-  let f _ k acc = p k : acc-      clearAssocs = ofoldrWithKey f []-  in Tab $ A.listArray obounds clearAssocs--accessTab :: Tab -> Id TileKind -> Bool-{-# INLINE accessTab #-}-accessTab (Tab tab) ki = tab A.! ki+type family Speedup a  -- | Content operations for the content of type @a@. data Ops a = Ops   { okind         :: Id a -> a      -- ^ the content element at given id-  , ouniqGroup    :: Text -> Id a   -- ^ the id of the unique member of-                                    --   a singleton content group-  , opick         :: Text -> (a -> Bool) -> Rnd (Maybe (Id a))+  , ouniqGroup    :: GroupName -> Id a  -- ^ the id of the unique member of+                                        --   a singleton content group+  , opick         :: GroupName -> (a -> Bool) -> Rnd (Maybe (Id a))                                     -- ^ pick a random id belonging to a group                                     --   and satisfying a predicate   , ofoldrWithKey :: forall b. (Id a -> a -> b -> b) -> b -> b                                     -- ^ fold over all content elements of @a@-  , ofoldrGroup   :: forall b. Text -> (Int -> Id a -> a -> b -> b) -> b -> b+  , ofoldrGroup   :: forall b.+                     GroupName -> (Int -> Id a -> a -> b -> b) -> b -> b                                     -- ^ fold over the given group only   , obounds       :: !(Id a, Id a)  -- ^ bounds of identifiers of content @a@   , ospeedup      :: !(Maybe (Speedup a))  -- ^ auxiliary speedup components@@ -78,11 +53,11 @@ -- | Create content operations for type @a@ from definition of content -- of type @a@. createOps :: forall a. Show a => ContentDef a -> Ops a-createOps ContentDef{getName, getFreq, content, validate} =+createOps ContentDef{getName, getFreq, content, validateSingle, validateAll} =   assert (length content <= fromEnum (maxBound :: Id a)) $   let kindMap :: EM.EnumMap (Id a) a       !kindMap = EM.fromDistinctAscList $ zip [Id 0..] content-      kindFreq :: M.Map Text [(Int, (Id a, a))]+      kindFreq :: M.Map GroupName [(Int, (Id a, a))]       kindFreq =         let tuples = [ (cgroup, (n, (i, k)))                      | (i, k) <- EM.assocs kindMap@@ -92,9 +67,16 @@       okind i = fromMaybe (assert `failure` "no kind" `twith` (i, kindMap))                 $ EM.lookup i kindMap       correct a = not (T.null (getName a)) && all ((> 0) . snd) (getFreq a)-      offenders = validate content+      singleOffenders = [ (offences, a)+                        | a <- content,+                          let offences = validateSingle a+                          , not (null offences) ]+      allOffences = validateAll content   in assert (allB correct content) $-     assert (null offenders `blame` "content not valid" `twith` offenders)+     assert (null singleOffenders `blame` "some content items not valid"+                                  `twith` singleOffenders) $+     assert (null allOffences `blame` "the content set not valid"+                              `twith` (allOffences, content)) $      -- By this point 'content' can be GCd.      Ops        { okind@@ -108,7 +90,7 @@        , opick = \cgroup p ->            case M.lookup cgroup kindFreq of              Just freqRaw ->-               let freq = toFreq ("opick ('" <> cgroup <> "')") freqRaw+               let freq = toFreq ("opick ('" <> tshow cgroup <> "')") freqRaw                in if nullFreq freq                   then return Nothing                   else fmap Just $ frequency $ do@@ -131,13 +113,12 @@  -- | Operations for all content types, gathered together. data COps = COps-  { cocave    :: !(Ops CaveKind)     -- server only-  , cofaction :: !(Ops FactionKind)-  , coitem    :: !(Ops ItemKind)-  , comode    :: !(Ops ModeKind)     -- server only-  , coplace   :: !(Ops PlaceKind)    -- server only, so far-  , corule    :: !(Ops RuleKind)-  , cotile    :: !(Ops TileKind)+  { cocave  :: !(Ops CaveKind)     -- server only+  , coitem  :: !(Ops ItemKind)+  , comode  :: !(Ops ModeKind)     -- server only+  , coplace :: !(Ops PlaceKind)    -- server only, so far+  , corule  :: !(Ops RuleKind)+  , cotile  :: !(Ops TileKind)   }  -- | The standard ruleset used for level operations.

@@ -65,25 +65,26 @@ -- | A view on single, inhabited dungeon level. "Remembered" fields -- carry a subset of the info in the client copies of levels. data Level = Level-  { ldepth     :: !AbsDepth   -- ^ absolute depth of the level-  , lprio      :: !ActorPrio  -- ^ remembered actor times on the level-  , lfloor     :: !ItemFloor  -- ^ remembered items lying on the floor-  , ltile      :: !TileMap    -- ^ remembered level map-  , lxsize     :: !X          -- ^ width of the level-  , lysize     :: !Y          -- ^ height of the level-  , lsmell     :: !SmellMap   -- ^ remembered smells on the level-  , ldesc      :: !Text       -- ^ level description-  , lstair     :: !([Point], [Point])-                              -- ^ destinations of (up, down) stairs-  , lseen      :: !Int        -- ^ currently remembered clear tiles-  , lclear     :: !Int        -- ^ total number of initially clear tiles-  , ltime      :: !Time       -- ^ date of the last activity on the level-  , lactorFreq :: !Freqs      -- ^ frequency of spawned actors; [] for clients-  , litemNum   :: !Int        -- ^ number of initial items, 0 for clients-  , litemFreq  :: !Freqs      -- ^ frequency of initial items; [] for clients-  , lsecret    :: !Int        -- ^ secret tile seed-  , lhidden    :: !Int        -- ^ secret tile density-  , lescape    :: !Bool       -- ^ has an Effect.Escape tile+  { ldepth      :: !AbsDepth   -- ^ absolute depth of the level+  , lprio       :: !ActorPrio  -- ^ remembered actor times on the level+  , lfloor      :: !ItemFloor  -- ^ remembered items lying on the floor+  , ltile       :: !TileMap    -- ^ remembered level map+  , lxsize      :: !X          -- ^ width of the level+  , lysize      :: !Y          -- ^ height of the level+  , lsmell      :: !SmellMap   -- ^ remembered smells on the level+  , ldesc       :: !Text       -- ^ level description+  , lstair      :: !([Point], [Point])+                               -- ^ destinations of (up, down) stairs+  , lseen       :: !Int        -- ^ currently remembered clear tiles+  , lclear      :: !Int        -- ^ total number of initially clear tiles+  , ltime       :: !Time       -- ^ date of the last activity on the level+  , lactorCoeff :: !Int        -- ^ the lower, the more monsters spawn+  , lactorFreq  :: !Freqs      -- ^ frequency of spawned actors; [] for clients+  , litemNum    :: !Int        -- ^ number of initial items, 0 for clients+  , litemFreq   :: !Freqs      -- ^ frequency of initial items; [] for clients+  , lsecret     :: !Int        -- ^ secret tile seed+  , lhidden     :: !Int        -- ^ secret tile density+  , lescape     :: !Bool       -- ^ has an Effect.Escape tile   }   deriving (Show, Eq) @@ -156,8 +157,8 @@ isSecretPos lvl (Point x y) =   (lsecret lvl `Bits.rotateR` x `Bits.xor` y + x) `mod` lhidden lvl == 0 -hideTile :: Kind.Ops TileKind -> Level -> Point -> Kind.Id TileKind-hideTile cotile lvl p =+hideTile :: Kind.COps -> Level -> Point -> Kind.Id TileKind+hideTile Kind.COps{cotile} lvl p =   let t = lvl `at` p       ht = Tile.hideAs cotile t  -- TODO; tabulate with Speedup?   in if isSecretPos lvl p then ht else t@@ -225,6 +226,7 @@     put lseen     put lclear     put ltime+    put lactorCoeff     put lactorFreq     put litemNum     put litemFreq@@ -244,6 +246,7 @@     lseen <- get     lclear <- get     ltime <- get+    lactorCoeff <- get     lactorFreq <- get     litemNum <- get     litemFreq <- get

@@ -7,28 +7,30 @@     -- * Item containers   , Container(..), CStore(..)     -- * Assorted-  , normalLevelBound, divUp, Freqs, breturn-  , serverSaveName, nearby+  , normalLevelBound, divUp, GroupName, toGroupName, Freqs, breturn+  , serverSaveName, Rarity, validateRarity   ) where  import Control.Monad import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES+import Data.Function import Data.Functor import Data.Hashable import qualified Data.HashMap.Strict as HM import Data.Key+import Data.List+import Data.Ord+import Data.String (IsString (..)) import Data.Text (Text)+import qualified Data.Text as T import Data.Traversable (traverse) import GHC.Generics (Generic)+import NLP.Miniutter.English ()  import Game.LambdaHack.Common.Point --- | What distance signifies that two actors are "nearby".-nearby :: Int-nearby = 10- serverSaveName :: String serverSaveName = "server.sav" @@ -41,10 +43,40 @@ divUp :: Integral a => a -> a -> a divUp n k = (n + k - 1) `div` k --- | For each group that the kind belongs to, denoted by a @Text@ name+-- If ever needed, we can use a symbol table here, since content+-- is never serialized. But we'd need to cover the few cases+-- (e.g., @litemFreq@) where @GroupName@ goes into savegame.+newtype GroupName = GroupName Text+  deriving (Eq, Ord, Read, Hashable, Binary)++instance IsString GroupName where+  fromString = GroupName . T.pack++instance Show GroupName where+  show (GroupName gn) = T.unpack gn++toGroupName :: Text -> GroupName+toGroupName = GroupName++-- | For each group that the kind belongs to, denoted by a @GroupName@ -- in the first component of a pair, the second component of a pair shows -- how common the kind is within the group.-type Freqs = [(Text, Int)]+type Freqs = [(GroupName, Int)]++-- | Rarity on given depths.+type Rarity = [(Int, Int)]++validateRarity :: Rarity -> [Text]+validateRarity rarity =+  let sortedRarity = sortBy (comparing fst) rarity+  in [ "rarity not sorted" | sortedRarity /= rarity ]+     ++ [ "rarity depth thresholds not unique"+        | nubBy ((==) `on` fst) sortedRarity /= sortedRarity ]+     ++ [ "rarity depth not between 1 and 10"+        | case (sortedRarity, reverse sortedRarity) of+            ((lowest, _) : _, (highest, _) : _) ->+              lowest < 1 || highest > 10+            _ -> False ]  -- | @breturn b a = [a | b]@ breturn :: MonadPlus m => Bool -> a -> m a

@@ -2,7 +2,7 @@ -- player actions. Has no access to the the main action type. module Game.LambdaHack.Common.MonadStateRead   ( MonadStateRead(..)-  , getLevel, nUI, posOfAid, fightsAgainstSpawners+  , getLevel, nUI, posOfAid, factionCanEscape, factionLoots   ) where  import qualified Data.EnumMap.Strict as EM@@ -25,17 +25,26 @@ nUI :: MonadStateRead m => m Int nUI = do   factionD <- getsState sfactionD-  return $! length $ filter (playerUI . gplayer) $ EM.elems factionD+  return $! length $ filter (fhasUI . gplayer) $ EM.elems factionD  posOfAid :: MonadStateRead m => ActorId -> m (LevelId, Point) posOfAid aid = do   b <- getsState $ getActorBody aid   return (blid b, bpos b) --- TODO: make a field of Faction?-fightsAgainstSpawners :: MonadStateRead m => FactionId -> m Bool-fightsAgainstSpawners fid = do+factionCanEscape :: MonadStateRead m => FactionId -> m Bool+factionCanEscape fid = do   fact <- getsState $ (EM.! fid) . sfactionD   dungeon <- getsState sdungeon   let escape = any lescape $ EM.elems dungeon-  return $! escape && keepArenaFact fact+  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

@@ -18,6 +18,8 @@ import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Vector import Game.LambdaHack.Common.Ability+import Game.LambdaHack.Common.Faction+import Game.LambdaHack.Content.ModeKind  -- TODO: make remove second arg from ReqLeader; this requires a separate -- channel for Ping, probably, and then client sends as many commands@@ -25,7 +27,7 @@ -- | Cclient-server requests sent by AI clients. data RequestAI =     forall a. ReqAITimed !(RequestTimed a)-  | ReqAILeader !ActorId !RequestAI+  | ReqAILeader !ActorId !(Maybe Target) !RequestAI   | ReqAIPong  deriving instance Show RequestAI@@ -33,10 +35,11 @@ -- | Client-server requests sent by UI clients. data RequestUI =     forall a. ReqUITimed !(RequestTimed a)-  | ReqUILeader !ActorId !RequestUI-  | ReqUIGameRestart !ActorId !Text !Int ![(Int, (Text, Text))]+  | ReqUILeader !ActorId !(Maybe Target) !RequestUI+  | ReqUIGameRestart !ActorId !GroupName !Int ![(Int, (Text, Text))]   | ReqUIGameExit !ActorId !Int   | ReqUIGameSave+  | ReqUITactic !Tactic   | ReqUIAutomate   | ReqUIPong [CmdAtomic] @@ -89,6 +92,8 @@   | ProjectBlockActor   | ProjectBlind   | TriggerNothing+  | NoChangeDunLeader+  | NoChangeLvlLeader  showReqFailure :: ReqFailure -> Msg showReqFailure reqFailure = case reqFailure of@@ -116,3 +121,5 @@   ProjectBlockActor -> "aiming blocked by an actor"   ProjectBlind -> "blind actors cannot aim"   TriggerNothing -> "wasting time on triggering nothing"+  NoChangeDunLeader -> "no manual level change for your team"+  NoChangeLvlLeader -> "no manual leader change for your team"

@@ -78,7 +78,7 @@   -- to spread the cost, to avoid a long pause at game exit.  -- | Restore a saved game, if it exists. Initialize directory structure--- and cope over data files, if needed.+-- and copy over data files, if needed. restoreGame :: Binary a             => String -> [(FilePath, FilePath)] -> (FilePath -> IO FilePath)             -> IO (Maybe a)

@@ -43,10 +43,11 @@  -- TODO: add a flag 'fresh' and when saving levels, don't save -- and when loading regenerate this level.-unknownLevel :: Kind.Ops TileKind -> AbsDepth -> X -> Y+unknownLevel :: Kind.COps -> AbsDepth -> X -> Y              -> Text -> ([Point], [Point]) -> Int -> Int -> Int -> Bool              -> Level-unknownLevel Kind.Ops{ouniqGroup} ldepth lxsize lysize ldesc lstair lclear+unknownLevel Kind.COps{cotile=Kind.Ops{ouniqGroup}}+             ldepth lxsize lysize ldesc lstair lclear              lsecret lhidden lescape =   let unknownId = ouniqGroup "unknown space"       outerId = ouniqGroup "basic outer fence"@@ -62,6 +63,7 @@            , lseen = 0            , lclear            , ltime = timeZero+           , lactorCoeff = 0            , lactorFreq = []            , litemNum = 0            , litemFreq = []@@ -112,11 +114,11 @@ -- | Local state created by removing secret information from global -- state components. localFromGlobal :: State -> State-localFromGlobal State{_scops=_scops@Kind.COps{cotile}, .. } =+localFromGlobal State{..} =   State     { _sdungeon =       EM.map (\Level{..} ->-              unknownLevel cotile ldepth lxsize lysize ldesc lstair lclear+              unknownLevel _scops ldepth lxsize lysize ldesc lstair lclear                            lsecret lhidden lescape)             _sdungeon     , ..

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP, TypeFamilies #-} -- | Operations concerning dungeon level tiles. -- -- Unlike for many other content types, there is no type @Tile@,@@ -19,9 +20,13 @@   , isExplorable, lookSimilar, speedup   , openTo, closeTo, causeEffects, revealAs, hideAs   , isOpenable, isClosable, isChangeable, isEscape, isStair+#ifdef EXPOSE_INTERNAL+  , TileSpeedup(..), Tab, createTab, accessTab+#endif   ) where  import Control.Exception.Assert.Sugar+import qualified Data.Array.Unboxed as A import Data.Maybe  import qualified Game.LambdaHack.Common.Effect as Effect@@ -35,6 +40,30 @@ -- by monsters that hunt by smell. type SmellTime = Time +type instance Kind.Speedup TileKind = TileSpeedup++data TileSpeedup = TileSpeedup+  { isClearTab      :: !Tab+  , isLitTab        :: !Tab+  , isWalkableTab   :: !Tab+  , isPassableTab   :: !Tab+  , isDoorTab       :: !Tab+  , isSuspectTab    :: !Tab+  , isChangeableTab :: !Tab+  }++newtype Tab = Tab (A.UArray (Kind.Id TileKind) Bool)++createTab :: Kind.Ops TileKind -> (TileKind -> Bool) -> Tab+createTab Kind.Ops{ofoldrWithKey, obounds} p =+  let f _ k acc = p k : acc+      clearAssocs = ofoldrWithKey f []+  in Tab $ A.listArray obounds clearAssocs++accessTab :: Tab -> Kind.Id TileKind -> Bool+{-# INLINE accessTab #-}+accessTab (Tab tab) ki = tab A.! ki+ -- | Whether a tile kind has the given feature. kindHasFeature :: F.Feature -> TileKind -> Bool {-# INLINE kindHasFeature #-}@@ -49,24 +78,24 @@ -- Essential for efficiency of "FOV", hence tabulated. isClear :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isClear #-}-isClear Kind.Ops{ospeedup = Just Kind.TileSpeedup{isClearTab}} =-  \k -> Kind.accessTab isClearTab k+isClear Kind.Ops{ospeedup = Just TileSpeedup{isClearTab}} =+  \k -> accessTab isClearTab k isClear cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether a tile is lit on its own. -- Essential for efficiency of "Perception", hence tabulated. isLit :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isLit #-}-isLit Kind.Ops{ospeedup = Just Kind.TileSpeedup{isLitTab}} =-  \k -> Kind.accessTab isLitTab k+isLit Kind.Ops{ospeedup = Just TileSpeedup{isLitTab}} =+  \k -> accessTab isLitTab k isLit cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether actors can walk into a tile. -- Essential for efficiency of pathfinding, hence tabulated. isWalkable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isWalkable #-}-isWalkable Kind.Ops{ospeedup = Just Kind.TileSpeedup{isWalkableTab}} =-  \k -> Kind.accessTab isWalkableTab k+isWalkable Kind.Ops{ospeedup = Just TileSpeedup{isWalkableTab}} =+  \k -> accessTab isWalkableTab k isWalkable cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether actors can walk into a tile, perhaps opening a door first,@@ -74,32 +103,32 @@ -- Essential for efficiency of pathfinding, hence tabulated. isPassable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isPassable #-}-isPassable Kind.Ops{ospeedup = Just Kind.TileSpeedup{isPassableTab}} =-  \k -> Kind.accessTab isPassableTab k+isPassable Kind.Ops{ospeedup = Just TileSpeedup{isPassableTab}} =+  \k -> accessTab isPassableTab k isPassable cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether a tile is a door, open or closed. -- Essential for efficiency of pathfinding, hence tabulated. isDoor :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isDoor #-}-isDoor Kind.Ops{ospeedup = Just Kind.TileSpeedup{isDoorTab}} =-  \k -> Kind.accessTab isDoorTab k+isDoor Kind.Ops{ospeedup = Just TileSpeedup{isDoorTab}} =+  \k -> accessTab isDoorTab k isDoor cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether a tile is suspect. -- Essential for efficiency of pathfinding, hence tabulated. isSuspect :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isSuspect #-}-isSuspect Kind.Ops{ospeedup = Just Kind.TileSpeedup{isSuspectTab}} =-  \k -> Kind.accessTab isSuspectTab k+isSuspect Kind.Ops{ospeedup = Just TileSpeedup{isSuspectTab}} =+  \k -> accessTab isSuspectTab k isSuspect cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether a tile kind (specified by its id) has a ChangeTo feature. -- Essential for efficiency of pathfinding, hence tabulated. isChangeable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool {-# INLINE isChangeable #-}-isChangeable Kind.Ops{ospeedup = Just Kind.TileSpeedup{isChangeableTab}} =-  \k -> Kind.accessTab isChangeableTab k+isChangeable Kind.Ops{ospeedup = Just TileSpeedup{isChangeableTab}} =+  \k -> accessTab isChangeableTab k isChangeable cotile = assert `failure` "no speedup" `twith` Kind.obounds cotile  -- | Whether one can easily explore a tile, possibly finding a treasure@@ -121,29 +150,29 @@   tcolor  t == tcolor  u &&   tcolor2 t == tcolor2 u -speedup :: Bool -> Kind.Ops TileKind -> Kind.Speedup TileKind+speedup :: Bool -> Kind.Ops TileKind -> TileSpeedup speedup allClear cotile =   -- Vectors pack bools as Word8 by default. No idea if the extra memory   -- taken makes random lookups more or less efficient, so not optimizing   -- further, until I have benchmarks.-  let isClearTab | allClear = Kind.createTab cotile+  let isClearTab | allClear = createTab cotile                               $ not . kindHasFeature F.Impenetrable-                 | otherwise = Kind.createTab cotile+                 | otherwise = createTab cotile                                $ kindHasFeature F.Clear-      isLitTab = Kind.createTab cotile $ not . kindHasFeature F.Dark-      isWalkableTab = Kind.createTab cotile $ kindHasFeature F.Walkable-      isPassableTab = Kind.createTab cotile isPassableKind-      isDoorTab = Kind.createTab cotile $ \tk ->+      isLitTab = createTab cotile $ not . kindHasFeature F.Dark+      isWalkableTab = createTab cotile $ kindHasFeature F.Walkable+      isPassableTab = createTab cotile isPassableKind+      isDoorTab = createTab cotile $ \tk ->         let getTo F.OpenTo{} = True             getTo F.CloseTo{} = True             getTo _ = False         in any getTo $ tfeature tk-      isSuspectTab = Kind.createTab cotile $ kindHasFeature F.Suspect-      isChangeableTab = Kind.createTab cotile $ \tk ->+      isSuspectTab = createTab cotile $ kindHasFeature F.Suspect+      isChangeableTab = createTab cotile $ \tk ->         let getTo F.ChangeTo{} = True             getTo _ = False         in any getTo $ tfeature tk-  in Kind.TileSpeedup {..}+  in TileSpeedup {..}  isPassableKind :: TileKind -> Bool isPassableKind tk =@@ -156,25 +185,25 @@  openTo :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind) openTo Kind.Ops{okind, opick} t = do-  let getTo (F.OpenTo group) acc = group : acc+  let getTo (F.OpenTo grp) acc = grp : acc       getTo _ acc = acc   case foldr getTo [] $ tfeature $ okind t of     [] -> return t     groups -> do-      group <- oneOf groups-      fmap (fromMaybe $ assert `failure` group)-        $ opick group (const True)+      grp <- oneOf groups+      fmap (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-  let getTo (F.CloseTo group) acc = group : acc+  let getTo (F.CloseTo grp) acc = grp : acc       getTo _ acc = acc   case foldr getTo [] $ tfeature $ okind t of     [] -> return t     groups -> do-      group <- oneOf groups-      fmap (fromMaybe $ assert `failure` group)-        $ opick group (const True)+      grp <- oneOf groups+      fmap (fromMaybe $ assert `failure` grp)+        $ opick grp (const True)  causeEffects :: Kind.Ops TileKind -> Kind.Id TileKind -> [Effect.Effect Int] causeEffects Kind.Ops{okind} t = do@@ -184,22 +213,22 @@  revealAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind) revealAs Kind.Ops{okind, opick} t = do-  let getTo (F.RevealAs group) acc = group : acc+  let getTo (F.RevealAs grp) acc = grp : acc       getTo _ acc = acc   case foldr getTo [] $ tfeature $ okind t of     [] -> return t     groups -> do-      group <- oneOf groups-      fmap (fromMaybe $ assert `failure` group)-        $ opick group (const True)+      grp <- oneOf groups+      fmap (fromMaybe $ assert `failure` grp)+        $ opick grp (const True)  hideAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind hideAs Kind.Ops{okind, ouniqGroup} t =-  let getTo (F.HideAs group) _ = Just group+  let getTo (F.HideAs grp) _ = Just grp       getTo _ acc = acc   in case foldr getTo Nothing (tfeature (okind t)) of        Nothing    -> t-       Just group -> ouniqGroup group+       Just grp -> ouniqGroup grp  -- | Whether a tile kind (specified by its id) has an OpenTo feature. isOpenable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool

@@ -1,6 +1,6 @@ -- | The type of cave layout kinds. module Game.LambdaHack.Content.CaveKind-  ( CaveKind(..), validateCaveKind+  ( CaveKind(..), validateSingleCaveKind, validateAllCaveKind   ) where  import Data.Text (Text)@@ -29,28 +29,26 @@   , cdoorChance     :: !Chance       -- ^ the chance of a door in an opening   , copenChance     :: !Chance       -- ^ if there's a door, is it open?   , chidden         :: !Int          -- ^ if not open, hidden one in n times+  , cactorCoeff     :: !Int          -- ^ the lower, the more monsters spawn   , cactorFreq      :: !Freqs        -- ^ actor groups to consider   , citemNum        :: !Dice.Dice    -- ^ the number of items in the cave   , citemFreq       :: !Freqs        -- ^ item groups to consider   , cplaceFreq      :: !Freqs        -- ^ place groups to consider   , cpassable       :: !Bool         -- ^ are passable default tiles permitted-  , cdefTile        :: !Text         -- ^ the default cave tile group name-  , cdarkCorTile    :: !Text         -- ^ the dark cave corridor tile group name-  , clitCorTile     :: !Text         -- ^ the lit cave corridor tile group name-  , cfillerTile     :: !Text         -- ^ the filler wall group name-  , couterFenceTile :: !Text         -- ^ the outer fence wall group name-  , clegendDarkTile :: !Text         -- ^ the dark place plan legend group name-  , clegendLitTile  :: !Text         -- ^ the lit place plan legend group name+  , cdefTile        :: !GroupName    -- ^ the default cave tile+  , cdarkCorTile    :: !GroupName    -- ^ the dark cave corridor tile+  , clitCorTile     :: !GroupName    -- ^ the lit cave corridor tile+  , cfillerTile     :: !GroupName    -- ^ the filler wall+  , couterFenceTile :: !GroupName    -- ^ the outer fence wall+  , clegendDarkTile :: !GroupName    -- ^ the dark place plan legend+  , clegendLitTile  :: !GroupName    -- ^ the lit place plan legend   }-  deriving Show  -- No Eq and Ord to make extending it logically sound, see #53+  deriving Show  -- No Eq and Ord to make extending it logically sound --- TODO: check many things, e.g., if all items and actors fit in the dungeon.--- | Filter a list of kinds, passing through only the incorrect ones, if any.------ Catch caves with not enough space for all the places. Check the size--- of the cave descriptions to make sure they fit on screen.-validateCaveKind :: [CaveKind] -> [CaveKind]-validateCaveKind = filter (\CaveKind{..} ->+-- | Catch caves with not enough space for all the places. Check the size+-- of the cave descriptions to make sure they fit on screen. Etc.+validateSingleCaveKind :: CaveKind -> [Text]+validateSingleCaveKind CaveKind{..} =   let (maxGridX, maxGridY) = Dice.maxDiceXY cgrid       (minMinSizeX, minMinSizeY) = Dice.minDiceXY cminPlaceSize       (maxMinSizeX, maxMinSizeY) = Dice.maxDiceXY cminPlaceSize@@ -64,12 +62,23 @@       yborder = if maxGridY == 1 || couterFenceTile /= "basic outer fence"                 then 2                 else 0-  in T.length cname > 25-     || cxsize < 7-     || cysize < 7-     || minMinSizeX < 1-     || minMinSizeY < 1-     || minMaxSizeX < maxMinSizeX-     || minMaxSizeY < maxMinSizeY-     || maxGridX * (maxMinSizeX + 1) + xborder >= cxsize-     || maxGridY * (maxMinSizeY + 1) + yborder >= cysize)+  in [ "cname longer than 25" | T.length cname > 25 ]+     ++ [ "cxsize < 7" | cxsize < 7 ]+     ++ [ "cysize < 7" | cysize < 7 ]+     ++ [ "minMinSizeX < 1" | minMinSizeX < 1 ]+     ++ [ "minMinSizeY < 1" | minMinSizeY < 1 ]+     ++ [ "minMaxSizeX < maxMinSizeX" | minMaxSizeX < maxMinSizeX ]+     ++ [ "minMaxSizeY < maxMinSizeY" | minMaxSizeY < maxMinSizeY ]+     ++ [ "cxsize too small"+        | maxGridX * (maxMinSizeX + 1) + xborder >= cxsize ]+     ++ [ "cysize too small"+        | maxGridY * (maxMinSizeY + 1) + yborder >= cysize ]++-- | Validate all cave kinds.+-- Note that names don't have to be unique: we can have several variants+-- of a cave with a given name.+validateAllCaveKind :: [CaveKind] -> [Text]+validateAllCaveKind lk =+  if any (\k -> maybe False (> 0) $ lookup "campaign random" $ cfreq k) lk+  then []+  else ["no cave defined for \"campaign random\""]

@@ -1,23 +0,0 @@--- | The type of kinds of game factions (heroes, enemies, NPCs, etc.).-module Game.LambdaHack.Content.FactionKind-  ( FactionKind(..), validateFactionKind-  ) where--import Data.Text (Text)-import Game.LambdaHack.Common.Ability-import Game.LambdaHack.Common.Misc---- | Faction properties that are fixed for a given kind of factions.-data FactionKind = FactionKind-  { fsymbol       :: !Char    -- ^ a symbol-  , fname         :: !Text    -- ^ short description-  , ffreq         :: !Freqs   -- ^ frequency within groups-  , fSkillsLeader :: !Skills  -- ^ skills of the picked leader-  , fSkillsOther  :: !Skills  -- ^ skills of the other actors-  }-  deriving Show---- | No specific possible problems for the content of this kind, so far,--- so the validation function always returns the empty list of offending kinds.-validateFactionKind :: [FactionKind] -> [FactionKind]-validateFactionKind _ = []

@@ -1,11 +1,9 @@ -- | The type of kinds of weapons, treasure, organs, shrapnel and actors. module Game.LambdaHack.Content.ItemKind-  ( ItemKind(..), toVelocity, toLinger, validateItemKind+  ( ItemKind(..), toVelocity, toLinger+  , validateSingleItemKind, validateAllItemKind   ) where -import Data.Function-import Data.List-import Data.Ord import Data.Text (Text) import qualified Data.Text as T import qualified NLP.Miniutter.English as MU@@ -22,7 +20,7 @@   , ifreq    :: !Freqs             -- ^ frequency within groups   , iflavour :: ![Flavour]         -- ^ possible flavours   , icount   :: !Dice.Dice         -- ^ created in that quantity-  , irarity  :: ![(Int, Int)]      -- ^ rarity on given depths+  , irarity  :: !Rarity            -- ^ rarity on given depths   , iverbHit :: !MU.Part           -- ^ the verb for applying and melee   , iweight  :: !Int               -- ^ weight in grams   , iaspects :: ![Effect.Aspect Dice.Dice]@@ -31,9 +29,9 @@                                    -- ^ cause the effect when triggered   , ifeature :: ![Effect.Feature]  -- ^ public properties   , idesc    :: !Text              -- ^ description-  , ikit     :: ![(Text, CStore)]  -- ^ accompanying organs and items+  , ikit     :: ![(GroupName, CStore)]  -- ^ accompanying organs and items   }-  deriving Show  -- No Eq and Ord to make extending it logically sound, see #53+  deriving Show  -- No Eq and Ord to make extending it logically sound  toVelocity :: Int -> Effect.Feature toVelocity n = Effect.ToThrow $ Effect.ThrowMod n 100@@ -41,15 +39,17 @@ toLinger :: Int -> Effect.Feature toLinger n = Effect.ToThrow $ Effect.ThrowMod 100 n --- | Filter a list of kinds, passing through only the incorrect ones, if any.-validateItemKind :: [ItemKind] -> [ItemKind]-validateItemKind l =-  let bad ik = T.length (iname ik) > 23-               || let sortedRarity = sortBy (comparing fst) (irarity ik)-                  in sortedRarity /= irarity ik-                     || nubBy ((==) `on` fst) sortedRarity /= sortedRarity-                     || case (sortedRarity, reverse sortedRarity) of-                       ((lowest, _) : _, (highest, _) : _) ->-                         lowest < 1 || highest > 10-                       _ -> False-  in filter bad l+-- | Catch invalid item kind definitions.+validateSingleItemKind :: ItemKind -> [Text]+validateSingleItemKind ItemKind{..} =+  [ "iname longer than 23" | T.length iname > 23 ]+  ++ validateRarity irarity++-- TODO: if "treasure" stays wired-in, assure there are some treasure items+-- TODO: (spans multiple contents) check that there is at least one item+-- in each ifreq group for each level (thought more precisely we'd need+-- to lookup caves and modes and only check at the levels the caves+-- can appear at).+-- | Validate all item kinds.+validateAllItemKind :: [ItemKind] -> [Text]+validateAllItemKind _ = []

@@ -1,84 +1,152 @@+{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of game modes. module Game.LambdaHack.Content.ModeKind-  ( Caves, Players(..), Player(..), ModeKind(..), validateModeKind+  ( Caves, Roster(..), Player(..), ModeKind(..), Tactic(..)+  , LeaderMode(..), AutoLeader(..)+  , validateSingleModeKind, validateAllModeKind   ) where  import Data.Binary+import Data.Hashable (Hashable) import qualified Data.IntMap.Strict as IM import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU () -import Game.LambdaHack.Common.Misc (Freqs)+import Game.LambdaHack.Common.Ability+import Game.LambdaHack.Common.Misc+import Game.LambdaHack.Common.Msg  -- | Game mode specification. data ModeKind = ModeKind-  { msymbol  :: !Char     -- ^ a symbol (matches the keypress, if any)-  , mname    :: !Text     -- ^ short description-  , mfreq    :: !Freqs    -- ^ frequency within groups-  , mplayers :: !Players  -- ^ players taking part in the game-  , mcaves   :: !Caves    -- ^ arena of the game-  , mdesc    :: !Text     -- ^ description+  { msymbol :: !Char    -- ^ a symbol (matches the keypress, if any)+  , mname   :: !Text    -- ^ short description+  , mfreq   :: !Freqs   -- ^ frequency within groups+  , mroster :: !Roster  -- ^ players taking part in the game+  , mcaves  :: !Caves   -- ^ arena of the game+  , mdesc   :: !Text    -- ^ description   }   deriving Show --- | Requested cave groups for particular levels. The default is--- the "dng" group, which means a random choice from all caves--- that can randomly appear. The second component of the pair+-- | Requested cave groups for particular levels. The second component -- is the @Escape@ feature on the level. @True@ means it's represented -- by @<@, @False@, by @>@.-type Caves = IM.IntMap (Text, Maybe Bool)+type Caves = IM.IntMap (GroupName, Maybe Bool)  -- | The specification of players for the game mode.-data Players = Players-  { playersList  :: ![Player]        -- ^ players, both human and computer-  , playersEnemy :: ![(Text, Text)]  -- ^ the initial enmity matrix-  , playersAlly  :: ![(Text, Text)]  -- ^ the initial aliance matrix+data Roster = Roster+  { rosterList  :: ![Player]        -- ^ players in the particular team+  , rosterEnemy :: ![(Text, Text)]  -- ^ the initial enmity matrix+  , rosterAlly  :: ![(Text, Text)]  -- ^ the initial aliance matrix   }   deriving (Show, Eq)  -- | Properties of a particular player. data Player = Player-  { playerName    :: !Text     -- ^ name of the player-  , playerFaction :: !Text     -- ^ name of faction(s) the player can control-  , playerIsSpawn :: !Bool     -- ^ whether the player is a spawn (score, AI)-  , playerIsHero  :: !Bool     -- ^ whether the player is a hero (score, AI, UI)-  , playerEntry   :: !Int      -- ^ level where the initial members start-  , playerInitial :: !Int      -- ^ number of initial members-  , playerLeader  :: !Bool     -- ^ leaderless factions can't be controlled-                               --   by a human or a user-supplied AI client-  , playerAI      :: !Bool     -- ^ is the faction under AI control?-  , playerUI      :: !Bool     -- ^ does the faction have a UI client-                               --   (for control or passive observation)+  { fname          :: !Text        -- ^ name of the player+  , fgroup         :: !GroupName   -- ^ name of the monster group to control+  , fskillsOther   :: !Skills      -- ^ skills of the other actors+  , fcanEscape     :: !Bool        -- ^ the player can escape the dungeon+  , fneverEmpty    :: !Bool        -- ^ the faction declared killed if no actors+  , fhasNumbers    :: !Bool        -- ^ whether actors have numbers, not symbols+  , fhasGender     :: !Bool        -- ^ whether actors have gender+  , ftactic        :: !Tactic      -- ^ members behave according to this tactic+  , fentryLevel    :: !Int         -- ^ level where the initial members start+  , finitialActors :: !Int         -- ^ number of initial members+  , fleaderMode    :: !LeaderMode  -- ^ the mode of switching the leader+  , fhasUI         :: !Bool        -- ^ does the faction have a UI client+                                   --   (for control or passive observation)   }-  deriving (Show, Eq)+  deriving (Show, Eq, Generic) --- TODO: assert every Player's playerName's first word's length <= 15--- TODO: assert if no UI, both Ai are on and there are some non-spawners;--- assert that playersEnemy and playersAlly mention only factions in play.--- | No specific possible problems for the content of this kind, so far,--- so the validation function always returns the empty list of offending kinds.-validateModeKind :: [ModeKind] -> [ModeKind]-validateModeKind _ = []+instance Binary Player -instance Binary Player where-  put Player{..} = do-    put playerName-    put playerFaction-    put playerIsSpawn-    put playerIsHero-    put playerEntry-    put playerInitial-    put playerLeader-    put playerAI-    put playerUI-  get = do-    playerName <- get-    playerFaction <- get-    playerIsSpawn <- get-    playerIsHero <- get-    playerEntry <- get-    playerInitial <- get-    playerLeader <- get-    playerAI <- get-    playerUI <- get-    return $! Player{..}+-- Keep this type here, so that Contents/ is as self-contained as possible.+-- 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+data Tactic =+    TBlock    -- ^ always only wait, even if enemy in melee range+  | TFollow   -- ^ always follow leader's target or his position if no target+  | TExplore  -- ^ if enemy nearby, attack, if no items, etc., explore unknown+  | 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@+              --   when enemy is seen by the faction and is within+              --   the actor's sight radius+              --   TODO (currently the same as TExplore; should it chase+              --   targets too (TRoam) and only switch to TPatrol when none?)+  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 TRoam = "roam freely, chase targets"+  show TPatrol = "find and patrol an area (TODO)"++instance Binary Tactic++instance Hashable Tactic++-- | If a faction with @LeaderUI@ and @LeaderAI@ has any actor, it has a leader.+data LeaderMode =+    LeaderNull  -- ^ faction can have no leader, is whole under AI control+  | LeaderAI AutoLeader -- ^ leader under AI control+  | LeaderUI AutoLeader -- ^ leader under UI control, assumes @fhasUI@+  deriving (Show, Eq, Generic)++instance Binary LeaderMode++data AutoLeader = AutoLeader+  { autoDungeon :: !Bool  -- ^ leader change between levels only automatic+  , autoLevel   :: !Bool  -- ^ leader change within a level only automatic+                          --   (for UI, currently no leader change here)+  }+  deriving (Show, Eq, Generic)++instance Binary AutoLeader++-- TODO: (spans multiple contents) Check that caves with the given groups exist.+-- | Catch invalid game mode kind definitions.+validateSingleModeKind :: ModeKind -> [Text]+validateSingleModeKind ModeKind{..} =+  [ "mname longer than 20" | T.length mname > 20 ]+  ++ validateSingleRoster mcaves mroster++-- TODO: if the diplomacy system stays in, check no teams are at once+-- in war and alliance, taking into account symmetry (but not transitvity)+-- | Checks, in particular, that there is at least one faction with fneverEmpty+-- or the game could get stuck when the dungeon is devoid of actors+validateSingleRoster :: Caves -> Roster -> [Text]+validateSingleRoster caves Roster{..} =+  [ "no player keeps the dungeon alive" | all (not . fneverEmpty) rosterList ]+  ++ concatMap (validateSinglePlayer caves) rosterList+  ++ let checkPl field pl =+           [ pl <+> "is not a player name in" <+> field+           | all ((/= pl) . fname) rosterList ]+         checkDipl field (pl1, pl2) =+           [ "self-diplomacy in" <+> field | pl1 == pl2 ]+           ++ checkPl field pl1+           ++ checkPl field pl2+     in concatMap (checkDipl "rosterEnemy") rosterEnemy+        ++ concatMap (checkDipl "rosterAlly") rosterAlly++-- Note that @fSkillsOther@ needn't be a subset of @fSkillsLeader@.+validateSinglePlayer :: Caves -> Player -> [Text]+validateSinglePlayer caves Player{..} =+  [ "fname empty:" <+> fname | T.null fname ]+  ++ [ "first word of fname longer than 15:" <+> fname+     | T.length (head $ T.words fname) > 15 ]+  ++ [ "no UI client, but UI leader:" <+> fname+     | not fhasUI && case fleaderMode of+                       LeaderUI _ -> True+                       _ -> False ]+  ++ [ "fentryLevel not among caves:" <+> fname+     | fentryLevel `notElem` IM.keys caves ]++-- | Validate all game mode kinds. Currently always valid.+validateAllModeKind :: [ModeKind] -> [Text]+validateAllModeKind _ = []

@@ -1,6 +1,7 @@ -- | The type of kinds of rooms, halls and passages. module Game.LambdaHack.Content.PlaceKind-  ( PlaceKind(..), Cover(..), Fence(..), validatePlaceKind+  ( PlaceKind(..), Cover(..), Fence(..)+  , validateSinglePlaceKind, validateAllPlaceKind   ) where  import Data.Text (Text)@@ -10,30 +11,31 @@  -- | Parameters for the generation of small areas within a dungeon level. data PlaceKind = PlaceKind-  { psymbol   :: !Char      -- ^ a symbol-  , pname     :: !Text      -- ^ short description-  , pfreq     :: !Freqs     -- ^ frequency within groups-  , prarity   :: ![(Int, Int)]  -- ^ rarity on given depths-  , pcover    :: !Cover     -- ^ how to fill whole place based on the corner-  , pfence    :: !Fence     -- ^ whether to fence the place with solid border-  , ptopLeft  :: ![Text]    -- ^ plan of the top-left corner of the place-  , poverride :: ![(Char, Text)]  -- ^ legend override, ignoring tile symbol+  { psymbol   :: !Char          -- ^ a symbol+  , pname     :: !Text          -- ^ short description+  , pfreq     :: !Freqs         -- ^ frequency within groups+  , prarity   :: !Rarity        -- ^ rarity on given depths+  , pcover    :: !Cover         -- ^ how to fill whole place based on the corner+  , pfence    :: !Fence         -- ^ whether to fence place with solid border+  , ptopLeft  :: ![Text]        -- ^ plan of the top-left corner of the place+  , poverride :: ![(Char, GroupName)]  -- ^ legend override   }-  deriving Show  -- No Eq and Ord to make extending it logically sound, see #53+  deriving Show  -- No Eq and Ord to make extending it logically sound  -- | A method of filling the whole area (except for CVerbatim, which is just--- placed in the middle of the area), by transforming a given corner.+-- placed in the middle of the area) by transforming a given corner. data Cover =-    CAlternate   -- ^ reflect every other corner, overlapping 1 row and column-  | CStretch     -- ^ fill symmetrically 4 corners and stretch their borders-  | CReflect     -- ^ tile separately and symmetrically quarters of the place-  | CVerbatim    -- ^ just build the given interior, without filling the area+    CAlternate  -- ^ reflect every other corner, overlapping 1 row and column+  | CStretch    -- ^ fill symmetrically 4 corners and stretch their borders+  | CReflect    -- ^ tile separately and symmetrically quarters of the place+  | CVerbatim   -- ^ just build the given interior, without filling the area   deriving (Show, Eq)  -- | The choice of a fence type for the place. data Fence =     FWall   -- ^ put a solid wall fence around the place-  | FFloor  -- ^ leave an empty floor space around the place+  | FFloor  -- ^ leave an empty space, like the rooms floor+  | FGround -- ^ leave an empty space, like the caves ground   | FNone   -- ^ skip the fence and fill all with the place proper   deriving (Show, Eq) @@ -41,14 +43,20 @@ -- that is at least 4 tiles distant from the edges, if the place is big enough, -- (unless the place has FNone fence, in which case the entrance is -- at the outer tiles of the place).--- TODO: Check that all symbols in place plans are present in the legend.--- TODO: Add a field with tile group to be used as the legend.--- | Filter a list of kinds, passing through only the incorrect ones, if any.------ Verify that the top-left corner map is rectangular and not empty.-validatePlaceKind :: [PlaceKind] -> [PlaceKind]-validatePlaceKind = filter (\ PlaceKind{..} ->+-- TODO: (spans multiple contents) Check that all symbols in place plans+-- are present in the legend.+-- | Catch invalid place kind definitions. In particular, verify that+-- the top-left corner map is rectangular and not empty.+validateSinglePlaceKind :: PlaceKind -> [Text]+validateSinglePlaceKind PlaceKind{..} =   let dxcorner = case ptopLeft of         [] -> 0         l : _ -> T.length l-  in dxcorner /= 0 && any (/= dxcorner) (map T.length ptopLeft))+  in [ "top-left corner empty" | dxcorner == 0 ]+     ++ [ "top-left corner not rectangular"+        | any (/= dxcorner) (map T.length ptopLeft) ]+     ++ validateRarity prarity++-- | Validate all place kinds. Currently always valid.+validateAllPlaceKind :: [PlaceKind] -> [Text]+validateAllPlaceKind _ = []

@@ -1,6 +1,6 @@ -- | The type of game rule sets and assorted game data. module Game.LambdaHack.Content.RuleKind-  ( RuleKind(..), validateRuleKind, FovMode(..)+  ( RuleKind(..), FovMode(..), validateSingleRuleKind, validateAllRuleKind   ) where  import Data.Binary@@ -25,7 +25,7 @@ -- and then @RuleKind@ will become just a starting template, analogously -- as for the other content. ----- The @raccessible@ field hold extra conditions that have to be met+-- The @raccessible@ field holds extra conditions that have to be met -- for a tile to be accessible, on top of being an open tile -- (or openable, in some contexts). The @raccessibleDoor@ field -- contains yet additional conditions concerning tiles that are doors,@@ -36,28 +36,29 @@   { rsymbol         :: !Char      -- ^ a symbol   , rname           :: !Text      -- ^ short description   , rfreq           :: !Freqs     -- ^ frequency within groups-  , raccessible     :: !(Maybe (Point -> Point -> Bool))-  , raccessibleDoor :: !(Maybe (Point -> Point -> Bool))+  , raccessible     :: !(Maybe (Point -> Point -> Bool))  -- ^ see above+  , raccessibleDoor :: !(Maybe (Point -> Point -> Bool))  -- ^ see above   , rtitle          :: !Text      -- ^ the title of the game   , rpathsDataFile  :: FilePath -> IO FilePath-                                   -- ^ the path to data files+                                  -- ^ the path to data files   , rpathsVersion   :: !Version   -- ^ the version of the game   , rcfgUIName      :: !FilePath  -- ^ base name of the UI config file   , rcfgUIDefault   :: !String    -- ^ the default UI settings config file   , rmainMenuArt    :: !Text      -- ^ the ASCII art for the Main Menu   , rfirstDeathEnds :: !Bool      -- ^ whether first non-spawner actor death-                                   --   ends the game+                                  --   ends the game   , rfovMode        :: !FovMode   -- ^ FOV calculation mode-  , rsaveBkpClips   :: !Int       -- ^ game backup is saved that often+  , rwriteSaveClips :: !Int       -- ^ game is saved that often   , rleadLevelClips :: !Int       -- ^ flip AI/spawn leader level that often   , rscoresFile     :: !FilePath  -- ^ name of the scores file   , rsavePrefix     :: !String    -- ^ name of the savefile prefix   , rsharedStash    :: !Bool      -- ^ whether shared stashes are available+  , rnearby         :: !Int       -- ^ what distance between actors is 'nearby'   }  -- | Field Of View scanning mode. data FovMode =-    Shadow      -- ^ restrictive shadow casting+    Shadow      -- ^ restrictive shadow casting (not symmetric!)   | Permissive  -- ^ permissive FOV   | Digital     -- ^ digital FOV   deriving (Show, Read)@@ -68,9 +69,14 @@ instance Show RuleKind where   show _ = "The game ruleset specification." --- | Validates the ASCII art format (TODO).-validateRuleKind :: [RuleKind] -> [RuleKind]-validateRuleKind _ = []+-- | Catch invalid rule kind definitions.+-- In particular, this validates the ASCII art format (TODO).+validateSingleRuleKind :: RuleKind -> [Text]+validateSingleRuleKind _ = []++-- | Since we have only one rule kind, the set of rule kinds is always valid.+validateAllRuleKind :: [RuleKind] -> [Text]+validateAllRuleKind _ = []  instance Binary FovMode where   put Shadow      = putWord8 0

@@ -1,6 +1,6 @@ -- | The type of kinds of terrain tiles. module Game.LambdaHack.Content.TileKind-  ( TileKind(..), validateTileKind, actionFeatures+  ( TileKind(..), validateSingleTileKind, validateAllTileKind, actionFeatures   ) where  import Control.Exception.Assert.Sugar@@ -13,6 +13,7 @@ import Game.LambdaHack.Common.Color import qualified Game.LambdaHack.Common.Feature as F import Game.LambdaHack.Common.Misc+import Game.LambdaHack.Common.Msg  -- | The type of kinds of terrain tiles. See @Tile.hs@ for explanation -- of the absence of a corresponding type @Tile@ that would hold@@ -25,25 +26,31 @@   , tcolor2  :: !Color        -- ^ map color when not in FOV   , tfeature :: ![F.Feature]  -- ^ properties   }-  deriving Show  -- No Eq and Ord to make extending it logically sound, see #53+  deriving Show  -- No Eq and Ord to make extending it logically sound --- TODO: Make sure only solid tiles have Suspect.--- TODO: check that all posible solid place fences have hidden counterparts.+-- TODO: (spans multiple contents) check that all posible solid place+-- fences have hidden counterparts.+-- | Validate a single tile kind.+validateSingleTileKind :: TileKind -> [Text]+validateSingleTileKind TileKind{..} =+  [ "suspect tile is walkable" | F.Walkable `elem` tfeature+                                 && F.Suspect `elem` tfeature ]+ -- TODO: verify that OpenTo, CloseTo and ChangeTo are assigned as specified.--- | Filter a list of kinds, passing through only the incorrect ones, if any.+-- | Validate all tile kinds. -- -- If tiles look the same on the map, the description and the substantial -- features should be the same, too. Otherwise, the player has to inspect -- manually all the tiles of that kind, or even experiment with them, -- to see if any is special. This would be tedious. Note that iiles may freely -- differ wrt dungeon generation, AI preferences, etc.-validateTileKind :: [TileKind] -> [TileKind]-validateTileKind lt =+validateAllTileKind :: [TileKind] -> [Text]+validateAllTileKind lt =   let listVis f = map (\kt -> ( ( tsymbol kt                                   , F.Suspect `elem` tfeature kt                                   , f kt                                   )-                                , [kt] )) lt+                                , [kt] ) ) lt       mapVis :: (TileKind -> Color) -> M.Map (Char, Bool, Color) [TileKind]       mapVis f = M.fromListWith (++) $ listVis f       namesUnequal [] = assert `failure` "no TileKind content" `twith` lt@@ -55,7 +62,7 @@       confusions f = filter namesUnequal $ M.elems $ mapVis f   in case confusions tcolor ++ confusions tcolor2 of     [] -> []-    l : _ -> l+    cfs -> ["tile confusions detected:" <+> tshow cfs]  -- | Features of tiles that differentiate them substantially from one another. -- By tile content validation condition, this means the player

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving,+{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving,              MultiParamTypeClasses #-} -- | The main game action monad type implementation. Just as any other -- component of the library, this implementation can be substituted.@@ -6,6 +6,9 @@ -- to expose the executor to any code using the library. module Game.LambdaHack.SampleImplementation.SampleMonadClient   ( executorCli+#ifdef EXPOSE_INTERNAL+  , CliImplementation+#endif   ) where  import Control.Applicative

@@ -1,10 +1,13 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} -- | The main game action monad type implementation. Just as any other -- component of the library, this implementation can be substituted. -- This module should not be imported anywhere except in 'Action' -- to expose the executor to any code using the library. module Game.LambdaHack.SampleImplementation.SampleMonadServer   ( executorSer+#ifdef EXPOSE_INTERNAL+  , SerImplementation+#endif   ) where  import Control.Applicative

@@ -6,6 +6,7 @@ import qualified Data.Text as T  import Game.LambdaHack.Common.ClientOptions+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Server.State  -- TODO: make more maintainable@@ -56,7 +57,7 @@       parseArgs ("--allClear" : rest) =         (parseArgs rest) {sallClear = True}       parseArgs ("--gameMode" : s : rest) =-        (parseArgs rest) {sgameMode = T.pack s}+        (parseArgs rest) {sgameMode = toGroupName (T.pack s)}       parseArgs ("--automateAll" : rest) =         (parseArgs rest) {sautomateAll = True}       parseArgs ("--newGame" : rest) =@@ -71,7 +72,8 @@       parseArgs ("--stopAfter" : s : rest) =         (parseArgs rest) {sstopAfter = Just $ read s}       parseArgs ("--benchmark" : rest) =-        (parseArgs rest) {sbenchmark = True}+        let debugSer = parseArgs rest+        in debugSer {sdebugCli = (sdebugCli debugSer) {sbenchmark = True}}       parseArgs ("--setDungeonRng" : s : rest) =         (parseArgs rest) {sdungeonRng = Just $ read s}       parseArgs ("--setMainRng" : s : rest) =

@@ -4,7 +4,7 @@   ( execFailure, resetFidPerception, resetLitInDungeon, getPerFid   , revealItems, moveStores, deduceQuits, deduceKilled, electLeader   , addActor, addActorIid, projectFail, pickWeaponServer, sumOrganEqpServer-  , actorSkillsServer+  , actorSkillsServer, maxActorSkillsServer   ) where  import Control.Applicative@@ -132,7 +132,7 @@     Just Conquer -> return ()     Just Escape -> return ()     _ -> do-      when (playerUI $ gplayer fact) $ do+      when (fhasUI $ gplayer fact) $ do         revealItems (Just fid) mbody         registerScore status mbody fid       execUpdAtomic $ UpdQuitFaction fid mbody oldSt $ Just status@@ -161,11 +161,12 @@   let assocsInGameOutcome = filter inGameOutcome $ EM.assocs factionD       keysInGame = map fst assocsInGameOutcome       assocsKeepArena = filter (keepArenaFact . snd) assocsInGame-      assocsUI = filter (playerUI . gplayer . snd) assocsInGame+      assocsUI = filter (fhasUI . gplayer . snd) assocsInGame+      nonHorrorAIG = filter (not . isHorrorFact . snd) assocsInGame       worldPeace =         all (\(fid1, _) -> all (\(_, fact2) -> not $ isAtWar fact2 fid1)-                           assocsInGame)-        assocsInGame+                           nonHorrorAIG)+        nonHorrorAIG   case assocsKeepArena of     _ | null assocsUI ->       -- Only non-UI players left in the game and they all win.@@ -173,7 +174,7 @@     [] ->       -- Only leaderless and spawners remain (the latter may sometimes       -- have no leader, just as the former), so they win,-      -- or we could end up in a state with no active arena.+      -- or we could get stuck in a state with no active arena and so no spawns.       mapQuitF status{stOutcome=Conquer} keysInGame     _ | worldPeace ->       -- Nobody is at war any more, so all win (e.g., horrors, but never mind).@@ -187,21 +188,30 @@       mapQuitF status{stOutcome=Defeated} $ map fst losers     _ -> return () +-- | Tell whether a faction that we know is still in game, keeps arena.+-- Keeping arena means, if the faction is still in game,+-- it always has a leader in the dungeon somewhere.+-- So, leaderless factions and spawner factions do not keep an arena,+-- even though the latter usually has a leader for most of the game.+keepArenaFact :: Faction -> Bool+keepArenaFact fact = fleaderMode (gplayer fact) /= LeaderNull+                     && fneverEmpty (gplayer fact)+ deduceKilled :: (MonadAtomic m, MonadServer m) => Actor -> m () deduceKilled body = do   Kind.COps{corule} <- getsState scops   let firstDeathEnds = rfirstDeathEnds $ Kind.stdRuleset corule       fid = bfid body   fact <- getsState $ (EM.! fid) . sfactionD-  unless (isSpawnFact fact) $ do  -- spawners never die off+  when (fneverEmpty $ gplayer fact) $ do     actorsAlive <- anyActorsAlive fid     when (not actorsAlive || firstDeathEnds) $-      deduceQuits body $ Status Killed (fromEnum $ blid body) ""+      deduceQuits body $ Status Killed (fromEnum $ blid body) Nothing  anyActorsAlive :: MonadServer m => FactionId -> m Bool anyActorsAlive fid = do   fact <- getsState $ (EM.! fid) . sfactionD-  if playerLeader (gplayer fact)+  if fleaderMode (gplayer fact) /= LeaderNull     then return $! isJust $ gleader fact     else do       as <- getsState $ fidActorNotProjList fid@@ -210,13 +220,14 @@ electLeader :: MonadAtomic m => FactionId -> LevelId -> ActorId -> m () electLeader fid lid aidDead = do   mleader <- getsState $ gleader . (EM.! fid) . sfactionD-  when (isNothing mleader || mleader == Just aidDead) $ do+  when (isNothing mleader || fmap fst mleader == Just aidDead) $ do     actorD <- getsState sactorD     let ours (_, b) = bfid b == fid && not (bproj b)         party = filter ours $ EM.assocs actorD     onLevel <- getsState $ actorRegularAssocs (== fid) lid-    let mleaderNew = listToMaybe $ filter (/= aidDead)-                     $ map fst $ onLevel ++ party+    let mleaderNew = case filter (/= aidDead) $ map fst $ onLevel ++ party of+          [] -> Nothing+          aid : _ -> Just (aid, Nothing)     unless (mleader == mleaderNew) $       execUpdAtomic $ UpdLeadFaction fid mleader mleaderNew @@ -314,7 +325,7 @@                      bfid bpos blid tweakBody bpronoun btime  addActor :: (MonadAtomic m, MonadServer m)-         => Text -> FactionId -> Point -> LevelId+         => GroupName -> FactionId -> Point -> LevelId          -> (Actor -> Actor) -> Text -> Time          -> m (Maybe ActorId) addActor actorGroup bfid pos lid tweakBody bpronoun time = do@@ -342,11 +353,11 @@       calm = xM $ max 1              $ sumSlotNoFilter Effect.EqpSlotAddMaxCalm [trunkFull]   -- Create actor.-  fact@Faction{gplayer} <- getsState $ (EM.! bfid) . sfactionD+  Faction{gplayer} <- getsState $ (EM.! bfid) . sfactionD   DebugModeSer{sdifficultySer} <- getsServer sdebugSer   nU <- nUI-  -- If no UI factions, the difficulty applies to heroes (for testing).-  let diffHP | playerUI gplayer || nU == 0 && isHeroFact fact =+  -- If no UI factions, the difficulty applies to the escapees (for testing).+  let diffHP | fhasUI gplayer || nU == 0 && fcanEscape gplayer =         (ceiling :: Double -> Int64)         $ fromIntegral hp           * 1.5 ^^ difficultyCoeff sdifficultySer@@ -403,3 +414,11 @@ actorSkillsServer aid mleader = do   activeItems <- activeItemsServer aid   getsState $ actorSkills aid mleader activeItems++maxActorSkillsServer :: MonadServer m+                     => ActorId -> m Ability.Skills+maxActorSkillsServer aid = do+  activeItems <- activeItemsServer aid+  skOther <- getsState $ actorSkills aid Nothing activeItems+  skLeader <- getsState $ actorSkills aid (Just aid) activeItems+  return $! Ability.maxSkills skOther skLeader

@@ -1,9 +1,11 @@+{-# LANGUAGE CPP #-} -- | The unpopulated dungeon generation routine. module Game.LambdaHack.Server.DungeonGen   ( -- * Public API     FreshDungeon(..), dungeonGen-    -- * Internal functions+#ifdef EXPOSE_INTERNAL   , convertTileMaps, placeStairs, buildLevel, levelFromCaveKind, findGenerator+#endif   ) where  import Control.Exception.Assert.Sugar@@ -12,7 +14,6 @@ import qualified Data.IntMap.Strict as IM import Data.List import Data.Maybe-import Data.Text (Text)  import qualified Game.LambdaHack.Common.Effect as Effect import qualified Game.LambdaHack.Common.Feature as F@@ -31,11 +32,12 @@ import Game.LambdaHack.Server.DungeonGen.Cave import Game.LambdaHack.Server.DungeonGen.Place -convertTileMaps :: Kind.Ops TileKind+convertTileMaps :: Kind.COps                 -> Rnd (Kind.Id TileKind) -> Maybe (Rnd (Kind.Id TileKind))                 -> Int -> Int -> TileMapEM                 -> Rnd TileMap-convertTileMaps cotile cdefTile mcdefTileWalkable cxsize cysize ltile = do+convertTileMaps Kind.COps{cotile}+                cdefTile mcdefTileWalkable cxsize cysize ltile = do   let f :: Point -> Rnd (Kind.Id TileKind)       f p = case EM.lookup p ltile of         Just t -> return t@@ -84,9 +86,9 @@             connect (not . yeven) blocksVertical walkable5 converted4       return converted5 -placeStairs :: Kind.Ops TileKind -> TileMap -> CaveKind -> [Point]+placeStairs :: Kind.COps -> TileMap -> CaveKind -> [Point]             -> Rnd Point-placeStairs cotile cmap CaveKind{..} ps = do+placeStairs Kind.COps{cotile} cmap CaveKind{..} ps = do   let dist cmin l _ = all (\pos -> chessDist l pos > cmin) ps   findPosTry 1000 cmap     (\p t -> Tile.isWalkable cotile t@@ -104,7 +106,7 @@            -> AbsDepth -> LevelId -> LevelId -> LevelId -> AbsDepth            -> Int -> Maybe Bool            -> Rnd Level-buildLevel cops@Kind.COps{ cotile=cotile@Kind.Ops{opick, okind}+buildLevel cops@Kind.COps{ cotile=Kind.Ops{opick, okind}                          , cocave=Kind.Ops{okind=cokind} }            Cave{..} ldepth ln minD maxD totalDepth nstairUp escapeFeature = do   let kc@CaveKind{..} = cokind dkind@@ -129,7 +131,7 @@         then Just $ fmap (fromMaybe $ assert `failure` cdefTile)                   $ opick cdefTile wcond         else Nothing-  cmap <- convertTileMaps cotile pickDefTile mpickWalkable cxsize cysize dmap+  cmap <- convertTileMaps cops pickDefTile mpickWalkable cxsize cysize dmap   -- We keep two-way stairs separately, in the last component.   let makeStairs :: Bool -> Bool -> Bool                  -> ( [(Point, Kind.Id TileKind)]@@ -147,7 +149,7 @@                         && (if noDesc then not (descendable tk) else True)               stairsCur = up ++ down ++ upDown               posCur = nub $ sort $ map fst stairsCur-          spos <- placeStairs cotile cmap kc posCur+          spos <- placeStairs cops cmap kc posCur           let legend = findLegend spos           stairId <- fmap (fromMaybe $ assert `failure` legend)                      $ opick legend cond@@ -177,7 +179,7 @@   assert (length stairsUpAndUpDown == nstairUp) skip   let stairsTotal = stairsUpAndUpDown ++ stairsDown       posTotal = nub $ sort $ map fst stairsTotal-  epos <- placeStairs cotile cmap kc posTotal+  epos <- placeStairs cops cmap kc posTotal   escape <- case escapeFeature of               Nothing -> return []               Just True -> do@@ -199,17 +201,17 @@   litemNum <- castDice ldepth totalDepth citemNum   lsecret <- randomR (1, maxBound)  -- 0 means unknown   return $! levelFromCaveKind cops kc ldepth ltile lstair-                              cactorFreq litemNum citemFreq+                              cactorCoeff cactorFreq litemNum citemFreq                               lsecret (isJust escapeFeature)  -- | Build rudimentary level from a cave kind. levelFromCaveKind :: Kind.COps                   -> CaveKind -> AbsDepth -> TileMap -> ([Point], [Point])-                  -> Freqs -> Int -> Freqs -> Int -> Bool+                  -> Int -> Freqs -> Int -> Freqs -> Int -> Bool                   -> Level levelFromCaveKind Kind.COps{cotile}                   CaveKind{..}-                  ldepth ltile lstair lactorFreq litemNum litemFreq+                  ldepth ltile lstair lactorCoeff lactorFreq litemNum litemFreq                   lsecret lescape =   let lvl = Level         { ldepth@@ -224,6 +226,7 @@         , lseen = 0         , lclear = 0  -- calculated below         , ltime = timeZero+        , lactorCoeff         , lactorFreq         , litemNum         , litemFreq@@ -237,7 +240,7 @@   in lvl {lclear}  findGenerator :: Kind.COps -> LevelId -> LevelId -> LevelId -> AbsDepth -> Int-              -> (Text, Maybe Bool)+              -> (GroupName, Maybe Bool)               -> Rnd Level findGenerator cops ln minD maxD totalDepth nstairUp               (genName, escapeFeature) = do@@ -266,7 +269,7 @@       freshTotalDepth = assert (signum minD == signum maxD)                         $ AbsDepth                         $ max 10 $ max (abs minD) (abs maxD)-  let gen :: (Int, [(LevelId, Level)]) -> (Int, (Text, Maybe Bool))+  let gen :: (Int, [(LevelId, Level)]) -> (Int, (GroupName, Maybe Bool))           -> Rnd (Int, [(LevelId, Level)])       gen (nstairUp, l) (n, caveTB) = do         let ln = toEnum n

@@ -122,14 +122,15 @@                 let shrinkPlace (r, Place{qkind}) =                       case shrink r of                         Nothing -> (r, r)  -- FNone place of x and/or y size 1-                        Just sr -> case pfence $ pokind qkind of-                          FFloor ->+                        Just sr ->+                          if pfence (pokind qkind) `elem` [FFloor, FGround]+                          then                             -- Avoid corridors touching the floor fence,                             -- but let them merge with the fence.                             case shrink sr of                               Nothing -> (sr, r)                               Just mergeArea -> (mergeArea, r)-                          _ -> (sr, sr)+                          else (sr, sr)                     shrinkForFence = either (id &&& id) shrinkPlace                     rr0 = shrinkForFence $ qplaces M.! p0                     rr1 = shrinkForFence $ qplaces M.! p1

@@ -9,7 +9,6 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Maybe-import Data.Text (Text) import qualified Data.Text as T  import Game.LambdaHack.Common.Frequency@@ -28,12 +27,13 @@ -- | The parameters of a place. Most are immutable and set -- at the time when a place is generated. data Place = Place-  { qkind        :: !(Kind.Id PlaceKind)-  , qarea        :: !Area-  , qseen        :: !Bool-  , qlegend      :: !Text-  , qsolidFence  :: !(Kind.Id TileKind)-  , qhollowFence :: !(Kind.Id TileKind)+  { qkind    :: !(Kind.Id PlaceKind)+  , qarea    :: !Area+  , qseen    :: !Bool+  , qlegend  :: !GroupName+  , qFWall   :: !(Kind.Id TileKind)+  , qFFloor  :: !(Kind.Id TileKind)+  , qFGround :: !(Kind.Id TileKind)   }   deriving Show @@ -76,9 +76,10 @@ -- generation process (e.g., for stairs). interiorArea :: Fence -> Area -> Maybe Area interiorArea fence r = case fence of-  FWall  -> shrink r-  FFloor -> shrink r-  FNone  -> Just r+  FWall   -> shrink r+  FFloor  -> shrink r+  FGround -> shrink r+  FNone   -> Just r  -- | Given a few parameters, roll and construct a 'Place' datastructure -- and fill a cave section acccording to it.@@ -91,11 +92,11 @@            -> AbsDepth          -- ^ absolute depth            -> Area              -- ^ whole area of the place, fence included            -> Rnd (TileMapEM, Place)-buildPlace Kind.COps{ cotile=cotile@Kind.Ops{opick=opick}-                    , coplace=Kind.Ops{ofoldrGroup} }+buildPlace cops@Kind.COps{ cotile=Kind.Ops{opick=opick}+                         , coplace=Kind.Ops{ofoldrGroup} }            CaveKind{..} dnight darkCorTile litCorTile            ldepth@(AbsDepth ld) totalDepth@(AbsDepth depth) r = do-  qsolidFence <- fmap (fromMaybe $ assert `failure` cfillerTile)+  qFWall <- fmap (fromMaybe $ assert `failure` cfillerTile)                  $ opick cfillerTile (const True)   dark <- chanceDice ldepth totalDepth cdarkChance   -- TODO: factor out from here and newItem:@@ -118,20 +119,22 @@       freq = toFreq ("buildPlace ('" <> tshow ld <> ")") checkedFreq   assert (not (nullFreq freq) `blame` (placeFreq, checkedFreq, r)) skip   ((qkind, kr), _) <- frequency freq-  let qhollowFence = if dark then darkCorTile else litCorTile+  let qFFloor = if dark then darkCorTile else litCorTile+      qFGround = if dnight then darkCorTile else litCorTile       qlegend = if dark then clegendDarkTile else clegendLitTile       qseen = False       qarea = fromMaybe (assert `failure` (kr, r)) $ interiorArea (pfence kr) r       place = Place {..}-  override <- ooverride cotile (poverride kr)-  legend <- olegend cotile qlegend-  legendLit <- olegend cotile clegendLitTile+  override <- ooverride cops (poverride kr)+  legend <- olegend cops qlegend+  legendLit <- olegend cops clegendLitTile   let xlegend = EM.union override legend       xlegendLit = EM.union override legendLit       cmap = tilePlace qarea kr       fence = case pfence kr of-        FWall -> buildFence qsolidFence qarea-        FFloor -> buildFence qhollowFence qarea+        FWall -> buildFence qFWall qarea+        FFloor -> buildFence qFFloor qarea+        FGround -> buildFence qFGround qarea         FNone -> EM.empty       (x0, y0, x1, y1) = fromArea qarea       isEdge (Point x y) = x `elem` [x0, x1] || y `elem` [y0, y1]@@ -146,9 +149,9 @@   return (tmap, place)  -- | Roll a legend of a place plan: a map from plan symbols to tile kinds.-olegend :: Kind.Ops TileKind -> Text+olegend :: Kind.COps -> GroupName         -> Rnd (EM.EnumMap Char (Kind.Id TileKind))-olegend Kind.Ops{ofoldrWithKey, opick} cgroup =+olegend Kind.COps{cotile=Kind.Ops{ofoldrWithKey, opick}} cgroup =   let getSymbols _ tk acc =         maybe acc (const $ ES.insert (tsymbol tk) acc)           (lookup cgroup $ tfreq tk)@@ -161,9 +164,9 @@       legend = ES.foldr getLegend (return EM.empty) symbols   in legend -ooverride :: Kind.Ops TileKind -> [(Char, Text)]+ooverride :: Kind.COps -> [(Char, GroupName)]           -> Rnd (EM.EnumMap Char (Kind.Id TileKind))-ooverride Kind.Ops{opick} poverride =+ooverride Kind.COps{cotile=Kind.Ops{opick}} poverride =   let getLegend (s, cgroup) acc = do         m <- acc         tk <- fmap (fromMaybe $ assert `failure` (cgroup, s))@@ -182,7 +185,7 @@                    | x <- [x0-1..x1+1], y <- [y0-1, y1+1] ]  -- | Construct a fence around an area, with the given tile group.-buildFenceRnd :: Kind.COps -> Text -> Area -> Rnd TileMapEM+buildFenceRnd :: Kind.COps -> GroupName -> Area -> Rnd TileMapEM buildFenceRnd Kind.COps{cotile=Kind.Ops{opick}} couterFenceTile area = do   let (x0, y0, x1, y1) = fromArea area       fenceIdRnd (xf, yf) = do@@ -254,13 +257,15 @@     put qarea     put qseen     put qlegend-    put qsolidFence-    put qhollowFence+    put qFWall+    put qFFloor+    put qFGround   get = do     qkind <- get     qarea <- get     qseen <- get     qlegend <- get-    qsolidFence <- get-    qhollowFence <- get+    qFWall <- get+    qFFloor <- get+    qFGround <- get     return $! Place{..}

@@ -33,7 +33,7 @@         _ -> False       gameOver = not $ any inGame $ EM.elems factionD   let getQuitter fact = case gquit fact of-        Just Status{stOutcome=Restart, stInfo} -> Just stInfo+        Just Status{stOutcome=Restart, stNewGame} -> stNewGame         _ -> Nothing       quitters = mapMaybe getQuitter $ EM.elems factionD   let isCamper fact = case gquit fact of@@ -44,9 +44,9 @@   mapM_ (\(fid, fact) ->             execUpdAtomic             $ UpdQuitFaction fid Nothing (gquit fact) Nothing) campers-  bkpSave <- getsServer sbkpSave+  bkpSave <- getsServer swriteSave   when bkpSave $ do-    modifyServer $ \ser -> ser {sbkpSave = False}+    modifyServer $ \ser -> ser {swriteSave = False}     gameSave   case (quitters, campers) of     (sgameMode : _, _) -> do@@ -65,9 +65,9 @@     b2 <- getsState $ getActorBody aid     execUpdAtomic $ UpdDestroyActor aid b2 []   else do-    disco <- getsServer sdisco+    discoKind <- getsServer sdiscoKind     trunk <- getsState $ getItemBody $ btrunk b-    let ikind = disco EM.! jkindIx trunk+    let ikind = discoKind EM.! jkindIx trunk     execUpdAtomic $ UpdRecordKill aid ikind 1     electLeader (bfid b) (blid b) aid     equipAllItems aid b

@@ -1,9 +1,13 @@+{-# LANGUAGE CPP #-} -- | Field Of View scanning with a variety of algorithms. -- See <https://github.com/LambdaHack/LambdaHack/wiki/Fov-and-los> -- for discussion. module Game.LambdaHack.Server.Fov   ( dungeonPerception, fidLidPerception   , PersLit, litInDungeon+#ifdef EXPOSE_INTERNAL+  , PerceptionLit, ActorEqpBody+#endif   ) where  import Control.Exception.Assert.Sugar@@ -29,7 +33,6 @@ import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.RuleKind-import Game.LambdaHack.Content.TileKind import Game.LambdaHack.Server.Fov.Common import qualified Game.LambdaHack.Server.Fov.Digital as Digital import qualified Game.LambdaHack.Server.Fov.Permissive as Permissive@@ -114,10 +117,10 @@ reachableFromActor :: Kind.COps -> FovMode -> Level                    -> ((ActorId, Actor), [ItemFull])                    -> PerceptionReachable-reachableFromActor Kind.COps{cotile} fovMode lvl ((_, body), allItems) =+reachableFromActor cops fovMode lvl ((_, body), allItems) =   let sumSight = sumSlotNoFilter Effect.EqpSlotAddSight allItems       radius = min (fromIntegral $ bcalm body `div` (5 * oneM)) sumSight-  in PerceptionReachable $ fullscan cotile fovMode radius (bpos body) lvl+  in PerceptionReachable $ fullscan cops fovMode radius (bpos body) lvl  -- | Compute all lit positions on a level, whether lit by actors or floor items. -- Note that an actor can be blind or a projectile, in which case he doesn't see@@ -125,11 +128,11 @@ litByItems :: Kind.COps -> FovMode -> Level            -> [(Point, [ItemFull])]            -> PerceptionLit-litByItems Kind.COps{cotile} fovMode lvl allItems =+litByItems cops@Kind.COps{cotile} fovMode lvl allItems =   let litPos :: (Point, [ItemFull]) -> [Point]       litPos (p, is) =         let radius = sumSlotNoFilter Effect.EqpSlotAddLight is-            scan = fullscan cotile fovMode radius p lvl+            scan = fullscan cops fovMode radius p lvl             -- Optimization: filter out positions already having ambient light.             opt = filter (\pos -> not $ Tile.isLit cotile $ lvl `at` pos) scan         in opt@@ -152,14 +155,14 @@               let fid = bfid bFid                   eqpBody (aid, b) =                     ( (aid, b)-                    , map snd $ fullAssocs cops (sdisco ser) (sdiscoAE ser)+                    , map snd $ fullAssocs cops (sdiscoKind ser) (sdiscoEffect ser)                                            aid [COrgan, CEqp] s )               in (fid, map eqpBody asFid)         in EM.fromDistinctAscList $ map bodyFid asGrouped       itemsOnFloor :: Level -> [(Point, [ItemFull])]       itemsOnFloor lvl =         let iToFull (iid, (item, k)) =-              itemToFull cops (sdisco ser) (sdiscoAE ser) iid item k+              itemToFull cops (sdiscoKind ser) (sdiscoEffect ser) iid item k             processPos (p, bag) =               (p, map iToFull $ bagAssocsK s bag)         in map processPos $ EM.assocs $ lfloor lvl@@ -182,13 +185,13 @@ -- that are currently in the field of view. The Field of View -- algorithm to use is passed in the second argument. -- The actor's own position is considred reachable by him.-fullscan :: Kind.Ops TileKind  -- ^ tile content, determines clear tiles-         -> FovMode            -- ^ scanning mode-         -> Int                -- ^ scanning radius-         -> Point              -- ^ position of the spectator-         -> Level              -- ^ the map that is scanned+fullscan :: Kind.COps  -- ^ tile content, determines clear tiles+         -> FovMode    -- ^ scanning mode+         -> Int        -- ^ scanning radius+         -> Point      -- ^ position of the spectator+         -> Level      -- ^ the map that is scanned          -> [Point]-fullscan cotile fovMode radius spectatorPos lvl =+fullscan Kind.COps{cotile} fovMode radius spectatorPos lvl =   if radius <= 0 then []   else if radius == 1 then [spectatorPos]   else spectatorPos : case fovMode of

@@ -5,13 +5,13 @@   , dropEqpItem, armorHurtBonus   ) where +import Control.Applicative import Control.Exception.Assert.Sugar import Control.Monad import Data.Bits (xor) import qualified Data.EnumMap.Strict as EM import Data.Key (mapWithKeyM_) import Data.Maybe-import Data.Text (Text) import qualified NLP.Miniutter.English as MU  import Game.LambdaHack.Atomic@@ -37,6 +37,7 @@ import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ItemKind+import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Server.CommonServer import Game.LambdaHack.Server.ItemServer import Game.LambdaHack.Server.MonadServer@@ -338,7 +339,8 @@           b <- getsState $ getActorBody aid           mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD           when (isNothing mleader) $-            execUpdAtomic $ UpdLeadFaction (bfid b) Nothing (Just aid)+            execUpdAtomic+            $ UpdLeadFaction (bfid b) Nothing (Just (aid, Nothing))           return True     return $! or bs @@ -394,8 +396,8 @@   else do     let switch1 = void $ switchLevels1 ((aid, b1), ais1)         switch2 = do-          -- Make the intiator of the stair move the leader,-          -- to let him clear the stairs for other to follow.+          -- Make the initiator of the stair move the leader,+          -- to let him clear the stairs for others to follow.           let mlead = Just aid           -- Move the actor to where the inhabitants were, if any.           switchLevels2 lid2 pos2 ((aid, b1), ais1) mlead@@ -435,7 +437,8 @@     return True  switchLevels1 :: MonadAtomic m-              => ((ActorId, Actor), [(ItemId, Item)]) -> m (Maybe ActorId)+              => ((ActorId, Actor), [(ItemId, Item)])+              -> m (Maybe ActorId) switchLevels1 ((aid, bOld), ais) = do   let side = bfid bOld   mleader <- getsState $ gleader . (EM.! side) . sfactionD@@ -443,7 +446,8 @@   mlead <-     if not (bproj bOld) && isJust mleader then do       execUpdAtomic $ UpdLeadFaction side mleader Nothing-      return mleader+      return $ fst <$> mleader+        -- outside of a client we don't know the real tgt of aid, hence fst     else return Nothing   -- Remove the actor from the old level.   -- Onlookers see somebody disappear suddenly.@@ -475,7 +479,10 @@   -- Onlookers see somebody appear suddenly. The actor himself   -- sees new surroundings and has to reset his perception.   execUpdAtomic $ UpdCreateActor aid bNew ais-  when (isJust mlead) $ execUpdAtomic $ UpdLeadFaction side Nothing mlead+  case mlead of+    Nothing -> return ()+    Just leader ->+      execUpdAtomic $ UpdLeadFaction side Nothing (Just (leader, Nothing))  -- ** Escape @@ -486,10 +493,10 @@   b <- getsState $ getActorBody target   let fid = bfid b   fact <- getsState $ (EM.! fid) . sfactionD-  if not (keepArenaFact fact) || bproj b then+  if not (fcanEscape $ gplayer fact) || bproj b then     return False   else do-    deduceQuits b $ Status Escape (fromEnum $ blid b) ""+    deduceQuits b $ Status Escape (fromEnum $ blid b) Nothing     return True  -- ** Paralyze@@ -762,7 +769,7 @@ -- ** Explode  effectExplode :: (MonadAtomic m, MonadServer m)-              => m () -> Text -> ActorId -> m Bool+              => m () -> GroupName -> ActorId -> m Bool effectExplode execSfx cgroup target = do   tb <- getsState $ getActorBody target   let itemFreq = [(cgroup, 1)]

@@ -37,6 +37,7 @@ import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Vector+import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.TileKind as TileKind import Game.LambdaHack.Server.CommonServer import Game.LambdaHack.Server.HandleEffectServer@@ -50,8 +51,8 @@                 => FactionId -> ActorId -> RequestAI -> m ActorId handleRequestAI fid aid cmd = case cmd of   ReqAITimed cmdT -> handleRequestTimed aid cmdT >> return aid-  ReqAILeader aidNew cmd2 -> do-    switchLeader fid aidNew+  ReqAILeader aidNew mtgtNew cmd2 -> do+    switchLeader fid aidNew mtgtNew     handleRequestAI fid aidNew cmd2   ReqAIPong -> return aid @@ -63,15 +64,16 @@ handleRequestUI fid cmd = case cmd of   ReqUITimed cmdT -> do     fact <- getsState $ (EM.! fid) . sfactionD-    let aid = fromMaybe (assert `failure` fact) $ gleader fact+    let (aid, _) = fromMaybe (assert `failure` fact) $ gleader fact     handleRequestTimed aid cmdT >> return (Just aid)-  ReqUILeader aidNew cmd2 -> do-    switchLeader fid aidNew+  ReqUILeader aidNew mtgtNew cmd2 -> do+    switchLeader fid aidNew mtgtNew     handleRequestUI fid cmd2   ReqUIGameRestart aid t d names ->     reqGameRestart aid t d names >> return Nothing   ReqUIGameExit aid d -> reqGameExit aid d >> return Nothing   ReqUIGameSave -> reqGameSave >> return Nothing+  ReqUITactic toT -> reqTactic fid toT >> return Nothing   ReqUIAutomate -> reqAutomate fid >> return Nothing   ReqUIPong _ -> return Nothing @@ -89,22 +91,30 @@   ReqApply iid cstore -> reqApply aid iid cstore   ReqTrigger mfeat -> reqTrigger aid mfeat -switchLeader :: MonadAtomic m-             => FactionId -> ActorId -> m ()-switchLeader fid aidNew = do-  cops <- getsState scops+switchLeader :: (MonadAtomic m, MonadServer m)+             => FactionId -> ActorId -> Maybe Target -> m ()+switchLeader fid aidNew mtgtNew = do   fact <- getsState $ (EM.! fid) . sfactionD   bPre <- getsState $ getActorBody aidNew   let mleader = gleader fact-      leadAtoms = [UpdLeadFaction fid mleader (Just aidNew)]-  mapM_ execUpdAtomic leadAtoms-  assert (Just aidNew /= mleader+      actorChanged = fmap fst mleader /= Just aidNew+  assert (Just (aidNew, mtgtNew) /= mleader           && not (bproj bPre)-          && not (isAllMoveFact cops fact)-         `blame` (aidNew, bPre, fid, fact)) skip+          `blame` (aidNew, mtgtNew, bPre, fid, fact)) skip   assert (bfid bPre == fid           `blame` "client tries to move other faction actors"-          `twith` (aidNew, bPre, fid, fact)) skip+          `twith` (aidNew, mtgtNew, bPre, fid, fact)) skip+  let (autoDun, autoLvl) = autoDungeonLevel fact+  arena <- case mleader of+    Nothing -> return $! blid bPre+    Just (leader, _) -> do+      b <- getsState $ getActorBody leader+      return $! blid b+  if actorChanged && blid bPre /= arena && autoDun+  then execFailure aidNew ReqWait{-hack-} NoChangeDunLeader+  else if actorChanged && autoLvl+  then execFailure aidNew ReqWait{-hack-} NoChangeLvlLeader+  else execUpdAtomic $ UpdLeadFaction fid mleader (Just (aidNew, mtgtNew))  -- * ReqMove @@ -117,7 +127,11 @@   b <- getsState $ getActorBody aid   fact <- getsState $ (EM.! bfid b) . sfactionD   smellRadius <- sumOrganEqpServer Effect.EqpSlotAddSmell aid-  unless (bproj b || not (isHeroFact fact) || smellRadius > 0) $ do+  -- TODO: right now only humans leave smell and content should not+  -- give humans the ability to smell (dominated monsters are rare enough).+  -- In the future smells should be marked by the faction that left them+  -- and actors shold only follow enemy smells.+  unless (bproj b || not (fhasGender $ gplayer fact) || smellRadius > 0) $ do     time <- getsState $ getLocalTime $ blid b     lvl <- getLevel $ blid b     let oldS = EM.lookup (bpos b) . lsmell $ lvl@@ -220,6 +234,7 @@   cops <- getsState scops   sb <- getsState $ getActorBody source   tb <- getsState $ getActorBody target+  sfact <- getsState $ (EM.! bfid sb) . sfactionD   tfact <- getsState $ (EM.! bfid tb) . sfactionD   let spos = bpos sb       tpos = bpos tb@@ -227,7 +242,8 @@       atWar = isAtWar tfact (bfid sb)       req = ReqDisplace target   activeItems <- activeItemsServer target-  dEnemy <- getsState $ dispEnemy source target activeItems+  dEnemy <-+    getsState $ dispEnemy source (fst <$> gleader sfact) target activeItems   if not adj then execFailure source req DisplaceDistant   else if atWar && not dEnemy   then do@@ -262,7 +278,7 @@ reqAlter :: (MonadAtomic m, MonadServer m)          => ActorId -> Point -> Maybe F.Feature -> m () reqAlter source tpos mfeat = do-  Kind.COps{cotile=cotile@Kind.Ops{okind, opick}} <- getsState scops+  cops@Kind.COps{cotile=cotile@Kind.Ops{okind, opick}} <- getsState scops   sb <- getsState $ getActorBody source   let lid = blid sb       spos = bpos sb@@ -271,7 +287,7 @@   else do     lvl <- getLevel lid     let serverTile = lvl `at` tpos-        freshClientTile = hideTile cotile lvl tpos+        freshClientTile = hideTile cops lvl tpos         changeTo tgroup = do           -- No @SfxAlter@, because the effect is obvious (e.g., opened door).           toTile <- rndToAction $ fmap (fromMaybe $ assert `failure` tgroup)@@ -420,8 +436,8 @@ -- so that they are available in the first game too, -- not only in subsequent, restarted, games. reqGameRestart :: (MonadAtomic m, MonadServer m)-               => ActorId -> Text -> Int -> [(Int, (Text, Text))] -> m ()-reqGameRestart aid stInfo d configHeroNames = do+               => ActorId -> GroupName -> Int -> [(Int, (Text, Text))] -> m ()+reqGameRestart aid groupName d configHeroNames = do   modifyServer $ \ser ->     ser {sdebugNxt = (sdebugNxt ser) { sdifficultySer = d                                      , sdebugCli = (sdebugCli (sdebugNxt ser))@@ -435,7 +451,7 @@         , sheroNames = EM.insert fid configHeroNames $ sheroNames ser }   revealItems Nothing Nothing   execUpdAtomic $ UpdQuitFaction fid (Just b) oldSt-                $ Just $ Status Restart (fromEnum $ blid b) stInfo+                $ Just $ Status Restart (fromEnum $ blid b) (Just groupName)  -- * ReqGameExit @@ -449,17 +465,24 @@   b <- getsState $ getActorBody aid   let fid = bfid b   oldSt <- getsState $ gquit . (EM.! fid) . sfactionD-  modifyServer $ \ser -> ser {sbkpSave = True}+  modifyServer $ \ser -> ser {swriteSave = True}   modifyServer $ \ser -> ser {squit = True}  -- do this at once   execUpdAtomic $ UpdQuitFaction fid (Just b) oldSt-                $ Just $ Status Camping (fromEnum $ blid b) ""+                $ Just $ Status Camping (fromEnum $ blid b) Nothing  -- * ReqGameSave  reqGameSave :: MonadServer m => m () reqGameSave = do-  modifyServer $ \ser -> ser {sbkpSave = True}+  modifyServer $ \ser -> ser {swriteSave = True}   modifyServer $ \ser -> ser {squit = True}  -- do this at once++-- * ReqTactic++reqTactic :: (MonadAtomic m, MonadServer m) => FactionId -> Tactic -> m ()+reqTactic fid toT = do+  fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD+  execUpdAtomic $ UpdTacticFaction fid toT fromT  -- * ReqAutomate 

@@ -4,7 +4,7 @@ module Game.LambdaHack.Server.ItemRev   ( ItemRev, buildItem, newItem     -- * Item discovery types-  , DiscoRev, serverDiscos, ItemSeedDict+  , DiscoveryKindRev, serverDiscos, ItemSeedDict     -- * The @FlavourMap@ type   , FlavourMap, emptyFlavourMap, dungeonFlavourMap   ) where@@ -17,7 +17,6 @@ import qualified Data.Ix as Ix import Data.List import qualified Data.Set as S-import Data.Text (Text)  import Game.LambdaHack.Common.Flavour import Game.LambdaHack.Common.Frequency@@ -28,15 +27,14 @@ import Game.LambdaHack.Common.Random import Game.LambdaHack.Content.ItemKind --- | The reverse map to @Discovery@, needed for item creation.-type DiscoRev = EM.EnumMap (Kind.Id ItemKind) ItemKindIx+-- | The reverse map to @DiscoveryKind@, needed for item creation.+type DiscoveryKindRev = EM.EnumMap (Kind.Id ItemKind) ItemKindIx --- | The map of item ids to item seeds.--- The full map is known by the server.+-- | The map of item ids to item seeds, needed for item creation. type ItemSeedDict = EM.EnumMap ItemId ItemSeed -serverDiscos :: Kind.Ops ItemKind -> Rnd (Discovery, DiscoRev)-serverDiscos Kind.Ops{obounds, ofoldrWithKey} = do+serverDiscos :: Kind.COps -> Rnd (DiscoveryKind, DiscoveryKindRev)+serverDiscos Kind.COps{coitem=Kind.Ops{obounds, ofoldrWithKey}} = do   let ixs = map toEnum $ take (Ix.rangeSize obounds) [0..]       shuffle :: Eq a => [a] -> Rnd [a]       shuffle [] = return []@@ -53,7 +51,7 @@   return (discoS, discoRev)  -- | Build an item with the given stats.-buildItem :: FlavourMap -> DiscoRev -> Kind.Id ItemKind -> ItemKind -> LevelId+buildItem :: FlavourMap -> DiscoveryKindRev -> Kind.Id ItemKind -> ItemKind -> LevelId           -> Item buildItem (FlavourMap flavour) discoRev ikChosen kind jlid =   let jkindIx  = discoRev EM.! ikChosen@@ -68,9 +66,9 @@   in Item{..}  -- | Generate an item based on level.-newItem :: Kind.COps -> FlavourMap -> DiscoRev+newItem :: Kind.COps -> FlavourMap -> DiscoveryKindRev         -> Freqs -> LevelId -> AbsDepth -> AbsDepth-        -> Rnd (Maybe (ItemKnown, ItemFull, ItemSeed, Int, Text))+        -> Rnd (Maybe (ItemKnown, ItemFull, ItemSeed, Int, GroupName)) newItem Kind.COps{coitem=Kind.Ops{ofoldrGroup}}         flavour discoRev itemFreq jlid         ldepth@(AbsDepth ld) totalDepth@(AbsDepth depth) = do@@ -100,7 +98,7 @@         iae = seedToAspectsEffects seed itemKind ldepth totalDepth         itemFull = ItemFull {itemBase, itemK, itemDisco = Just itemDisco}         itemDisco = ItemDisco {itemKindId, itemKind, itemAE = Just iae}-    return $ Just ( (itemBase, iae)+    return $ Just ( (jkindIx itemBase, iae)                   , itemFull                   , seed                   , itemK@@ -137,8 +135,8 @@                 , EM.insert (isymbol ik) availableReduced availableMap)  -- | Randomly chooses flavour for all item kinds for this game.-dungeonFlavourMap :: Kind.Ops ItemKind -> Rnd FlavourMap-dungeonFlavourMap Kind.Ops{ofoldrWithKey} =+dungeonFlavourMap :: Kind.COps -> Rnd FlavourMap+dungeonFlavourMap Kind.COps{coitem=Kind.Ops{ofoldrWithKey}} =   liftM (FlavourMap . fst) $     ofoldrWithKey (rollFlavourMap (S.fromList stdFlav))                   (return (EM.empty, EM.empty))

@@ -8,7 +8,6 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.HashMap.Strict as HM import Data.Key (mapWithKeyM_)-import Data.Text (Text)  import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor@@ -27,8 +26,9 @@ import Game.LambdaHack.Server.State  registerItem :: (MonadAtomic m, MonadServer m)-             => ItemKnown -> ItemSeed -> Int -> Container -> Bool -> m ItemId-registerItem itemKnown@(item, iae) seed k container verbose = do+             => Item -> ItemKnown -> ItemSeed -> Int -> Container -> Bool+             -> m ItemId+registerItem item itemKnown@(_, iae) seed k container verbose = do   itemRev <- getsServer sitemRev   let cmd = if verbose then UpdCreateItem else UpdSpotItem   case HM.lookup itemKnown itemRev of@@ -43,7 +43,7 @@         ser { sicounter = succ icounter             , sitemRev = HM.insert itemKnown icounter (sitemRev ser)             , sitemSeedD = EM.insert icounter seed (sitemSeedD ser)-            , sdiscoAE = EM.insert icounter iae (sdiscoAE ser)}+            , sdiscoEffect = EM.insert icounter iae (sdiscoEffect ser)}       execUpdAtomic $ cmd icounter item k container       return $! icounter @@ -56,11 +56,11 @@  rollAndRegisterItem :: (MonadAtomic m, MonadServer m)                     => LevelId -> Freqs -> Container -> Bool-                    -> m (Maybe (ItemId, (ItemFull, Text)))+                    -> m (Maybe (ItemId, (ItemFull, GroupName))) rollAndRegisterItem lid itemFreq container verbose = do   cops <- getsState scops   flavour <- getsServer sflavour-  discoRev <- getsServer sdiscoRev+  discoRev <- getsServer sdiscoKindRev   totalDepth <- getsState stotalDepth   Level{ldepth} <- getLevel lid   m4 <- rndToAction@@ -68,7 +68,7 @@   case m4 of     Nothing -> return Nothing     Just (itemKnown, itemFull, seed, k, itemGroup) -> do-      iid <- registerItem itemKnown seed k container verbose+      iid <- registerItem (itemBase itemFull) itemKnown seed k container verbose       return $ Just (iid, (itemFull, itemGroup))  placeItemsInDungeon :: (MonadAtomic m, MonadServer m) => m ()@@ -76,7 +76,7 @@   Kind.COps{cotile} <- getsState scops   let initialItems lid (Level{ltile, litemNum, lxsize, lysize}) = do         let factionDist = max lxsize lysize - 5-        replicateM (3 * litemNum `div` 2) $ do+        replicateM litemNum $ do           Level{lfloor} <- getLevel lid           let dist p = minimum $ maxBound : map (chessDist p) (EM.keys lfloor)           pos <- rndToAction $ findPosTry 100 ltile@@ -108,9 +108,9 @@                  => ActorId -> [CStore] -> m [(ItemId, ItemFull)] fullAssocsServer aid cstores = do   cops <- getsState scops-  disco <- getsServer sdisco-  discoAE <- getsServer sdiscoAE-  getsState $ fullAssocs cops disco discoAE aid cstores+  discoKind <- getsServer sdiscoKind+  discoEffect <- getsServer sdiscoEffect+  getsState $ fullAssocs cops discoKind discoEffect aid cstores  activeItemsServer :: MonadServer m => ActorId -> m [ItemFull] activeItemsServer aid = do@@ -120,10 +120,10 @@ itemToFullServer :: MonadServer m => m (ItemId -> Int -> ItemFull) itemToFullServer = do   cops <- getsState scops-  disco <- getsServer sdisco-  discoAE <- getsServer sdiscoAE+  discoKind <- getsServer sdiscoKind+  discoEffect <- getsServer sdiscoEffect   s <- getState-  let itemToF iid = itemToFull cops disco discoAE iid (getItemBody iid s)+  let itemToF iid = itemToFull cops discoKind discoEffect iid (getItemBody iid s)   return itemToF  -- | Mapping over actor's items from a give store.

@@ -16,6 +16,7 @@ import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState+import Game.LambdaHack.Common.ClientOptions import qualified Game.LambdaHack.Common.Color as Color import qualified Game.LambdaHack.Common.Effect as Effect import Game.LambdaHack.Common.Faction@@ -88,7 +89,7 @@       updConn       initPer       reinitGame-      saveBkpAll False+      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@@ -100,7 +101,7 @@               case gleader fact of                -- Even spawners and horrors need an active arena                -- for their leader, or they start clogging stairs.-               Just leader -> do+               Just (leader, _) -> do                   b <- getsState $ getActorBody leader                   return $ Just $ blid b                Nothing -> return Nothing@@ -114,7 +115,7 @@           -- 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 (saveBkpAll True)+          endOrLoop loop (restartGame updConn loop) gameExit (writeSaveAll True)         else do           continue <- endClip arenas           when continue loop@@ -125,7 +126,7 @@ endClip arenas = do   Kind.COps{corule} <- getsState scops   let stdRuleset = Kind.stdRuleset corule-      saveBkpClips = rsaveBkpClips stdRuleset+      writeSaveClips = rwriteSaveClips stdRuleset       leadLevelClips = rleadLevelClips stdRuleset       ageProcessed lid processed =         EM.insertWith absoluteTimeAdd lid timeClip processed@@ -138,9 +139,9 @@       clipInTurn = let r = timeTurn `timeFit` timeClip                    in assert (r > 2) r       clipMod = clipN `mod` clipInTurn-  when (clipN `mod` saveBkpClips == 0) $ do-    modifyServer $ \ser -> ser {sbkpSave = False}-    saveBkpAll False+  when (clipN `mod` writeSaveClips == 0) $ do+    modifyServer $ \ser -> ser {swriteSave = False}+    writeSaveAll False   when (clipN `mod` leadLevelClips == 0) leadLevelFlip   -- Add monsters each turn, not each clip.   -- Do this on only one of the arenas to prevent micromanagement,@@ -194,7 +195,7 @@   s <- getState   let -- Actors of the same faction move together.       -- TODO: insert wrt the order, instead of sorting-      isLeader (aid, b) = Just aid /= gleader (factionD EM.! bfid b)+      isLeader (aid, b) = Just aid /= fmap fst (gleader (factionD EM.! bfid b))       order = Ord.comparing $         ((>= 0) . bhp . snd) &&& bfid . snd &&& isLeader &&& bsymbol . snd       (atime, as) = EM.findMin lprio@@ -233,18 +234,20 @@       let side = bfid body           fact = factionD EM.! side           mleader = gleader fact-          aidIsLeader = mleader == Just aid+          aidIsLeader = fmap fst mleader == Just aid+          mainUIactor = fhasUI (gplayer fact)+                        && (aidIsLeader+                            || fleaderMode (gplayer fact) == LeaderNull)       queryUI <--        if playerUI (gplayer fact)-           && (aidIsLeader || not (playerLeader (gplayer fact))) then do-          let underAI = playerAI $ gplayer fact+        if mainUIactor then do+          let underAI = isAIFact fact           if underAI then do             -- If UI client for the faction completely under AI control,             -- ping often to sync frames and to catch ESC,             -- which switches off Ai control.             sendPingUI side             fact2 <- getsState $ (EM.! side) . sfactionD-            let underAI2 = playerAI $ gplayer fact2+            let underAI2 = isAIFact fact2             return $! not underAI2           else return True         else return False@@ -261,7 +264,7 @@         -- but do not crash (currently server asserts things and crashes)         aidNew <- handleRequestUI side cmdS         let hasWait (ReqUITimed ReqWait{}) = True-            hasWait (ReqUILeader _ cmd) = hasWait cmd+            hasWait (ReqUILeader _ _ cmd) = hasWait cmd             hasWait _ = False         maybe skip (setBWait (hasWait cmdS)) aidNew         -- Advance time once, after the leader switched perhaps many times.@@ -279,13 +282,11 @@         -- computer-controlled) or if faction is leaderless.         -- We could record history more often, to avoid long reports,         -- but we'd have to add -more- prompts.-        let mainUIactor = playerUI (gplayer fact)-                          && (aidIsLeader || not (playerLeader (gplayer fact)))         when mainUIactor $ execUpdAtomic $ UpdRecordHistory side         cmdS <- sendQueryAI side aid         aidNew <- handleRequestAI side aid cmdS         let hasWait (ReqAITimed ReqWait{}) = True-            hasWait (ReqAILeader _ cmd) = hasWait cmd+            hasWait (ReqAILeader _ _ cmd) = hasWait cmd             hasWait _ = False         setBWait (hasWait cmdS) aidNew         -- AI always takes time and so doesn't loop.@@ -322,7 +323,7 @@   updConn   initPer   reinitGame-  saveBkpAll False+  writeSaveAll False   loop  -- TODO: This can be improved by adding a timeout@@ -331,16 +332,16 @@ -- and when all report back, asking them to commit the save. -- | Save game on server and all clients. Clients are pinged first, -- which greatly reduced the chance of saves being out of sync.-saveBkpAll :: (MonadAtomic m, MonadServerReadRequest m) => Bool -> m ()-saveBkpAll unconditional = do-  bench <- getsServer $ sbenchmark . sdebugSer-  when (unconditional || not bench) $ do+writeSaveAll :: (MonadAtomic m, MonadServerReadRequest m) => Bool -> m ()+writeSaveAll uiRequested = do+  bench <- getsServer $ sbenchmark . sdebugCli . sdebugSer+  when (uiRequested || not bench) $ do     factionD <- getsState sfactionD     let ping fid _ = do           sendPingAI fid-          when (playerUI $ gplayer $ factionD EM.! fid) $ sendPingUI fid+          when (fhasUI $ gplayer $ factionD EM.! fid) $ sendPingUI fid     mapWithKeyM_ ping factionD-    execUpdAtomic UpdSaveBkp+    execUpdAtomic UpdWriteSave     saveServer  -- TODO: move somewhere?

@@ -33,6 +33,7 @@  import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState+import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.File import qualified Game.LambdaHack.Common.HighScore as HighScore@@ -119,7 +120,7 @@     Just body -> getsState $ snd . calculateTotal body     Nothing -> case gleader fact of       Nothing -> return 0-      Just aid -> do+      Just (aid, _) -> do         b <- getsState $ getActorBody aid         getsState $ snd . calculateTotal b   let stdRuleset = Kind.stdRuleset corule@@ -131,21 +132,22 @@   date <- liftIO getClockTime   DebugModeSer{sdifficultySer} <- getsServer sdebugSer   factionD <- getsState sfactionD-  fightsSpawners <- fightsAgainstSpawners fid+  loots <- factionLoots fid+  bench <- getsServer $ sbenchmark . sdebugCli . sdebugSer   let path = dataDir </> scoresFile       outputScore (worthMentioning, (ntable, pos)) =         -- If not human, probably debugging, so dump instead of registering.-        if not $ playerAI $ gplayer fact then+        if bench || isAIFact fact then+          debugPrint $ T.intercalate "\n"+          $ HighScore.showScore (pos, HighScore.getRecord pos ntable)+        else           if worthMentioning then             liftIO $ encodeEOF path (ntable :: HighScore.ScoreTable)           else return ()-        else-          debugPrint $ T.intercalate "\n"-          $ HighScore.showScore (pos, HighScore.getRecord pos ntable)-      diff | not $ playerUI $ gplayer fact = difficultyDefault+      diff | not $ fhasUI $ gplayer fact = difficultyDefault            | otherwise = sdifficultySer       theirVic (fi, fa) | isAtWar fact fi-                          && not (isHorrorFact cops fa) = Just $ gvictims fa+                          && not (isHorrorFact fa) = Just $ gvictims fa                         | otherwise = Nothing       theirVictims = EM.unionsWith (+) $ mapMaybe theirVic $ EM.assocs factionD       ourVic (fi, fa) | isAllied fact fi || fi == fid = Just $ gvictims fa@@ -153,8 +155,8 @@       ourVictims = EM.unionsWith (+) $ mapMaybe ourVic $ EM.assocs factionD       registeredScore =         HighScore.register table total time status date diff-                           (playerName $ gplayer fact)-                           ourVictims theirVictims fightsSpawners+                           (fname $ gplayer fact)+                           ourVictims theirVictims loots   outputScore registeredScore  resetSessionStart :: MonadServer m => m ()@@ -179,7 +181,7 @@  tellAllClipPS :: MonadServer m => m () tellAllClipPS = do-  bench <- getsServer $ sbenchmark . sdebugSer+  bench <- getsServer $ sbenchmark . sdebugCli . sdebugSer   when bench $ do     TOD s p <- getsServer sstart     TOD sCur pCur <- liftIO getClockTime@@ -194,7 +196,7 @@  tellGameClipPS :: MonadServer m => m () tellGameClipPS = do-  bench <- getsServer $ sbenchmark . sdebugSer+  bench <- getsServer $ sbenchmark . sdebugCli . sdebugSer   when bench $ do     TOD s p <- getsServer sgstart     unless (s == 0) $ do  -- loaded game, don't report anything@@ -209,14 +211,17 @@ tryRestore :: MonadServer m            => Kind.COps -> DebugModeSer -> m (Maybe (State, StateServer)) tryRestore Kind.COps{corule} sdebugSer = do-  let stdRuleset = Kind.stdRuleset corule-      scoresFile = rscoresFile stdRuleset-      pathsDataFile = rpathsDataFile stdRuleset-      prefix = ssavePrefixSer sdebugSer-  let copies = [( "GameDefinition" </> scoresFile-                , scoresFile )]-      name = fromMaybe "save" prefix <.> saveName-  liftIO $ Save.restoreGame name copies pathsDataFile+  let bench = sbenchmark $ sdebugCli sdebugSer+  if bench then return Nothing+  else do+    let stdRuleset = Kind.stdRuleset corule+        scoresFile = rscoresFile stdRuleset+        pathsDataFile = rpathsDataFile stdRuleset+        prefix = ssavePrefixSer sdebugSer+    let copies = [( "GameDefinition" </> scoresFile+                  , scoresFile )]+        name = fromMaybe "save" prefix <.> saveName+    liftIO $ Save.restoreGame name copies pathsDataFile  -- | Compute and insert auxiliary optimized components into game content, -- to be used in time-critical sections of the code.

@@ -45,12 +45,13 @@ spawnMonster lid = do   -- We check the number of current dungeon dwellers (whether spawned or not)   -- to decide if more should be spawned.-  f <- getsState $ \s fid -> isSpawnFact $ sfactionD s EM.! fid+  f <- getsState $ \s fid -> not $ fcanEscape $ gplayer $ sfactionD s EM.! fid   spawns <- getsState $ actorRegularList f lid   totalDepth <- getsState stotalDepth   -- We do not check @playerSpawn@ of any faction, but just take @lactorFreq@.-  Level{ldepth, lactorFreq} <- getLevel lid-  rc <- rndToAction $ monsterGenChance ldepth totalDepth (length spawns)+  Level{ldepth, lactorCoeff, lactorFreq} <- getLevel lid+  rc <- rndToAction+        $ monsterGenChance ldepth totalDepth (length spawns) lactorCoeff   when rc $ do     time <- getsState $ getLocalTime lid     maid <- addAnyActor lactorFreq lid time Nothing@@ -60,7 +61,7 @@         b <- getsState $ getActorBody aid         mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD         when (isNothing mleader) $-          execUpdAtomic $ UpdLeadFaction (bfid b) Nothing (Just aid)+          execUpdAtomic $ UpdLeadFaction (bfid b) Nothing (Just (aid, Nothing))  addAnyActor :: (MonadAtomic m, MonadServer m)             => Freqs -> LevelId -> Time -> Maybe Point@@ -70,7 +71,7 @@   -- contains the constant properties.   cops <- getsState scops   flavour <- getsServer sflavour-  discoRev <- getsServer sdiscoRev+  discoRev <- getsServer sdiscoKindRev   totalDepth <- getsState stotalDepth   lvl@Level{ldepth} <- getLevel lid   factionD <- getsState sfactionD@@ -81,12 +82,12 @@     Just (itemKnown, trunkFull, seed, k, _) -> do       let ik = maybe (assert `failure` trunkFull) itemKind $ itemDisco trunkFull           freqNames = map fst $ ifreq ik-          f fact = playerFaction (gplayer fact)+          f fact = fgroup (gplayer fact)           factNames = map f $ EM.elems factionD           fidName = case freqNames `intersect` factNames of             [] -> head factNames  -- fall back to an arbitrary faction             fName : _ -> fName-          g (_, fact) = playerFaction (gplayer fact) == fidName+          g (_, fact) = fgroup (gplayer fact) == fidName           mfid = find g $ EM.assocs factionD           fid = fst $ fromMaybe (assert `failure` (factionD, fidName)) mfid       pers <- getsServer sper@@ -98,7 +99,8 @@           rollPos <- getsState $ rollSpawnPos cops allPers lid lvl fid           rndToAction rollPos       let container = (CTrunk fid lid pos)-      trunkId <- registerItem itemKnown seed k container False+      trunkId <-+        registerItem (itemBase trunkFull) itemKnown seed k container False       addActorIid trunkId trunkFull fid pos lid id "it" time  rollSpawnPos :: Kind.COps -> ES.EnumSet Point@@ -129,7 +131,8 @@ dominateFidSfx :: (MonadAtomic m, MonadServer m)                => FactionId -> ActorId -> m Bool dominateFidSfx fid target = do-  actorSk <- actorSkillsServer target (Just target)+  -- Actors that never ever move can't be dominated+  actorSk <- maxActorSkillsServer target   let canMove = EM.findWithDefault 0 Ability.AbMove actorSk > 0   if canMove     then do@@ -149,9 +152,9 @@   Kind.COps{cotile} <- getsState scops   tb0 <- getsState $ getActorBody target   -- Only record the initial domination as a kill.-  disco <- getsServer sdisco+  discoKind <- getsServer sdiscoKind   trunk <- getsState $ getItemBody $ btrunk tb0-  let ikind = disco EM.! jkindIx trunk+  let ikind = discoKind EM.! jkindIx trunk   when (boldfid tb0 == bfid tb0) $ execUpdAtomic $ UpdRecordKill target ikind 1   electLeader (bfid tb0) (blid tb0) target   fact <- getsState $ (EM.! bfid tb0) . sfactionD@@ -170,13 +173,13 @@   -- Keep the leader if he is on stairs. We don't want to clog stairs.   keepLeader <- case mleaderOld of     Nothing -> return False-    Just leaderOld -> do+    Just (leaderOld, _) -> do       body <- getsState $ getActorBody leaderOld       lvl <- getLevel $ blid body       return $! Tile.isStair cotile $ lvl `at` bpos body   unless keepLeader $     -- Focus on the dominated actor, by making him a leader.-    execUpdAtomic $ UpdLeadFaction fid mleaderOld (Just target)+    execUpdAtomic $ UpdLeadFaction fid mleaderOld (Just (target, Nothing))  -- | Advance the move time for the given actor, check if he's dominated -- and update his calm. We don't update calm once per game turn@@ -197,7 +200,8 @@     dominated <-       if bcalm b == 0          && boldfid b /= bfid b-         && playerLeader (gplayer fact)  -- animals never Calm-dominated+         && fleaderMode (gplayer fact) /= LeaderNull+              -- animals never Calm-dominated       then dominateFidSfx (boldfid b) aid       else return False     unless dominated $ do@@ -215,15 +219,16 @@  leadLevelFlip :: (MonadAtomic m, MonadServer m) => m () leadLevelFlip = do-  cops@Kind.COps{cotile} <- getsState scops-  let canFlip fact =-        -- We don't have to check @playerLeader@: @gleader@ would be @Nothing@.-        playerAI (gplayer fact) || isAllMoveFact cops fact+  Kind.COps{cotile} <- getsState scops+  let canFlip fact = case fleaderMode (gplayer fact) of+                       LeaderNull -> True+                       LeaderAI _ -> True+                       LeaderUI AutoLeader{autoDungeon} -> autoDungeon       flipFaction fact | not $ canFlip fact = return ()       flipFaction fact = do         case gleader fact of           Nothing -> return ()-          Just leader -> do+          Just (leader, _) -> do             body <- getsState $ getActorBody leader             lvl2 <- getLevel $ blid body             let leaderStuck = waitedLastTurn body@@ -255,6 +260,7 @@                                         $ toFreq "leadLevel" freqList                 unless (lid == blid body) $  -- flip levels rather than actors                   execUpdAtomic-                  $ UpdLeadFaction (bfid body) (Just leader) (Just a)+                  $ UpdLeadFaction (bfid body) (gleader fact)+                                               (Just (a, Nothing))   factionD <- getsState sfactionD   mapM_ flipFaction $ EM.elems factionD

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | The server definitions for the server-client communication protocol. module Game.LambdaHack.Server.ProtocolServer   ( -- * The communication channels@@ -16,6 +17,9 @@   , sendUpdateUI, sendQueryUI, sendPingUI     -- * Assorted   , killAllClients, childrenServer, updateConn+#ifdef EXPOSE_INTERNAL+  , ConnServerFaction+#endif   ) where  import Control.Concurrent@@ -193,7 +197,7 @@       addConn :: FactionId -> Faction -> IO ConnServerFaction       addConn fid fact = case EM.lookup fid oldD of         Just conns -> return conns  -- share old conns and threads-        Nothing | playerUI $ gplayer fact -> do+        Nothing | fhasUI $ gplayer fact -> do           connS <- mkChanServer           connAI <- mkChanServer           return (Just connS, connAI)

@@ -30,6 +30,7 @@ import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.Level+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Msg import Game.LambdaHack.Common.Point@@ -37,7 +38,6 @@ import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time-import Game.LambdaHack.Content.FactionKind import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind@@ -67,13 +67,13 @@   s <- getState   let defLocal | knowMap = s                | otherwise = localFromGlobal s-  discoS <- getsServer sdisco-  let sdisco = let f ik = Effect.Identified `elem` ifeature (okind ik)+  discoS <- getsServer sdiscoKind+  let sdiscoKind = let f ik = Effect.Identified `elem` ifeature (okind ik)                in EM.filter f discoS   sdebugCli <- getsServer $ sdebugCli . sdebugSer   modeName <- getsServer $ sgameMode . sdebugSer   broadcastUpdAtomic-    $ \fid -> UpdRestart fid sdisco (pers EM.! fid) defLocal sdebugCli modeName+    $ \fid -> UpdRestart fid sdiscoKind (pers EM.! fid) defLocal sdebugCli modeName   populateDungeon  mapFromFuns :: (Bounded a, Enum a, Ord b) => [a -> b] -> M.Map b a@@ -87,31 +87,33 @@ lowercase :: Text -> Text lowercase = T.pack . map Char.toLower . T.unpack -createFactions :: Kind.COps -> Players -> Rnd FactionDict-createFactions Kind.COps{cofaction=Kind.Ops{opick}} players = do+createFactions :: Roster -> Rnd FactionDict+createFactions players = do   let rawCreate gplayer@Player{..} = do         let cmap = mapFromFuns                      [colorToTeamName, colorToPlainName, colorToFancyName]-            nameoc = lowercase $ head $ T.words playerName-            prefix | playerAI = "Autonomous"+            nameoc = lowercase $ head $ T.words fname+            fisAI = case fleaderMode of+              LeaderNull -> True+              LeaderAI _ -> True+              LeaderUI _ -> False+            prefix | fisAI = "Autonomous"                    | otherwise = "Controlled"             (gcolor, gname) = case M.lookup nameoc cmap of-              Nothing -> (Color.BrWhite, prefix <+> playerName)-              Just c -> (c, prefix <+> playerName <+> "Team")-        gkind <- fmap (fromMaybe $ assert `failure` playerFaction)-                 $ opick playerFaction (const True)+              Nothing -> (Color.BrWhite, prefix <+> fname)+              Just c -> (c, prefix <+> fname <+> "Team")         let gdipl = EM.empty  -- fixed below             gquit = Nothing             gleader = Nothing             gvictims = EM.empty             gsha = EM.empty         return $! Faction{..}-  lUI <- mapM rawCreate $ filter playerUI $ playersList players-  lnoUI <- mapM rawCreate $ filter (not . playerUI) $ playersList players+  lUI <- mapM rawCreate $ filter fhasUI $ rosterList players+  lnoUI <- mapM rawCreate $ filter (not . fhasUI) $ rosterList players   let lFs = reverse (zip [toEnum (-1), toEnum (-2)..] lnoUI)  -- sorted             ++ zip [toEnum 1..] lUI       swapIx l =-        let findPlayerName name = find ((name ==) . playerName . gplayer . snd)+        let findPlayerName name = find ((name ==) . fname . gplayer . snd)             f (name1, name2) =               case (findPlayerName name1 lFs, findPlayerName name2 lFs) of                 (Just (ix1, _), Just (ix2, _)) -> (ix1, ix2)@@ -128,13 +130,13 @@         in foldr f       rawFs = EM.fromDistinctAscList lFs       -- War overrides alliance, so 'warFs' second.-      allianceFs = mkDipl Alliance rawFs (swapIx (playersAlly players))-      warFs = mkDipl War allianceFs (swapIx (playersEnemy players))+      allianceFs = mkDipl Alliance rawFs (swapIx (rosterAlly players))+      warFs = mkDipl War allianceFs (swapIx (rosterEnemy players))   return $! warFs  gameReset :: MonadServer m           => Kind.COps -> DebugModeSer -> Maybe R.StdGen -> m State-gameReset cops@Kind.COps{coitem, comode=Kind.Ops{opick, okind}}+gameReset cops@Kind.COps{comode=Kind.Ops{opick, okind}}           sdebug mrandom = do   dungeonSeed <- getSetGen $ sdungeonRng sdebug `mplus` mrandom   srandom <- getSetGen $ smainRng sdebug `mplus` mrandom@@ -146,23 +148,23 @@   sallTime <- getsServer sallTime  -- copy over from previous game   sheroNames <- getsServer sheroNames  -- copy over from previous game   let smode = sgameMode sdebug-      rnd :: Rnd (FactionDict, FlavourMap, Discovery, DiscoRev,+      rnd :: Rnd (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,                   DungeonGen.FreshDungeon)       rnd = do         modeKind <- fmap (fromMaybe $ assert `failure` smode)                     $ opick smode (const True)         let mode = okind modeKind-            automate p = p {playerAI = True}-            automatePS ps = ps {playersList = map automate $ playersList ps}+            automatePS ps = ps {rosterList =+                                  map (automatePlayer True) $ rosterList ps}             players = if sautomateAll sdebug-                      then automatePS $ mplayers mode-                      else mplayers mode-        faction <- createFactions cops players-        sflavour <- dungeonFlavourMap coitem-        (sdisco, sdiscoRev) <- serverDiscos coitem+                      then automatePS $ mroster mode+                      else mroster mode+        faction <- createFactions players+        sflavour <- dungeonFlavourMap cops+        (sdiscoKind, sdiscoKindRev) <- serverDiscos cops         freshDng <- DungeonGen.dungeonGen cops $ mcaves mode-        return (faction, sflavour, sdisco, sdiscoRev, freshDng)-  let (faction, sflavour, sdisco, sdiscoRev, DungeonGen.FreshDungeon{..}) =+        return (faction, sflavour, sdiscoKind, sdiscoKindRev, freshDng)+  let (faction, sflavour, sdiscoKind, sdiscoKindRev, DungeonGen.FreshDungeon{..}) =         St.evalState rnd dungeonSeed       defState = defStateGlobal freshDungeon freshTotalDepth                                 faction cops scoreTable@@ -170,8 +172,8 @@                                 , srngs = RNGs (Just dungeonSeed)                                                (Just srandom) }   putServer defSer-  when (sbenchmark sdebug) resetGameStart-  modifyServer $ \ser -> ser {sdisco, sdiscoRev, sflavour}+  when (sbenchmark $ sdebugCli sdebug) resetGameStart+  modifyServer $ \ser -> ser {sdiscoKind, sdiscoKindRev, sflavour}   when (sdumpInitRngs sdebug) $ dumpRngs   return $! defState @@ -187,10 +189,10 @@         case (EM.minViewWithKey dungeon, EM.maxViewWithKey dungeon) of           (Just ((s, _), _), Just ((e, _), _)) -> (s, e)           _ -> assert `failure` "empty dungeon" `twith` dungeon-      needInitialCrew = filter ((> 0 ) . playerInitial . gplayer . snd)+      needInitialCrew = filter ((> 0 ) . finitialActors . gplayer . snd)                         $ EM.assocs factionD       getEntryLevel (_, fact) =-        max minD $ min maxD $ toEnum $ playerEntry $ gplayer fact+        max minD $ min maxD $ toEnum $ fentryLevel $ gplayer fact       arenas = ES.toList $ ES.fromList $ map getEntryLevel needInitialCrew       initialActors lid = do         lvl <- getLevel lid@@ -213,10 +215,10 @@             ntime = timeShift time (timeDeltaScale (Delta timeClip) nmult)             validTile t = not $ Tile.hasFeature cotile F.NoActor t         psFree <- getsState $ nearbyFreePoints validTile ppos lid-        let ps = take (playerInitial $ gplayer fact3) $ zip [0..] psFree+        let ps = take (finitialActors $ gplayer fact3) $ zip [0..] psFree         forM_ ps $ \ (n, p) -> do           go <--            if not $ isHeroFact fact3+            if not $ fhasNumbers $ gplayer fact3             then recruitActors [p] lid ntime fid3             else do               let hNames = fromMaybe [] $ EM.lookup fid3 sheroNames@@ -226,7 +228,8 @@                 Just aid -> do                   mleader <- getsState $ gleader . (EM.! fid3) . sfactionD                   when (isNothing mleader) $-                    execUpdAtomic $ UpdLeadFaction fid3 Nothing (Just aid)+                    execUpdAtomic+                    $ UpdLeadFaction fid3 Nothing (Just (aid, Nothing))                   return True           unless go $ assert `failure` "can't spawn initial actors"                              `twith` (lid, (fid3, fact3))@@ -238,11 +241,10 @@               => [Point] -> LevelId -> Time -> FactionId               -> m Bool recruitActors ps lid time fid = assert (not $ null ps) $ do-  Kind.COps{cofaction=Kind.Ops{okind}} <- getsState scops   fact <- getsState $ (EM.! fid) . sfactionD-  let spawnName = fname $ okind $ gkind fact+  let spawnName = fgroup $ gplayer fact   laid <- forM ps $ \ p ->-    if isHeroFact fact+    if fhasNumbers $ gplayer fact     then addHero fid p lid [] Nothing time     else addMonster spawnName fid p lid time   case catMaybes laid of@@ -250,18 +252,17 @@     aid : _ -> do       mleader <- getsState $ gleader . (EM.! fid) . sfactionD  -- just changed       when (isNothing mleader) $-        execUpdAtomic $ UpdLeadFaction fid Nothing (Just aid)+        execUpdAtomic $ UpdLeadFaction fid Nothing (Just (aid, Nothing))       return True  -- | Create a new monster on the level, at a given position -- and with a given actor kind and HP. addMonster :: (MonadAtomic m, MonadServer m)-           => Text -> FactionId -> Point -> LevelId -> Time+           => GroupName -> FactionId -> Point -> LevelId -> Time            -> m (Maybe ActorId) addMonster groupName bfid ppos lid time = do-  cops <- getsState scops   fact <- getsState $ (EM.! bfid) . sfactionD-  pronoun <- if isCivilianFact cops fact+  pronoun <- if fhasGender $ gplayer fact              then rndToAction $ oneOf ["he", "she"]              else return "it"   addActor groupName bfid ppos lid id pronoun time@@ -272,9 +273,8 @@         -> Maybe Int -> Time         -> m (Maybe ActorId) addHero bfid ppos lid heroNames mNumber time = do-  Kind.COps{cofaction=Kind.Ops{okind=okind}} <- getsState scops-  Faction{gcolor, gplayer, gkind} <- getsState $ (EM.! bfid) . sfactionD-  let fName = fname $ okind gkind+  Faction{gcolor, gplayer} <- getsState $ (EM.! bfid) . sfactionD+  let groupName = fgroup gplayer   mhs <- mapM (\n -> getsState $ \s -> tryFindHeroK s bfid n) [0..9]   let freeHeroK = elemIndex Nothing mhs       n = fromMaybe (fromMaybe 100 freeHeroK) mNumber@@ -286,9 +286,9 @@         fromMaybe (nameFromNumber n) $ lookup n heroNames                        | otherwise =         let (nameN, pronounN) = nameFromNumber n-        in (playerName gplayer <+> nameN, pronounN)+        in (fname gplayer <+> nameN, pronounN)       tweakBody b = b {bsymbol, bname, bcolor = gcolor}-  addActor fName bfid ppos lid tweakBody pronoun time+  addActor groupName bfid ppos lid tweakBody pronoun time  -- | Find starting postions for all factions. Try to make them distant -- from each other. If only one faction, also move it away from any stairs.

@@ -19,6 +19,7 @@ import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Level+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Time import Game.LambdaHack.Content.RuleKind@@ -26,29 +27,29 @@  -- | Global, server state. data StateServer = StateServer-  { sdisco     :: !Discovery     -- ^ full item discoveries data-  , sdiscoRev  :: !DiscoRev      -- ^ reverse disco map, used for item creation-  , sdiscoAE   :: !DiscoAE       -- ^ full item aspect and effect data-  , sitemSeedD :: !ItemSeedDict  -- ^ map from item ids to item seeds-  , sitemRev   :: !ItemRev       -- ^ reverse id map, used for item creation-  , sflavour   :: !FlavourMap    -- ^ association of flavour to items-  , sacounter  :: !ActorId       -- ^ stores next actor index-  , sicounter  :: !ItemId        -- ^ stores next item index-  , sprocessed :: !(EM.EnumMap LevelId Time)-                                 -- ^ actors are processed up to this time-  , sundo      :: ![CmdAtomic]   -- ^ atomic commands performed to date-  , sper       :: !Pers          -- ^ perception of all factions-  , srandom    :: !R.StdGen      -- ^ current random generator-  , srngs      :: !RNGs          -- ^ initial random generators-  , squit      :: !Bool          -- ^ exit the game loop-  , sbkpSave   :: !Bool          -- ^ make backup savefile now-  , sstart     :: !ClockTime     -- ^ this session start time-  , sgstart    :: !ClockTime     -- ^ this game start time-  , sallTime   :: !Time          -- ^ clips since the start of the session-  , sheroNames :: !(EM.EnumMap FactionId [(Int, (Text, Text))])-                                 -- ^ hero names sent by clients-  , sdebugSer  :: !DebugModeSer  -- ^ current debugging mode-  , sdebugNxt  :: !DebugModeSer  -- ^ debugging mode for the next game+  { sdiscoKind    :: !DiscoveryKind     -- ^ full item kind discoveries data+  , sdiscoKindRev :: !DiscoveryKindRev  -- ^ reverse map, used for item creation+  , sdiscoEffect  :: !DiscoveryEffect   -- ^ full item effect&Co data+  , sitemSeedD    :: !ItemSeedDict  -- ^ map from item ids to item seeds+  , sitemRev      :: !ItemRev       -- ^ reverse id map, used for item creation+  , sflavour      :: !FlavourMap    -- ^ association of flavour to items+  , sacounter     :: !ActorId       -- ^ stores next actor index+  , sicounter     :: !ItemId        -- ^ stores next item index+  , sprocessed    :: !(EM.EnumMap LevelId Time)+                                    -- ^ actors are processed up to this time+  , sundo         :: ![CmdAtomic]   -- ^ atomic commands performed to date+  , sper          :: !Pers          -- ^ perception of all factions+  , srandom       :: !R.StdGen      -- ^ current random generator+  , srngs         :: !RNGs          -- ^ initial random generators+  , squit         :: !Bool          -- ^ exit the game loop+  , swriteSave    :: !Bool          -- ^ write savegame to a file now+  , sstart        :: !ClockTime     -- ^ this session start time+  , sgstart       :: !ClockTime     -- ^ this game start time+  , sallTime      :: !Time          -- ^ clips since the start of the session+  , sheroNames    :: !(EM.EnumMap FactionId [(Int, (Text, Text))])+                                    -- ^ hero names sent by clients+  , sdebugSer     :: !DebugModeSer  -- ^ current debugging mode+  , sdebugNxt     :: !DebugModeSer  -- ^ debugging mode for the next game   }   deriving (Show) @@ -59,10 +60,9 @@   , sniffIn        :: !Bool   , sniffOut       :: !Bool   , sallClear      :: !Bool-  , sgameMode      :: !Text+  , sgameMode      :: !GroupName   , sautomateAll   :: !Bool   , sstopAfter     :: !(Maybe Int)-  , sbenchmark     :: !Bool   , sdungeonRng    :: !(Maybe R.StdGen)   , smainRng       :: !(Maybe R.StdGen)   , sfovMode       :: !(Maybe FovMode)@@ -92,9 +92,9 @@ emptyStateServer :: StateServer emptyStateServer =   StateServer-    { sdisco = EM.empty-    , sdiscoRev = EM.empty-    , sdiscoAE = EM.empty+    { sdiscoKind = EM.empty+    , sdiscoKindRev = EM.empty+    , sdiscoEffect = EM.empty     , sitemSeedD = EM.empty     , sitemRev = HM.empty     , sflavour = emptyFlavourMap@@ -107,7 +107,7 @@     , srngs = RNGs { dungeonRandomGenerator = Nothing                    , startingRandomGenerator = Nothing }     , squit = False-    , sbkpSave = False+    , swriteSave = False     , sstart = TOD 0 0     , sgstart = TOD 0 0     , sallTime = timeZero@@ -125,7 +125,6 @@                                , sgameMode = "campaign"                                , sautomateAll = False                                , sstopAfter = Nothing-                               , sbenchmark = False                                , sdungeonRng = Nothing                                , smainRng = Nothing                                , sfovMode = Nothing@@ -139,9 +138,9 @@  instance Binary StateServer where   put StateServer{..} = do-    put sdisco-    put sdiscoRev-    put sdiscoAE+    put sdiscoKind+    put sdiscoKindRev+    put sdiscoEffect     put sitemSeedD     put sitemRev     put sflavour@@ -154,9 +153,9 @@     put sheroNames     put sdebugSer   get = do-    sdisco <- get-    sdiscoRev <- get-    sdiscoAE <- get+    sdiscoKind <- get+    sdiscoKindRev <- get+    sdiscoEffect <- get     sitemSeedD <- get     sitemRev <- get     sflavour <- get@@ -171,7 +170,7 @@     let srandom = read g         sper = EM.empty         squit = False-        sbkpSave = False+        swriteSave = False         sstart = TOD 0 0         sgstart = TOD 0 0         sallTime = timeZero@@ -206,7 +205,6 @@     sdbgMsgSer <- get     sdebugCli <- get     let sstopAfter = Nothing-        sbenchmark = False         sdungeonRng = Nothing         smainRng = Nothing         snewGameSer = False

@@ -105,7 +105,7 @@       , ("p", ([CmdItem], MoveItem [CEqp, CSha] CInv                                    "pack" "an item into inventory backpack"                                    False))-      , ("s", ([CmdItem], MoveItem [CEqp, CInv] CSha+      , ("s", ([CmdItem], MoveItem [CInv, CEqp] CSha                                    "stash" "and share an item" False))       , ("a", ([CmdItem, CmdMinimal], Apply            [ ApplyItem { verb = "activate"@@ -155,6 +155,7 @@       , ("CTRL-v", ([CmdAuto], Repeat 1000))       , ("CTRL-V", ([CmdAuto], Repeat 10))       , ("apostrophe", ([CmdAuto], Record))+      , ("CTRL-T", ([CmdAuto], Tactic))       , ("CTRL-A", ([CmdAuto], Automate))        -- Assorted

@@ -1,4 +1,4 @@--- | Cave layouts for LambdaHack.+-- | Cave layouts. module Content.CaveKind ( cdefs ) where  import Data.Ratio@@ -13,7 +13,8 @@   { getSymbol = csymbol   , getName = cname   , getFreq = cfreq-  , validate = validateCaveKind+  , validateSingle = validateSingleCaveKind+  , validateAll = validateAllCaveKind   , content =       [rogue, arena, empty, noise, battle, skirmish, ambush, safari1, safari2, safari3]   }@@ -22,7 +23,7 @@ rogue = CaveKind   { csymbol       = 'R'   , cname         = "A maze of twisty passages"-  , cfreq         = [("dng", 100), ("caveRogue", 1)]+  , cfreq         = [("campaign random", 100), ("caveRogue", 1)]   , cxsize        = fst normalLevelBound + 1   , cysize        = snd normalLevelBound + 1   , cgrid         = DiceXY (3 * d 2) (d 2 + 2)@@ -36,9 +37,10 @@   , cdoorChance   = 1%2   , copenChance   = 1%10   , chidden       = 8+  , cactorCoeff   = 20   , cactorFreq    = [("monster", 50), ("animal", 50)]-  , citemNum      = 10 * d 2-  , citemFreq     = [("useful", 70), ("treasure", 30)]+  , citemNum      = 15 * d 2+  , citemFreq     = [("useful", 50), ("treasure", 50)]   , cplaceFreq    = [("rogue", 100)]   , cpassable     = False   , cdefTile        = "fillerWall"@@ -52,15 +54,16 @@ arena = rogue   { csymbol       = 'A'   , cname         = "Underground city"-  , cfreq         = [("dng", 30), ("caveArena", 1)]+  , cfreq         = [("campaign random", 30), ("caveArena", 1)]   , cgrid         = DiceXY (2 * d 2) (2 * d 2)   , cminPlaceSize = DiceXY (2 * d 2 + 3) 4   , cdarkChance   = d 80 + dl 60   , cnightChance  = 0-  , cmaxVoid      = 1%3+  , cmaxVoid      = 1%4   , chidden       = 1000+  , cactorCoeff   = 40   , cactorFreq    = [("monster", 70), ("animal", 30)]-  , citemNum      = 8 * d 2  -- few rooms+  , citemNum      = 11 * d 2  -- few rooms   , cpassable     = True   , cdefTile      = "arenaSet"   , cdarkCorTile  = "trailLit"  -- let trails give off light@@ -69,7 +72,7 @@ empty = rogue   { csymbol       = 'E'   , cname         = "Tall cavern"-  , cfreq         = [("dng", 20), ("caveEmpty", 1)]+  , cfreq         = [("campaign random", 20), ("caveEmpty", 1)]   , cgrid         = DiceXY (d 2 + 1) 1   , cminPlaceSize = DiceXY 10 10   , cmaxPlaceSize = DiceXY 24 12@@ -79,8 +82,9 @@   , cmaxVoid      = 1%2   , cminStairDist = 50   , chidden       = 1000+  , cactorCoeff   = 50   , cactorFreq    = [("monster", 10), ("animal", 90)]-  , citemNum      = 6 * d 2  -- few rooms+  , citemNum      = 9 * d 2  -- few rooms   , cpassable     = True   , cdefTile      = "emptySet"   , cdarkCorTile  = "floorArenaDark"@@ -89,18 +93,19 @@ noise = rogue   { csymbol       = 'N'   , cname         = "Glittering cave"-  , cfreq         = [("dng", 10), ("caveNoise", 1)]-  , cgrid         = DiceXY 3 3-  , cminPlaceSize = DiceXY 8 4+  , cfreq         = [("campaign random", 10), ("caveNoise", 1)]+  , cgrid         = DiceXY (2 + d 2) 3+  , cminPlaceSize = DiceXY 12 5   , cmaxPlaceSize = DiceXY 24 12-  , cnightChance  = d 100+  , cnightChance  = d 80 + dl 80   , cauxConnects  = 0   , cmaxVoid      = 0   , chidden       = 1000+  , cactorCoeff   = 30   , cactorFreq    = [("monster", 80), ("animal", 20)]-  , citemNum      = 12 * d 2  -- an incentive to explore the labyrinth+  , citemNum      = 16 * d 2  -- an incentive to explore the labyrinth   , cpassable     = True-  , cplaceFreq    = [("noise", 50), ("rogue", 50)]+  , cplaceFreq    = [("noise", 100)]   , cdefTile      = "noiseSet"   , cdarkCorTile  = "floorArenaDark"   , clitCorTile   = "floorArenaLit"@@ -110,16 +115,17 @@   , cname         = "Old battle ground"   , cfreq         = [("caveBattle", 1)]   , cgrid         = DiceXY (2 * d 2 + 1) 3-  , cminPlaceSize = DiceXY 3 3+  , cminPlaceSize = DiceXY 4 4   , cmaxPlaceSize = DiceXY 9 7   , cdarkChance   = 0   , cnightChance  = 100+  , cmaxVoid      = 0   , cdoorChance   = 2%10   , copenChance   = 9%10   , chidden       = 1000   , cactorFreq    = []-  , citemNum      = 12 * d 2-  , citemFreq     = [("useful", 100)]+  , citemNum      = 20 * d 2+  , citemFreq     = [("useful", 100), ("light source", 200)]   , cplaceFreq    = [("battle", 50), ("rogue", 50)]   , cpassable     = True   , cdefTile      = "battleSet"@@ -139,7 +145,7 @@   , copenChance   = 0   , chidden       = 1000   , cactorFreq    = []-  , citemNum      = 12 * d 2+  , citemNum      = 20 * d 2   , citemFreq     = [("useful", 100)]   , cplaceFreq    = [("skirmish", 60), ("rogue", 40)]   , cpassable     = True@@ -161,8 +167,8 @@   , copenChance   = 9%10   , chidden       = 1000   , cactorFreq    = []-  , citemNum      = 12 * d 2-  , citemFreq     = [("useful", 100)]+  , citemNum      = 22 * d 2+  , citemFreq     = [("useful", 100), ("light source", 200)]   , cplaceFreq    = [("ambush", 100)]   , cpassable     = True   , cdefTile      = "ambushSet"

@@ -1,73 +0,0 @@--- | The type of kinds of game factions (heroes, enemies, NPCs, etc.)--- for LambdaHack.-module Content.FactionKind ( cdefs ) where--import qualified Data.EnumMap.Strict as EM--import Game.LambdaHack.Common.Ability-import Game.LambdaHack.Common.ContentDef-import Game.LambdaHack.Content.FactionKind--cdefs :: ContentDef FactionKind-cdefs = ContentDef-  { getSymbol = fsymbol-  , getName = fname-  , getFreq = ffreq-  , validate = validateFactionKind-  , content =-      [hero, civilian, monster, animal, horror]-  }-hero,        civilian, monster, animal, horror :: FactionKind--hero = FactionKind-  { fsymbol       = '1'-  , fname         = "hero"-  , ffreq         = [("hero", 1)]-  , fSkillsLeader = allSkills-  , fSkillsOther  = meleeAdjacent-  }--civilian = FactionKind-  { fsymbol       = '@'-  , fname         = "civilian"-  , ffreq         = [("civilian", 1)]-  , fSkillsLeader = allSkills-  , fSkillsOther  = allSkills  -- not coordinated by any leadership-  }--monster = FactionKind-  { fsymbol       = 'm'-  , fname         = "monster"-  , ffreq         = [("monster", 1)]-  , fSkillsLeader = allSkills-  , fSkillsOther  = allSkills-  }--animal = FactionKind-  { fsymbol       = 'd'-  , fname         = "animal"-  , ffreq         = [("animal", 1)]-  , fSkillsLeader = animalSkills-  , fSkillsOther  = animalSkills-  }--horror = FactionKind-  { fsymbol       = 'h'-  , fname         = "horror"-  , ffreq         = [("horror", 1)]-  , fSkillsLeader = allSkills-  , fSkillsOther  = allSkills-  }---meleeAdjacent, _meleeAndRanged, animalSkills, allSkills :: Skills--meleeAdjacent = EM.fromList $ zip [AbWait, AbMelee] [1, 1..]---- Melee and reaction fire.-_meleeAndRanged = EM.fromList $ zip [AbWait, AbMelee, AbProject] [1, 1..]--animalSkills =-  EM.fromList $ zip [AbMove, AbMelee, AbAlter, AbWait, AbTrigger] [1, 1..]--allSkills = unitSkills

@@ -1,4 +1,4 @@--- | Weapon and treasure definitions.+-- | Item and treasure definitions. module Content.ItemKind ( cdefs ) where  import Data.List@@ -19,15 +19,16 @@   { getSymbol = isymbol   , getName = iname   , getFreq = ifreq-  , validate = validateItemKind+  , validateSingle = validateSingleItemKind+  , validateAll = validateAllItemKind   , content = items ++ organs ++ shrapnels ++ actors   }  items :: [ItemKind] items =-  [bolas, brassLantern, buckler, dart, dart200, gem1, gem2, gem3, gloveFencing, gloveGauntlet, gloveJousting, currency, gorget, harpoon, jumpingPole, monocle, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, net, oilLamp, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, ring1, ring2, ring3, ring4, ring5, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, shield, dagger, hammer, sword, halberd, wand1, wand2, woodenTorch, armorLeather, armorMail, whetstone]+  [bolas, brassLantern, buckler, dart, dart200, gem1, gem2, gem3, gloveFencing, gloveGauntlet, gloveJousting, currency, gorget, harpoon, jumpingPole, monocle, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, net, oilLamp, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, ring1, ring2, ring3, ring4, ring5, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, shield, dagger, hammer, sword, halberd, wand1, wand2, woodenTorch, armorLeather, armorMail, whetstone] -bolas,    brassLantern, buckler, dart, dart200, gem1, gem2, gem3, gloveFencing, gloveGauntlet, gloveJousting, currency, gorget, harpoon, jumpingPole, monocle, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, net, oilLamp, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, ring1, ring2, ring3, ring4, ring5, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, shield, dagger, hammer, sword, halberd, wand1, wand2, woodenTorch, armorLeather, armorMail, whetstone :: ItemKind+bolas,    brassLantern, buckler, dart, dart200, gem1, gem2, gem3, gloveFencing, gloveGauntlet, gloveJousting, currency, gorget, harpoon, jumpingPole, monocle, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, net, oilLamp, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, ring1, ring2, ring3, ring4, ring5, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, shield, dagger, hammer, sword, halberd, wand1, wand2, woodenTorch, armorLeather, armorMail, whetstone :: ItemKind  gem, necklace, potion, ring, scroll, wand :: ItemKind  -- generic templates @@ -39,7 +40,7 @@   , ifreq    = [("useful", 100), ("any arrow", 100)]   , iflavour = zipPlain [Cyan]   , icount   = 3 * d 3-  , irarity  = [(1, 20)]+  , irarity  = [(1, 20), (10, 10)]   , iverbHit = "prick"   , iweight  = 50   , iaspects = [AddHurtRanged ((d 6 + dl 6) |*| 10)]@@ -54,7 +55,7 @@   , ifreq    = [("useful", 100), ("any arrow", 50)]  -- TODO: until arrows added   , iflavour = zipPlain [BrRed]   , icount   = 3 * d 3-  , irarity  = [(4, 20)]+  , irarity  = [(4, 20), (10, 10)]   , iverbHit = "prick"   , iweight  = 50   , iaspects = [AddHurtRanged ((d 6 + dl 6) |*| 10)]@@ -87,7 +88,7 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain [Brown]   , icount   = dl 5-  , irarity  = [(5, 5), (10, 20)]+  , irarity  = [(10, 10)]   , iverbHit = "hook"   , iweight  = 4000   , iaspects = [AddHurtRanged ((d 2 + 2 * dl 5) |*| 10)]@@ -118,10 +119,10 @@ woodenTorch = ItemKind   { isymbol  = '('   , iname    = "wooden torch"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("light source", 100)]   , iflavour = zipPlain [Brown]   , icount   = 1-  , irarity  = [(1, 10)]+  , irarity  = [(1, 8), (3, 6)]   , iverbHit = "scorch"   , iweight  = 1200   , iaspects = [ AddLight 3@@ -134,10 +135,10 @@ oilLamp = ItemKind   { isymbol  = '('   , iname    = "oil lamp"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("light source", 100)]   , iflavour = zipPlain [BrYellow]   , icount   = 1-  , irarity  = [(5, 4), (10, 4)]+  , irarity  = [(5, 5), (10, 5)]   , iverbHit = "burn"   , iweight  = 1000   , iaspects = [AddLight 3, AddSight (-1)]@@ -150,10 +151,10 @@ brassLantern = ItemKind   { isymbol  = '('   , iname    = "brass lantern"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("light source", 100)]   , iflavour = zipPlain [BrWhite]   , icount   = 1-  , irarity  = [(10, 3)]+  , irarity  = [(10, 4)]   , iverbHit = "burn"   , iweight  = 2400   , iaspects = [AddLight 4, AddSight (-1)]@@ -197,7 +198,7 @@   , ifreq    = [("treasure", 100), ("currency", 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 10 + d 20 + dl 20-  , irarity  = [(1, 0), (5, 20), (10, 10)]+  , irarity  = [(1, 0), (2, 15), (5, 25), (10, 10)]   , iverbHit = "tap"   , iweight  = 31   , iaspects = []@@ -230,7 +231,7 @@   , iname    = "necklace"   , ifreq    = [("useful", 100)]   , iflavour = zipFancy stdCol ++ zipPlain brightCol-  , irarity  = [(4, 2), (10, 5)]+  , irarity  = [(10, 3)]   , icount   = 1   , iverbHit = "whip"   , iweight  = 30@@ -250,7 +251,7 @@   { irarity  = [(2, 0), (10, 1)]   , iaspects = [Periodic $ d 4 + dl 2]   , ieffects = [ Impress-               , Summon [("summonable animal", 1)] $ 1 + dl 2, Explode "waste" ]+               , Summon [("mobile animal", 1)] $ 1 + dl 2, Explode "waste" ]   } necklace3 = necklace   { iaspects = [Periodic $ d 4 + dl 2]@@ -258,11 +259,11 @@   } necklace4 = necklace   { iaspects = [Periodic $ 2 * d 10 + dl 10]-  , ieffects = [Teleport $ 2 + d 3]+  , ieffects = [Teleport $ d 3 |*| 3]   } necklace5 = necklace   { iaspects = [Periodic $ d 4 + dl 2]-  , ieffects = [Teleport $ 10 + d 10]+  , ieffects = [Teleport $ 12 + d 3 |*| 3]   } necklace6 = necklace   { iaspects = [Periodic $ 2 * d 5 + dl 5]@@ -286,10 +287,10 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain [White]   , icount   = 1-  , irarity  = [(6, 0), (10, 1)]+  , irarity  = [(5, 0), (10, 1)]   , iverbHit = "rap"   , iweight  = 50-  , iaspects = [AddSight $ dl 3]+  , iaspects = [AddSight $ d 2, AddHurtMelee $ d 2 |*| 3]   , ieffects = []   , ifeature = [Precious, Identified, Durable, EqpSlot EqpSlotAddSight ""]   , idesc    = "Let's you better focus your weaker eye."@@ -301,7 +302,7 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain stdCol ++ zipFancy darkCol   , icount   = 1-  , irarity  = [(6, 2), (10, 5)]+  , irarity  = [(10, 3)]   , iverbHit = "knock"   , iweight  = 15   , iaspects = []@@ -312,7 +313,7 @@   } ring1 = ring   { irarity  = [(2, 0), (10, 2)]-  , iaspects = [AddSpeed 1, AddMaxHP $ dl 3 - 5 - d 3]+  , iaspects = [AddSpeed $ d 2, AddMaxHP $ dl 3 - 5 - d 3]   , ifeature = ifeature ring ++ [Durable, EqpSlot EqpSlotAddSpeed ""]   } ring2 = ring@@ -325,12 +326,12 @@   , idesc    = "Cold, solid to the touch, perfectly round, engraved with solemn, strangely comforting, worn out words."   } ring4 = ring  -- TODO: move to level-ups and to timed effects-  { irarity  = [(3, 8), (10, 12)]-  , iaspects = [AddHurtMelee $ 3 * d 4 + dl 15, AddMaxHP $ dl 3 - 4 - d 2]+  { irarity  = [(3, 12), (10, 12)]+  , iaspects = [AddHurtMelee $ (d 5 + dl 5) |*| 3, AddMaxHP $ dl 3 - 4 - d 2]   , ifeature = ifeature ring ++ [Durable, EqpSlot EqpSlotAddHurtMelee ""]   } ring5 = ring  -- by the time it's found, probably no space in eqp-  { irarity  = [(5, 0), (10, 1)]+  { irarity  = [(5, 0)]   , iaspects = [AddLight $ d 2]   , ifeature = ifeature ring ++ [EqpSlot EqpSlotAddLight ""]   , idesc    = "A sturdy ring with a large, shining stone."@@ -344,7 +345,7 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain stdCol ++ zipFancy brightCol   , icount   = 1-  , irarity  = [(1, 10), (10, 8)]+  , irarity  = [(1, 15), (10, 12)]   , iverbHit = "splash"   , iweight  = 200   , iaspects = []@@ -360,7 +361,7 @@   } potion2 = potion   { ifreq    = [("useful", 1)]  -- extremely rare-  , irarity  = [(10, 1)]+  , irarity  = [(1, 1)]   , ieffects = [ NoEffect "of musky concoction", Impress, DropBestWeapon                , OnSmash (Explode "pheromone")]   }@@ -368,7 +369,7 @@   { ieffects = [RefillHP 5, OnSmash (Explode "healing mist")]   } potion4 = potion  -- TODO: a bit boring-  { irarity  = [(1, 5)]+  { irarity  = [(1, 7)]   , ieffects = [RefillHP (-5), OnSmash (Explode "wounding mist")]   } potion5 = potion@@ -378,12 +379,12 @@   } potion6 = potion   { irarity  = [(10, 2)]-  , ieffects = [ NoEffect "of distortion"+  , ieffects = [ NoEffect "of distortion", Impress                , OnSmash (Explode "distortion")]   } potion7 = potion   { ieffects = [ NoEffect "of bait cocktail", Impress-               , OnSmash (Summon [("summonable animal", 1)] $ 1 + dl 2)+               , OnSmash (Summon [("mobile animal", 1)] $ 1 + dl 2)                , OnSmash (Explode "waste") ]   } potion8 = potion@@ -394,22 +395,27 @@                                 , Explode "explosion blast 10" ]) ]   } potion9 = potion-  { irarity  = [(4, 1), (10, 2)]-  , ieffects = [ OneOf [ Dominate, DropBestWeapon, RefillHP 15, Burn 9+  { irarity  = [(3, 3), (10, 6)]+  , ieffects = [ OneOf [ Dominate, DropBestWeapon, RefillHP 20, Burn 9                        , InsertMove 2]-               , OnSmash (OneOf [ Explode "healing mist"-                                , Explode "healing mist"+               , OnSmash (OneOf [ Explode "healing mist 2"+                                , Explode "healing mist 2"                                 , Explode "pheromone"                                 , Explode "distortion"                                 , Explode "explosion blast 20" ]) ]   }-potion10 = potion+potion10 = potion  -- used only as initial equipmnt; count betray identity   { ifreq    = [("useful", 100), ("potion of glue", 1)]   , irarity  = [(1, 1)]   , icount   = 1 + d 2   , ieffects = [ NoEffect "of glue", Paralyze (5 + d 5)                , OnSmash (Explode "glue")]+  , ifeature = [Identified]   }+potion11 = potion+  { irarity  = [(10, 5)]+  , ieffects = [RefillHP 10, OnSmash (Explode "healing mist 2")]+  }  -- * Non-exploding consumables, not specifically designed for throwing @@ -419,7 +425,7 @@   , ifreq    = [("useful", 100), ("any scroll", 100)]   , iflavour = zipFancy stdCol ++ zipPlain darkCol  -- arcane and old   , icount   = 1-  , irarity  = [(1, 10), (10, 7)]+  , irarity  = [(1, 15), (10, 12)]   , iverbHit = "thump"   , iweight  = 50   , iaspects = []@@ -430,23 +436,23 @@   , ikit     = []   } scroll1 = scroll-  { irarity  = [(10, 2)]+  { irarity  = [(1, 2), (10, 3)]   , ieffects = [CallFriend 1]   } scroll2 = scroll-  { irarity  = [(1, 5), (10, 3)]+  { irarity  = [(1, 7), (10, 5)]   , ieffects = [NoEffect "of fireworks", Explode "firecracker 7"]   } scroll3 = scroll-  { irarity  = [(1, 4), (10, 2)]+  { irarity  = [(1, 5), (10, 3)]   , ieffects = [Ascend (-1)]   } scroll4 = scroll-  { ieffects = [ OneOf [ Teleport $ 2 + d 5, RefillCalm 10, RefillCalm (-10)+  { ieffects = [ OneOf [ Teleport $ d 3 |*| 3, RefillCalm 10, RefillCalm (-10)                        , InsertMove 4, Paralyze 10, Identify CGround ] ]   } scroll5 = scroll-  { irarity  = [(1, 4), (10, 6)]+  { irarity  = [(3, 3), (10, 6)]   , ieffects = [ OneOf [ Summon standardSummon $ d 2                        , CallFriend 1, Ascend (-1), Ascend 1                        , RefillCalm 30, RefillCalm (-30), CreateItem $ d 2@@ -454,23 +460,23 @@                -- TODO: ask player: Escape 1   } scroll6 = scroll-  { ieffects = [Teleport $ 2 + d 5]+  { ieffects = [Teleport $ d 3 |*| 3]   } scroll7 = scroll-  { irarity  = [(10, 2)]+  { irarity  = [(10, 3)]   , ieffects = [InsertMove $ d 2 + dl 2]   } scroll8 = scroll-  { irarity  = [(3, 6), (10, 3)]+  { irarity  = [(3, 8), (10, 4)]   , ieffects = [Identify CGround]  -- TODO: ask player: AskPlayer cstore eff?   } scroll9 = scroll-  { irarity  = [(3, 3), (10, 9)]+  { irarity  = [(10, 10)]   , ieffects = [PolyItem CGround]   }  standardSummon :: Freqs-standardSummon = [("monster", 30), ("summonable animal", 70)]+standardSummon = [("monster", 30), ("mobile animal", 70)]  -- * Armor @@ -480,7 +486,7 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain [Brown]   , icount   = 1-  , irarity  = [(4, 9)]+  , irarity  = [(3, 6), (10, 3)]   , iverbHit = "thud"   , iweight  = 7000   , iaspects = [ AddHurtMelee (-3)@@ -495,11 +501,11 @@ armorMail = armorLeather   { iname    = "mail armor"   , iflavour = zipPlain [Cyan]-  , irarity  = [(7, 9)]+  , irarity  = [(6, 6), (10, 6)]   , iweight  = 12000   , iaspects = [ AddHurtMelee (-3)-               , AddArmorMelee $ (2 + dl 3) |*| 5-               , AddArmorRanged $ (2 + dl 3) |*| 5 ]+               , AddArmorMelee $ (2 + dl 4) |*| 5+               , AddArmorRanged $ (2 + dl 4) |*| 5 ]   , idesc    = "A long shirt woven from iron rings. Discourages foes from attacking your torso, making it harder for them to land a blow."   } gloveFencing = ItemKind@@ -508,11 +514,11 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain [BrYellow]   , icount   = 1-  , irarity  = [(4, 6), (10, 12)]+  , irarity  = [(5, 8), (10, 8)]   , iverbHit = "flap"   , iweight  = 100-  , iaspects = [ AddHurtMelee $ 2 * (d 3 + 2 * dl 5)-               , AddArmorRanged $ d 2 + dl 2 ]+  , iaspects = [ AddHurtMelee $ (d 2 + dl 10) * 3+               , AddArmorRanged $ d 2 |*| 5 ]   , ieffects = []   , ifeature = [ toVelocity 30  -- flaps and flutters                , Durable, EqpSlot EqpSlotAddArmorRanged "", Identified ]@@ -524,8 +530,8 @@   , irarity  = [(6, 12)]   , iflavour = zipPlain [BrCyan]   , iweight  = 300-  , iaspects = [ AddArmorMelee $ 2 * (d 2 + dl 2)-               , AddArmorRanged $ 2 * (d 2 + dl 2) ]+  , iaspects = [ AddArmorMelee $ (1 + dl 2) |*| 5+               , AddArmorRanged $ (1 + dl 2) |*| 5 ]   , idesc    = "Long leather gauntlet covered in overlapping steel plates."   } gloveJousting = gloveFencing@@ -533,9 +539,9 @@   , irarity  = [(6, 6)]   , iflavour = zipFancy [BrRed]   , iweight  = 500-  , iaspects = [ AddHurtMelee $ - 10 - d 5 + dl 5-               , AddArmorMelee $ 2 * (d 2 + dl 3)-               , AddArmorRanged $ 2 * (d 2 + dl 3) ]+  , iaspects = [ AddHurtMelee $ (dl 4 - 6) |*| 3+               , AddArmorMelee $ (2 + dl 2) |*| 5+               , AddArmorRanged $ (2 + dl 2) |*| 5 ]   , idesc    = "Rigid, steel, jousting handgear. If only you had a lance. And a horse."   } -- Shield doesn't protect against ranged attacks to prevent@@ -546,7 +552,7 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain [Blue]   , icount   = 1-  , irarity  = [(4, 7)]+  , irarity  = [(4, 6)]   , iverbHit = "bash"   , iweight  = 2000   , iaspects = [AddArmorMelee 40, AddHurtMelee (-30)]@@ -558,7 +564,7 @@   } shield = buckler   { iname    = "shield"-  , irarity  = [(7, 7)]+  , irarity  = [(7, 5)]   , iflavour = zipPlain [Green]   , iweight  = 3000   , iaspects = [AddArmorMelee 80, AddHurtMelee (-70)]@@ -572,14 +578,14 @@ dagger = ItemKind   { isymbol  = ')'   , iname    = "dagger"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("starting weapon", 100)]   , iflavour = zipPlain [BrCyan]   , icount   = 1-  , irarity  = [(1, 20), (10, 4)]+  , irarity  = [(1, 12), (10, 4)]   , iverbHit = "stab"   , iweight  = 1000-  , iaspects = [AddHurtMelee $ 2 * (d 3 + 2 * dl 5), AddArmorMelee $ d 4 + dl 4]-  , ieffects = [Hurt (4 * d 1)]+  , iaspects = [AddHurtMelee $ (d 3 + dl 3) |*| 3, AddArmorMelee $ d 2 |*| 5]+  , ieffects = [Hurt (6 * d 1)]   , ifeature = [ toVelocity 40  -- ensuring it hits with the tip costs speed                , Durable, EqpSlot EqpSlotWeapon "", Identified ]   , idesc    = "A short dagger for thrusting and parrying blows. Does not penetrate deeply, but is hard to block. Especially useful in conjunction with a larger weapon."@@ -588,14 +594,14 @@ hammer = ItemKind   { isymbol  = ')'   , iname    = "war hammer"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("starting weapon", 100)]   , iflavour = zipPlain [BrMagenta]   , icount   = 1   , irarity  = [(4, 12), (10, 2)]   , iverbHit = "club"   , iweight  = 1500-  , iaspects = [AddHurtMelee $ d 3 + 2 * dl 5]-  , ieffects = [Hurt (6 * d 1)]+  , iaspects = [AddHurtMelee $ (d 2 + dl 2) |*| 3]+  , ieffects = [Hurt (8 * d 1)]   , ifeature = [ toVelocity 20  -- ensuring it hits with the sharp tip costs                , Durable, EqpSlot EqpSlotWeapon "", Identified ]   , idesc    = "It may not cause grave wounds, but neither does it glance off nor ricochet. Great sidearm for opportunistic blows against armored foes."@@ -604,14 +610,14 @@ sword = ItemKind   { isymbol  = ')'   , iname    = "sword"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("starting weapon", 100)]   , iflavour = zipPlain [BrBlue]   , icount   = 1-  , irarity  = [(3, 1), (6, 20), (10, 10)]+  , irarity  = [(3, 1), (6, 16), (10, 8)]   , iverbHit = "slash"   , iweight  = 2000   , iaspects = []-  , ieffects = [Hurt (9 * d 1)]+  , ieffects = [Hurt (10 * d 1)]   , ifeature = [ toVelocity 20  -- ensuring it hits with the tip costs speed                , Durable, EqpSlot EqpSlotWeapon "", Identified ]   , idesc    = "Difficult to master; deadly when used effectively. The steel is particularly hard and keen, but rusts quickly without regular maintenance."@@ -620,14 +626,14 @@ halberd = ItemKind   { isymbol  = ')'   , iname    = "halberd"-  , ifreq    = [("useful", 100)]+  , ifreq    = [("useful", 100), ("starting weapon", 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 1   , irarity  = [(7, 1), (10, 10)]   , iverbHit = "impale"   , iweight  = 3000-  , iaspects = [AddArmorMelee $ 2 * (d 4 + dl 4)]-  , ieffects = [Hurt (12 * d 1)]+  , iaspects = [AddArmorMelee $ (1 + dl 3) |*| 5]+  , ieffects = [Hurt (14 * d 1)]   , ifeature = [ toVelocity 20  -- not balanced                , Durable, EqpSlot EqpSlotWeapon "", Identified ]   , idesc    = "Versatile, with great reach and leverage. Foes are held at a distance."@@ -684,10 +690,10 @@   , ifreq    = [("useful", 100)]   , iflavour = zipPlain [Blue]   , icount   = 1-  , irarity  = [(5, 5)]+  , irarity  = [(10, 10)]   , iverbHit = "smack"   , iweight  = 400-  , iaspects = [AddHurtMelee $ 2 * (d 3 + 2 * dl 5)]+  , iaspects = [AddHurtMelee $ d 10 |*| 3]   , ieffects = []   , ifeature = [EqpSlot EqpSlotAddHurtMelee "", Identified]   , idesc    = "A portable sharpening stone that lets you fix your weapons between or even during fights, without the need to set up camp, fish out tools and assemble a proper sharpening workshop."

@@ -12,9 +12,9 @@  actors :: [ItemKind] actors =-  [warrior, adventurer, blacksmith, forester, scientist, clerk, hairdresser, lawyer, peddler, taxCollector, eye, fastEye, nose, elbow, armadillo, gilaMonster, komodoDragon, hyena, alligator, hornetSwarm, thornbush, geyser]+  [warrior, adventurer, blacksmith, forester, scientist, soldier, clerk, hairdresser, lawyer, peddler, taxCollector, eye, fastEye, nose, elbow, armadillo, gilaMonster, komodoDragon, hyena, alligator, hornetSwarm, thornbush, geyser] -warrior,    adventurer, blacksmith, forester, scientist, clerk, hairdresser, lawyer, peddler, taxCollector, eye, fastEye, nose, elbow, armadillo, gilaMonster, komodoDragon, hyena, alligator, hornetSwarm, thornbush, geyser :: ItemKind+warrior,    adventurer, blacksmith, forester, scientist, soldier, clerk, hairdresser, lawyer, peddler, taxCollector, eye, fastEye, nose, elbow, armadillo, gilaMonster, komodoDragon, hyena, alligator, hornetSwarm, thornbush, geyser :: ItemKind  -- * Hunams @@ -43,6 +43,12 @@ scientist = warrior   { iname    = "scientist" } +soldier = warrior+  { iname    = "soldier"+  , ifreq    = [("soldier", 100)]+  , ikit     = ikit warrior ++ [("starting weapon", CEqp)]+  }+ clerk = warrior   { iname    = "clerk"   , ifreq    = [("civilian", 100)] }@@ -135,7 +141,7 @@ armadillo = ItemKind   { isymbol  = 'a'   , iname    = "giant armadillo"-  , ifreq    = [("animal", 100), ("horror", 100), ("summonable animal", 100)]+  , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Brown]   , icount   = 1   , irarity  = [(1, 5)]@@ -153,7 +159,7 @@ gilaMonster = ItemKind   { isymbol  = 'g'   , iname    = "Gila monster"-  , ifreq    = [("animal", 100), ("horror", 100), ("summonable animal", 100)]+  , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Magenta]   , icount   = 1   , irarity  = [(2, 5), (10, 3)]@@ -171,7 +177,7 @@ komodoDragon = ItemKind  -- bad hearing   { isymbol  = 'k'   , iname    = "Komodo dragon"-  , ifreq    = [("animal", 100), ("horror", 100), ("summonable animal", 100)]+  , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Blue]   , icount   = 1   , irarity  = [(5, 5), (10, 7)]@@ -189,7 +195,7 @@ hyena = ItemKind   { isymbol  = 'h'   , iname    = "spotted hyena"-  , ifreq    = [("animal", 100), ("horror", 100), ("summonable animal", 100)]+  , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Red]   , icount   = 1   , irarity  = [(4, 6), (10, 6)]@@ -205,7 +211,7 @@ alligator = ItemKind   { isymbol  = 'a'   , iname    = "alligator"-  , ifreq    = [("animal", 100), ("horror", 100), ("summonable animal", 100)]+  , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Blue]   , icount   = 1   , irarity  = [(10, 8)]@@ -226,7 +232,7 @@ hornetSwarm = ItemKind   { isymbol  = 'h'   , iname    = "hornet swarm"-  , ifreq    = [("animal", 100), ("horror", 100), ("summonable animal", 100)]+  , ifreq    = [("animal", 100), ("horror", 100), ("mobile animal", 100)]   , iflavour = zipPlain [Magenta]   , icount   = 1   , irarity  = [(5, 1), (10, 5)]

@@ -5,6 +5,7 @@ import Game.LambdaHack.Common.Dice import Game.LambdaHack.Common.Effect import Game.LambdaHack.Common.Flavour+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Msg import Game.LambdaHack.Content.ItemKind @@ -19,7 +20,7 @@ speedGland :: Int -> ItemKind speedGland n = fist   { iname    = "speed gland"-  , ifreq    = [("speed gland" <+> tshow n, 100)]+  , ifreq    = [(toGroupName $ "speed gland" <+> tshow n, 100)]   , icount   = 1   , iverbHit = "spit at"   , iaspects = [AddSpeed $ intToDice n, Periodic $ intToDice n]@@ -35,7 +36,7 @@ eye :: Int -> ItemKind eye n = fist   { iname    = "eye"-  , ifreq    = [("eye" <+> tshow n, 100)]+  , ifreq    = [(toGroupName $ "eye" <+> tshow n, 100)]   , icount   = 2   , iverbHit = "glare at"   , iaspects = [AddSight (intToDice n)]@@ -226,7 +227,7 @@   , ifreq    = [("armored skin", 100)]   , icount   = 1   , iverbHit = "bash"-  , iaspects = [AddArmorMelee 33, AddArmorRanged 33]+  , iaspects = [AddArmorMelee 30, AddArmorRanged 30]   , ieffects = []   , ifeature = [Durable, Identified]   , idesc    = ""

@@ -5,14 +5,15 @@ import Game.LambdaHack.Common.Dice import Game.LambdaHack.Common.Effect import Game.LambdaHack.Common.Flavour+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Msg import Game.LambdaHack.Content.ItemKind  shrapnels :: [ItemKind] shrapnels =-  [fragrance, pheromone, firecracker2, firecracker3, firecracker4, firecracker5, firecracker6, firecracker7, mistHealing, mistWounding, distortion, waste, burningOil2, burningOil3, burningOil4, explosionBlast10, explosionBlast20, glassPiece, smoke, boilingWater, glue]+  [fragrance, pheromone, firecracker2, firecracker3, firecracker4, firecracker5, firecracker6, firecracker7, mistHealing, mistHealing2, mistWounding, distortion, waste, burningOil2, burningOil3, burningOil4, explosionBlast10, explosionBlast20, glassPiece, smoke, boilingWater, glue] -fragrance,    pheromone, firecracker2, firecracker3, firecracker4, firecracker5, firecracker6, firecracker7, mistHealing, mistWounding, distortion, waste, burningOil2, burningOil3, burningOil4, explosionBlast10, explosionBlast20, glassPiece, smoke, boilingWater, glue :: ItemKind+fragrance,    pheromone, firecracker2, firecracker3, firecracker4, firecracker5, firecracker6, firecracker7, mistHealing, mistHealing2, mistWounding, distortion, waste, burningOil2, burningOil3, burningOil4, explosionBlast10, explosionBlast20, glassPiece, smoke, boilingWater, glue :: ItemKind  -- * Parameterized shrapnel @@ -20,7 +21,7 @@ burningOil n = ItemKind   { isymbol  = '*'   , iname    = "burning oil"-  , ifreq    = [("burning oil" <+> tshow n, 1)]+  , ifreq    = [(toGroupName $ "burning oil" <+> tshow n, 1)]   , iflavour = zipFancy [BrYellow]   , icount   = intToDice (n * 4)   , irarity  = [(1, 1)]@@ -41,7 +42,7 @@ explosionBlast n = ItemKind   { isymbol  = '*'   , iname    = "explosion blast"-  , ifreq    = [("explosion blast" <+> tshow n, 1)]+  , ifreq    = [(toGroupName $ "explosion blast" <+> tshow n, 1)]   , iflavour = zipPlain [BrRed]   , icount   = 12  -- strong, but few, so not always hits target   , irarity  = [(1, 1)]@@ -59,14 +60,14 @@ firecracker n = ItemKind   { isymbol  = '*'   , iname    = "firecracker"-  , ifreq    = [("firecracker" <+> tshow n, 1)]+  , ifreq    = [(toGroupName $ "firecracker" <+> tshow n, 1)]   , iflavour = zipPlain [stdCol !! (n `mod` length stdCol)]   , icount   = intToDice $ 2 * n   , irarity  = [(1, 1)]   , iverbHit = "crack"   , iweight  = 1   , iaspects = [AddLight $ intToDice $ n `div` 2]-  , ieffects = [Burn 1, Explode $ "firecracker" <+> tshow (n - 1)]+  , ieffects = [Burn 1, Explode $ toGroupName $ "firecracker" <+> tshow (n - 1)]   , ifeature = [ ToThrow $ ThrowMod (n * 10) 20                , Fragile, Identified ]   , idesc    = ""@@ -124,6 +125,22 @@   , iweight  = 1   , iaspects = [AddLight 1]   , ieffects = [RefillHP 2]+  , ifeature = [ toVelocity 7  -- the slowest that gets anywhere (1 step only)+               , Fragile, Identified ]+  , idesc    = ""+  , ikit     = []+  }+mistHealing2 = ItemKind+  { isymbol  = '\''+  , iname    = "mist"+  , ifreq    = [("healing mist 2", 1)]+  , iflavour = zipFancy [White]+  , icount   = 12+  , irarity  = [(1, 1)]+  , iverbHit = "revitalize"+  , iweight  = 1+  , iaspects = [AddLight 2]+  , ieffects = [RefillHP 4]   , ifeature = [ toVelocity 7  -- the slowest that gets anywhere (1 step only)                , Fragile, Identified ]   , idesc    = ""

@@ -1,8 +1,9 @@--- | The type of kinds of game modes for LambdaHack.+-- | Game mode definitions. module Content.ModeKind ( cdefs ) where  import qualified Data.IntMap.Strict as IM +import Content.ModeKindPlayer import Game.LambdaHack.Common.ContentDef import Game.LambdaHack.Content.ModeKind @@ -11,288 +12,235 @@   { getSymbol = msymbol   , getName = mname   , getFreq = mfreq-  , validate = validateModeKind+  , validateSingle = validateSingleModeKind+  , validateAll = validateAllModeKind   , content =       [campaign, duel, skirmish, ambush, battle, safari, pvp, coop, defense]   } campaign,        duel, skirmish, ambush, battle, safari, pvp, coop, defense :: ModeKind  campaign = ModeKind-  { msymbol  = 'a'-  , mname    = "campaign"-  , mfreq    = [("campaign", 1)]-  , mplayers = playersCampaign-  , mcaves   = cavesCampaign-  , mdesc    = "Don't let wanton curiosity, greed and the creeping abstraction madness keep you down there in the darkness for too long!"+  { msymbol = 'a'+  , mname   = "campaign"+  , mfreq   = [("campaign", 1)]+  , mroster = rosterCampaign+  , mcaves  = cavesCampaign+  , 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)]-  , mplayers = playersDuel-  , mcaves   = cavesSkirmish-  , mdesc    = "You disagreed about the premises of a relative completeness theorem and there's only one way to settle that."+  { 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."   }  skirmish = ModeKind-  { msymbol  = 'k'-  , mname    = "skirmish"-  , mfreq    = [("skirmish", 1)]-  , mplayers = playersSkirmish-  , mcaves   = cavesSkirmish-  , mdesc    = "The scoring system of a programming contest fails to determine the winning team and participants take matters into their own hands."+  { msymbol = 'k'+  , mname   = "skirmish"+  , 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."   }  ambush = ModeKind-  { msymbol  = 'm'-  , mname    = "ambush"-  , mfreq    = [("ambush", 1)]-  , mplayers = playersAmbush-  , mcaves   = cavesAmbush-  , mdesc    = "Surprising, striking ideas and fast execution are what makes or breaks a creative team!"+  { msymbol = 'm'+  , mname   = "ambush"+  , mfreq   = [("ambush", 1)]+  , mroster = rosterAmbush+  , mcaves  = cavesAmbush+  , mdesc   = "Surprising, striking ideas and fast execution are what makes or breaks a creative team!"   }  battle = ModeKind-  { msymbol  = 'b'-  , mname    = "battle"-  , mfreq    = [("battle", 1)]-  , mplayers = playersBattle-  , mcaves   = cavesBattle-  , mdesc    = "Odds are stacked against those that unleash the horrors of abstraction."+  { msymbol = 'b'+  , mname   = "battle"+  , mfreq   = [("battle", 1)]+  , mroster = rosterBattle+  , mcaves  = cavesBattle+  , mdesc   = "Odds are stacked against those that unleash the horrors of abstraction."   }  safari = ModeKind-  { msymbol  = 'f'-  , mname    = "safari"-  , mfreq    = [("safari", 1)]-  , mplayers = playersSafari-  , mcaves   = cavesSafari-  , mdesc    = "In this simulation you'll discover the joys of hunting the most exquisite of Earth's flora and fauna, both animal and semi-intelligent (exit at the bottommost level)."+  { msymbol = 'f'+  , mname   = "safari"+  , mfreq   = [("safari", 1)]+  , mroster = rosterSafari+  , mcaves  = cavesSafari+  , mdesc   = "In this simulation you'll discover the joys of hunting the most exquisite of Earth's flora and fauna, both animal and semi-intelligent (exit at the bottommost level)."   }  pvp = ModeKind-  { msymbol  = 'v'-  , mname    = "PvP"-  , mfreq    = [("PvP", 1)]-  , mplayers = playersPvP-  , mcaves   = cavesSkirmish-  , mdesc    = "(Not usable right now.) This is a fight to the death between two human-controlled teams."+  { msymbol = 'v'+  , mname   = "PvP"+  , mfreq   = [("PvP", 1)]+  , mroster = rosterPvP+  , mcaves  = cavesSkirmish+  , mdesc   = "(Not usable right now.) This is a fight to the death between two human-controlled teams."   }  coop = ModeKind-  { msymbol  = 'o'-  , mname    = "Coop"-  , mfreq    = [("Coop", 1)]-  , mplayers = playersCoop-  , mcaves   = cavesCampaign-  , mdesc    = "(This mode is intended solely for automated testing.)"+  { msymbol = 'o'+  , mname   = "Coop"+  , mfreq   = [("Coop", 1)]+  , mroster = rosterCoop+  , mcaves  = cavesCampaign+  , mdesc   = "(This mode is intended solely for automated testing.)"   }  defense = ModeKind-  { msymbol  = 'e'-  , mname    = "defense"-  , mfreq    = [("defense", 1)]-  , mplayers = playersDefense-  , mcaves   = cavesCampaign-  , mdesc    = "Don't let the humans defile your abstract secrets and flee, like the vulgar, literal, base scoundrels that they are!"+  { msymbol = 'e'+  , mname   = "defense"+  , mfreq   = [("defense", 1)]+  , mroster = rosterDefense+  , mcaves  = cavesCampaign+  , mdesc   = "Don't let the humans defile your abstract secrets and flee, like the vulgar, literal, base scoundrels that they are!"   }  -playersCampaign, playersDuel, playersSkirmish, playersAmbush, playersBattle, playersSafari, playersPvP, playersCoop, playersDefense :: Players--playersCampaign = Players-  { playersList = [ playerHero-                  , playerMonster-                  , playerAnimal ]-  , playersEnemy = [ ("Adventurer Party", "Monster Hive")-                   , ("Adventurer Party", "Animal Kingdom") ]-  , playersAlly = [("Monster Hive", "Animal Kingdom")] }--playersDuel = Players-  { playersList = [ playerHero { playerName = "White Recursive"-                               , playerInitial = 1 }-                  , playerAntiHero { playerName = "Red Iterative"-                                   , playerInitial = 1 }-                  , playerHorror ]-  , playersEnemy = [ ("White Recursive", "Red Iterative")-                   , ("White Recursive", "Horror Den")-                   , ("Red Iterative", "Horror Den") ]-  , playersAlly = [] }--playersSkirmish = playersDuel-  { playersList = [ playerHero {playerName = "White Haskell"}-                  , playerAntiHero {playerName = "Purple Agda"}-                  , playerHorror ]-  , playersEnemy = [ ("White Haskell", "Purple Agda")-                   , ("White Haskell", "Horror Den")-                   , ("Purple Agda", "Horror Den") ] }--playersAmbush = playersDuel-  { playersList = [ playerHero {playerName = "Yellow Idris"}-                  , playerAntiHero {playerName = "Blue Epigram"}-                  , playerHorror ]-  , playersEnemy = [ ("Yellow Idris", "Blue Epigram")-                   , ("Yellow Idris", "Horror Den")-                   , ("Blue Epigram", "Horror Den") ] }--playersBattle = Players-  { playersList = [ playerHero {playerInitial = 5}-                  , playerMonster { playerInitial = 15-                                  , playerIsSpawn = False }-                  , playerAnimal { playerInitial = 10-                                 , playerIsSpawn = False } ]-  , playersEnemy = [ ("Adventurer Party", "Monster Hive")-                   , ("Adventurer Party", "Animal Kingdom") ]-  , playersAlly = [("Monster Hive", "Animal Kingdom")] }--playersSafari = Players-  { playersList = [ playerMonster { playerName = "Monster Tourist Office"-                                  , playerIsSpawn = False-                                  , playerEntry = -4-                                  , playerInitial = 10-                                  , playerAI = False-                                  , playerUI = True }-                  , playerCivilian { playerName = "Hunam Convict Pack"-                                   , playerEntry = -4 }-                  , playerAnimal { playerName =-                                     "Animal Magnificent Specimen Variety"-                                 , playerIsSpawn = False-                                 , playerEntry = -7-                                 , playerInitial = 7 }-                  , playerAnimal { playerName =-                                     "Animal Exquisite Herds and Packs"-                                 , playerIsSpawn = False-                                 , playerEntry = -10-                                 , playerInitial = 20 } ]-  , playersEnemy = [ ("Monster Tourist Office", "Hunam Convict Pack")-                   , ("Monster Tourist Office",-                      "Animal Magnificent Specimen Variety")-                   , ("Monster Tourist Office",-                      "Animal Exquisite Herds and Packs") ]-  , playersAlly = [( "Animal Magnificent Specimen Variety"-                   , "Animal Exquisite Herds and Packs" )] }--playersPvP = Players-  { playersList = [ playerHero {playerName = "Red"}-                  , playerHero {playerName = "Blue"}-                  , playerHorror ]-  , playersEnemy = [ ("Red", "Blue")-                   , ("Red", "Horror Den")-                   , ("Blue", "Horror Den") ]-  , playersAlly = [] }+rosterCampaign, rosterDuel, rosterSkirmish, rosterAmbush, rosterBattle, rosterSafari, rosterPvP, rosterCoop, rosterDefense :: Roster -playersCoop = Players-  { playersList = [ playerAntiHero { playerName = "Coral" }-                  , playerAntiHero { playerName = "Amber"-                                   , playerLeader = False }-                  , playerAntiHero { playerName = "Green" }-                  , playerAnimal { playerUI = True }-                  , playerMonster-                  , playerMonster { playerName = "Leaderless Monster Hive"-                                  , playerLeader = False } ]-  , playersEnemy = [ ("Coral", "Monster Hive")-                   , ("Amber", "Monster Hive")-                   , ("Animal Kingdom", "Leaderless Monster Hive") ]-  , playersAlly = [ ("Coral", "Amber")-                  , ("Coral", "Green")-                  , ("Amber", "Green")-                  , ("Green", "Animal Kingdom")-                  , ("Green", "Monster Hive")-                  , ("Green", "Leaderless Monster Hive") ] }+rosterCampaign = Roster+  { rosterList = [ playerHero+                 , playerMonster+                 , playerAnimal ]+  , rosterEnemy = [ ("Adventurer Party", "Monster Hive")+                  , ("Adventurer Party", "Animal Kingdom") ]+  , rosterAlly = [("Monster Hive", "Animal Kingdom")] } -playersDefense = Players-  { playersList = [ playerMonster { playerInitial = 1-                                  , playerAI = False-                                  , playerUI = True }-                  , playerAntiHero { playerName = "Yellow"-                                   , playerInitial = 10 }-                  , playerAnimal ]-  , playersEnemy = [ ("Yellow", "Monster Hive")-                   , ("Yellow", "Animal Kingdom") ]-  , playersAlly = [("Monster Hive", "Animal Kingdom")] }+rosterDuel = Roster+  { rosterList = [ playerHero { fname = "White Recursive"+                              , fentryLevel = -3+                              , finitialActors = 1 }+                 , playerAntiHero { fname = "Red Iterative"+                                  , fentryLevel = -3+                                  , finitialActors = 1 }+                 , playerHorror ]+  , rosterEnemy = [ ("White Recursive", "Red Iterative")+                  , ("White Recursive", "Horror Den")+                  , ("Red Iterative", "Horror Den") ]+  , rosterAlly = [] } -playerHero, playerAntiHero, playerCivilian, playerMonster, playerAnimal, playerHorror :: Player+rosterSkirmish = rosterDuel+  { rosterList = [ playerHero { fname = "White Haskell"+                              , fentryLevel = -3 }+                 , playerAntiHero { fname = "Purple Agda"+                                  , fentryLevel = -3 }+                 , playerHorror ]+  , rosterEnemy = [ ("White Haskell", "Purple Agda")+                  , ("White Haskell", "Horror Den")+                  , ("Purple Agda", "Horror Den") ] } -playerHero = Player-  { playerName = "Adventurer Party"-  , playerFaction = "hero"-  , playerIsSpawn = False-  , playerIsHero = True-  , playerEntry = -1-  , playerInitial = 3-  , playerLeader = True-  , playerAI = False-  , playerUI = True-  }+rosterAmbush = rosterDuel+  { rosterList = [ playerHero { fname = "Yellow Idris"+                              , fentryLevel = -5 }+                 , playerAntiHero { fname = "Blue Epigram"+                                  , fentryLevel = -5 }+                 , playerHorror {fentryLevel = -5} ]+  , rosterEnemy = [ ("Yellow Idris", "Blue Epigram")+                  , ("Yellow Idris", "Horror Den")+                  , ("Blue Epigram", "Horror Den") ] } -playerAntiHero = playerHero-  { playerAI = True-  , playerUI = False-  }+rosterBattle = Roster+  { rosterList = [ playerSoldier { finitialActors = 5+                                 , fentryLevel = -5 }+                 , playerMobileMonster { finitialActors = 30+                                       , fentryLevel = -5+                                       , fneverEmpty = True }+                 , playerMobileAnimal { finitialActors = 20+                                      , fentryLevel = -5+                                      , fneverEmpty = True } ]+  , rosterEnemy = [ ("Armed Adventurer Party", "Monster Hive")+                  , ("Armed Adventurer Party", "Animal Kingdom") ]+  , rosterAlly = [("Monster Hive", "Animal Kingdom")] } -playerCivilian = Player-  { playerName = "Civilian Crowd"-  , playerFaction = "civilian"-  , playerIsSpawn = False-  , playerIsHero = False-  , playerEntry = -1-  , playerInitial = 3-  , playerLeader = False  -- unorganized-  , playerAI = True-  , playerUI = False-  }+rosterSafari = Roster+  { rosterList = [ playerAntiMonster { fname = "Monster Tourist Office"+                                     , fcanEscape = True+                                     , fneverEmpty = True+                                     -- Follow-the-guide, as tourists do.+                                     , ftactic = TFollow+                                     , fentryLevel = -4+                                     , finitialActors = 15+                                     , fleaderMode =+                                         LeaderUI $ AutoLeader False False }+                 , playerCivilian { fname = "Hunam Convict Pack"+                                  , fentryLevel = -4 }+                 , playerMobileAnimal { fname =+                                          "Animal Magnificent Specimen Variety"+                                      , fneverEmpty = True+                                      , fentryLevel = -7+                                      , finitialActors = 10 }+                 , playerMobileAnimal { fname =+                                          "Animal Exquisite Herds and Packs"+                                      , fneverEmpty = True+                                      , fentryLevel = -10+                                      , finitialActors = 25 } ]+  , rosterEnemy = [ ("Monster Tourist Office", "Hunam Convict Pack")+                  , ("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" )] } -playerMonster = Player-  { playerName = "Monster Hive"-  , playerFaction = "monster"-  , playerIsSpawn = True-  , playerIsHero = False-  , playerEntry = -3-  , playerInitial = 5-  , playerLeader = True-  , playerAI = True-  , playerUI = False-  }+rosterPvP = Roster+  { rosterList = [ playerHero { fname = "Red"+                              , fentryLevel = -3 }+                 , playerHero { fname = "Blue"+                              , fentryLevel = -3 }+                 , playerHorror ]+  , rosterEnemy = [ ("Red", "Blue")+                  , ("Red", "Horror Den")+                  , ("Blue", "Horror Den") ]+  , rosterAlly = [] } -playerAnimal = Player-  { playerName = "Animal Kingdom"-  , playerFaction = "animal"-  , playerIsSpawn = True-  , playerIsHero = False-  , playerEntry = -2-  , playerInitial = 3-  , playerLeader = False-  , playerAI = True-  , playerUI = False-  }+rosterCoop = Roster+  { rosterList = [ playerAntiHero { fname = "Coral" }+                 , playerAntiHero { fname = "Amber"+                                  , fleaderMode = LeaderNull }+                 , playerAntiHero { fname = "Green" }+                 , playerAnimal { fhasUI = True }+                 , 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") ] } -playerHorror = Player-  { playerName = "Horror Den"-  , playerFaction = "horror"-  , playerIsSpawn = False-  , playerIsHero = False-  , playerEntry = -1-  , playerInitial = 0-  , playerLeader = False-  , playerAI = True-  , playerUI = False-  }+rosterDefense = Roster+  { rosterList = [ playerAntiMonster { finitialActors = 1 }+                 , playerAntiHero { fname = "Yellow"+                                  , finitialActors = 10 }+                 , playerAnimal ]+  , rosterEnemy = [ ("Yellow", "Monster Hive")+                  , ("Yellow", "Animal Kingdom") ]+  , rosterAlly = [("Monster Hive", "Animal Kingdom")] }   cavesCampaign, cavesSkirmish, cavesAmbush, cavesBattle, cavesSafari :: Caves -cavesCampaign = IM.fromList $ [ (-1, ("caveRogue", Just True))-                              , (-2, ("caveRogue", Nothing))-                              , (-3, ("caveEmpty", Nothing)) ]-                              ++ zip [-4, -5..(-9)] (repeat ("dng", Nothing))-                              ++ [(-10, ("caveNoise", Nothing))]+cavesCampaign = IM.fromList+                $ [ (-1, ("caveRogue", Just True))+                  , (-2, ("caveRogue", Nothing))+                  , (-3, ("caveEmpty", Nothing)) ]+                  ++ zip [-4, -5..(-9)] (repeat ("campaign random", Nothing))+                  ++ [(-10, ("caveNoise", Nothing))]  cavesSkirmish = IM.fromList [(-3, ("caveSkirmish", Nothing))]  cavesAmbush = IM.fromList [(-5, ("caveAmbush", Nothing))] -cavesBattle = IM.fromList [(-3, ("caveBattle", Nothing))]+cavesBattle = IM.fromList [(-5, ("caveBattle", Nothing))]  cavesSafari = IM.fromList [ (-4, ("caveSafari1", Nothing))                           , (-7, ("caveSafari2", Nothing))