LambdaHack 0.8.1.2 → 0.8.3.0

raw patch · 53 files changed

+714/−660 lines, 53 filesdep ~randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• CREDITS +1/−0
• Game/LambdaHack/Atomic/CmdAtomic.hs +10/−8
• Game/LambdaHack/Atomic/HandleAtomicWrite.hs +26/−31
• Game/LambdaHack/Atomic/PosAtomicRead.hs +2/−2
• Game/LambdaHack/Client.hs +2/−3
• Game/LambdaHack/Client/AI.hs +3/−4
• Game/LambdaHack/Client/AI/HandleAbilityM.hs +107/−130
• Game/LambdaHack/Client/CommonM.hs +1/−2
• Game/LambdaHack/Client/HandleAtomicM.hs +15/−13
• Game/LambdaHack/Client/Request.hs +14/−23
• Game/LambdaHack/Client/UI/DisplayAtomicM.hs +2/−2
• Game/LambdaHack/Client/UI/DrawM.hs +46/−31
• Game/LambdaHack/Client/UI/Frontend/Common.hs +18/−3
• Game/LambdaHack/Client/UI/Frontend/Sdl.hs +2/−8
• Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs +117/−83
• Game/LambdaHack/Client/UI/HandleHumanM.hs +9/−12
• Game/LambdaHack/Client/UI/InventoryM.hs +0/−1
• Game/LambdaHack/Client/UI/RunM.hs +2/−2
• Game/LambdaHack/Common/Actor.hs +1/−1
• Game/LambdaHack/Common/Item.hs +6/−5
• Game/LambdaHack/Common/ItemAspect.hs +8/−15
• Game/LambdaHack/Common/Misc.hs +8/−0
• Game/LambdaHack/Common/ReqFailure.hs +17/−2
• Game/LambdaHack/Common/State.hs +2/−2
• Game/LambdaHack/Content/RuleKind.hs +7/−7
• Game/LambdaHack/Server/BroadcastAtomic.hs +2/−2
• Game/LambdaHack/Server/Commandline.hs +1/−1
• Game/LambdaHack/Server/CommonM.hs +12/−36
• Game/LambdaHack/Server/DebugM.hs +1/−1
• Game/LambdaHack/Server/EndM.hs +3/−3
• Game/LambdaHack/Server/HandleEffectM.hs +23/−24
• Game/LambdaHack/Server/HandleRequestM.hs +79/−29
• Game/LambdaHack/Server/ItemM.hs +16/−18
• Game/LambdaHack/Server/ItemRev.hs +5/−11
• Game/LambdaHack/Server/LoopM.hs +7/−8
• Game/LambdaHack/Server/MonadServer.hs +1/−1
• Game/LambdaHack/Server/PeriodicM.hs +4/−4
• Game/LambdaHack/Server/ProtocolM.hs +19/−18
• Game/LambdaHack/Server/ServerOptions.hs +1/−1
• Game/LambdaHack/Server/StartM.hs +3/−2
• Game/LambdaHack/Server/State.hs +0/−4
• GameDefinition/Content/CaveKind.hs +2/−2
• GameDefinition/Content/ItemKind.hs +3/−2
• GameDefinition/Content/RuleKind.hs +4/−11
• GameDefinition/Content/TileKind.hs +1/−11
• GameDefinition/Implementation/MonadClientImplementation.hs +0/−1
• GameDefinition/Implementation/MonadServerImplementation.hs +1/−1
• GameDefinition/Main.hs +20/−3
• GameDefinition/MainMenu.ascii +45/−60
• LambdaHack.cabal +3/−3
• Makefile +9/−2
• README.md +14/−11

@@ -1,3 +1,12 @@+## [v0.8.3.0](https://github.com/LambdaHack/LambdaHack/compare/v0.8.1.2...v0.8.3.0)++- Add a hack to run SDL2 on the main thread, fixing the OS X crash+- Warn visually when impressed and Calm running low, risking domination+- Display actor as red when low Calm and impressed or when low HP+- Fix, complete and fine tune UI, AI and server skill and weapon checks+- Fix a bug where item aspects look different to clients than to the server+- Change the requirements for the main menu ASCII art+ ## [v0.8.1.2](https://github.com/LambdaHack/LambdaHack/compare/v0.8.1.1...v0.8.1.2)  - Fix typos detected by lintian

@@ -6,6 +6,7 @@ Tuukka Turto Veronika Romashkina @Peritract+Pablo Reszczynski   Fonts 16x16x.fon, 8x8x.fon and 8x8xb.fon are are taken from

@@ -104,12 +104,12 @@   | UpdTimeItem ItemId Container ItemTimer ItemTimer   | UpdAgeGame [LevelId]   | UpdUnAgeGame [LevelId]-  | UpdDiscover Container ItemId (ContentId ItemKind) IA.ItemSeed-  | UpdCover Container ItemId (ContentId ItemKind) IA.ItemSeed+  | UpdDiscover Container ItemId (ContentId ItemKind) IA.AspectRecord+  | UpdCover Container ItemId (ContentId ItemKind) IA.AspectRecord   | UpdDiscoverKind Container ItemKindIx (ContentId ItemKind)   | UpdCoverKind Container ItemKindIx (ContentId ItemKind)-  | UpdDiscoverSeed Container ItemId IA.ItemSeed-  | UpdCoverSeed Container ItemId IA.ItemSeed+  | UpdDiscoverAspect Container ItemId IA.AspectRecord+  | UpdCoverAspect Container ItemId IA.AspectRecord   | UpdDiscoverServer ItemId IA.AspectRecord   | UpdCoverServer ItemId IA.AspectRecord   | UpdPerception LevelId Perception Perception@@ -215,12 +215,14 @@   UpdTimeItem iid c fromIt toIt -> Just $ UpdTimeItem iid c toIt fromIt   UpdAgeGame lids -> Just $ UpdUnAgeGame lids   UpdUnAgeGame lids -> Just $ UpdAgeGame lids-  UpdDiscover c iid ik seed -> Just $ UpdCover c iid ik seed-  UpdCover c iid ik seed -> Just $ UpdDiscover c iid ik seed+  UpdDiscover c iid ik aspectRecord -> Just $ UpdCover c iid ik aspectRecord+  UpdCover c iid ik aspectRecord -> Just $ UpdDiscover c iid ik aspectRecord   UpdDiscoverKind c ix ik -> Just $ UpdCoverKind c ix ik   UpdCoverKind c ix ik -> Just $ UpdDiscoverKind c ix ik-  UpdDiscoverSeed c iid seed -> Just $ UpdCoverSeed c iid seed-  UpdCoverSeed c iid seed -> Just $ UpdDiscoverSeed c iid seed+  UpdDiscoverAspect c iid aspectRecord ->+    Just $ UpdCoverAspect c iid aspectRecord+  UpdCoverAspect c iid aspectRecord ->+    Just $ UpdDiscoverAspect c iid aspectRecord   UpdDiscoverServer iid aspectRecord -> Just $ UpdCoverServer iid aspectRecord   UpdCoverServer iid aspectRecord -> Just $ UpdDiscoverServer iid aspectRecord   UpdPerception lid outPer inPer -> Just $ UpdPerception lid inPer outPer

@@ -17,7 +17,7 @@   , updAlterSmell, updSpotSmell, updLoseSmell, updTimeItem   , updAgeGame, updUnAgeGame, ageLevel, updDiscover, updCover   , updDiscoverKind, discoverKind, updCoverKind-  , updDiscoverSeed, discoverSeed, updCoverSeed+  , updDiscoverAspect, discoverAspect, updCoverAspect   , updDiscoverServer, updCoverServer   , updRestart, updRestartServer, updResumeServer #endif@@ -107,12 +107,12 @@   UpdTimeItem iid c fromIt toIt -> updTimeItem iid c fromIt toIt   UpdAgeGame lids -> updAgeGame lids   UpdUnAgeGame lids -> updUnAgeGame lids-  UpdDiscover c iid ik seed -> updDiscover c iid ik seed-  UpdCover c iid ik seed -> updCover c iid ik seed+  UpdDiscover c iid ik aspectRecord -> updDiscover c iid ik aspectRecord+  UpdCover c iid ik aspectRecord -> updCover c iid ik aspectRecord   UpdDiscoverKind c ix ik -> updDiscoverKind c ix ik   UpdCoverKind c ix ik -> updCoverKind c ix ik-  UpdDiscoverSeed c iid seed -> updDiscoverSeed c iid seed-  UpdCoverSeed c iid seed -> updCoverSeed c iid seed+  UpdDiscoverAspect c iid aspectRecord -> updDiscoverAspect c iid aspectRecord+  UpdCoverAspect c iid aspectRecord -> updCoverAspect c iid aspectRecord   UpdDiscoverServer iid aspectRecord -> updDiscoverServer iid aspectRecord   UpdCoverServer iid aspectRecord -> updCoverServer iid aspectRecord   UpdPerception _ outPer inPer ->@@ -557,30 +557,31 @@   updateLevel lid $ \lvl -> lvl {ltime = timeShift (ltime lvl) delta}  updDiscover :: MonadStateWrite m-            => Container -> ItemId -> ContentId ItemKind -> IA.ItemSeed -> m ()-updDiscover _c iid ik seed = do+            => Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord+            -> m ()+updDiscover _c iid ik aspectRecord = do   itemD <- getsState sitemD   COps{coItemSpeedup} <- getsState scops   let kmIsConst = IA.kmConst $ IK.getKindMean ik coItemSpeedup   discoKind <- getsState sdiscoKind-  let discoverAtMostSeed = do+  let discoverAtMostAspect = do         discoAspect <- getsState sdiscoAspect         if kmIsConst || iid `EM.member` discoAspect         then atomicFail "item already fully discovered"-        else discoverSeed iid seed+        else discoverAspect iid aspectRecord   case EM.lookup iid itemD of     Nothing -> atomicFail "discovered item unheard of"     Just item -> case jkind item of-      IdentityObvious _ -> discoverAtMostSeed+      IdentityObvious _ -> discoverAtMostAspect       IdentityCovered ix _ik -> case EM.lookup ix discoKind of-        Just{} -> discoverAtMostSeed+        Just{} -> discoverAtMostAspect         Nothing -> do           discoverKind ix ik-          unless kmIsConst $ discoverSeed iid seed+          unless kmIsConst $ discoverAspect iid aspectRecord   resetActorAspect -updCover :: Container -> ItemId -> ContentId ItemKind -> IA.ItemSeed -> m ()-updCover _c _iid _ik _seed = undefined+updCover :: Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord -> m ()+updCover _c _iid _ik _aspectRecord = undefined  updDiscoverKind :: MonadStateWrite m                 => Container -> ItemKindIx -> ContentId ItemKind -> m ()@@ -602,9 +603,9 @@ updCoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m () updCoverKind _c _ix _ik = undefined -updDiscoverSeed :: MonadStateWrite m-                => Container -> ItemId -> IA.ItemSeed -> m ()-updDiscoverSeed _c iid seed = do+updDiscoverAspect :: MonadStateWrite m+                  => Container -> ItemId -> IA.AspectRecord -> m ()+updDiscoverAspect _c iid aspectRecord = do   COps{coItemSpeedup} <- getsState scops   itemD <- getsState sitemD   case EM.lookup iid itemD of@@ -615,27 +616,21 @@       discoAspect <- getsState sdiscoAspect       let kmIsConst = IA.kmConst $ IK.getKindMean kindId coItemSpeedup       if kmIsConst || iid `EM.member` discoAspect-      then atomicFail "item seed already discovered"+      then atomicFail "item aspectRecord already discovered"       else do-        discoverSeed iid seed+        discoverAspect iid aspectRecord         resetActorAspect -discoverSeed :: MonadStateWrite m => ItemId -> IA.ItemSeed -> m ()-discoverSeed iid seed = do-  item <- getsState $ getItemBody iid-  totalDepth <- getsState stotalDepth-  Level{ldepth} <- getLevel $ jlid item-  -- Here we know the kind information is exact, hence @getItemKindServer@.-  kind <- getsState $ getItemKindServer item-  let aspects = IA.seedToAspect seed (IK.iaspects kind) ldepth totalDepth-      f Nothing = Just aspects-      f Just{} = error $ "already discovered" `showFailure` (iid, seed)+discoverAspect :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()+discoverAspect iid aspectRecord = do+  let f Nothing = Just aspectRecord+      f Just{} = error $ "already discovered" `showFailure` (iid, aspectRecord)   -- At this point we know the item is not @kmConst@.   modifyState $ updateDiscoAspect $ \discoAspect1 ->     EM.alter f iid discoAspect1 -updCoverSeed :: Container -> ItemId -> IA.ItemSeed -> m ()-updCoverSeed _c _iid _seed = undefined+updCoverAspect :: Container -> ItemId -> IA.AspectRecord -> m ()+updCoverAspect _c _iid _aspectRecord = undefined  updDiscoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m () updDiscoverServer iid aspectRecord =

@@ -136,8 +136,8 @@   UpdCover c _ _ _ -> singleContainer c   UpdDiscoverKind c _ _ -> singleContainer c   UpdCoverKind c _ _ -> singleContainer c-  UpdDiscoverSeed c _ _ -> singleContainer c-  UpdCoverSeed c _ _ -> singleContainer c+  UpdDiscoverAspect c _ _ -> singleContainer c+  UpdCoverAspect c _ _ -> singleContainer c   UpdDiscoverServer{} -> return PosSer   UpdCoverServer{} -> return PosSer   UpdPerception{} -> return PosNone

@@ -9,12 +9,11 @@   ( -- * Re-exported from "Game.LambdaHack.Client.LoopM"     loopCli     -- * Re-exported from "Game.LambdaHack.Client.Request"-  , RequestAI, ReqAI(..), RequestUI, ReqUI(..)-  , RequestAnyAbility(..), RequestTimed(..)+  , RequestAI, ReqAI(..), RequestUI, ReqUI(..), RequestTimed(..)     -- * Re-exported from "Game.LambdaHack.Client.Response"   , Response (..)     -- * Re-exported from "Game.LambdaHack.Client.ClientOptions"-  , ClientOptions, defClientOptions, sbenchmark+  , ClientOptions(..), defClientOptions     -- * Re-exported from "Game.LambdaHack.Client.UI"   , KeyKind   , UIOptions, applyUIOptions, uCmdline, mkUIOptions

@@ -1,4 +1,3 @@-{-# LANGUAGE GADTs #-} -- | 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@@ -41,7 +40,7 @@   (aidToMove, treq, oldFlee) <- pickActorAndAction Nothing aid   (aidToMove2, treq2) <-     case treq of-      RequestAnyAbility ReqWait | mleader == Just aid -> do+      ReqWait | mleader == Just aid -> do         -- Leader waits; a waste; try once to pick a yet different leader.         -- Undo state changes in @pickAction@:         modifyClient $ \cli -> cli@@ -58,8 +57,8 @@ -- | Pick an actor to move and an action for him to perform, given an optional -- previous candidate actor and action and the server-proposed actor. pickActorAndAction :: MonadClient m-                   => Maybe (ActorId, RequestAnyAbility) -> ActorId-                   -> m (ActorId, RequestAnyAbility, Maybe Point)+                   => Maybe (ActorId, RequestTimed) -> ActorId+                   -> m (ActorId, RequestTimed, Maybe Point) -- This inline speeds up execution by 15% and decreases allocation by 15%, -- despite probably bloating executable: {-# INLINE pickActorAndAction #-}

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} -- | AI procedure for picking the best action for an actor. module Game.LambdaHack.Client.AI.HandleAbilityM   ( pickAction@@ -8,7 +7,7 @@   , waitBlockNow, pickup, equipItems, toShare, yieldUnneeded, unEquipItems   , groupByEqpSlot, bestByEqpSlot, harmful, meleeBlocker, meleeAny   , trigger, projectItem, ApplyItemGroup, applyItem, flee-  , displaceFoe, displaceBlocker, displaceTowards+  , displaceFoe, displaceBlocker, displaceTgt   , chase, moveTowards, moveOrRunAid #endif   ) where@@ -56,7 +55,7 @@ import           Game.LambdaHack.Content.ModeKind  -- | Pick the most desirable AI ation for the actor.-pickAction :: MonadClient m => ActorId -> Bool -> m RequestAnyAbility+pickAction :: MonadClient m => ActorId -> Bool -> m RequestTimed {-# INLINE pickAction #-} pickAction aid retry = do   side <- getsClient sside@@ -77,15 +76,10 @@   -- Run the AI: chose an action from those given by the AI strategy.   rndToAction $ frequency bestAction -type ToAny a = Strategy (RequestTimed a) -> Strategy RequestAnyAbility--toAny :: ToAny a-toAny strat = RequestAnyAbility <$> strat- -- AI strategy based on actor's sight, smell, etc. -- Never empty. actionStrategy :: forall m. MonadClient m-               => ActorId -> Bool -> m (Strategy RequestAnyAbility)+               => ActorId -> Bool -> m (Strategy RequestTimed) {-# INLINE actionStrategy #-} actionStrategy aid retry = do   body <- getsState $ getActorBody aid@@ -136,8 +130,10 @@       canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL       actorMaxSk = IA.aSkills ar       abInMaxSkill ab = EM.findWithDefault 0 ab actorMaxSk > 0-      stratToFreq :: Int -> m (Strategy RequestAnyAbility)-                  -> m (Frequency RequestAnyAbility)+      runSkills = [AbMove, AbDisplace, AbAlter]+      stratToFreq :: Int+                  -> m (Strategy RequestTimed)+                  -> m (Frequency RequestTimed)       stratToFreq scale mstrat = do         st <- mstrat         return $! if scale == 0@@ -146,13 +142,13 @@       -- Order matters within the list, because it's summed with .| after       -- filtering. Also, the results of prefix, distant and suffix       -- are summed with .| at the end.-      prefix, suffix :: [([Ability], m (Strategy RequestAnyAbility), Bool)]+      prefix, suffix :: [([Ability], m (Strategy RequestTimed), Bool)]       prefix =-        [ ( [AbApply], (toAny :: ToAny 'AbApply)-            <$> applyItem aid ApplyFirstAid+        [ ( [AbApply]+          , applyItem aid ApplyFirstAid           , not condAnyFoeAdj && condHpTooLow)-        , ( [AbAlter], (toAny :: ToAny 'AbAlter)-            <$> trigger aid ViaStairs+        , ( [AbAlter]+          , trigger aid ViaStairs               -- explore next or flee via stairs, even if to wrong level;               -- in the latter case, may return via different stairs later on           , condAdjTriggerable && not condAimEnemyPresent@@ -163,16 +159,16 @@         , ( [AbDisplace]           , displaceFoe aid  -- only swap with an enemy to expose him           , condAnyFoeAdj && condBlocksFriends)  -- later checks foe eligible-        , ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)-            <$> pickup aid True+        , ( [AbMoveItem]+          , pickup aid True           , condNoEqpWeapon  -- we assume organ weapons usually inferior             && condFloorWeapon && not condHpTooLow             && abInMaxSkill AbMelee )-        , ( [AbAlter], (toAny :: ToAny 'AbAlter)-            <$> trigger aid ViaEscape+        , ( [AbAlter]+          , trigger aid ViaEscape           , condAdjTriggerable && not condAimEnemyPresent             && not condDesirableFloorItem )  -- collect the last loot-        , ( [AbMove]+        , ( runSkills           , flee aid fleeL           , -- Flee either from melee, if our melee is bad and enemy close             -- or from missiles, if hit and enemies are only far away,@@ -200,24 +196,24 @@                     not condInMelee                     && heavilyDistressed                     && (not condCanProject || canFleeFromLight) )-        , ( [AbMelee], (toAny :: ToAny 'AbMelee)-            <$> meleeBlocker aid  -- only melee blocker+        , ( [AbMelee]+          , meleeBlocker aid  -- only melee blocker           , condAnyFoeAdj  -- if foes, don't displace, otherwise friends:             || not (abInMaxSkill AbDisplace)  -- displace friends, if possible                && condAimEnemyPresent )  -- excited                     -- So animals block each other until hero comes and then                     -- the stronger makes a show for him and kills the weaker.-        , ( [AbAlter], (toAny :: ToAny 'AbAlter)-            <$> trigger aid ViaNothing+        , ( [AbAlter]+          , trigger aid ViaNothing           , not condInMelee  -- don't incur overhead             && condAdjTriggerable && not condAimEnemyPresent )         , ( [AbDisplace]  -- prevents some looping movement           , displaceBlocker aid retry  -- fires up only when path blocked           , retry || not condDesirableFloorItem )-        , ( [AbMelee], (toAny :: ToAny 'AbMelee)-            <$> meleeAny aid+        , ( [AbMelee]+          , meleeAny aid           , condAnyFoeAdj )  -- won't flee nor displace, so let it melee-        , ( [AbMove]+        , ( runSkills           , flee aid panicFleeL  -- ultimate panic mode, displaces foes           , condAnyFoeAdj )         ]@@ -226,16 +222,15 @@       -- so if any of these can fire, it will fire. If none, @suffix@ is tried.       -- Only the best variant of @chase@ is taken, but it's almost always       -- good, and if not, the @chase@ in @suffix@ may fix that.-      distant :: [([Ability], m (Frequency RequestAnyAbility), Bool)]+      distant :: [([Ability], m (Frequency RequestTimed), Bool)]       distant =         [ ( [AbMoveItem]           , stratToFreq (if condInMelee then 2 else 20000)-            $ (toAny :: ToAny 'AbMoveItem)-            <$> yieldUnneeded aid  -- 20000 to unequip ASAP, unless is thrown+            $ yieldUnneeded aid  -- 20000 to unequip ASAP, unless is thrown           , True )         , ( [AbMoveItem]-          , stratToFreq 1 $ (toAny :: ToAny 'AbMoveItem)-            <$> equipItems aid  -- doesn't take long, very useful if safe+          , stratToFreq 1+            $ equipItems aid  -- doesn't take long, very useful if safe           , not (condInMelee                  || condDesirableFloorItem                  || condNotCalmEnough@@ -243,14 +238,13 @@         , ( [AbProject]           , stratToFreq (if condTgtNonmoving then 20 else 3)               -- not too common, to leave missiles for pre-melee dance-            $ (toAny :: ToAny 'AbProject)-            <$> projectItem aid  -- equivalent of @condCanProject@ called inside+            $ projectItem aid  -- equivalent of @condCanProject@ called inside           , condAimEnemyPresent && not condInMelee )         , ( [AbApply]-          , stratToFreq 1 $ (toAny :: ToAny 'AbApply)-            <$> applyItem aid ApplyAll  -- use any potion or scroll+          , stratToFreq 1+            $ applyItem aid ApplyAll  -- use any potion or scroll           , condAimEnemyPresent || condThreat 9 )  -- can affect enemies-        , ( [AbMove]+        , ( runSkills           , stratToFreq (if | condInMelee ->                               400  -- friends pummeled by target, go to help                             | not condAimEnemyPresent ->@@ -275,13 +269,13 @@         ]       -- Order matters again.       suffix =-        [ ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)-            <$> pickup aid False  -- e.g., to give to other party members+        [ ( [AbMoveItem]+          , pickup aid False  -- e.g., to give to other party members           , not condInMelee )-        , ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)-            <$> unEquipItems aid  -- late, because these items not bad+        , ( [AbMoveItem]+          , unEquipItems aid  -- late, because these items not bad           , not condInMelee )-        , ( [AbMove]+        , ( runSkills           , chase aid (not condInMelee                        && heavilyDistressed                        && aCanDeLight) retry@@ -289,8 +283,8 @@             else not (condThreat 2) || not condMeleeBad )         ]       fallback =-        [ ( [AbWait], (toAny :: ToAny 'AbWait)-            <$> waitBlockNow+        [ ( [AbWait]+          , waitBlockNow             -- Wait until friends sidestep; ensures strategy is never empty.           , True )         ]@@ -298,7 +292,7 @@   -- as non-leader action.   let abInSkill ab = EM.findWithDefault 0 ab actorSk > 0       checkAction :: ([Ability], m a, Bool) -> Bool-      checkAction (abts, _, cond) = all abInSkill abts && cond+      checkAction (abts, _, cond) = any abInSkill abts && cond       sumS abAction = do         let as = filter checkAction abAction         strats <- mapM (\(_, m, _) -> m) as@@ -314,11 +308,10 @@   sumFallback <- sumS fallback   return $! sumPrefix .| comDistant .| sumSuffix .| sumFallback -waitBlockNow :: MonadClient m => m (Strategy (RequestTimed 'AbWait))+waitBlockNow :: MonadClient m => m (Strategy RequestTimed) waitBlockNow = return $! returN "wait" ReqWait -pickup :: MonadClient m-       => ActorId -> Bool -> m (Strategy (RequestTimed 'AbMoveItem))+pickup :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed) pickup aid onlyWeapon = do   benItemL <- benGroundItems aid   b <- getsState $ getActorBody aid@@ -356,8 +349,7 @@ -- and with @inEqp@ (which implies @goesIntoEqp@). -- Such items are moved between any stores, as needed. In this case, -- from inv or sha to eqp.-equipItems :: MonadClient m-           => ActorId -> m (Strategy (RequestTimed 'AbMoveItem))+equipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed) equipItems aid = do   body <- getsState $ getActorBody aid   ar <- getsState $ getActorAspect aid@@ -421,8 +413,7 @@ toShare IA.EqpSlotMiscAbility = False toShare _ = True -yieldUnneeded :: MonadClient m-              => ActorId -> m (Strategy (RequestTimed 'AbMoveItem))+yieldUnneeded :: MonadClient m => ActorId -> m (Strategy RequestTimed) yieldUnneeded aid = do   body <- getsState $ getActorBody aid   ar <- getsState $ getActorAspect aid@@ -457,8 +448,7 @@ -- and with @inEqp@ (which implies @goesIntoEqp@). -- Such items are moved between any stores, as needed. In this case, -- from inv or eqp to sha.-unEquipItems :: MonadClient m-             => ActorId -> m (Strategy (RequestTimed 'AbMoveItem))+unEquipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed) unEquipItems aid = do   body <- getsState $ getActorBody aid   ar <- getsState $ getActorAspect aid@@ -561,7 +551,7 @@   not $ benInEqp $ discoBenefit EM.! iid  -- Everybody melees in a pinch, even though some prefer ranged attacks.-meleeBlocker :: MonadClient m => ActorId -> m (Strategy (RequestTimed 'AbMelee))+meleeBlocker :: MonadClient m => ActorId -> m (Strategy RequestTimed) meleeBlocker aid = do   b <- getsState $ getActorBody aid   actorAspect <- getsState sactorAspect@@ -588,8 +578,8 @@           -- No problem if there are many projectiles at the spot. We just           -- attack the first one.           if | actorDying body2-               || bproj body2  -- displacing saves a move-                  && EM.findWithDefault 0 AbDisplace actorSk <= 0 ->+               || bproj body2  -- displacing saves a move, so don't melee+                  && EM.findWithDefault 0 AbDisplace actorSk > 0 ->                return reject              | isFoe (bfid b) fact (bfid body2)                  -- at war with us, so hit, not displace@@ -606,7 +596,7 @@  -- Everybody melees in a pinch, skills and weapons allowing, -- even though some prefer ranged attacks.-meleeAny :: MonadClient m => ActorId -> m (Strategy (RequestTimed 'AbMelee))+meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed) meleeAny aid = do   b <- getsState $ getActorBody aid   fact <- getsState $ (EM.! bfid b) . sfactionD@@ -634,7 +624,7 @@ -- the actor doesn't target a visible enemy at this point. trigger :: MonadClient m         => ActorId -> FleeViaStairsOrEscape-        -> m (Strategy (RequestTimed 'AbAlter))+        -> m (Strategy RequestTimed) trigger aid fleeVia = do   b <- getsState $ getActorBody aid   lvl <- getLevel (blid b)@@ -647,8 +637,7 @@     [ (ceiling benefit, ReqAlter pos)     | (benefit, (pos, _)) <- efeat ] -projectItem :: MonadClient m-            => ActorId -> m (Strategy (RequestTimed 'AbProject))+projectItem :: MonadClient m => ActorId -> m (Strategy RequestTimed) projectItem aid = do   btarget <- getsClient $ getTarget aid   b <- getsState $ getActorBody aid@@ -698,7 +687,7 @@   deriving Eq  applyItem :: MonadClient m-          => ActorId -> ApplyItemGroup -> m (Strategy (RequestTimed 'AbApply))+          => ActorId -> ApplyItemGroup -> m (Strategy RequestTimed) applyItem aid applyGroup = do   actorSk <- currentSkillsClient aid   b <- getsState $ getActorBody aid@@ -796,7 +785,7 @@ -- and as far from the attackers, as possible. Usually fleeing from -- foes will lead towards friends, but we don't insist on that. flee :: MonadClient m-     => ActorId -> [(Int, Point)] -> m (Strategy RequestAnyAbility)+     => ActorId -> [(Int, Point)] -> m (Strategy RequestTimed) flee aid fleeL = do   b <- getsState $ getActorBody aid   -- Regardless if fleeing accomplished, mark the need.@@ -807,7 +796,7 @@  -- The result of all these conditions is that AI displaces rarely, -- but it can't be helped as long as the enemy is smart enough to form fronts.-displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestAnyAbility)+displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestTimed) displaceFoe aid = do   COps{coTileSpeedup} <- getsState scops   b <- getsState $ getActorBody aid@@ -815,11 +804,13 @@   fact <- getsState $ (EM.! bfid b) . sfactionD   friends <- getsState $ friendRegularList (bfid b) (blid b)   adjacentAssocs <- getsState $ actorAdjacentAssocs b-  let foe (_, b2) =-        not (bproj b2) && isFoe (bfid b) fact (bfid b2) && bhp b2 > 0+  let foe (_, b2) = not (bproj b2) && isFoe (bfid b) fact (bfid b2)+        -- DisplaceProjectiles       adjFoes = filter foe adjacentAssocs-      displaceable body =  -- DisplaceAccess-        Tile.isWalkable coTileSpeedup (lvl `at` bpos body)+      walkable p =  -- DisplaceAccess+        Tile.isWalkable coTileSpeedup (lvl `at` p)+      notLooping body p =  -- avoid displace loops+        boldpos body /= Just p || waitedLastTurn body       nFriends body = length $ filter (adjacent (bpos body) . bpos) friends       nFrNew = nFriends b + 1       qualifyActor (aid2, body2) = do@@ -827,40 +818,40 @@         dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk           -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported         let nFrOld = nFriends body2-        return $! if displaceable body2 && dEnemy && nFrOld < nFrNew-                  then Just (nFrOld * nFrOld, bpos body2 `vectorToFrom` bpos b)+        return $! if walkable (bpos body2) && dEnemy && nFrOld < nFrNew+                     && notLooping b (bpos body2)+                  then Just (nFrOld * nFrOld, ReqDisplace aid2)                   else Nothing-  vFoes <- mapM qualifyActor adjFoes-  let str = liftFrequency $ toFreq "displaceFoe" $ catMaybes vFoes-  mapStrategyM (moveOrRunAid aid) str+  foes <- mapM qualifyActor adjFoes+  return $! liftFrequency $ toFreq "displaceFoe" $ catMaybes foes -displaceBlocker :: MonadClient m-                => ActorId -> Bool -> m (Strategy RequestAnyAbility)+displaceBlocker :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed) displaceBlocker aid retry = do   b <- getsState $ getActorBody aid   mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  str <- case mtgtMPath of+  case mtgtMPath of     Just TgtAndPath{ tapTgt=TEnemy{}                    , tapPath=AndPath{pathList=q : _, pathGoal} }       | q == pathGoal && not retry ->         return reject  -- not a real blocker but goal, possibly enemy to melee     Just TgtAndPath{tapPath=AndPath{pathList=q : _}}       | adjacent (bpos b) q ->  -- not veered off target-      displaceTowards aid q retry+      displaceTgt aid q retry     _ -> return reject  -- goal reached-  mapStrategyM (moveOrRunAid aid) str -displaceTowards :: MonadClient m-                => ActorId -> Point -> Bool -> m (Strategy Vector)-displaceTowards aid target retry = do+displaceTgt :: MonadClient m+            => ActorId -> Point -> Bool -> m (Strategy RequestTimed)+displaceTgt aid target retry = do   COps{coTileSpeedup} <- getsState scops   b <- getsState $ getActorBody aid   let source = bpos b   let !_A = assert (adjacent source target) ()   lvl <- getLevel $ blid b-  if boldpos b /= Just target -- avoid trivial loops-     && Tile.isWalkable coTileSpeedup (lvl `at` target) then do-       -- DisplaceAccess+  let walkable p =  -- DisplaceAccess+        Tile.isWalkable coTileSpeedup (lvl `at` p)+      notLooping body p =  -- avoid displace loops+        boldpos body /= Just p || waitedLastTurn body+  if walkable target && notLooping b target then do     mleader <- getsClient sleader     mBlocker <- getsState $ posToAssocs target (blid b)     case mBlocker of@@ -881,20 +872,21 @@                  -- he doesn't have Enemy target and I have, so push him aside,                  -- because, for heroes, he will never be a leader, so he can't                  -- step aside himself-              return $! returN "displace friend" $ target `vectorToFrom` source+              return $! returN "displace friend" $ ReqDisplace aid2           Just _ -> return reject           Nothing -> do  -- an enemy or ally or disoriented friend --- swap             tfact <- getsState $ (EM.! bfid b2) . sfactionD             actorMaxSk <- maxActorSkillsClient aid2             dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk+              -- DisplaceDying, DisplaceBraced, DisplaceImmobile,+              -- DisplaceSupported             if not (isFoe (bfid b2) tfact (bfid b)) || dEnemy then-              return $! returN "displace other" $ target `vectorToFrom` source-            else return reject  -- DisplaceDying, etc.+              return $! returN "displace other" $ ReqDisplace aid2+            else return reject       _ -> return reject  -- DisplaceProjectiles or trying to displace leader   else return reject -chase :: MonadClient m-      => ActorId -> Bool -> Bool -> m (Strategy RequestAnyAbility)+chase :: MonadClient m => ActorId -> Bool -> Bool -> m (Strategy RequestTimed) chase aid avoidAmbient retry = do   COps{coTileSpeedup} <- getsState scops   body <- getsState $ getActorBody aid@@ -955,15 +947,17 @@ -- Actor moves or searches or alters or attacks. -- This function is very general, even though it's often used in contexts -- when only one or two of the many cases can possibly occur.-moveOrRunAid :: MonadClient m-             => ActorId -> Vector -> m (Maybe RequestAnyAbility)+moveOrRunAid :: MonadClient m => ActorId -> Vector -> m (Maybe RequestTimed) moveOrRunAid source dir = do   COps{coTileSpeedup} <- getsState scops   sb <- getsState $ getActorBody source   actorSk <- currentSkillsClient source   let lid = blid sb   lvl <- getLevel lid-  let alterSkill = EM.findWithDefault 0 AbAlter actorSk+  let walkable =  -- DisplaceAccess+        Tile.isWalkable coTileSpeedup (lvl `at` tpos)+      notLooping body p =  -- avoid displace loops+        boldpos body /= Just p || waitedLastTurn body       spos = bpos sb           -- source position       tpos = spos `shift` dir  -- target position       t = lvl `at` tpos@@ -973,44 +967,27 @@   -- (tiles can't be invisible).   tgts <- getsState $ posToAssocs tpos lid   case tgts of-    [(target, b2)] -> do+    [(target, b2)] | walkable+                     && EM.findWithDefault 0 AbDisplace actorSk > 0+                     && notLooping sb tpos -> do       -- @target@ can be a foe, as well as a friend.       tfact <- getsState $ (EM.! bfid b2) . sfactionD       actorMaxSk <- maxActorSkillsClient target       dEnemy <- getsState $ dispEnemy source target actorMaxSk-      if | boldpos sb == Just tpos && not (waitedLastTurn sb)-             -- avoid displace loops-           || not (Tile.isWalkable coTileSpeedup $ lvl `at` tpos) ->-             -- DisplaceAccess-           return Nothing-         | isFoe (bfid b2) tfact (bfid sb)-           && not dEnemy -> do  -- DisplaceDying, etc.-           -- If really can't displace, melee.-           wps <- pickWeaponClient source target-           case wps of-             Nothing -> return Nothing-             Just wp -> return $ Just $ RequestAnyAbility wp-         | otherwise ->-           return $ Just $ RequestAnyAbility $ ReqDisplace target-    (target, _) : _ -> do  -- can be a foe, as well as friend (e.g., projectile)-      -- If really can't displace, melee.-      -- No problem if there are many projectiles at the spot. We just-      -- attack the first one.-      -- Attacking does not require full access, adjacency is enough.-      wps <- pickWeaponClient source target-      case wps of-        Nothing -> return Nothing-        Just wp -> return $ Just $ RequestAnyAbility wp-    [] -- move or search or alter-       | Tile.isWalkable coTileSpeedup $ lvl `at` tpos ->-         -- Movement requires full access.-         return $ Just $ RequestAnyAbility $ ReqMove dir-         -- The potential invisible actor is hit.-       | alterSkill < Tile.alterMinWalk coTileSpeedup t ->-         error $ "AI causes AlterUnwalked" `showFailure` (source, dir)-       | EM.member tpos $ lfloor lvl ->-         -- Only possible if items allowed inside unwalkable tiles.-         error $ "AI causes AlterBlockItem" `showFailure` (source, dir)-       | otherwise ->-         -- Not walkable, but alter skill suffices, so search or alter the tile.-         return $ Just $ RequestAnyAbility $ ReqAlter tpos+        -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported+      if isFoe (bfid b2) tfact (bfid sb) && not dEnemy+      then return Nothing+      else return $ Just $ ReqDisplace target+    [] | walkable && EM.findWithDefault 0 AbMove actorSk > 0 ->+      -- Movement requires full access. The potential invisible actor is hit.+      return $ Just $ ReqMove dir+    [] | not walkable+         && EM.findWithDefault 0 AbAlter actorSk+              >= Tile.alterMinWalk coTileSpeedup t  -- AlterUnwalked+         -- Only possible if items allowed inside unwalkable tiles:+         && EM.notMember tpos (lfloor lvl) ->  -- AlterBlockItem+      -- Not walkable, but alter skill suffices, so search or alter the tile.+      -- We assume that unalterable unwalkable tiles are protected+      -- by high skill req. We don't alter walkable tiles (e.g., close doors).+      return $ Just $ ReqAlter tpos+    _ -> return Nothing  -- can't displace, move nor alter

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} -- | Common client monad operations. module Game.LambdaHack.Client.CommonM   ( getPerFid, aidTgtToPos, makeLine@@ -136,7 +135,7 @@ -- primitive and random here as well. pickWeaponClient :: MonadClient m                  => ActorId -> ActorId-                 -> m (Maybe (RequestTimed 'Ability.AbMelee))+                 -> m (Maybe RequestTimed) pickWeaponClient source target = do   eqpAssocs <- getsState $ kitAssocs source [CEqp]   bodyAssocs <- getsState $ kitAssocs source [COrgan]

@@ -6,7 +6,7 @@     -- * Internal operations   , wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs, createActor, destroyActor   , addItemToDiscoBenefit, perception-  , discoverKind, coverKind, discoverSeed, coverSeed+  , discoverKind, coverKind, discoverAspect, coverAspect   , killExit #endif   ) where@@ -148,7 +148,7 @@   UpdLoseTile lid ts -> do     updateSalter lid ts     invalidateBfsLid lid  -- from known to unknown tiles-  UpdDiscover c iid ik seed -> do+  UpdDiscover c iid ik aspectRecord -> do     item <- getsState $ getItemBody iid     discoKind <- getsState sdiscoKind     case jkind item of@@ -156,9 +156,9 @@       IdentityCovered ix _ik | ix `EM.notMember` discoKind ->         discoverKind c ix ik       IdentityCovered _ix _ik -> return ()-    discoverSeed c iid seed-  UpdCover c iid ik seed -> do-    coverSeed c iid seed+    discoverAspect c iid aspectRecord+  UpdCover c iid ik aspectRecord -> do+    coverAspect c iid aspectRecord     item <- getsState $ getItemBody iid     discoKind <- getsState sdiscoKind     case jkind item of@@ -168,8 +168,8 @@       IdentityCovered _ix _ik -> return ()   UpdDiscoverKind c ix ik -> discoverKind c ix ik   UpdCoverKind c ix ik -> coverKind c ix ik-  UpdDiscoverSeed c iid seed -> discoverSeed c iid seed-  UpdCoverSeed c iid seed -> coverSeed c iid seed+  UpdDiscoverAspect c iid aspectRecord -> discoverAspect c iid aspectRecord+  UpdCoverAspect c iid aspectRecord -> coverAspect c iid aspectRecord   UpdPerception lid outPer inPer -> perception lid outPer inPer   UpdRestart side sfper s scurChal soptions -> do     COps{cocave, comode} <- getsState scops@@ -276,8 +276,9 @@   cops <- getsState scops   discoBenefit <- getsClient sdiscoBenefit   case EM.lookup iid discoBenefit of-    Just{} -> return ()  -- already there, with real or provisional aspects,-                         -- but we haven't learned anything new about the item+    Just{} -> return ()+      -- already there, with real or provisional aspect record,+      -- but we haven't learned anything new about the item     Nothing -> do       side <- getsClient sside       fact <- getsState $ (EM.! side) . sfactionD@@ -332,8 +333,9 @@ coverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m () coverKind _c _ix _ik = undefined -discoverSeed :: MonadClient m => Container -> ItemId -> IA.ItemSeed -> m ()-discoverSeed _c iid _seed = do+discoverAspect :: MonadClient m+               => Container -> ItemId -> IA.AspectRecord -> m ()+discoverAspect _c iid _aspectRecord = do   cops <- getsState scops   -- Wipe out BFS, because the player could potentially learn that his items   -- affect his actors' skills relevant to BFS.@@ -346,8 +348,8 @@   modifyClient $ \cli ->     cli {sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli)} -coverSeed :: Container -> ItemId -> IA.ItemSeed -> m ()-coverSeed _c _iid _seed = undefined+coverAspect :: Container -> ItemId -> IA.AspectRecord -> m ()+coverAspect _c _iid _aspectRecord = undefined  killExit :: MonadClient m => m () killExit = do

@@ -1,18 +1,15 @@-{-# LANGUAGE DataKinds, GADTs, KindSignatures, StandaloneDeriving #-} -- | Abstract syntax of requests. -- -- See -- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>. module Game.LambdaHack.Client.Request-  ( RequestAI, ReqAI(..), RequestUI, ReqUI(..)-  , RequestAnyAbility(..), RequestTimed(..)+  ( RequestAI, ReqAI(..), RequestUI, ReqUI(..), RequestTimed(..)   ) where  import Prelude ()  import Game.LambdaHack.Common.Prelude -import Game.LambdaHack.Common.Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item@@ -28,7 +25,7 @@ -- | Possible forms of requests sent by AI clients. data ReqAI =     ReqAINop-  | ReqAITimed RequestAnyAbility+  | ReqAITimed RequestTimed   deriving Show  -- | Requests sent by UI clients to the server. If faction leader is to be@@ -38,7 +35,7 @@ -- | Possible forms of requests sent by UI clients. data ReqUI =     ReqUINop-  | ReqUITimed RequestAnyAbility+  | ReqUITimed RequestTimed   | ReqUIGameRestart (GroupName ModeKind) Challenge   | ReqUIGameDropAndExit   | ReqUIGameSaveAndExit@@ -47,22 +44,16 @@   | ReqUIAutomate   deriving Show --- | Basic form of requests, sent by both AI and UI clients to the server.-data RequestAnyAbility = forall a. RequestAnyAbility (RequestTimed a)--deriving instance Show RequestAnyAbility- -- | Requests that take game time, indexed by actor ability -- that is needed for performing the corresponding actions.-data RequestTimed :: Ability -> * where-  ReqMove :: Vector -> RequestTimed 'AbMove-  ReqMelee :: ActorId -> ItemId -> CStore -> RequestTimed 'AbMelee-  ReqDisplace :: ActorId -> RequestTimed 'AbDisplace-  ReqAlter :: Point -> RequestTimed 'AbAlter-  ReqWait :: RequestTimed 'AbWait-  ReqWait10 :: RequestTimed 'AbWait-  ReqMoveItems :: [(ItemId, Int, CStore, CStore)] -> RequestTimed 'AbMoveItem-  ReqProject :: Point -> Int -> ItemId -> CStore -> RequestTimed 'AbProject-  ReqApply :: ItemId -> CStore -> RequestTimed 'AbApply--deriving instance Show (RequestTimed a)+data RequestTimed =+    ReqMove Vector+  | ReqMelee ActorId ItemId CStore+  | ReqDisplace ActorId+  | ReqAlter Point+  | ReqWait+  | ReqWait10+  | ReqMoveItems [(ItemId, Int, CStore, CStore)]+  | ReqProject Point Int ItemId CStore+  | ReqApply ItemId CStore+  deriving Show

@@ -296,8 +296,8 @@   UpdCover{} -> return ()  -- don't spam when doing undo   UpdDiscoverKind{} -> return ()  -- don't spam when server tweaks stuff   UpdCoverKind{} -> return ()  -- don't spam when doing undo-  UpdDiscoverSeed{} -> return ()  -- don't spam when server tweaks stuff-  UpdCoverSeed{} -> return ()  -- don't spam when doing undo+  UpdDiscoverAspect{} -> return ()  -- don't spam when server tweaks stuff+  UpdCoverAspect{} -> return ()  -- don't spam when doing undo   UpdDiscoverServer{} -> error "server command leaked to client"   UpdCoverServer{} -> error "server command leaked to client"   UpdPerception{} -> return ()

@@ -270,12 +270,11 @@  drawFrameActor :: forall m. MonadClientUI m => LevelId -> m FrameForall drawFrameActor drawnLevelId = do-  SessionUI{sselected} <- getSession+  SessionUI{sactorUI, sselected, sUIOptions} <- getSession   Level{lxsize, lactor} <- getLevel drawnLevelId   side <- getsClient sside   mleader <- getsClient sleader   s <- getState-  sactorUI <- getsSession sactorUI   let {-# INLINE viewActor #-}       viewActor _ as = case as of         aid : _ ->@@ -292,8 +291,14 @@                                        then Color.HighlightWhite                                        else Color.HighlightMagenta                         | otherwise -> Color.HighlightNone-          in Color.attrCharToW32-             $ Color.AttrChar Color.Attr{fg=bcolor, bg} symbol+              fg | bfid /= side || bproj || bhp <= 0 = bcolor+                 | otherwise =+                let (hpCheckWarning, calmCheckWarning) =+                      checkWarnings sUIOptions aid s+                in if hpCheckWarning || calmCheckWarning+                   then Color.Red+                   else bcolor+         in Color.attrCharToW32 $ Color.AttrChar Color.Attr{..} symbol         [] -> error $ "lactor not sparse" `showFailure` ()       mapVAL :: forall a s. (Point -> a -> Color.AttrCharW32) -> [(Point, a)]              -> FrameST s@@ -501,29 +506,36 @@               $ T.take 29 (lvlN <+> T.justifyLeft 26 ' ' (cname ck))                 <+> seenStatus +checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)+checkWarnings UIOptions{uhpWarningPercent} leader s =+  let b = getActorBody leader s+      ar = getActorAspect leader s+      isImpression iid =+        maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getIidKind iid s+      isImpressed = any isImpression $ EM.keys $ borgan b+      hpCheckWarning = bhp b <= xM (uhpWarningPercent * IA.aMaxHP ar `div` 100)+      calmCheckWarning =+        bcalm b <= xM (uhpWarningPercent * IA.aMaxCalm ar `div` 100)+        && isImpressed+  in (hpCheckWarning, calmCheckWarning)+ drawLeaderStatus :: MonadClientUI m => Int -> m AttrLine drawLeaderStatus waitT = do   let calmHeaderText = "Calm"       hpHeaderText = "HP"-  UIOptions{uhpWarningPercent} <- getsSession sUIOptions+  sUIOptions <- getsSession sUIOptions   mleader <- getsClient sleader   case mleader of     Just leader -> do+      b <- getsState $ getActorBody leader       ar <- getsState $ getActorAspect leader-      s <- getState+      (hpCheckWarning, calmCheckWarning)+        <- getsState $ checkWarnings sUIOptions leader+      bdark <- getsState $ \s -> not (actorInAmbient b s)       let showTrunc x = let t = show x                         in if length t > 3                            then if x > 0 then "***" else "---"                            else t-          (bhpM, darkL, bracedL, hpDelta, calmDelta,-           ahpS, bhpS, acalmS, bcalmS) =-            let b@Actor{bhp, bcalm} = getActorBody leader s-            in ( bhp, not (actorInAmbient b s)-               , braced b, bhpDelta b, bcalmDelta b-               , showTrunc $ max 0 $ IA.aMaxHP ar-               , showTrunc (bhp `divUp` oneM)-               , showTrunc $ max 0 $ IA.aMaxCalm ar-               , showTrunc (bcalm `divUp` oneM))           -- This is a valuable feedback for the otherwise hard to observe           -- 'wait' command.           slashes = ["/", "|", "\\", "|"]@@ -535,30 +547,33 @@             | snd resCurrentTurn > 0 || snd resPreviousTurn > 0               = addColor Color.BrGreen             | otherwise = stringToAL  -- only if nothing at all noteworthy-          checkWarning =-            if bhpM <= xM (uhpWarningPercent * IA.aMaxHP ar `div` 100)-            then addColor Color.Red-            else stringToAL-          calmAddAttr = checkDelta calmDelta+          calmAddAttr = checkDelta $ bcalmDelta b           -- We only show ambient light, because in fact client can't tell           -- if a tile is lit, because it it's seen it may be due to ambient           -- or dynamic light or due to infravision.-          darkPick | darkL   = "."+          darkPick | bdark = "."                    | otherwise = ":"           calmHeader = calmAddAttr $ calmHeaderText <> darkPick-          calmText = bcalmS <> (if darkL || not bracedL-                                then slashPick-                                else "/") <> acalmS-          bracePick | bracedL   = "}"+          calmText = showTrunc (bcalm b `divUp` oneM)+                     <> (if bdark || not (braced b)+                         then slashPick+                         else "/")+                     <> showTrunc (max 0 $ IA.aMaxCalm ar)+          bracePick | braced b  = "}"                     | otherwise = ":"-          hpAddAttr = checkDelta hpDelta+          hpAddAttr = checkDelta $ bhpDelta b           hpHeader = hpAddAttr $ hpHeaderText <> bracePick-          hpText = bhpS <> (if bracedL || not darkL-                            then slashPick-                            else "/") <> ahpS+          hpText = showTrunc (bhp b `divUp` oneM)+                   <> (if braced b || not bdark+                       then slashPick+                       else "/")+                   <> showTrunc (max 0 $ IA.aMaxHP ar)           justifyRight n t = replicate (n - length t) ' ' ++ t-      return $! calmHeader <> stringToAL (justifyRight 7 calmText)-                <+:> hpHeader <> checkWarning (justifyRight 7 hpText)+          colorWarning w = if w then addColor Color.Red else stringToAL+      return $! calmHeader+                <> colorWarning calmCheckWarning (justifyRight 7 calmText)+                <+:> hpHeader+                <> colorWarning hpCheckWarning (justifyRight 7 hpText)     Nothing -> return $! stringToAL (calmHeaderText ++ ":  --/--")                          <+:> stringToAL (hpHeaderText <> ":  --/--") 

@@ -10,12 +10,12 @@ import Game.LambdaHack.Common.Prelude  import           Control.Concurrent-import           Control.Concurrent.Async import qualified Control.Concurrent.STM as STM  import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Key (KMP (..)) import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Common.Misc import           Game.LambdaHack.Common.Point  -- | Raw frontend definition. The minimal closed set of values that need@@ -28,11 +28,26 @@   , fprintScreen :: IO ()   } +-- | Start up a frontend on a bound thread.+--+-- In fact, it is started on the very main thread, via a hack, because+-- apparently some SDL backends are not thread-safe+-- (<https://wiki.libsdl.org/FAQDevelopment>;+-- "this should only be run in the thread that initialized the video subsystem,+-- and for extra safety, you should consider only doing those things+-- on the main thread in any case")+-- and at least the newer OS X obtusely requires the main thread, see+-- https://github.com/AllureOfTheStars/Allure/issues/79+-- In case any other exotic architecture requires the main thread,+-- we make the hack the default for all (on frontends that require a bound+-- thread, e.g., SLD2 or GTK). startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend startupBound k = do   rfMVar <- newEmptyMVar-  a <- asyncBound $ k rfMVar-  link a+  putMVar workaroundOnMainThreadMVar $ k rfMVar+  -- The following would run frontend on a bound thread, but it's not enough:+  -- a <- asyncBound $ k rfMVar+  -- link a   takeMVar rfMVar  createRawFrontend :: (SingleFrame -> IO ()) -> IO () -> IO RawFrontend

@@ -71,14 +71,8 @@  -- | Set up and start the main loop providing input and output. ----- Apparently some SDL backends are not thread-safe--- (<https://wiki.libsdl.org/FAQDevelopment>;--- "this should only be run in the thread that initialized the video subsystem,--- and for extra safety, you should consider only doing those things--- on the main thread in any case")--- so we stick to a single bound thread (but not to the main thread;--- enough is enough and at least in the case of OpenGL all bound threads--- are supposed to be as good as the main thread).+-- Because of Windows and OS X, SDL2 needs to be on a bound thread,+-- so we can't avoid the communication overhead of bound threads. startup :: ClientOptions -> IO RawFrontend startup soptions = startupBound $ startupFun soptions 

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds, GADTs #-} -- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd" -- client commands that return server requests. -- A couple of them do not take time, the rest does.@@ -25,8 +24,8 @@ #ifdef EXPOSE_INTERNAL     -- * Internal operations   , areaToRectangles, meleeAid, displaceAid, moveSearchAlter, goToXhair-  , multiActorGoTo, selectItemsToMove, moveItems, projectItem, applyItem-  , alterTile, alterTileAtPos, verifyAlters, verifyEscape, guessAlter+  , multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems, projectItem+  , applyItem, alterTile, alterTileAtPos, verifyAlters, verifyEscape, guessAlter   , artWithVersion, generateMenu, nxtGameMode #endif   ) where@@ -230,25 +229,32 @@ -- * Wait  -- | Leader waits a turn (and blocks, etc.).-waitHuman :: MonadClientUI m => m (RequestTimed 'AbWait)+waitHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) waitHuman = do-  modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}-  return ReqWait+  actorSk <- leaderSkillsClientUI+  if EM.findWithDefault 0 AbWait actorSk > 0 then do+    modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}+    return $ Right ReqWait+  else failSer WaitUnskilled  -- * Wait10  -- | Leader waits a 1/10th of a turn (and doesn't block, etc.).-waitHuman10 :: MonadClientUI m => m (RequestTimed 'AbWait)+waitHuman10 :: MonadClientUI m => m (FailOrCmd RequestTimed) waitHuman10 = do-  modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}-  return ReqWait10+  actorSk <- leaderSkillsClientUI+  if EM.findWithDefault 0 AbWait actorSk > 0 then do+    modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}+    return $ Right ReqWait10+  else failSer WaitUnskilled  -- * MoveDir and RunDir  moveRunHuman :: MonadClientUI m              => Bool -> Bool -> Bool -> Bool -> Vector-             -> m (FailOrCmd RequestAnyAbility)+             -> m (FailOrCmd RequestTimed) moveRunHuman initialStep finalGoal run runAhead dir = do+  actorSk <- leaderSkillsClientUI   arena <- getArenaUI   leader <- getLeaderUI   sb <- getsState $ getActorBody leader@@ -292,32 +298,40 @@           -- Don't check @initialStep@ and @finalGoal@           -- and don't stop going to target: door opening is mundane enough.           return $ Right runCmd-    [(target, _)] | run && initialStep ->+    [(target, _)] | run+                    && initialStep+                    && EM.findWithDefault 0 AbDisplace actorSk > 0 ->       -- No @stopPlayBack@: initial displace is benign enough.       -- Displacing requires accessibility, but it's checked later on.-      RequestAnyAbility <$$> displaceAid target-    _ : _ : _ | run && initialStep -> do+      displaceAid target+    _ : _ : _ | run+                && initialStep+                && EM.findWithDefault 0 AbDisplace actorSk > 0 -> do       let !_A = assert (all (bproj . snd) tgts) ()       failSer DisplaceProjectiles-    (target, tb) : _ | initialStep && finalGoal -> do+    (target, tb) : _ | not run+                       && initialStep && finalGoal+                       && bfid tb == bfid sb && not (bproj tb) -> do+      stopPlayBack  -- don't ever auto-repeat leader choice+      -- We always see actors from our own faction.+      -- Select one of adjacent actors by bumping into him. Takes no time.+      success <- pickLeader True target+      let !_A = assert (success `blame` "bump self"+                                `swith` (leader, target, tb)) ()+      failWith "by bumping"+    (target, tb) : _ | not run+                       && initialStep && finalGoal+                       && (bfid tb /= bfid sb || bproj tb)+                       && EM.findWithDefault 0 AbMelee actorSk > 0 -> do       stopPlayBack  -- don't ever auto-repeat melee       -- No problem if there are many projectiles at the spot. We just       -- attack the first one.-      -- We always see actors from our own faction.-      if bfid tb == bfid sb && not (bproj tb) then do-        -- Select adjacent actor by bumping into him. Takes no time.-        success <- pickLeader True target-        let !_A = assert (success `blame` "bump self"-                                  `swith` (leader, target, tb)) ()-        failWith "by bumping"-      else-        -- Attacking does not require full access, adjacency is enough.-        RequestAnyAbility <$$> meleeAid target+      meleeAid target     _ : _ -> failWith "actor in the way"  -- | Actor attacks an enemy actor or his own projectile. meleeAid :: MonadClientUI m-         => ActorId -> m (FailOrCmd (RequestTimed 'AbMelee))+         => ActorId -> m (FailOrCmd RequestTimed) meleeAid target = do   leader <- getLeaderUI   sb <- getsState $ getActorBody leader@@ -352,7 +366,7 @@  -- | Actor swaps position with another. displaceAid :: MonadClientUI m-            => ActorId -> m (FailOrCmd (RequestTimed 'AbDisplace))+            => ActorId -> m (FailOrCmd RequestTimed) displaceAid target = do   COps{coTileSpeedup} <- getsState scops   leader <- getLeaderUI@@ -389,14 +403,15 @@        else failSer DisplaceAccess  -- | Leader moves or searches or alters. No visible actor at the position.-moveSearchAlter :: MonadClientUI m => Vector -> m (FailOrCmd RequestAnyAbility)+moveSearchAlter :: MonadClientUI m => Vector -> m (FailOrCmd RequestTimed) moveSearchAlter dir = do   COps{coTileSpeedup} <- getsState scops+  actorSk <- leaderSkillsClientUI   leader <- getLeaderUI   sb <- getsState $ getActorBody leader   ar <- getsState $ getActorAspect leader-  actorSk <- leaderSkillsClientUI   let calmE = calmEnough sb ar+      moveSkill = EM.findWithDefault 0 AbMove actorSk       alterSkill = EM.findWithDefault 0 AbAlter actorSk       applySkill = EM.findWithDefault 0 AbApply actorSk       spos = bpos sb           -- source position@@ -418,12 +433,13 @@                    || Tile.isSuspect coTileSpeedup t   runStopOrCmd <-     -- Movement requires full access.-    if | Tile.isWalkable coTileSpeedup t ->+    if | Tile.isWalkable coTileSpeedup t && moveSkill > 0 ->          -- A potential invisible actor is hit. War started without asking.-         return $ Right $ RequestAnyAbility $ ReqMove dir-       -- No free access, so search and/or alter the tile.+         return $ Right $ ReqMove dir+       -- No free access or skill, so search and/or alter the tile.        | not (modifiable || canApplyEmbeds) ->-           failWith "never mind"  -- misclick? related to AlterNothing+           failWith "never mind"+             -- misclick? walkable but no move skill? related to AlterNothing        | alterSkill <= 1 -> failSer AlterUnskilled        | not (Tile.isSuspect coTileSpeedup t)          && alterSkill < alterMinSkill -> failSer AlterUnwalked@@ -432,7 +448,7 @@        | otherwise -> do  -- promising             verAlters <- verifyAlters (blid sb) tpos             case verAlters of-              Right() -> return $ Right $ RequestAnyAbility $ ReqAlter tpos+              Right() -> return $ Right $ ReqAlter tpos               Left err -> return $ Left err             -- We don't use ReqMove, because we don't hit invisible actors,             -- e.g., hidden in a wall. If server performed an attack for free@@ -448,7 +464,7 @@  -- * RunOnceAhead -runOnceAheadHuman :: MonadClientUI m => m (Either MError ReqUI)+runOnceAheadHuman :: MonadClientUI m => m (Either MError RequestTimed) runOnceAheadHuman = do   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD@@ -483,14 +499,14 @@           then weaveJust <$> failWith ("run stop:" <+> stopMsg)           else return $ Left Nothing         Right runCmd ->-          return $ Right $ ReqUITimed runCmd+          return $ Right runCmd  -- * MoveOnceToXhair -moveOnceToXhairHuman :: MonadClientUI m => m (FailOrCmd RequestAnyAbility)+moveOnceToXhairHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) moveOnceToXhairHuman = goToXhair True False -goToXhair :: MonadClientUI m => Bool -> Bool -> m (FailOrCmd RequestAnyAbility)+goToXhair :: MonadClientUI m => Bool -> Bool -> m (FailOrCmd RequestTimed) goToXhair initialStep run = do   aimMode <- getsSession saimMode   -- Movement is legal only outside aiming mode.@@ -501,9 +517,10 @@     xhairPos <- xhairToPos     case xhairPos of       Nothing -> failWith "crosshair position invalid"-      Just c | c == bpos b ->-        if initialStep-        then return $ Right $ RequestAnyAbility ReqWait+      Just c | c == bpos b -> do+        actorSk <- leaderSkillsClientUI+        if initialStep && EM.findWithDefault 0 AbWait actorSk > 0+        then return $ Right $ ReqWait         else failWith "position reached"       Just c -> do         running <- getsSession srunning@@ -574,24 +591,33 @@  -- * RunOnceToXhair -runOnceToXhairHuman :: MonadClientUI m => m (FailOrCmd RequestAnyAbility)+runOnceToXhairHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) runOnceToXhairHuman = goToXhair True True  -- * ContinueToXhair -continueToXhairHuman :: MonadClientUI m => m (FailOrCmd RequestAnyAbility)+continueToXhairHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) continueToXhairHuman = goToXhair False False{-irrelevant-}  -- * MoveItem --- This cannot be structured as projecting or applying, with @ByItemMode@--- and @ChooseItemToMove@, because at least in case of grabbing items,--- more than one item is chosen, which doesn't fit @sitemSel@. Separating--- grabbing of multiple items as a distinct command is too high a proce. moveItemHuman :: forall m. MonadClientUI m               => [CStore] -> CStore -> Maybe MU.Part -> Bool-              -> m (FailOrCmd (RequestTimed 'AbMoveItem))+              -> m (FailOrCmd RequestTimed) moveItemHuman cLegalRaw destCStore mverb auto = do+  actorSk <- leaderSkillsClientUI+  if EM.findWithDefault 0 AbMoveItem actorSk > 0 then+    moveOrSelectItem cLegalRaw destCStore mverb auto+  else failSer MoveItemUnskilled++-- This cannot be structured as projecting or applying, with @ByItemMode@+-- and @ChooseItemToMove@, because at least in case of grabbing items,+-- more than one item is chosen, which doesn't fit @sitemSel@. Separating+-- grabbing of multiple items as a distinct command is too high a price.+moveOrSelectItem :: forall m. MonadClientUI m+                 => [CStore] -> CStore -> Maybe MU.Part -> Bool+                 -> m (FailOrCmd RequestTimed)+moveOrSelectItem cLegalRaw destCStore mverb auto = do   itemSel <- getsSession sitemSel   modifySession $ \sess -> sess {sitemSel = Nothing}  -- prevent surprise   case itemSel of@@ -680,7 +706,7 @@  moveItems :: forall m. MonadClientUI m           => [CStore] -> (CStore, [(ItemId, ItemFullKit)]) -> CStore-          -> m (FailOrCmd (RequestTimed 'AbMoveItem))+          -> m (FailOrCmd RequestTimed) moveItems cLegalRaw (fromCStore, l) destCStore = do   leader <- getLeaderUI   b <- getsState $ getActorBody leader@@ -736,25 +762,29 @@  -- * Project -projectHuman :: MonadClientUI m => m (FailOrCmd (RequestTimed 'AbProject))+projectHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) projectHuman = do-  itemSel <- getsSession sitemSel-  case itemSel of-    Just (iid, fromCStore, _) -> do-      leader <- getLeaderUI-      b <- getsState $ getActorBody leader-      bag <- getsState $ getBodyStoreBag b fromCStore-      case iid `EM.lookup` bag of-        Nothing -> failWith "no item to fling"-        Just _kit -> do-          itemFull <- getsState $ itemToFull iid-          let i = (fromCStore, (iid, itemFull))-          projectItem i-    Nothing -> failWith "no item to fling"+  actorSk <- leaderSkillsClientUI+  if EM.findWithDefault 0 AbProject actorSk <= 0 then  -- detailed check later+    failSer ProjectUnskilled+  else do+    itemSel <- getsSession sitemSel+    case itemSel of+      Just (iid, fromCStore, _) -> do+        leader <- getLeaderUI+        b <- getsState $ getActorBody leader+        bag <- getsState $ getBodyStoreBag b fromCStore+        case iid `EM.lookup` bag of+          Nothing -> failWith "no item to fling"+          Just _kit -> do+            itemFull <- getsState $ itemToFull iid+            let i = (fromCStore, (iid, itemFull))+            projectItem i+      Nothing -> failWith "no item to fling"  projectItem :: MonadClientUI m             => (CStore, (ItemId, ItemFull))-            -> m (FailOrCmd (RequestTimed 'AbProject))+            -> m (FailOrCmd RequestTimed) projectItem (fromCStore, (iid, itemFull)) = do   leader <- getLeaderUI   b <- getsState $ getActorBody leader@@ -780,24 +810,28 @@  -- * Apply -applyHuman :: MonadClientUI m => m (FailOrCmd (RequestTimed 'AbApply))+applyHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) applyHuman = do-  itemSel <- getsSession sitemSel-  case itemSel of-    Just (iid, fromCStore, _) -> do-      leader <- getLeaderUI-      b <- getsState $ getActorBody leader-      bag <- getsState $ getBodyStoreBag b fromCStore-      case iid `EM.lookup` bag of-        Nothing -> failWith "no item to apply"-        Just kit -> do-          itemFull <- getsState $ itemToFull iid-          applyItem (fromCStore, (iid, (itemFull, kit)))-    Nothing -> failWith "no item to apply"+  actorSk <- leaderSkillsClientUI+  if EM.findWithDefault 0 AbApply actorSk <= 0 then  -- detailed check later+    failSer ApplyUnskilled+  else do+    itemSel <- getsSession sitemSel+    case itemSel of+      Just (iid, fromCStore, _) -> do+        leader <- getLeaderUI+        b <- getsState $ getActorBody leader+        bag <- getsState $ getBodyStoreBag b fromCStore+        case iid `EM.lookup` bag of+          Nothing -> failWith "no item to apply"+          Just kit -> do+            itemFull <- getsState $ itemToFull iid+            applyItem (fromCStore, (iid, (itemFull, kit)))+      Nothing -> failWith "no item to apply"  applyItem :: MonadClientUI m           => (CStore, (ItemId, ItemFullKit))-          -> m (FailOrCmd (RequestTimed 'AbApply))+          -> m (FailOrCmd RequestTimed) applyItem (fromCStore, (iid, (itemFull, kit))) = do   leader <- getLeaderUI   b <- getsState $ getActorBody leader@@ -814,7 +848,7 @@  -- | Ask for a direction and alter a tile in the specified way, if possible. alterDirHuman :: MonadClientUI m-              => [TriggerTile] -> m (FailOrCmd (RequestTimed 'AbAlter))+              => [TriggerTile] -> m (FailOrCmd RequestTimed) alterDirHuman ts = do   UIOptions{uVi, uLaptop} <- getsSession sUIOptions   let verb1 = case ts of@@ -844,7 +878,7 @@  -- | Try to alter a tile using a feature in the given direction. alterTile :: MonadClientUI m-          => [TriggerTile] -> Vector -> m (FailOrCmd (RequestTimed 'AbAlter))+          => [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed) alterTile ts dir = do   leader <- getLeaderUI   b <- getsState $ getActorBody leader@@ -860,7 +894,7 @@ -- the time will be wasted and the server will describe the failure in detail. alterTileAtPos :: MonadClientUI m                => [TriggerTile] -> Point -> Text-               -> m (FailOrCmd (RequestTimed 'AbAlter))+               -> m (FailOrCmd RequestTimed) alterTileAtPos ts tpos pText = do   cops@COps{cotile, coTileSpeedup} <- getsState scops   leader <- getLeaderUI@@ -956,7 +990,7 @@  -- | Try to alter a tile using a feature under the pointer. alterWithPointerHuman :: MonadClientUI m-                      => [TriggerTile] -> m (FailOrCmd (RequestTimed 'AbAlter))+                      => [TriggerTile] -> m (FailOrCmd RequestTimed) alterWithPointerHuman ts = do   COps{cotile} <- getsState scops   lidV <- viewedLevelUI@@ -1174,8 +1208,8 @@   let stdRuleset = getStdRuleset cops       lxsize = fst normalLevelBound + 1       lysize = snd normalLevelBound + 4-      xoffset = (110 - lxsize) `div` 2-      yoffset = (60 - lysize) `div` 2+      xoffset = (80 - lxsize) `div` 2+      yoffset = (45 - lysize) `div` 2       tlines = T.lines $ rmainMenuArt stdRuleset       f = T.take lxsize . T.drop xoffset   return $! map f $ take lysize $ drop yoffset tlines

@@ -3,7 +3,7 @@   ( cmdHumanSem #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , noRemoteHumanCmd, cmdAction, addNoError, fmapTimedToUI+  , noRemoteHumanCmd, cmdAction, addNoError #endif   ) where @@ -69,23 +69,23 @@   LoopOnNothing cmd1 -> loopOnNothingHuman (cmdAction cmd1)   ExecuteIfClear cmd1 -> executeIfClearHuman (cmdAction cmd1) -  Wait -> weaveJust <$> Right <$> fmapTimedToUI waitHuman-  Wait10 -> weaveJust <$> Right <$> fmapTimedToUI waitHuman10+  Wait -> weaveJust <$> (ReqUITimed <$$> waitHuman)+  Wait10 -> weaveJust <$> (ReqUITimed <$$> waitHuman10)   MoveDir v ->     weaveJust <$> (ReqUITimed <$$> moveRunHuman True True False False v)   RunDir v -> weaveJust <$> (ReqUITimed <$$> moveRunHuman True True True True v)-  RunOnceAhead -> runOnceAheadHuman+  RunOnceAhead -> ReqUITimed <$$> runOnceAheadHuman   MoveOnceToXhair -> weaveJust <$> (ReqUITimed <$$> moveOnceToXhairHuman)   RunOnceToXhair  -> weaveJust <$> (ReqUITimed <$$> runOnceToXhairHuman)   ContinueToXhair -> weaveJust <$> (ReqUITimed <$$> continueToXhairHuman)   MoveItem cLegalRaw toCStore mverb auto ->     weaveJust-    <$> (fmapTimedToUI <$> moveItemHuman cLegalRaw toCStore mverb auto)-  Project -> weaveJust <$> (fmapTimedToUI <$> projectHuman)-  Apply -> weaveJust <$> (fmapTimedToUI <$> applyHuman)-  AlterDir ts -> weaveJust <$> (fmapTimedToUI <$> alterDirHuman ts)+    <$> (ReqUITimed <$$> moveItemHuman cLegalRaw toCStore mverb auto)+  Project -> weaveJust <$> (ReqUITimed <$$> projectHuman)+  Apply -> weaveJust <$> (ReqUITimed <$$> applyHuman)+  AlterDir ts -> weaveJust <$> (ReqUITimed <$$> alterDirHuman ts)   AlterWithPointer ts -> weaveJust-                         <$> (fmapTimedToUI <$> alterWithPointerHuman ts)+                         <$> (ReqUITimed <$$> alterWithPointerHuman ts)   Help -> helpHuman cmdAction   Hint -> hintHuman cmdAction   ItemMenu -> itemMenuHuman cmdAction@@ -145,6 +145,3 @@  addNoError :: Monad m => m () -> m (Either MError ReqUI) addNoError cmdCli = cmdCli >> return (Left Nothing)--fmapTimedToUI :: Monad m => m (RequestTimed a) -> m ReqUI-fmapTimedToUI mr = ReqUITimed . RequestAnyAbility <$> mr

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} -- | UI of inventory management. module Game.LambdaHack.Client.UI.InventoryM   ( Suitability(..)

@@ -46,7 +46,7 @@ -- | Continue running in the given direction. continueRun :: MonadClientUI m             => LevelId -> RunParams-            -> m (Either Text RequestAnyAbility)+            -> m (Either Text RequestTimed) continueRun arena paramOld = case paramOld of   RunParams{ runMembers = []            , runStopMsg = Just stopMsg } -> return $ Left stopMsg@@ -88,7 +88,7 @@              s <- getState              modifyClient $ updateLeader r s              modifySession $ \sess -> sess {srunning = Just paramNew}-             return $ Right $ RequestAnyAbility $ ReqMove dir+             return $ Right $ ReqMove dir          -- The potential invisible actor is hit. War is started without asking.  -- | This function implements the actual logic of running. It checks if we

@@ -99,7 +99,7 @@ actorCanMelee actorAspect aid b =   let ar = actorAspect EM.! aid       actorMaxSk = IA.aSkills ar-      condUsableWeapon = bweapon b >= 0+      condUsableWeapon = bweapon b > 0       canMelee = EM.findWithDefault 0 Ability.AbMelee actorMaxSk > 0   in condUsableWeapon && canMelee 

@@ -45,9 +45,9 @@ -- Then they are presented as having a template kind that is really -- not their own, though usually close. Full kind information about -- item's kind is available through the @ItemKindIx@ index once the item--- is identified and full information about the value of item's aspects+-- is identified and full information about the value of item's aspect record -- is available elsewhere (both @IdentityObvious@ and @IdentityCovered@--- items may or may not need identification of their aspects).+-- items may or may not need identification of their aspect record). data Item = Item   { jkind    :: ItemIdentity  -- ^ the kind of the item, or an indiretion   , jlid     :: LevelId       -- ^ lowest level the item was created at@@ -74,7 +74,8 @@  instance Binary ItemIdentity --- | The map of item ids to item aspects. The full map is known by the server.+-- | The map of item ids to item aspect reocrd. The full map is known+-- by the server. type DiscoveryAspect = EM.EnumMap ItemId IA.AspectRecord  -- | An index of the kind identifier of an item. Clients have partial knowledge@@ -84,7 +85,7 @@   deriving (Show, Eq, Ord, Enum, Ix.Ix, Hashable, Binary)  -- | The secret part of the information about an item. If a faction--- knows the aspects of the item (the @kmConst@ flag is set or+-- knows the aspect record of the item (the @kmConst@ flag is set or -- the @itemAspect@ field is @Left@), this is a complete secret information. -- Items that don't need second identification may be identified or not and both -- cases are OK (their display flavour will differ and that may be the point).@@ -166,7 +167,7 @@       itemKind = okind coitem itemKindId       km = IK.getKindMean itemKindId coItemSpeedup       -- If the kind is not identified, we know nothing about the real-      -- aspects, so we at least assume they are variable.+      -- aspect record, so we at least assume they are variable.       itemAspectMean | itemSuspect = km {IA.kmConst = False}                      | otherwise = km       itemDisco = case EM.lookup iid discoAspect of

@@ -1,9 +1,9 @@ {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | The type of item aspects and its operations. module Game.LambdaHack.Common.ItemAspect-  ( Aspect(..), AspectRecord(..), KindMean(..), ItemSeed, EqpSlot(..)+  ( Aspect(..), AspectRecord(..), KindMean(..), EqpSlot(..)   , emptyAspectRecord, addMeanAspect, castAspect, aspectsRandom-  , sumAspectRecord, aspectRecordToList, seedToAspect, prEqpSlot+  , sumAspectRecord, aspectRecordToList, rollAspectRecord, prEqpSlot #ifdef EXPOSE_INTERNAL     -- * Internal operations   , ceilingMeanDice@@ -65,20 +65,14 @@  -- | Partial information about an item, deduced from its item kind. -- These are assigned to each 'ItemKind'. The @kmConst@ flag says whether--- the item's aspects are constant rather than random or dependent+-- the item's aspect record is constant rather than random or dependent -- on item creation dungeon level. data KindMean = KindMean   { kmConst :: Bool  -- ^ whether the item doesn't need second identification-  , kmMean  :: AspectRecord  -- ^ mean value of item's possible aspects+  , kmMean  :: AspectRecord  -- ^ mean value of item's possible aspect records   }   deriving (Show, Eq, Ord, Generic) --- | A seed for rolling aspects of an item--- Clients have partial knowledge of how item ids map to the seeds.--- They gain knowledge by identifying items.-newtype ItemSeed = ItemSeed Int-  deriving (Show, Eq, Ord, Enum, Hashable, Binary)- -- | AI and UI hints about the role of the item. data EqpSlot =     EqpSlotMiscBonus@@ -272,11 +266,10 @@   ++ [AddAggression $ Dice.intToDice aAggression | aAggression /= 0]   ++ [AddAbility ab $ Dice.intToDice n | (ab, n) <- EM.assocs aSkills, n /= 0] -seedToAspect :: ItemSeed -> [Aspect] -> Dice.AbsDepth -> Dice.AbsDepth-             -> AspectRecord-seedToAspect (ItemSeed itemSeed) ass ldepth totalDepth =-  let rollM = foldlM' (castAspect ldepth totalDepth) emptyAspectRecord ass-  in St.evalState rollM (R.mkStdGen itemSeed)+rollAspectRecord :: [Aspect] -> Dice.AbsDepth -> Dice.AbsDepth+                 -> Rnd AspectRecord+rollAspectRecord ass ldepth totalDepth =+  foldlM' (castAspect ldepth totalDepth) emptyAspectRecord ass  prEqpSlot :: EqpSlot -> AspectRecord -> Int prEqpSlot eqpSlot ar@AspectRecord{..} =

@@ -11,12 +11,14 @@   , toGroupName, describeTactic   , makePhrase, makeSentence, squashedWWandW, normalLevelBound   , appDataDir, xM, xD, minusM, minusM1, oneM, tenthM+  , workaroundOnMainThreadMVar   ) where  import Prelude ()  import Game.LambdaHack.Common.Prelude +import           Control.Concurrent import           Control.DeepSeq import           Data.Binary import qualified Data.Char as Char@@ -34,6 +36,7 @@ import qualified NLP.Miniutter.English as MU import           System.Directory (getAppUserDataDirectory) import           System.Environment (getProgName)+import           System.IO.Unsafe (unsafePerformIO)  import Game.LambdaHack.Common.Point @@ -205,6 +208,11 @@ minusM1 = xM (-1) - 1 oneM = xM 1 tenthM = 100000++-- Global variable for passing the action to run on main thread, if any.+workaroundOnMainThreadMVar :: MVar (IO ())+{-# NOINLINE workaroundOnMainThreadMVar #-}+workaroundOnMainThreadMVar = unsafePerformIO newEmptyMVar  -- Data.Binary orphan instances 

@@ -23,9 +23,12 @@  -- | Possible causes of failure of request. data ReqFailure =-    MoveNothing+    MoveUnskilled+  | MoveNothing+  | MeleeUnskilled   | MeleeSelf   | MeleeDistant+  | DisplaceUnskilled   | DisplaceDistant   | DisplaceAccess   | DisplaceProjectiles@@ -39,6 +42,8 @@   | AlterBlockActor   | AlterBlockItem   | AlterNothing+  | WaitUnskilled+  | MoveItemUnskilled   | EqpOverfull   | EqpStackFull   | ApplyUnskilled@@ -63,9 +68,12 @@  impossibleReqFailure :: ReqFailure -> Bool impossibleReqFailure reqFailure = case reqFailure of+  MoveUnskilled -> False  -- unidentified skill items   MoveNothing -> True+  MeleeUnskilled -> False  -- unidentified skill items   MeleeSelf -> True   MeleeDistant -> True+  DisplaceUnskilled -> False  -- unidentified skill items   DisplaceDistant -> True   DisplaceAccess -> True   DisplaceProjectiles -> True@@ -79,12 +87,14 @@   AlterBlockActor -> True  -- adjacent actor always visible   AlterBlockItem -> True  -- adjacent item always visible   AlterNothing -> True+  WaitUnskilled -> False  -- unidentified skill items+  MoveItemUnskilled -> False  -- unidentified skill items   EqpOverfull -> True   EqpStackFull -> True   ApplyUnskilled -> False  -- unidentified skill items   ApplyRead -> False  -- unidentified skill items   ApplyOutOfReach -> True-  ApplyCharging -> False  -- if aspects unknown, charging unknown+  ApplyCharging -> False  -- if aspect record unknown, charging unknown   ApplyNoEffects -> False  -- if effects unknown, can't prevent it   ItemNothing -> True   ItemNotCalm -> False  -- unidentified skill items@@ -100,9 +110,12 @@  showReqFailure :: ReqFailure -> Text showReqFailure reqFailure = case reqFailure of+  MoveUnskilled -> "unskilled actors cannot move"   MoveNothing -> "wasting time on moving into obstacle"+  MeleeUnskilled -> "unskilled actors cannot melee"   MeleeSelf -> "trying to melee oneself"   MeleeDistant -> "trying to melee a distant foe"+  DisplaceUnskilled -> "unskilled actors cannot displace"   DisplaceDistant -> "trying to displace a distant actor"   DisplaceAccess -> "switching places without access"   DisplaceProjectiles -> "trying to displace multiple projectiles"@@ -116,6 +129,8 @@   AlterBlockActor -> "blocked by an actor"   AlterBlockItem -> "jammed by an item"   AlterNothing -> "wasting time on altering nothing"+  WaitUnskilled -> "unskilled actors cannot wait"+  MoveItemUnskilled -> "unskilled actors cannot move items"   EqpOverfull -> "cannot equip any more items"   EqpStackFull -> "cannot equip the whole item stack"   ApplyUnskilled -> "unskilled actors cannot apply items"

@@ -65,7 +65,7 @@   , _sgameModeId  :: ContentId ModeKind   -- ^ current game mode   , _sdiscoKind   :: DiscoveryKind    -- ^ item kind discoveries data   , _sdiscoAspect :: DiscoveryAspect  -- ^ item aspect data; could be recomputed-  , _sactorAspect :: ActorAspect      -- ^ actor aspects; is recomputed+  , _sactorAspect :: ActorAspect      -- ^ actor aspect records; is recomputed   }   deriving (Show, Eq) @@ -275,7 +275,7 @@ getItemBody :: ItemId -> State -> Item getItemBody iid s = sitemD s EM.! iid --- This is best guess, including mean aspects, so we can take into+-- This is best guess, including mean aspect record, so we can take into -- consideration even the kind the item hides under. aspectRecordFromItem :: ItemId -> Item -> State -> IA.AspectRecord aspectRecordFromItem iid item s =

@@ -21,7 +21,7 @@  -- | The type of game rule sets and assorted game data. ----- In principle, it'se possible to have many rule sets+-- In principle, it's possible to have many rule sets -- and switch between them during a game session or even a single game. data RuleKind = RuleKind   { rsymbol         :: Char      -- ^ a symbol@@ -54,12 +54,12 @@ validateSingle :: RuleKind -> [Text] validateSingle RuleKind{rmainMenuArt} =   let ts = T.lines rmainMenuArt-      tsNot110 = filter ((/= 110) . T.length) ts-  in case tsNot110 of-     [] -> [ "rmainMenuArt doesn't have 60 lines, but " <> tshow (length ts)-           | length ts /= 60]-     tNot110 : _ ->-       ["rmainMenuArt has a line with length other than 110:" <> tNot110]+      tsNot80 = filter ((/= 80) . T.length) ts+  in case tsNot80 of+     [] -> [ "rmainMenuArt doesn't have 45 lines, but " <> tshow (length ts)+           | length ts /= 45]+     tNot80 : _ ->+       ["rmainMenuArt has a line with length other than 80:" <> tNot80]  -- | Since we have only one rule kind, the set of rule kinds is always valid. validateAll :: [RuleKind] -> ContentData RuleKind -> [Text]

@@ -53,7 +53,7 @@   return (ps, atomicBroken, executedOnServer)  -- | Send an atomic action to all clients that can see it.-handleAndBroadcast :: (MonadServerAtomic m, MonadServerReadRequest m)+handleAndBroadcast :: (MonadServerAtomic m, MonadServerComm m)                    => PosAtomic -> [UpdAtomic] -> CmdAtomic -> m () handleAndBroadcast ps atomicBroken atomic = do   -- This is calculated in the server State before action (simulating@@ -148,7 +148,7 @@       return $ Just $ SfxLoudSummon (bproj b) grp p     _ -> return Nothing -sendPer :: (MonadServerAtomic m, MonadServerReadRequest m)+sendPer :: (MonadServerAtomic m, MonadServerComm m)         => FactionId -> LevelId -> Perception -> Perception -> Perception         -> m () {-# INLINE sendPer #-}

@@ -24,7 +24,7 @@ -- remaining commandline should be passed and parsed by the client to extract -- client and ui options from and singnal an error if anything was left. -import Game.LambdaHack.Client.ClientOptions+import Game.LambdaHack.Client (ClientOptions (..)) import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Misc import Game.LambdaHack.Content.ModeKind

@@ -1,7 +1,7 @@ {-# LANGUAGE TupleSections #-} -- | Server operations common to many modules. module Game.LambdaHack.Server.CommonM-  ( execFailure, revealItems, moveStores, generalMoveItem+  ( revealItems, moveStores, generalMoveItem   , deduceQuits, deduceKilled, electLeader, supplantLeader   , updatePer, recomputeCachePer, projectFail   , addActorFromGroup, registerActor, discoverIfMinorEffects@@ -18,11 +18,8 @@ import Game.LambdaHack.Common.Prelude  import qualified Data.EnumMap.Strict as EM-import qualified Data.Text as T-import qualified Text.Show.Pretty as Show.Pretty  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client import qualified Game.LambdaHack.Common.Ability as Ability import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState@@ -51,26 +48,6 @@ import           Game.LambdaHack.Server.ServerOptions import           Game.LambdaHack.Server.State -execFailure :: MonadServerAtomic m-            => ActorId -> RequestTimed a -> ReqFailure -> m ()-execFailure aid req failureSer = do-  -- Clients should rarely do that (only in case of invisible actors)-  -- so we report it to the client, but do not crash-  -- (server should work OK with stupid clients, too).-  body <- getsState $ getActorBody aid-  let fid = bfid body-      msg = showReqFailure failureSer-      impossible = impossibleReqFailure failureSer-      debugShow :: Show a => a -> Text-      debugShow = T.pack . Show.Pretty.ppShow-      possiblyAlarm = if impossible-                      then debugPossiblyPrintAndExit-                      else debugPossiblyPrint-  possiblyAlarm $-    "execFailure:" <+> msg <> "\n"-    <> debugShow body <> "\n" <> debugShow req <> "\n" <> debugShow failureSer-  execSfxAtomic $ SfxMsgFid fid $ SfxUnexpected failureSer- revealItems :: MonadServerAtomic m => Maybe FactionId -> m () revealItems mfid = do   COps{coitem} <- getsState scops@@ -79,8 +56,8 @@         let itemKind = okind coitem itemKindId             c = CActor aid store         unless (IK.isHumanTrinket itemKind) $ do  -- a hack-          seed <- getsServer $ (EM.! iid) . sitemSeedD-          execUpdAtomic $ UpdDiscover c iid itemKindId seed+          discoAspect <- getsState sdiscoAspect+          execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid       f aid = do         b <- getsState $ getActorBody aid         let ourSide = maybe True (== bfid b) mfid@@ -377,23 +354,22 @@   -- We bootstrap the actor by first creating the trunk of the actor's body   -- that contains the constant properties.   let trunkFreq = [(actorGroup, 1)]-  m4 <- rollItem 0 lid trunkFreq-  case m4 of+  m3 <- rollItem 0 lid trunkFreq+  case m3 of     Nothing -> return Nothing-    Just (itemKnown, itemFullKit, seed, _) ->-      Just <$> registerActor False itemKnown itemFullKit seed bfid pos lid time+    Just (itemKnown, itemFullKit, _) ->+      Just <$> registerActor False itemKnown itemFullKit bfid pos lid time  registerActor :: MonadServerAtomic m-              => Bool -> ItemKnown -> ItemFullKit -> IA.ItemSeed+              => Bool -> ItemKnown -> ItemFullKit               -> FactionId -> Point -> LevelId -> Time               -> m ActorId-registerActor summoned (kindIx, ar, _) (itemFullRaw, kit)-              seed bfid pos lid time = do+registerActor summoned (kindIx, ar, _) (itemFullRaw, kit) bfid pos lid time = do   let container = CTrunk bfid lid pos       jfid = Just bfid       itemKnown = (kindIx, ar, jfid)       itemFull = itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}}-  trunkId <- registerItem (itemFull, kit) itemKnown seed container False+  trunkId <- registerItem (itemFull, kit) itemKnown container False   addNonProjectile summoned trunkId (itemFull, kit) bfid pos lid time  addProjectile :: MonadServerAtomic m@@ -488,8 +464,8 @@   let itemKind = okind coitem itemKindId   if IK.onlyMinorEffects itemKind   then do-    seed <- getsServer $ (EM.! iid) . sitemSeedD-    execUpdAtomic $ UpdDiscover c iid itemKindId seed+    discoAspect <- getsState sdiscoAspect+    execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid   else return ()  -- discover by use when item's effects get activated later on  pickWeaponServer :: MonadServer m => ActorId -> m (Maybe (ItemId, CStore))

@@ -18,7 +18,7 @@ import qualified Text.Show.Pretty as Show.Pretty  import Game.LambdaHack.Atomic-import Game.LambdaHack.Client+import Game.LambdaHack.Client (Response (..)) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction

@@ -14,7 +14,7 @@ import qualified Data.EnumMap.Strict as EM  import Game.LambdaHack.Atomic-import Game.LambdaHack.Client+import Game.LambdaHack.Client (sbenchmark) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction@@ -32,7 +32,7 @@ import Game.LambdaHack.Server.State  -- | Continue or exit or restart the game.-endOrLoop :: (MonadServerAtomic m, MonadServerReadRequest m)+endOrLoop :: (MonadServerAtomic m, MonadServerComm m)           => m () -> (Maybe (GroupName ModeKind) -> m ())           -> m () endOrLoop loop restart = do@@ -62,7 +62,7 @@      | not $ null campers -> gameExit  -- and @loop@ is not called      | otherwise -> loop  -- continue current game -gameExit :: (MonadServerAtomic m, MonadServerReadRequest m) => m ()+gameExit :: (MonadServerAtomic m, MonadServerComm m) => m () gameExit = do --  debugPossiblyPrint "Verifying all perceptions."   -- Verify that the possibly not saved caches are equal to future

@@ -34,7 +34,6 @@ import qualified Data.Ord as Ord  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState import qualified Game.LambdaHack.Common.Dice as Dice@@ -125,6 +124,18 @@         [] -> return ()         aid : _ -> execUpdAtomic $ UpdLeadFaction (bfid tb) mleader $ Just aid +cutCalm :: MonadServerAtomic m => ActorId -> m ()+cutCalm target = do+  tb <- getsState $ getActorBody target+  ar <- getsState $ getActorAspect target+  let upperBound = if hpTooLow tb ar+                   then 2  -- to trigger domination on next attack, etc.+                   else xM $ IA.aMaxCalm ar+      deltaCalm = min minusM1 (upperBound - bcalm tb)+  -- HP loss decreases Calm by at least @minusM1@ to avoid "hears something",+  -- which is emitted when decreasing Calm by @minusM@.+  udpateCalm target deltaCalm+ -- Here melee damage is applied. This is necessary so that the same -- AI benefit calculation may be used for flinging and for applying items. meleeEffectAndDestroy :: MonadServerAtomic m@@ -256,8 +267,8 @@   -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary.   when (ur >= UseId && not (IK.onlyMinorEffects itemKind)) $ do     kindId <- getsState $ getIidKindIdServer iid-    seed <- getsServer $ (EM.! iid) . sitemSeedD-    execUpdAtomic $ UpdDiscover c iid kindId seed+    discoAspect <- getsState sdiscoAspect+    execUpdAtomic $ UpdDiscover c iid kindId $ discoAspect EM.! iid   return ur  -- | The source actor affects the target actor, with a given effect and power.@@ -389,14 +400,14 @@               ++ [zip (repeat True)                   $ take 8 (drop ((k100 + fuzz) `mod` 8) $ cycle psFuzz)]         forM_ ps $ \(centerRaw, tpxy) -> do-          let req = ReqProject tpxy veryrandom iid COrgan-              center = centerRaw && itemK >= 8  -- if few, keep them regular+          let center = centerRaw && itemK >= 8  -- if few, keep them regular           mfail <- projectFail target tpxy veryrandom center iid COrgan True           case mfail of             Nothing -> return ()             Just ProjectBlockTerrain -> return ()             Just ProjectBlockActor | not $ bproj tb -> return ()-            Just failMsg -> execFailure target req failMsg+            Just failMsg ->+              execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnexpected failMsg       tryFlying 0 = return ()       tryFlying k100 = do         -- Explosion particles are placed among organs of the victim:@@ -439,18 +450,6 @@        refillHP source target deltaHP        return UseUp -cutCalm :: MonadServerAtomic m => ActorId -> m ()-cutCalm target = do-  tb <- getsState $ getActorBody target-  ar <- getsState $ getActorAspect target-  let upperBound = if hpTooLow tb ar-                   then 0  -- to trigger domination, etc.-                   else xM $ IA.aMaxCalm ar-      deltaCalm = min minusM1 (upperBound - bcalm tb)-  -- HP loss decreases Calm by at least @minusM1@ to avoid "hears something",-  -- which is emitted when decreasing Calm by @minusM@.-  udpateCalm target deltaCalm- -- ** RefillCalm  effectRefillCalm :: MonadServerAtomic m@@ -974,9 +973,9 @@   bagBefore <- getsState $ getBodyStoreBag tb store   let litemFreq = [(grp, 1)]   -- Power depth of new items unaffected by number of spawned actors.-  m4 <- rollItem 0 (blid tb) litemFreq-  let (itemKnownRaw, (itemFullRaw, kitRaw), seed, _) =-        fromMaybe (error $ "" `showFailure` (blid tb, litemFreq, c)) m4+  m3 <- rollItem 0 (blid tb) litemFreq+  let (itemKnownRaw, (itemFullRaw, kitRaw), _) =+        fromMaybe (error $ "" `showFailure` (blid tb, litemFreq, c)) m3       -- Avoid too many different item identifiers (one for each faction)       -- for blasts or common item generating tiles. Temporary organs are       -- allowed to be duplicated, because they provide really useful info@@ -1019,7 +1018,7 @@       -- No such items or some items, but void delta, so create items.       -- If it's, e.g., a periodic poison, the new items will stack with any       -- already existing items.-      iid <- registerItem (itemFull, kitNew) itemKnown seed c True+      iid <- registerItem (itemFull, kitNew) itemKnown c True       -- If created not on the ground, ID it, because it won't be on pickup.       when (store /= CGround) $         discoverIfMinorEffects c iid (itemKindId itemFull)@@ -1178,8 +1177,8 @@ identifyIid :: MonadServerAtomic m             => ItemId -> Container -> ContentId ItemKind -> m () identifyIid iid c itemKindId = do-  seed <- getsServer $ (EM.! iid) . sitemSeedD-  execUpdAtomic $ UpdDiscover c iid itemKindId seed+  discoAspect <- getsState sdiscoAspect+  execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid  -- ** Detect 

@@ -1,4 +1,3 @@-{-# LANGUAGE GADTs #-} -- | Semantics of requests -- . -- A couple of them do not take time, the rest does.@@ -13,9 +12,9 @@   , reqMove, reqDisplace, reqAlterFail, reqGameDropAndExit, reqGameSaveAndExit #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , setBWait, managePerRequest, handleRequestTimedCases-  , affectSmell, reqMelee, reqAlter, reqWait-  , reqMoveItems, reqMoveItem, computeRndTimeout, reqProject, reqApply+  , execFailure, setBWait, managePerRequest, handleRequestTimedCases+  , affectSmell, reqMelee, reqMeleeChecked, reqAlter+  , reqWait, reqMoveItems, reqMoveItem, computeRndTimeout, reqProject, reqApply   , reqGameRestart, reqGameSave, reqTactic, reqAutomate #endif   ) where@@ -25,9 +24,12 @@ import Game.LambdaHack.Common.Prelude  import qualified Data.EnumMap.Strict as EM+import qualified Data.Text as T+import qualified Text.Show.Pretty as Show.Pretty  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client+import           Game.LambdaHack.Client (ReqAI (..), ReqUI (..),+                                         RequestTimed (..)) import qualified Game.LambdaHack.Common.Ability as Ability import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState@@ -56,11 +58,31 @@ import           Game.LambdaHack.Server.ServerOptions import           Game.LambdaHack.Server.State +execFailure :: MonadServerAtomic m+            => ActorId -> RequestTimed -> ReqFailure -> m ()+execFailure aid req failureSer = do+  -- Clients should rarely do that (only in case of invisible actors)+  -- so we report it to the client, but do not crash+  -- (server should work OK with stupid clients, too).+  body <- getsState $ getActorBody aid+  let fid = bfid body+      msg = showReqFailure failureSer+      impossible = impossibleReqFailure failureSer+      debugShow :: Show a => a -> Text+      debugShow = T.pack . Show.Pretty.ppShow+      possiblyAlarm = if impossible+                      then debugPossiblyPrintAndExit+                      else debugPossiblyPrint+  possiblyAlarm $+    "execFailure:" <+> msg <> "\n"+    <> debugShow body <> "\n" <> debugShow req <> "\n" <> debugShow failureSer+  execSfxAtomic $ SfxMsgFid fid $ SfxUnexpected failureSer+ -- | The semantics of server commands. -- AI always takes time and so doesn't loop. handleRequestAI :: MonadServerAtomic m                 => ReqAI-                -> m (Maybe RequestAnyAbility)+                -> m (Maybe RequestTimed) handleRequestAI cmd = case cmd of   ReqAITimed cmdT -> return $ Just cmdT   ReqAINop -> return Nothing@@ -68,7 +90,7 @@ -- | The semantics of server commands. Only the first two cases affect time. handleRequestUI :: MonadServerAtomic m                 => FactionId -> ActorId -> ReqUI-                -> m (Maybe RequestAnyAbility)+                -> m (Maybe RequestTimed) handleRequestUI fid aid cmd = case cmd of   ReqUITimed cmdT -> return $ Just cmdT   ReqUIGameRestart t d -> reqGameRestart aid t d >> return Nothing@@ -83,7 +105,7 @@ -- and unsetting in all other requests, we call this once before -- executing a request. setBWait :: MonadServerAtomic m-         => RequestTimed a -> ActorId -> Actor -> m (Maybe Bool)+         => RequestTimed -> ActorId -> Actor -> m (Maybe Bool) {-# INLINE setBWait #-} setBWait cmd aid b = do   let mwait = case cmd of@@ -95,7 +117,7 @@   return mwait  handleRequestTimed :: MonadServerAtomic m-                   => FactionId -> ActorId -> RequestTimed a -> m Bool+                   => FactionId -> ActorId -> RequestTimed -> m Bool handleRequestTimed fid aid cmd = do   b <- getsState $ getActorBody aid   mwait <- setBWait cmd aid b@@ -123,7 +145,7 @@     execUpdAtomic $ UpdRefillHP aid clearMark  handleRequestTimedCases :: MonadServerAtomic m-                        => ActorId -> RequestTimed a -> m ()+                        => ActorId -> RequestTimed -> m () handleRequestTimedCases aid cmd = case cmd of   ReqMove target -> reqMove aid target   ReqMelee target iid cstore -> reqMelee aid target iid cstore@@ -206,8 +228,11 @@ reqMove :: MonadServerAtomic m => ActorId -> Vector -> m () reqMove source dir = do   COps{coTileSpeedup} <- getsState scops+  actorSk <- currentSkillsServer source   sb <- getsState $ getActorBody source-  let lid = blid sb+  let abInSkill ab = isJust (btrajectory sb)+                     || EM.findWithDefault 0 ab actorSk > 0+      lid = blid sb   lvl <- getLevel lid   let spos = bpos sb           -- source position       tpos = spos `shift` dir  -- target position@@ -250,15 +275,20 @@       -- Below the only weapon (the only item) of projectiles is picked.       mweapon <- pickWeaponServer source       case mweapon of-        Nothing -> reqWait source-        Just (wp, cstore) -> reqMelee source target wp cstore-    _ | Tile.isWalkable coTileSpeedup $ lvl `at` tpos -> do-          -- Movement requires full access.+        Just (wp, cstore) | abInSkill Ability.AbMelee ->+          reqMeleeChecked source target wp cstore+        _ -> return ()  -- waiting, even if no @AbWait@ ability+    _ -> do+      -- Either the position is empty, or all involved actors are proj.+      -- Movement requires full access and skill.+      if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then+        if abInSkill Ability.AbMove then do           execUpdAtomic $ UpdMoveActor source spos tpos           affectSmell source-      | otherwise ->-          -- Client foolishly tries to move into blocked, boring tile.-          execFailure source (ReqMove dir) MoveNothing+        else execFailure source (ReqMove dir) MoveUnskilled+      else+        -- Client foolishly tries to move into unwalkable tile.+        execFailure source (ReqMove dir) MoveNothing  -- * ReqMelee @@ -272,6 +302,14 @@ reqMelee :: MonadServerAtomic m          => ActorId -> ActorId -> ItemId -> CStore -> m () reqMelee source target iid cstore = do+  actorSk <- currentSkillsServer source+  if EM.findWithDefault 0 Ability.AbMelee actorSk > 0 then+    reqMeleeChecked source target iid cstore+  else execFailure source (ReqMelee target iid cstore) MeleeUnskilled++reqMeleeChecked :: MonadServerAtomic m+                => ActorId -> ActorId -> ItemId -> CStore -> m ()+reqMeleeChecked source target iid cstore = do   sb <- getsState $ getActorBody source   tb <- getsState $ getActorBody target   let req = ReqMelee target iid cstore@@ -371,7 +409,10 @@ reqDisplace :: MonadServerAtomic m => ActorId -> ActorId -> m () reqDisplace source target = do   COps{coTileSpeedup} <- getsState scops+  actorSk <- currentSkillsServer source   sb <- getsState $ getActorBody source+  let abInSkill ab = isJust (btrajectory sb)+                     || EM.findWithDefault 0 ab actorSk > 0   tb <- getsState $ getActorBody target   tfact <- getsState $ (EM.! bfid tb) . sfactionD   let tpos = bpos tb@@ -379,7 +420,9 @@       req = ReqDisplace target   ar <- getsState $ getActorAspect target   dEnemy <- getsState $ dispEnemy source target $ IA.aSkills ar-  if | not (checkAdjacent sb tb) -> execFailure source req DisplaceDistant+  if | not (abInSkill Ability.AbDisplace) ->+         execFailure source req DisplaceUnskilled+     | not (checkAdjacent sb tb) -> execFailure source req DisplaceDistant      | atWar && not dEnemy -> do  -- if not at war, can displace always        -- We don't fail with DisplaceImmobile and DisplaceSupported.        -- because it's quite common they can't be determined by the attacker,@@ -389,8 +432,9 @@        -- verify here that they don't occur, for simplicity.        mweapon <- pickWeaponServer source        case mweapon of-         Nothing -> reqWait source-         Just (wp, cstore) -> reqMelee source target wp cstore+         Just (wp, cstore) | abInSkill Ability.AbMelee ->+           reqMeleeChecked source target wp cstore+         _ -> return ()  -- waiting, even if no @AbWait@ ability      | otherwise -> do        let lid = blid sb        lvl <- getLevel lid@@ -573,19 +617,25 @@ -- Something is sometimes done in 'setBWait'. reqWait :: MonadServerAtomic m => ActorId -> m () {-# INLINE reqWait #-}-reqWait _ = return ()+reqWait source = do+  actorSk <- currentSkillsServer source+  unless (EM.findWithDefault 0 Ability.AbWait actorSk > 0) $+    execFailure source ReqWait WaitUnskilled  -- * ReqMoveItems  reqMoveItems :: MonadServerAtomic m              => ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()-reqMoveItems aid l = do-  b <- getsState $ getActorBody aid-  ar <- getsState $ getActorAspect aid-  -- Server accepts item movement based on calm at the start, not end-  -- or in the middle, to avoid interrupted or partially ignored commands.-  let calmE = calmEnough b ar-  mapM_ (reqMoveItem aid calmE) l+reqMoveItems source l = do+  actorSk <- currentSkillsServer source+  if EM.findWithDefault 0 Ability.AbMoveItem actorSk > 0 then do+    b <- getsState $ getActorBody source+    ar <- getsState $ getActorAspect source+    -- Server accepts item movement based on calm at the start, not end+    -- or in the middle, to avoid interrupted or partially ignored commands.+    let calmE = calmEnough b ar+    mapM_ (reqMoveItem source calmE) l+  else execFailure source (ReqMoveItems l) MoveItemUnskilled  reqMoveItem :: MonadServerAtomic m             => ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()

@@ -23,7 +23,6 @@ import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.ContentData import           Game.LambdaHack.Common.Item-import qualified Game.LambdaHack.Common.ItemAspect as IA import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level import           Game.LambdaHack.Common.Misc@@ -42,8 +41,8 @@ import           Game.LambdaHack.Server.ServerOptions import           Game.LambdaHack.Server.State -onlyRegisterItem :: MonadServerAtomic m => ItemKnown -> IA.ItemSeed -> m ItemId-onlyRegisterItem itemKnown@(_, aspectRecord, _) seed = do+onlyRegisterItem :: MonadServerAtomic m => ItemKnown -> m ItemId+onlyRegisterItem itemKnown@(_, aspectRecord, _) = do   itemRev <- getsServer sitemRev   case HM.lookup itemKnown itemRev of     Just iid -> return iid@@ -53,17 +52,16 @@         execUpdAtomicSer $ UpdDiscoverServer icounter aspectRecord       let !_A = assert executedOnServer ()       modifyServer $ \ser ->-        ser { sitemSeedD = EM.insert icounter seed (sitemSeedD ser)-            , sitemRev = HM.insert itemKnown icounter (sitemRev ser)+        ser { sitemRev = HM.insert itemKnown icounter (sitemRev ser)             , sicounter = succ icounter }       return $! icounter  registerItem :: MonadServerAtomic m-             => ItemFullKit -> ItemKnown -> IA.ItemSeed -> Container -> Bool+             => ItemFullKit -> ItemKnown -> Container -> Bool              -> m ItemId registerItem (ItemFull{itemBase, itemKindId, itemKind}, kit)-             itemKnown seed container verbose = do-  iid <- onlyRegisterItem itemKnown seed+             itemKnown@(_, aspectRecord, _) container verbose = do+  iid <- onlyRegisterItem itemKnown   let cmd = if verbose then UpdCreateItem else UpdSpotItem False   execUpdAtomic $ cmd iid itemBase kit container   let worth = itemPrice (fst kit) itemKind@@ -71,7 +69,7 @@   knowItems <- getsServer $ sknowItems . soptions   when knowItems $ case container of     CTrunk{} -> return ()-    _ -> execUpdAtomic $ UpdDiscover container iid itemKindId seed+    _ -> execUpdAtomic $ UpdDiscover container iid itemKindId aspectRecord   return iid  createLevelItem :: MonadServerAtomic m => Point -> LevelId -> m ()@@ -93,7 +91,7 @@  rollItem :: MonadServerAtomic m          => Int -> LevelId -> Freqs ItemKind-         -> m (Maybe (ItemKnown, ItemFullKit, IA.ItemSeed, GroupName ItemKind))+         -> m (Maybe (ItemKnown, ItemFullKit, GroupName ItemKind)) rollItem lvlSpawned lid itemFreq = do   cops <- getsState scops   flavour <- getsServer sflavour@@ -101,15 +99,15 @@   uniqueSet <- getsServer suniqueSet   totalDepth <- getsState stotalDepth   Level{ldepth} <- getLevel lid-  m4 <- rndToAction $ newItem cops flavour discoRev uniqueSet+  m3 <- rndToAction $ newItem cops flavour discoRev uniqueSet                               itemFreq lvlSpawned lid ldepth totalDepth-  case m4 of-    Just (_, (ItemFull{itemKindId, itemKind}, _), _, _) ->+  case m3 of+    Just (_, (ItemFull{itemKindId, itemKind}, _), _) ->       when (IK.Unique `elem` IK.ifeature itemKind) $         modifyServer $ \ser ->           ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)}     _ -> return ()-  return m4+  return m3  rollAndRegisterItem :: MonadServerAtomic m                     => LevelId -> Freqs ItemKind -> Container -> Bool@@ -117,12 +115,12 @@                     -> m (Maybe (ItemId, (ItemFullKit, GroupName ItemKind))) rollAndRegisterItem lid itemFreq container verbose mk = do   -- Power depth of new items unaffected by number of spawned actors.-  m4 <- rollItem 0 lid itemFreq-  case m4 of+  m3 <- rollItem 0 lid itemFreq+  case m3 of     Nothing -> return Nothing-    Just (itemKnown, (itemFull, kit), seed, itemGroup) -> do+    Just (itemKnown, (itemFull, kit), itemGroup) -> do       let kit2 = (fromMaybe (fst kit) mk, snd kit)-      iid <- registerItem (itemFull, kit2) itemKnown seed container verbose+      iid <- registerItem (itemFull, kit2) itemKnown container verbose       return $ Just (iid, ((itemFull, kit2), itemGroup))  placeItemsInDungeon :: forall m. MonadServerAtomic m

@@ -4,7 +4,7 @@ module Game.LambdaHack.Server.ItemRev   ( ItemKnown, ItemRev, UniqueSet, buildItem, newItem     -- * Item discovery types-  , DiscoveryKindRev, ItemSeedDict, emptyDiscoveryKindRev, serverDiscos+  , DiscoveryKindRev, emptyDiscoveryKindRev, serverDiscos     -- * The @FlavourMap@ type   , FlavourMap, emptyFlavourMap, dungeonFlavourMap   ) where@@ -42,7 +42,7 @@ -- However, the first item generated by the server wins, which in case -- of normal items (not organs), is most of the time the lower absolute -- @jlid@ (shallower depth) item, which makes sense for the client.--- Note 2: @ItemSeed@ instead of @AspectRecord@ is not enough,+-- Note 2: item seed instead of @AspectRecord@ is not enough, -- becaused different seeds may result in the same @AspectRecord@ -- and we don't want such items to be distinct in UI and elsewhere. type ItemKnown = (ItemIdentity, IA.AspectRecord, Maybe FactionId)@@ -73,7 +73,7 @@ -- | Generate an item based on level. newItem :: COps -> FlavourMap -> DiscoveryKindRev -> UniqueSet         -> Freqs ItemKind -> Int -> LevelId -> Dice.AbsDepth -> Dice.AbsDepth-        -> Rnd (Maybe (ItemKnown, ItemFullKit, IA.ItemSeed, GroupName ItemKind))+        -> Rnd (Maybe (ItemKnown, ItemFullKit, GroupName ItemKind)) newItem cops@COps{coitem} flavourMap discoRev uniqueSet         itemFreq lvlSpawned lid         ldepth@(Dice.AbsDepth ldAbs) totalDepth@(Dice.AbsDepth depth) = do@@ -110,21 +110,18 @@     ((itemKindId, itemKind), itemGroup) <- frequency freq     -- Number of new items/actors unaffected by number of spawned actors.     itemN <- castDice ldepth totalDepth (IK.icount itemKind)-    seed <- toEnum <$> random     let itemBase = buildItem cops flavourMap discoRev itemKindId itemKind lid         itemIdentity = jkind itemBase         itemK = max 1 itemN         itemTimer = [timeZero | IK.Periodic `elem` IK.ifeature itemKind]                       -- delay first discharge of single organs         itemSuspect = False-        itemDisco = ItemDiscoFull {..}         -- Bonuses on items/actors unaffected by number of spawned actors.-        itemAspect =-          IA.seedToAspect seed (IK.iaspects itemKind) ldepth totalDepth+    itemAspect <- IA.rollAspectRecord (IK.iaspects itemKind) ldepth totalDepth+    let itemDisco = ItemDiscoFull {..}         itemFull = ItemFull {..}     return $ Just ( (itemIdentity, itemAspect, jfid itemBase)                   , (itemFull, (itemK, itemTimer))-                  , seed                   , itemGroup )  -- | The reverse map to @DiscoveryKind@, needed for item creation.@@ -132,9 +129,6 @@ -- Morally, it's indexed by @ContentId ItemKind@ and elements are @ItemKindIx@. newtype DiscoveryKindRev = DiscoveryKindRev (U.Vector Word16)   deriving (Show, Binary)---- | The map of item ids to item seeds, needed for item creation.-type ItemSeedDict = EM.EnumMap ItemId IA.ItemSeed  emptyDiscoveryKindRev :: DiscoveryKindRev emptyDiscoveryKindRev = DiscoveryKindRev U.empty

@@ -1,4 +1,3 @@-{-# LANGUAGE GADTs #-} -- | The main loop of the server, processing human and computer player -- moves turn by turn. module Game.LambdaHack.Server.LoopM@@ -21,7 +20,7 @@ import qualified Data.Ord as Ord  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client+import           Game.LambdaHack.Client (ReqUI (..)) import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Faction@@ -53,7 +52,7 @@ -- communicating with the clients. -- -- The loop is started in server state that is empty, see 'emptyStateServer'.-loopSer :: (MonadServerAtomic m, MonadServerReadRequest m)+loopSer :: (MonadServerAtomic m, MonadServerComm m)         => ServerOptions              -- ^ player-supplied server options         -> (Bool -> FactionId -> ChanServer -> IO ())@@ -129,7 +128,7 @@                     `swith` factionD) ()   return $! arenas -handleFidUpd :: (MonadServerAtomic m, MonadServerReadRequest m)+handleFidUpd :: (MonadServerAtomic m, MonadServerComm m)              => (FactionId -> m ()) -> FactionId -> Faction -> m () {-# INLINE handleFidUpd #-} handleFidUpd updatePerFid fid fact = do@@ -159,7 +158,7 @@ -- | Handle a clip (the smallest fraction of a game turn for which a frame may -- potentially be generated). Run the leader and other actors moves. -- Eventually advance the time and repeat.-loopUpd :: forall m. (MonadServerAtomic m, MonadServerReadRequest m)+loopUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)         => m () -> m () loopUpd updConn = do   let updatePerFid :: FactionId -> m ()@@ -436,7 +435,7 @@       $ execUpdAtomic $ UpdTrajectory aid (btrajectory b) Nothing     _ -> error $ "Nothing trajectory" `showFailure` (aid, b) -handleActors :: (MonadServerAtomic m, MonadServerReadRequest m)+handleActors :: (MonadServerAtomic m, MonadServerComm m)              => LevelId -> FactionId -> m Bool handleActors lid fid = do   localTime <- getsState $ getLocalTime lid@@ -460,7 +459,7 @@     Just aid | aid `elem` l -> aid : delete aid l     _ -> l -hActors :: forall m. (MonadServerAtomic m, MonadServerReadRequest m)+hActors :: forall m. (MonadServerAtomic m, MonadServerComm m)         => [ActorId] -> m Bool hActors [] = return False hActors as@(aid : rest) = do@@ -506,7 +505,7 @@         mtimed <- handleRequestUI side aidNew cmd         return (aidNew, mtimed)     case mtimed of-      Just (RequestAnyAbility timed) -> do+      Just timed -> do         nonWaitMove <- handleRequestTimed side aidNew timed         -- Even if the actor got a free turn of time via a scroll,         -- he will not act again this clip, only next clip.

@@ -33,7 +33,7 @@ import qualified System.Random as R  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client+import           Game.LambdaHack.Client (sbenchmark) import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.File

@@ -83,10 +83,10 @@   lvl <- getLevel lid   factionD <- getsState sfactionD   lvlSpawned <- getsServer $ fromMaybe 0 . EM.lookup lid . snumSpawned-  m4 <- rollItem lvlSpawned lid actorFreq-  case m4 of+  m3 <- rollItem lvlSpawned lid actorFreq+  case m3 of     Nothing -> return Nothing-    Just (itemKnownRaw, (itemFullRaw, kit), seed, _) -> do+    Just (itemKnownRaw, (itemFullRaw, kit), _) -> do       let freqNames = map fst $ IK.ifreq $ itemKind itemFullRaw           f fact = fgroups (gplayer fact)           factGroups = concatMap f $ EM.elems factionD@@ -110,7 +110,7 @@           rollPos <- getsState $ rollSpawnPos cops allPers mobile lid lvl fid           rndToAction rollPos       Just <$> registerActor summoned itemKnownRaw (itemFullRaw, kit)-                             seed fid pos lid time+                             fid pos lid time  rollSpawnPos :: COps -> ES.EnumSet Point              -> Bool -> LevelId -> Level -> FactionId -> State

@@ -3,7 +3,7 @@   ( -- * The communication channels     CliSerQueue, ConnServerDict, ChanServer(..)     -- * The server-client communication monad-  , MonadServerReadRequest+  , MonadServerComm       ( getsDict  -- exposed only to be implemented, not used       , modifyDict  -- exposed only to be implemented, not used       , liftIO  -- exposed only to be implemented, not used@@ -31,7 +31,8 @@ import           System.IO.Unsafe (unsafePerformIO)  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client+import           Game.LambdaHack.Client (RequestAI, RequestUI, Response (..),+                                         sbenchmark) import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.File@@ -48,17 +49,17 @@ import           Game.LambdaHack.Server.ServerOptions import           Game.LambdaHack.Server.State -writeQueue :: MonadServerReadRequest m+writeQueue :: MonadServerComm m            => Response -> CliSerQueue Response -> m () {-# INLINE writeQueue #-} writeQueue cmd responseS = liftIO $ putMVar responseS cmd -readQueueAI :: MonadServerReadRequest m+readQueueAI :: MonadServerComm m             => CliSerQueue RequestAI -> m RequestAI {-# INLINE readQueueAI #-} readQueueAI requestS = liftIO $ takeMVar requestS -readQueueUI :: MonadServerReadRequest m+readQueueUI :: MonadServerComm m             => CliSerQueue RequestUI -> m RequestUI {-# INLINE readQueueUI #-} readQueueUI requestS = liftIO $ takeMVar requestS@@ -79,20 +80,20 @@   }  -- | The server monad with the ability to communicate with clients.-class MonadServer m => MonadServerReadRequest m where+class MonadServer m => MonadServerComm m where   getsDict     :: (ConnServerDict -> a) -> m a   modifyDict   :: (ConnServerDict -> ConnServerDict) -> m ()   liftIO       :: IO a -> m a -getDict :: MonadServerReadRequest m => m ConnServerDict+getDict :: MonadServerComm m => m ConnServerDict getDict = getsDict id -putDict :: MonadServerReadRequest m => ConnServerDict -> m ()+putDict :: MonadServerComm m => ConnServerDict -> m () putDict s = modifyDict (const s)  -- | If the @AtomicFail@ conditions hold, send a command to client, -- otherwise do nothing.-sendUpdate :: (MonadServerAtomic m, MonadServerReadRequest m)+sendUpdate :: (MonadServerAtomic m, MonadServerComm m)            => FactionId -> UpdAtomic -> m () sendUpdate !fid !cmd = do   succeeded <- execUpdAtomicFidCatch fid cmd@@ -100,13 +101,13 @@  -- | Send a command to client, crashing if the @AtomicFail@ conditions -- don't hold when executed on the client's state.-sendUpdateCheck :: (MonadServerAtomic m, MonadServerReadRequest m)+sendUpdateCheck :: (MonadServerAtomic m, MonadServerComm m)                 => FactionId -> UpdAtomic -> m () sendUpdateCheck !fid !cmd = do   execUpdAtomicFid fid cmd   sendUpd fid cmd -sendUpd :: MonadServerReadRequest m => FactionId -> UpdAtomic -> m ()+sendUpd :: MonadServerComm m => FactionId -> UpdAtomic -> m () sendUpd !fid !cmd = do   chan <- getsDict (EM.! fid)   s <- getsServer $ (EM.! fid) . sclientStates@@ -115,7 +116,7 @@   when debug $ debugResponse fid resp   writeQueue resp $ responseS chan -sendUpdNoState :: MonadServerReadRequest m => FactionId -> UpdAtomic -> m ()+sendUpdNoState :: MonadServerComm m => FactionId -> UpdAtomic -> m () sendUpdNoState !fid !cmd = do   chan <- getsDict (EM.! fid)   let resp = RespUpdAtomicNoState cmd@@ -123,7 +124,7 @@   when debug $ debugResponse fid resp   writeQueue resp $ responseS chan -sendSfx :: MonadServerReadRequest m => FactionId -> SfxAtomic -> m ()+sendSfx :: MonadServerComm m => FactionId -> SfxAtomic -> m () sendSfx !fid !sfx = do   let resp = RespSfxAtomic sfx   debug <- getsServer $ sniff . soptions@@ -133,7 +134,7 @@     ChanServer{requestUIS=Just{}} -> writeQueue resp $ responseS chan     _ -> return () -sendQueryAI :: MonadServerReadRequest m => FactionId -> ActorId -> m RequestAI+sendQueryAI :: MonadServerComm m => FactionId -> ActorId -> m RequestAI sendQueryAI fid aid = do   let respAI = RespQueryAI aid   debug <- getsServer $ sniff . soptions@@ -145,7 +146,7 @@   when debug $ debugRequestAI aid   return req -sendQueryUI :: (MonadServerAtomic m, MonadServerReadRequest m)+sendQueryUI :: (MonadServerAtomic m, MonadServerComm m)             => FactionId -> ActorId -> m RequestUI sendQueryUI fid _aid = do   let respUI = RespQueryUI@@ -158,7 +159,7 @@   when debug $ debugRequestUI _aid   return req -killAllClients :: (MonadServerAtomic m, MonadServerReadRequest m) => m ()+killAllClients :: (MonadServerAtomic m, MonadServerComm m) => m () killAllClients = do   d <- getDict   let sendKill fid _ = sendUpdNoState fid $ UpdKillExit fid@@ -174,7 +175,7 @@ -- | Update connections to the new definition of factions. -- Connect to clients in old or newly spawned threads -- that read and write directly to the channels.-updateConn :: (MonadServerAtomic m, MonadServerReadRequest m)+updateConn :: (MonadServerAtomic m, MonadServerComm m)            => (Bool -> FactionId -> ChanServer -> IO ())            -> m () updateConn executorClient = do@@ -211,7 +212,7 @@         forkUI fid conn   liftIO $ mapWithKeyM_ forkClient toSpawn -tryRestore :: MonadServerReadRequest m => m (Maybe (State, StateServer))+tryRestore :: MonadServerComm m => m (Maybe (State, StateServer)) tryRestore = do   cops <- getsState scops   soptions <- getsServer soptions

@@ -10,7 +10,7 @@ import           Data.Binary import qualified System.Random as R -import Game.LambdaHack.Client+import Game.LambdaHack.Client (ClientOptions (..), defClientOptions) import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Misc import Game.LambdaHack.Content.ModeKind

@@ -186,8 +186,9 @@       rnd :: Rnd (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,                   DungeonGen.FreshDungeon, ContentId ModeKind)       rnd = do-        modeKindId <- fromMaybe (error $ "" `showFailure` gameMode)-                      <$> opick comode gameMode (const True)+        modeKindId <-+          fromMaybe (error $ "Unknown game mode:" `showFailure` gameMode)+          <$> opick comode gameMode (const True)         let mode = okind comode modeKindId             automatePS ps = ps {rosterList =               map (first $ automatePlayer True) $ rosterList ps}

@@ -36,7 +36,6 @@   , sdiscoKindRev :: DiscoveryKindRev                                     -- ^ reverse map, used for item creation   , suniqueSet    :: UniqueSet      -- ^ already generated unique items-  , 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@@ -76,7 +75,6 @@     , sactorStasis = ES.empty     , sdiscoKindRev = emptyDiscoveryKindRev     , suniqueSet = ES.empty-    , sitemSeedD = EM.empty     , sitemRev = HM.empty     , sflavour = emptyFlavourMap     , sacounter = toEnum 0@@ -118,7 +116,6 @@     put sactorStasis     put sdiscoKindRev     put suniqueSet-    put sitemSeedD     put sitemRev     put sflavour     put sacounter@@ -133,7 +130,6 @@     sactorStasis <- get     sdiscoKindRev <- get     suniqueSet <- get-    sitemSeedD <- get     sitemRev <- get     sflavour <- get     sacounter <- get

@@ -121,8 +121,8 @@   { csymbol       = 'E'   , cname         = "Tall cavern"   , cfreq         = [("caveEmpty", 1)]-  , cgrid         = DiceXY 1 1-  , cminPlaceSize = DiceXY 12 12+  , cgrid         = DiceXY 2 2+  , cminPlaceSize = DiceXY 12 9   , cmaxPlaceSize = DiceXY 48 32  -- favour large rooms   , cdarkChance   = 1 `d` 100 + 1 `dL` 100   , cnightChance  = 0  -- always day

@@ -233,7 +233,8 @@ light1 = ItemKind   { isymbol  = symbolLight   , iname    = "wooden torch"-  , ifreq    = [("common item", 100), ("light source", 100), ("wooden torch", 1)]+  , ifreq    = [ ("common item", 100), ("light source", 100)+               , ("wooden torch", 1) ]   , iflavour = zipPlain [Brown]   , icount   = 1 `dL` 4   , irarity  = [(1, 15)]@@ -245,7 +246,7 @@   , ieffects = [Burn 1]   , ifeature = [Lobable, Equipable, EqpSlot EqpSlotLightSource]                  -- not Fragile; reusable flare-  , idesc    = "A smoking, heavy wooden torch, burning in an unsteady glow."+  , idesc    = "A heavy smoking wooden torch, improvised using a cloth soaked in tar, burning in an unsteady glow."   , ikit     = []   } light2 = ItemKind

@@ -44,17 +44,10 @@   -- The keybindings overwrite places marked with left curly brace signs.   -- This sign is forbidden anywhere else in the picture.   -- The picture and the whole main menu is displayed dull white on black.-  ---  -- The picture should be exactly 60 rows by 110 columns,-  -- but only the middle rectangle of 24 rows by 80 columns is partially-  -- overwritten with UI information and the curly brace signs are allowed-  -- only there. So, the rectangle is 15 characters distant from the left-  -- and 18 from top. For screen sizes larger than 60 by 100,-  -- the picture is centered and padded with spaces, so it makes sense-  -- for some or all of the picture borders to be spaces, as well.-  -- If the screen is smaller than 60 by 100, borders of the picture-  -- are cut off. Minimal screes size is 24 by 80 and the picture-  -- should look well at this size, as well.+  -- The glyphs, or at least the character cells, are perfect squares.+  -- The picture should be exactly 45 rows by 80 columns.+  -- For larger screen sizes, the picture is centered and padded with spaces,+  -- so it makes sense for some or all of the picture borders to be spaces.   , rmainMenuArt = $(do       let path = "GameDefinition/MainMenu.ascii"       qAddDependentFile path

@@ -117,7 +117,6 @@   , talter   = 2   , tfeature = [ RevealAs "trapped vertical door Lit"                , ObscureAs "obscured vertical wall Lit"-                ]   } wallObscured = TileKind@@ -129,7 +128,6 @@   , talter   = 5   , tfeature = [ Embed "scratch on wall"                , HideAs "suspect vertical wall Lit"-                ]   } wallH = TileKind@@ -139,9 +137,7 @@   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 100-  , tfeature = [ BuildAs "suspect horizontal wall Lit"--               ]+  , tfeature = [BuildAs "suspect horizontal wall Lit"]   } wallSuspectH = TileKind  -- only on client   { tsymbol  = '-'@@ -152,7 +148,6 @@   , talter   = 2   , tfeature = [ RevealAs "trapped horizontal door Lit"                , ObscureAs "obscured horizontal wall Lit"-                ]   } wallObscuredDefacedH = TileKind@@ -164,7 +159,6 @@   , talter   = 5   , tfeature = [ Embed "obscene pictogram"                , HideAs "suspect horizontal wall Lit"-                ]   } wallObscuredFrescoedH = TileKind@@ -176,7 +170,6 @@   , talter   = 5   , tfeature = [ Embed "subtle fresco"                , HideAs "suspect horizontal wall Lit"-                ]  -- a bit beneficial, but AI would loop if allowed to trigger                   -- so no @ConsideredByAI@   }@@ -222,7 +215,6 @@   , talter   = 5   , tfeature = [ ConsideredByAI  -- changes after use, so safe for AI                , RevealAs "signboard"  -- to display as hidden-                ]   } signboardRead = TileKind@@ -299,7 +291,6 @@   , tfeature = [ Embed "doorway trap"                , OpenTo "open vertical door Lit"                , HideAs "suspect vertical wall Lit"-                ]   } doorClosed = TileKind@@ -321,7 +312,6 @@   , tfeature = [ Embed "doorway trap"                , OpenTo "open horizontal door Lit"                , HideAs "suspect horizontal wall Lit"-                ]   } doorClosedH = TileKind

@@ -19,7 +19,6 @@  import           Game.LambdaHack.Atomic (MonadStateWrite (..), putState) import           Game.LambdaHack.Client-import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.HandleAtomicM import           Game.LambdaHack.Client.HandleResponseM import           Game.LambdaHack.Client.LoopM

@@ -77,7 +77,7 @@   chanSaveServer = SerImplementation $ gets serToSave   liftIO         = SerImplementation . IO.liftIO -instance MonadServerReadRequest SerImplementation where+instance MonadServerComm SerImplementation where   {-# INLINE getsDict #-}   getsDict   f = SerImplementation $ gets $ f . serDict   {-# INLINE modifyDict #-}

@@ -8,6 +8,7 @@  import Game.LambdaHack.Common.Prelude +import           Control.Concurrent import           Control.Concurrent.Async import qualified Control.Exception as Ex import qualified Options.Applicative as OA@@ -19,9 +20,9 @@ import qualified System.IO as SIO  import Game.LambdaHack.Common.File (tryCreateDir)-import Game.LambdaHack.Common.Misc #endif +import Game.LambdaHack.Common.Misc import Game.LambdaHack.Server (serverOptionsPI)  import Implementation.TieKnot@@ -30,9 +31,14 @@ -- run the game and handle exit. main :: IO () main = do+  -- This may be broken with JS and also bloats the outcome file, so disabled. #ifndef USE_JSFILE-  -- For the case when the game is started not on a console.-  -- This is broken with JS and also bloats the outcome file.+  -- Special case hack, when the game is started not on a console.+  -- Without this, any attempt to output on stdout crashes a Windows exe+  -- (at least on Windows Vista) launched from the desktop or start menu.+  -- This is very crude and results in the inability to, e.g., process+  -- the output of @--help@ through a unix pipe. However, this should be+  -- effective on all Windows version, without the need to test all.   isTerminal <- SIO.hIsTerminalDevice SIO.stdout   unless isTerminal $ do     dataDir <- appDataDir@@ -41,12 +47,23 @@     fstderr <- SIO.openFile (dataDir </> "stderr.txt") SIO.WriteMode     GHC.IO.Handle.hDuplicateTo fstdout SIO.stdout     GHC.IO.Handle.hDuplicateTo fstderr SIO.stderr+  let fillWorkaround =+        -- Set up void workaround if nothing specific required.+        void $ tryPutMVar workaroundOnMainThreadMVar $ return () #endif   -- Fail here, not inside server code, so that savefiles are not removed,   -- because they are not the source of the failure.   !serverOptions <- OA.execParser serverOptionsPI   -- Avoid the bound thread that would slow down the communication.   a <- async $ tieKnot serverOptions+#ifndef USE_JSFILE+               `Ex.finally` fillWorkaround+  -- Run a (possibly void) workaround. It's needed for architectures/frontends+  -- that need to perform some actions on the main thread+  -- (not just any bound thread), e.g., newer OS X drawing with SDL2.+  workaround <- takeMVar workaroundOnMainThreadMVar+  workaround+#endif   resOrEx <- waitCatch a   let unwrapEx e = #if MIN_VERSION_async(2,2,1)

@@ -1,60 +1,45 @@-                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -               fffffjjjjtti,:Lft:                tDEGLLGEKEK;   .    .   . .  .iEDEGL.;iiij ...               -               fLLLLfffjjjti;.fL .              GDDLfGDEDEf .    .  .      .    ;LDWEGi,;iit ..               -               LD#WWELfffjjtt;.if.:           .DEGLLGEDLti,   . .    . . .        ,tLKDG ,;itt.               -               fK#WWW#DLffjjtt;:;j...        tDEGfLDEDGtK.  . LambdaHack           itLEG::;itt.               -               ;K#WWWWW Lfffjjti:.t...      tDEGfLDEDL, .                           tDGj.;itt.                -                EWWWWKW  GLffjjti: t,      tDEGLGEEDj;   <lambdahack.github.io>      tLDLi,ittj               -                EKWWWEWG  GLffjjti: tt   .tDEGGDEDGi,                                ;fEG :iitj               -                LEWWWKKK   GLfffjti: tt  tDDLGDEDGf.  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ;jGG :iitj               -                 DWWWKDWL   DLffjjti: jt.DDLGDEDLD    {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG .ittj               -                 LEWWWEDKj   DLffjjti: jj.LGDEDLE     {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG  ittj               -                  DKKWKDEKf   GLffjjti::ff.EEDLE      {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGG  ittj               -                   GWKWEDEEt   GLffjjji :fL.ELE       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ :tGL  ittf               -                   EEWKKDGDEjt..DLfftjji.,fG:K,       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGj,.tjjf               -                    EfKGKDLGDDDGDGLffiiti ttf:.       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ .LG;i,;itt               -                   ..EDKEKEGjiLDDfGLLfijtii;fL:       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ jLj ,;tjtL               -                  . . KLEEKKDGLLLGLGLfffjji,;LL:,.    {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{,tfL.fijffL               -                 .......jDKEEKKKKKEDGLffffji;;LL:...  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{j fGii tjff               -               ..........KtGDKEDEEDGLGLfffjti,;Lf:::: {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{iDf j:jffL.               -               ..........::,E,tjjifL,,LLfffjji.;fL.,: {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{fiififffL .               -                ......::,;tjLGGGGGLfji;LLfffjjt.,jft.                              ;t;i:jfff  .               -                ..:::::,;;;,iiiiiiii;;;;LLfffjjt,,;LL:  ...                       ,iiijjfffL ..               -               ..:::::,,;;;;;;;;;;;;;;;;;GLffffjt;j,jff,:::,                   ;ifLjjijifffL ..               -               .......::,,,,;;;;,,,,,,,,,:GLffffjjt:::tLiL                   LLLLGj;i,ffLLL ...               -               .    ..:::::,,,,,,,,,,, Version X.X.X (frontend: xxx, engine: LambdaHack X.X.X).               -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              -                                                                                                              +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +fffffjjjjtti,:Lft:                tDEGLLGEKEK;   .    .   . .  .iEDEGL.;iiij ...+fLLLLfffjjjti;.fL .              GDDLfGDEDEf .    .  .      .    ;LDWEGi,;iit ..+LD#WWELfffjjtt;.if.:           .DEGLLGEDLti,   . .    . . .        ,tLKDG ,;itt.+fK#WWW#DLffjjtt;:;j...        tDEGfLDEDGtK.  . LambdaHack           itLEG::;itt.+;K#WWWWW Lfffjjti:.t...      tDEGfLDEDL, .                           tDGj.;itt. + EWWWWKW  GLffjjti: t,      tDEGLGEEDj;   <lambdahack.github.io>      tLDLi,ittj+ EKWWWEWG  GLffjjti: tt   .tDEGGDEDGi,                                ;fEG :iitj+ LEWWWKKK   GLfffjti: tt  tDDLGDEDGf.  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ;jGG :iitj+  DWWWKDWL   DLffjjti: jt.DDLGDEDLD    {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG .ittj+  LEWWWEDKj   DLffjjti: jj.LGDEDLE     {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG  ittj+   DKKWKDEKf   GLffjjti::ff.EEDLE      {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGG  ittj+    GWKWEDEEt   GLffjjji :fL.ELE       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ :tGL  ittf+    EEWKKDGDEjt..DLfftjji.,fG:K,       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGj,.tjjf+     EfKGKDLGDDDGDGLffiiti ttf:.       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ .LG;i,;itt+    ..EDKEKEGjiLDDfGLLfijtii;fL:       {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ jLj ,;tjtL+   . . KLEEKKDGLLLGLGLfffjji,;LL:,.    {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{,tfL.fijffL+  .......jDKEEKKKKKEDGLffffji;;LL:...  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{j fGii tjff+..........KtGDKEDEEDGLGLfffjti,;Lf:::: {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{iDf j:jffL.+..........::,E,tjjifL,,LLfffjji.;fL.,: {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{fiififffL .+ ......::,;tjLGGGGGLfji;LLfffjjt.,jft.                              ;t;i:jfff  .+ ..:::::,;;;,iiiiiiii;;;;LLfffjjt,,;LL:  ...                       ,iiijjfffL ..+..:::::,,;;;;;;;;;;;;;;;;;GLffffjt;j,jff,:::,                   ;ifLjjijifffL ..+.......::,,,,;;;;,,,,,,,,,:GLffffjjt:::tLiL                   LLLLGj;i,ffLLL ...+.    ..:::::,,,,,,,,,,, Version X.X.X (frontend: xxx, engine: LambdaHack X.X.X).+                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                +                                                                                

@@ -5,13 +5,13 @@ -- PVP summary:+-+------- breaking API changes --             | | +----- minor or non-breaking API additions --             | | | +--- code changes with no API change-version:       0.8.1.2+version:       0.8.3.0 synopsis:      A game engine library for tactical squad ASCII roguelike dungeon crawlers description:   LambdaHack is a Haskell game engine library for ASCII roguelike                games of arbitrary theme, size and complexity, with optional                tactical squad combat. It's packaged together with a sample                dungeon crawler in fantasy setting that can be tried out-               in the browser: <http://lambdahack.github.io>+               in the browser at <http://lambdahack.github.io>.                (It runs fastest on Chrome. Keyboard commands and savefiles                are supported only on recent enough versions of browsers.                Mouse should work everywhere.)@@ -93,7 +93,7 @@   manual:             True  flag jsaddle-  description:        switch to the JSaddle frontend+  description:        switch to the JSaddle frontend (may be bit-rotted)   default:            False   manual:             True 

@@ -82,7 +82,7 @@ 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7  benchFrontendBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 1500 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7+	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7  benchCrawl: 	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0@@ -217,11 +217,18 @@ 	cp COPYLEFT LambdaHackTheGame 	cp CREDITS LambdaHackTheGame -build-binary: build-binary-common+build-binary-ubuntu: build-binary-common 	cp LambdaHackTheGameInstall/bin/LambdaHack LambdaHackTheGame 	dist/build/LambdaHack/LambdaHack --version > /dev/null; \ 	LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \ 	tar -czf LambdaHack_$${LH_VERSION}_ubuntu-16.04-amd64.tar.gz LambdaHackTheGame++build-binary-macosx: build-binary-common+	cp LambdaHackTheGameInstall/bin/LambdaHack LambdaHackTheGame+	dist/build/LambdaHack/LambdaHack --version > /dev/null; \+	LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \+	OS_VERSION=$$(sw_vers -productVersion); \+	tar -czf LambdaHack_$${LH_VERSION}_macosx-$${OS_VERSION}-amd64.tar.gz LambdaHackTheGame  new-build-dev: 	cabal new-build --datadir=. --disable-optimization -j1

@@ -9,7 +9,7 @@ games of arbitrary theme, size and complexity, with optional tactical squad combat. It's packaged together with a sample dungeon crawler in fantasy setting that can be tried out-in the browser: http://lambdahack.github.io+in the browser at http://lambdahack.github.io. (It runs fastest on Chrome. Keyboard commands and savefiles are supported only on recent enough versions of browsers. Mouse should work everywhere.)@@ -82,16 +82,19 @@ you may prefer to use a native binary for your architecture, if it exists.  Pre-compiled game binaries are available through-the release page[11] (and continuously from AppVeyor[18]).-Note that Windows binaries no longer work on Windows XP, since Cygwin-and MSYS2 dropped support for XP. To use a pre-compiled binary archive,-unpack it and run the executable in the unpacked directory-or use program shortcuts from the installer, if available.+the release page[11] (and, for Windows, continuously from AppVeyor[18]).+To use a pre-compiled binary archive, unpack it and run the executable+in the unpacked directory or use program shortcuts from the installer,+if available.  On Linux, make sure you have the SDL2 libraries installed on your system-(e.g., libsdl2-2.0-0, libsdl2-ttf-2.0-0 on Ubuntu; also libdw1).-For Windows, the SDL2 and all other needed libraries are already contained-in the game's binary archive.+(e.g., libsdl2-2.0-0, libsdl2-ttf-2.0-0 on Ubuntu).+On Mac OS X, you need SDL2 installed, e.g.,+from [libsdlorg](https://www.libsdl.org/download-2.0.php).+For Windows, the SDL2 and all other needed libraries are already+contained in the game's binary archive.+Note that Windows binaries no longer work on Windows XP, since Cygwin+and MSYS2 dropped support for XP.   Screen and keyboard configuration@@ -155,7 +158,7 @@     cabal update     cabal install LambdaHack -For a newer snapshot, download the source code from github[5]+For a newer snapshot, clone the source code from github[5] and run Cabal from the main directory      cabal install@@ -247,7 +250,7 @@ [8]: https://github.com/tuturto/space-privateers [9]: https://github.com/LambdaHack/LambdaHack/wiki/Sample-dungeon-crawler [10]: https://github.com/AllureOfTheStars/Allure-[11]: https://github.com/LambdaHack/LambdaHack/releases/latest+[11]: https://github.com/LambdaHack/LambdaHack/releases [15]: https://github.com/ghcjs/ghcjs [16]: https://www.npmjs.com/package/google-closure-compiler [18]: https://ci.appveyor.com/project/Mikolaj/lambdahack/build/artifacts