LambdaHack 0.8.3.0 → 0.9.3.0

raw patch · 297 files changed

+52760/−37482 lines, 297 filesdep +ghc-compactdep +primitivedep ~assert-failuredep ~asyncdep ~basebinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-compact, primitive

Dependency ranges changed: assert-failure, async, base, base-compat, binary, containers, deepseq, enummapset, filepath, hashable, keys, miniutter, optparse-applicative, random, text, time, transformers, unordered-containers, vector, vector-binary-instances

API changes (from Hackage documentation)

Files

• CHANGELOG.md +154/−0
• COPYLEFT +9/−9
• CREDITS +21/−3
• Game/LambdaHack/Atomic.hs +0/−22
• Game/LambdaHack/Atomic/CmdAtomic.hs +0/−255
• Game/LambdaHack/Atomic/HandleAtomicWrite.hs +0/−653
• Game/LambdaHack/Atomic/MonadStateWrite.hs +0/−329
• Game/LambdaHack/Atomic/PosAtomicRead.hs +0/−265
• Game/LambdaHack/Client.hs +0/−28
• Game/LambdaHack/Client/AI.hs +0/−78
• Game/LambdaHack/Client/AI/ConditionM.hs +0/−337
• Game/LambdaHack/Client/AI/HandleAbilityM.hs +0/−993
• Game/LambdaHack/Client/AI/PickActorM.hs +0/−342
• Game/LambdaHack/Client/AI/PickTargetM.hs +0/−433
• Game/LambdaHack/Client/AI/Strategy.hs +0/−117
• Game/LambdaHack/Client/Bfs.hs +0/−249
• Game/LambdaHack/Client/BfsM.hs +0/−440
• Game/LambdaHack/Client/ClientOptions.hs +0/−89
• Game/LambdaHack/Client/CommonM.hs +0/−169
• Game/LambdaHack/Client/HandleAtomicM.hs +0/−389
• Game/LambdaHack/Client/HandleResponseM.hs +0/−69
• Game/LambdaHack/Client/LoopM.hs +0/−116
• Game/LambdaHack/Client/MonadClient.hs +0/−59
• Game/LambdaHack/Client/Preferences.hs +0/−453
• Game/LambdaHack/Client/Request.hs +0/−59
• Game/LambdaHack/Client/Response.hs +0/−33
• Game/LambdaHack/Client/State.hs +0/−192
• Game/LambdaHack/Client/UI.hs +0/−182
• Game/LambdaHack/Client/UI/ActorUI.hs +0/−102
• Game/LambdaHack/Client/UI/Animation.hs +0/−244
• Game/LambdaHack/Client/UI/Content/KeyKind.hs +0/−175
• Game/LambdaHack/Client/UI/DisplayAtomicM.hs +0/−1280
• Game/LambdaHack/Client/UI/DrawM.hs +0/−644
• Game/LambdaHack/Client/UI/EffectDescription.hs +0/−350
• Game/LambdaHack/Client/UI/Frame.hs +0/−111
• Game/LambdaHack/Client/UI/FrameM.hs +0/−149
• Game/LambdaHack/Client/UI/Frontend.hs +0/−197
• Game/LambdaHack/Client/UI/Frontend/Chosen.hs +0/−21
• Game/LambdaHack/Client/UI/Frontend/Common.hs +0/−88
• Game/LambdaHack/Client/UI/Frontend/Curses.hs +0/−177
• Game/LambdaHack/Client/UI/Frontend/Dom.hs +0/−282
• Game/LambdaHack/Client/UI/Frontend/Gtk.hs +0/−253
• Game/LambdaHack/Client/UI/Frontend/Sdl.hs +0/−504
• Game/LambdaHack/Client/UI/Frontend/Teletype.hs +0/−80
• Game/LambdaHack/Client/UI/Frontend/Vty.hs +0/−148
• Game/LambdaHack/Client/UI/HandleHelperM.hs +0/−430
• Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs +0/−1497
• Game/LambdaHack/Client/UI/HandleHumanLocalM.hs +0/−1087
• Game/LambdaHack/Client/UI/HandleHumanM.hs +0/−147
• Game/LambdaHack/Client/UI/HumanCmd.hs +0/−203
• Game/LambdaHack/Client/UI/InventoryM.hs +0/−489
• Game/LambdaHack/Client/UI/ItemDescription.hs +0/−351
• Game/LambdaHack/Client/UI/ItemSlot.hs +0/−122
• Game/LambdaHack/Client/UI/Key.hs +0/−523
• Game/LambdaHack/Client/UI/KeyBindings.hs +0/−282
• Game/LambdaHack/Client/UI/MonadClientUI.hs +0/−421
• Game/LambdaHack/Client/UI/Msg.hs +0/−193
• Game/LambdaHack/Client/UI/MsgM.hs +0/−77
• Game/LambdaHack/Client/UI/Overlay.hs +0/−121
• Game/LambdaHack/Client/UI/RunM.hs +0/−248
• Game/LambdaHack/Client/UI/SessionUI.hs +0/−214
• Game/LambdaHack/Client/UI/Slideshow.hs +0/−131
• Game/LambdaHack/Client/UI/SlideshowM.hs +0/−228
• Game/LambdaHack/Client/UI/UIOptions.hs +0/−153
• Game/LambdaHack/Common/Ability.hs +0/−93
• Game/LambdaHack/Common/Actor.hs +0/−189
• Game/LambdaHack/Common/ActorState.hs +0/−504
• Game/LambdaHack/Common/Color.hs +0/−225
• Game/LambdaHack/Common/ContentData.hs +0/−204
• Game/LambdaHack/Common/Dice.hs +0/−244
• Game/LambdaHack/Common/Faction.hs +0/−209
• Game/LambdaHack/Common/File.hs +0/−13
• Game/LambdaHack/Common/Flavour.hs +0/−139
• Game/LambdaHack/Common/Frequency.hs +0/−130
• Game/LambdaHack/Common/HSFile.hs +0/−73
• Game/LambdaHack/Common/HighScore.hs +0/−201
• Game/LambdaHack/Common/Item.hs +0/−260
• Game/LambdaHack/Common/ItemAspect.hs +0/−303
• Game/LambdaHack/Common/JSFile.hs +0/−84
• Game/LambdaHack/Common/Kind.hs +0/−58
• Game/LambdaHack/Common/Level.hs +0/−248
• Game/LambdaHack/Common/Misc.hs +0/−282
• Game/LambdaHack/Common/MonadStateRead.hs +0/−83
• Game/LambdaHack/Common/Perception.hs +0/−98
• Game/LambdaHack/Common/Point.hs +0/−144
• Game/LambdaHack/Common/PointArray.hs +0/−319
• Game/LambdaHack/Common/Prelude.hs +0/−68
• Game/LambdaHack/Common/Random.hs +0/−111
• Game/LambdaHack/Common/ReqFailure.hs +0/−219
• Game/LambdaHack/Common/RingBuffer.hs +0/−55
• Game/LambdaHack/Common/Save.hs +0/−160
• Game/LambdaHack/Common/State.hs +0/−300
• Game/LambdaHack/Common/Thread.hs +0/−31
• Game/LambdaHack/Common/Tile.hs +0/−311
• Game/LambdaHack/Common/Time.hs +0/−284
• Game/LambdaHack/Common/Vector.hs +0/−257
• Game/LambdaHack/Content/CaveKind.hs +0/−151
• Game/LambdaHack/Content/ItemKind.hs +0/−566
• Game/LambdaHack/Content/ModeKind.hs +0/−228
• Game/LambdaHack/Content/PlaceKind.hs +0/−85
• Game/LambdaHack/Content/RuleKind.hs +0/−69
• Game/LambdaHack/Content/TileKind.hs +0/−320
• Game/LambdaHack/Server.hs +0/−22
• Game/LambdaHack/Server/BroadcastAtomic.hs +0/−269
• Game/LambdaHack/Server/Commandline.hs +0/−289
• Game/LambdaHack/Server/CommonM.hs +0/−537
• Game/LambdaHack/Server/DebugM.hs +0/−113
• Game/LambdaHack/Server/DungeonGen.hs +0/−249
• Game/LambdaHack/Server/DungeonGen/Area.hs +0/−135
• Game/LambdaHack/Server/DungeonGen/AreaRnd.hs +0/−234
• Game/LambdaHack/Server/DungeonGen/Cave.hs +0/−323
• Game/LambdaHack/Server/DungeonGen/Place.hs +0/−338
• Game/LambdaHack/Server/EndM.hs +0/−157
• Game/LambdaHack/Server/Fov.hs +0/−337
• Game/LambdaHack/Server/FovDigital.hs +0/−254
• Game/LambdaHack/Server/HandleAtomicM.hs +0/−305
• Game/LambdaHack/Server/HandleEffectM.hs +0/−1439
• Game/LambdaHack/Server/HandleRequestM.hs +0/−813
• Game/LambdaHack/Server/ItemM.hs +0/−182
• Game/LambdaHack/Server/ItemRev.hs +0/−201
• Game/LambdaHack/Server/LoopM.hs +0/−534
• Game/LambdaHack/Server/MonadServer.hs +0/−211
• Game/LambdaHack/Server/PeriodicM.hs +0/−307
• Game/LambdaHack/Server/ProtocolM.hs +0/−230
• Game/LambdaHack/Server/ServerOptions.hs +0/−126
• Game/LambdaHack/Server/StartM.hs +0/−342
• Game/LambdaHack/Server/State.hs +0/−156
• GameDefinition/Client/UI/Content/KeyKind.hs +0/−282
• GameDefinition/Content/CaveKind.hs +286/−174
• GameDefinition/Content/ItemKind.hs +1769/−1473
• GameDefinition/Content/ItemKindActor.hs +220/−164
• GameDefinition/Content/ItemKindBlast.hs +218/−143
• GameDefinition/Content/ItemKindEmbed.hs +111/−64
• GameDefinition/Content/ItemKindOrgan.hs +205/−116
• GameDefinition/Content/ItemKindTemporary.hs +84/−38
• GameDefinition/Content/ModeKind.hs +181/−67
• GameDefinition/Content/ModeKindPlayer.hs +48/−30
• GameDefinition/Content/PlaceKind.hs +675/−325
• GameDefinition/Content/RuleKind.hs +8/−42
• GameDefinition/Content/TileKind.hs +115/−86
• GameDefinition/Implementation/MonadClientImplementation.hs +0/−146
• GameDefinition/Implementation/MonadServerImplementation.hs +0/−199
• GameDefinition/Implementation/TieKnot.hs +0/−77
• GameDefinition/InGameHelp.txt +94/−95
• GameDefinition/Main.hs +7/−19
• GameDefinition/MainMenu.ascii +0/−21
• GameDefinition/MoveKeys.txt +19/−0
• GameDefinition/PLAYING.md +201/−136
• GameDefinition/config.ui.default +17/−13
• GameDefinition/fonts/16x16x.fnt binary
• GameDefinition/fonts/16x16x.fon binary
• GameDefinition/fonts/16x16xw.bdf +9271/−0
• GameDefinition/fonts/16x16xw.woff binary
• GameDefinition/fonts/8x8x.fnt binary
• GameDefinition/fonts/8x8x.fon binary
• GameDefinition/fonts/8x8xb.fnt binary
• GameDefinition/fonts/8x8xb.fon binary
• GameDefinition/fonts/Fix15Mono-Bold.woff binary
• GameDefinition/game-src/Client/UI/Content/Input.hs +280/−0
• GameDefinition/game-src/Client/UI/Content/Screen.hs +66/−0
• GameDefinition/game-src/Implementation/MonadClientImplementation.hs +159/−0
• GameDefinition/game-src/Implementation/MonadServerImplementation.hs +198/−0
• GameDefinition/game-src/TieKnot.hs +139/−0
• LambdaHack.cabal +193/−191
• Makefile +88/−40
• README.md +41/−31
• definition-src/Game/LambdaHack/Content/CaveKind.hs +155/−0
• definition-src/Game/LambdaHack/Content/ItemKind.hs +453/−0
• definition-src/Game/LambdaHack/Content/ModeKind.hs +238/−0
• definition-src/Game/LambdaHack/Content/PlaceKind.hs +106/−0
• definition-src/Game/LambdaHack/Content/RuleKind.hs +65/−0
• definition-src/Game/LambdaHack/Content/TileKind.hs +246/−0
• definition-src/Game/LambdaHack/Core/Dice.hs +266/−0
• definition-src/Game/LambdaHack/Core/Frequency.hs +134/−0
• definition-src/Game/LambdaHack/Core/Prelude.hs +151/−0
• definition-src/Game/LambdaHack/Core/Random.hs +118/−0
• definition-src/Game/LambdaHack/Definition/Ability.hs +243/−0
• definition-src/Game/LambdaHack/Definition/Color.hs +227/−0
• definition-src/Game/LambdaHack/Definition/ContentData.hs +168/−0
• definition-src/Game/LambdaHack/Definition/Defs.hs +172/−0
• definition-src/Game/LambdaHack/Definition/Flavour.hs +152/−0
• engine-src/Game/LambdaHack/Atomic.hs +22/−0
• engine-src/Game/LambdaHack/Atomic/CmdAtomic.hs +275/−0
• engine-src/Game/LambdaHack/Atomic/HandleAtomicWrite.hs +698/−0
• engine-src/Game/LambdaHack/Atomic/MonadStateWrite.hs +368/−0
• engine-src/Game/LambdaHack/Atomic/PosAtomicRead.hs +297/−0
• engine-src/Game/LambdaHack/Client.hs +28/−0
• engine-src/Game/LambdaHack/Client/AI.hs +81/−0
• engine-src/Game/LambdaHack/Client/AI/ConditionM.hs +431/−0
• engine-src/Game/LambdaHack/Client/AI/PickActionM.hs +1072/−0
• engine-src/Game/LambdaHack/Client/AI/PickActorM.hs +358/−0
• engine-src/Game/LambdaHack/Client/AI/PickTargetM.hs +478/−0
• engine-src/Game/LambdaHack/Client/AI/Strategy.hs +123/−0
• engine-src/Game/LambdaHack/Client/Bfs.hs +317/−0
• engine-src/Game/LambdaHack/Client/BfsM.hs +500/−0
• engine-src/Game/LambdaHack/Client/ClientOptions.hs +94/−0
• engine-src/Game/LambdaHack/Client/CommonM.hs +169/−0
• engine-src/Game/LambdaHack/Client/HandleAtomicM.hs +446/−0
• engine-src/Game/LambdaHack/Client/HandleResponseM.hs +69/−0
• engine-src/Game/LambdaHack/Client/LoopM.hs +115/−0
• engine-src/Game/LambdaHack/Client/MonadClient.hs +86/−0
• engine-src/Game/LambdaHack/Client/Preferences.hs +527/−0
• engine-src/Game/LambdaHack/Client/Request.hs +59/−0
• engine-src/Game/LambdaHack/Client/Response.hs +33/−0
• engine-src/Game/LambdaHack/Client/State.hs +225/−0
• engine-src/Game/LambdaHack/Client/UI.hs +186/−0
• engine-src/Game/LambdaHack/Client/UI/ActorUI.hs +78/−0
• engine-src/Game/LambdaHack/Client/UI/Animation.hs +236/−0
• engine-src/Game/LambdaHack/Client/UI/Content/Input.hs +249/−0
• engine-src/Game/LambdaHack/Client/UI/Content/Screen.hs +48/−0
• engine-src/Game/LambdaHack/Client/UI/ContentClientUI.hs +30/−0
• engine-src/Game/LambdaHack/Client/UI/DisplayAtomicM.hs +1722/−0
• engine-src/Game/LambdaHack/Client/UI/DrawM.hs +755/−0
• engine-src/Game/LambdaHack/Client/UI/EffectDescription.hs +385/−0
• engine-src/Game/LambdaHack/Client/UI/Frame.hs +119/−0
• engine-src/Game/LambdaHack/Client/UI/FrameM.hs +166/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend.hs +197/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Chosen.hs +21/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Common.hs +92/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Curses.hs +185/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Dom.hs +250/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Gtk.hs +264/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Sdl.hs +544/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Teletype.hs +79/−0
• engine-src/Game/LambdaHack/Client/UI/Frontend/Vty.hs +159/−0
• engine-src/Game/LambdaHack/Client/UI/HandleHelperM.hs +684/−0
• engine-src/Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs +1553/−0
• engine-src/Game/LambdaHack/Client/UI/HandleHumanLocalM.hs +1175/−0
• engine-src/Game/LambdaHack/Client/UI/HandleHumanM.hs +152/−0
• engine-src/Game/LambdaHack/Client/UI/HumanCmd.hs +216/−0
• engine-src/Game/LambdaHack/Client/UI/InventoryM.hs +515/−0
• engine-src/Game/LambdaHack/Client/UI/ItemDescription.hs +386/−0
• engine-src/Game/LambdaHack/Client/UI/ItemSlot.hs +117/−0
• engine-src/Game/LambdaHack/Client/UI/Key.hs +533/−0
• engine-src/Game/LambdaHack/Client/UI/KeyBindings.hs +287/−0
• engine-src/Game/LambdaHack/Client/UI/MonadClientUI.hs +435/−0
• engine-src/Game/LambdaHack/Client/UI/Msg.hs +401/−0
• engine-src/Game/LambdaHack/Client/UI/MsgM.hs +108/−0
• engine-src/Game/LambdaHack/Client/UI/Overlay.hs +145/−0
• engine-src/Game/LambdaHack/Client/UI/RunM.hs +270/−0
• engine-src/Game/LambdaHack/Client/UI/SessionUI.hs +219/−0
• engine-src/Game/LambdaHack/Client/UI/Slideshow.hs +172/−0
• engine-src/Game/LambdaHack/Client/UI/SlideshowM.hs +235/−0
• engine-src/Game/LambdaHack/Client/UI/UIOptions.hs +47/−0
• engine-src/Game/LambdaHack/Client/UI/UIOptionsParse.hs +136/−0
• engine-src/Game/LambdaHack/Common/Actor.hs +226/−0
• engine-src/Game/LambdaHack/Common/ActorState.hs +510/−0
• engine-src/Game/LambdaHack/Common/Analytics.hs +88/−0
• engine-src/Game/LambdaHack/Common/Area.hs +87/−0
• engine-src/Game/LambdaHack/Common/Faction.hs +183/−0
• engine-src/Game/LambdaHack/Common/File.hs +13/−0
• engine-src/Game/LambdaHack/Common/HSFile.hs +78/−0
• engine-src/Game/LambdaHack/Common/HighScore.hs +183/−0
• engine-src/Game/LambdaHack/Common/Item.hs +331/−0
• engine-src/Game/LambdaHack/Common/ItemAspect.hs +215/−0
• engine-src/Game/LambdaHack/Common/JSFile.hs +92/−0
• engine-src/Game/LambdaHack/Common/Kind.hs +117/−0
• engine-src/Game/LambdaHack/Common/Level.hs +341/−0
• engine-src/Game/LambdaHack/Common/Misc.hs +95/−0
• engine-src/Game/LambdaHack/Common/MonadStateRead.hs +129/−0
• engine-src/Game/LambdaHack/Common/Perception.hs +97/−0
• engine-src/Game/LambdaHack/Common/Point.hs +145/−0
• engine-src/Game/LambdaHack/Common/PointArray.hs +331/−0
• engine-src/Game/LambdaHack/Common/ReqFailure.hs +234/−0
• engine-src/Game/LambdaHack/Common/RingBuffer.hs +55/−0
• engine-src/Game/LambdaHack/Common/Save.hs +163/−0
• engine-src/Game/LambdaHack/Common/State.hs +304/−0
• engine-src/Game/LambdaHack/Common/Thread.hs +33/−0
• engine-src/Game/LambdaHack/Common/Tile.hs +335/−0
• engine-src/Game/LambdaHack/Common/Time.hs +306/−0
• engine-src/Game/LambdaHack/Common/Types.hs +56/−0
• engine-src/Game/LambdaHack/Common/Vector.hs +273/−0
• engine-src/Game/LambdaHack/Server.hs +22/−0
• engine-src/Game/LambdaHack/Server/BroadcastAtomic.hs +349/−0
• engine-src/Game/LambdaHack/Server/Commandline.hs +307/−0
• engine-src/Game/LambdaHack/Server/CommonM.hs +676/−0
• engine-src/Game/LambdaHack/Server/DebugM.hs +114/−0
• engine-src/Game/LambdaHack/Server/DungeonGen.hs +366/−0
• engine-src/Game/LambdaHack/Server/DungeonGen/AreaRnd.hs +351/−0
• engine-src/Game/LambdaHack/Server/DungeonGen/Cave.hs +353/−0
• engine-src/Game/LambdaHack/Server/DungeonGen/Place.hs +346/−0
• engine-src/Game/LambdaHack/Server/EndM.hs +154/−0
• engine-src/Game/LambdaHack/Server/Fov.hs +352/−0
• engine-src/Game/LambdaHack/Server/FovDigital.hs +318/−0
• engine-src/Game/LambdaHack/Server/HandleAtomicM.hs +327/−0
• engine-src/Game/LambdaHack/Server/HandleEffectM.hs +1893/−0
• engine-src/Game/LambdaHack/Server/HandleRequestM.hs +1001/−0
• engine-src/Game/LambdaHack/Server/ItemM.hs +238/−0
• engine-src/Game/LambdaHack/Server/ItemRev.hs +198/−0
• engine-src/Game/LambdaHack/Server/LoopM.hs +647/−0
• engine-src/Game/LambdaHack/Server/MonadServer.hs +210/−0
• engine-src/Game/LambdaHack/Server/PeriodicM.hs +341/−0
• engine-src/Game/LambdaHack/Server/ProtocolM.hs +229/−0
• engine-src/Game/LambdaHack/Server/ServerOptions.hs +125/−0
• engine-src/Game/LambdaHack/Server/StartM.hs +435/−0
• engine-src/Game/LambdaHack/Server/State.hs +185/−0
• test/test.hs +10/−4

@@ -1,3 +1,157 @@+## [v0.9.3.0, aka 'Velvet smoking jacket'](https://github.com/LambdaHack/LambdaHack/compare/v0.8.3.0...v0.9.3.0)++- Introduce message classes with configurable behaviour+- Create a new 16x16 font and use it everywhere; tweak smaller fonts+- Lock some levels or otherwise make ascending tricky+- Add cooldown to most melee weapons, display that in HUD, adjust AI+- Add per-scenario and per-outcome end-game messages in content+- Add duplicate and reroll item effects in preparation for crafting+- Add actor and item analytics as a preparation for XP gain quests+- Implement piercing projectiles that may share a tile with a big actor+- Increase the spawn speed now that monsters sleep a lot+- Introduce actors falling asleep and yelling+- Allow any level size and position+- Mention places when looking at tiles and add place lore menu+- Expand all kinds of content and rebalance+- Create and rework all item, cave and plot prose (Dan Keefe @Peritract)+- Make explosives in cramped spaces twice weaker+- Tweak player fling command+- Tweak equipping when equipment overfull+- Start cycling stores at equipment since that's the one mentioned in help+- Overhaul CI scripts+- Restructure and clean up codebase+- Extend balance debugging tools, using item and actor analytics, places, etc.+- Drop the gameplay option that first death means defeat+- Avoid idle-GC between slow keystrokes+- Put content data into a compact region to limit GC+- Remove the border around web frontend game screen; seems unneeded now+- Don't draw aiming line nor path in vty frontend+- Highlight xhair by cursor in vty frontend+- Highlight player by cursor in vty frontend+- Switch the default FPS to 24 for tradition's sake+- Highlight current high score+- Remove most stopPlayBack, now spurious, because message classes used+- Overhaul cabal file: define common options, split into internal libraries+- Fix confusion of nub and uniq+- Rename short wait to lurk and many lurks to heed+- Show a red message when HP or Calm dip too low or when foe appears+- Lose Calm and so alert AI even at weakest non-zero HP draining attacks+- Enable screenshots while in menus+- Rename config options related to fonts+- Recolour aiming line not to clash with the red crosshair+- Exchange the functions of yellow and red highlight+- Tweak all colours, in particular to differentiate blues/cyans+- Cap bright colours at 85 CIELAB Lightness at D65+- Normalize dark colours to be between 42 and 57 CIELAB Lightness at D65+- Get rid of colorIsBold option; KISS+- Tint white in alternating lines with different hue for long text readability+- Don't split lines at articles+- Set xhair to currently meleed foe to see his HP+- Display speed on HUD; tweak status lines in other ways+- Don't show description of leader target in HUD; TMI+- Help AI flee in a consistent direction over many turns+- Expose the save backup command, for browser games+- Don't display target info when item selected+- Let AI actors spawn even quite far from the player+- Auto-select all new team members, to help new players+- Replace O by zero on the map display; make zero distinct from O in all fonts+- Flesh out the initial ? prompt+- Add 'I' alias for pack-related commands, unless laptop key-scheme used+- Turn off movementLaptopKeys by default not to confuse new players+- Make sure AI attacks bosses even if distant and fleeing or non-moving+- Lower bonus HP at extreme difficulty+- Add a separate frame for each projectiles start+- Don't go modal at the frequent and weak hidden tile detection effect+- Make AI pick closest stairs more often+- Let apply-unskilled actors activate embedded items+- Don't boost damage by speed unless actor is projectile+- If everything else fails, let AI flee by opening doors+- Help AI actor prevent being dominated+- Make computing gameplay benefit to items more accurate+- Rename, clone and fine-tune effect Temporary+- Simplify code and content by getting rid of Recharging effect+- Let applying periodic items only produce the first effect+- Tweak item detection to help in skipping boring level portions and in stealth+- Invoke and display embedded items in the order specified in tile definitions+- Let lit trails illuminate colonnades+- Prevent an exploit for avoiding self-invoked firecrackers+- Don't let AI attempt summoning if not enough Calm+- Improve item label bracket codes in menus+- Pick randomly destination stairs if teleporting level+- Display the number of items in store+- Summarize value of player loot in shared stash menu's header+- Start history menu at the close-up of the last message+- Make fast-dying insects aggressive+- Overhaul game score DSL and particular scoring definitions in content+- Add and extend messages, e.g., tell if victim blocks and with what armor+- Extend and rework menu manipulation keys+- Remove specialized quaff, read and throw commands; KISS+- Split walls of text into more paragraphs and/or make them narrower+- Extend and update help and manual+- Don't let AI waste time looting distant lone projectiles+- Make Enum instances of Point and Vector contiguous, hackily+- Make dominated actor drop all his items, for ID and in case he defects ASAP+- Try to find a non-waiting action, if better AI leader can't be found+- Prevent summoning OoD actors+- Let animals eat food and add several foods+- Make Domination effect harder to activate+- Let only actors and items with SkOdor property leave smell and add perfumes+- Let spawning rate level out after a few dozen spawns+- Describe smell, if present in an inspected tile+- Let pushed actor fly after crashing a door open+- Show passing time and heard events even if no actors in the UI faction+- When movement impossible, describe the tile with SHIFT-direction+- Catch and steal projectiles when braced instead of when weaponless+- Let actors that are pushed perform any action in addition to movement+- Improve deduplication of messages+- When describing actor on map, tell if it has loot+- Represent being braced as having an organ; also add other pseudo-organs+- Overhaul hearing to facilitate triangulation based on sound cues+- Prefer to spawn aquatic actors on aquatic tiles+- Add swimming and flying skills and shallow water tile features+- Boost/drain skills via many new items+- Rework and extend skills and their effects as a preparation for XP rewards+- Enable specifying each side of outer cave fence separately+- Make definition of caves of a scenario more precise+- Specify more properties of levels in content+- Extend content validation+- Improve placement and fitting stairs and rooms on levels+- Don't hardwire level size+- Simplify game rules content+- Change the format of game client content+- Fix an arbitrary delay in killing dying actors+- Fix arbitrary branch of a corridor chosen when running+- Fix bush patches blocking off a level's corner+- Fix config file ignored at game reinit+- Fix running disturbed by flavours of walls+- Fix splitting lines one character too early+- Fix Calm drain from nearby foes occurring only every other turn+- Fix some AI looping movement, in particular when fleeing+- Fix running into own periodic explosions, e.g., from necklaces+- Fix 'she painfullies collide'+- Fix AI with vector targets unwilling to change them+- Fix crash when attempting to fling at a target on remote level+- Fix wrong timestamps in history+- Fix, again, various kinds of frames intruding between fadeout and fadein+- Fix wrong pluralization of some item names, compound and exceptions+- Fix disabled items benefit recalculation after item kind learned+- Fix in many ways too close initial faction and item positions+- Fix performance in many ways and places, particularly for JS translation+- Fix missing perception updates, causing missed AI actions concerning us+- Fix uninitialized sarenas, which was probably causing resume to change state+- Fix weak AI actors fleeing even if enemy can't melee+- Fix and optimize sifting free tiles for spawn/summon location+- Fix various cases of excessive summoning+- Fix recording of item first seen level+- Fix many problems with item descriptions and other messages+- Fix reporting of reduction and elimination of actor conditions+- Fix reading and interpreting old format config files+- Fix synced initial item timeouts and actor times, leading to artificial feel+- Fix actors erratically following their leader+- Fix lifts continuing as stars and the other way around+- Fix various 32bit overflows+- Fix other errors, probably not present or not visible in previous version+ ## [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

@@ -5,26 +5,26 @@  Files: * Copyright: 2008-2011 Andres Loeh-           2010-2018 Mikolaj Konarski and others (see git history)-License: BSD-3-clause+           2010-2019 Mikolaj Konarski and others (see git history)+License: BSD-3-Clause -Files: GameDefinition/fonts/*.fon+Files: GameDefinition/fonts/{*.fnt,*.bdf,16x16xw.woff} Copyright: 1997-2016 Leon Marrick            1997-2016 Sheldon Simms III            1997-2016 Nick McConnell-           2016-2018 Mikolaj Konarski-License: GPL-2+           2016-2019 Mikolaj Konarski+License: GPL-2.0-or-later  Files: GameDefinition/fonts/Fix15Mono-Bold.woff Copyright: 2012-2015 The Mozilla Foundation and Telefonica S.A-           2016-2018 Mikolaj Konarski+           2016-2019 Mikolaj Konarski License: OFL-1.1  Files: debian/* Copyright: held by the contributors mentioned in debian/changelog-License: BSD-3-clause+License: BSD-3-Clause -License: BSD-3-clause+License: BSD-3-Clause  Redistribution and use in source and binary forms, with or without  modification, are permitted provided that the following conditions  are met:@@ -48,7 +48,7 @@  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -License: GPL-2+License: GPL-2.0-or-later  This program is free software; you can redistribute it  and/or modify it under the terms of the GNU General Public  License, version 2, as published by the Free Software Foundation

@@ -5,17 +5,32 @@ Mikolaj Konarski Tuukka Turto Veronika Romashkina-@Peritract+Daniel Keefe Pablo Reszczynski  -Fonts 16x16x.fon, 8x8x.fon and 8x8xb.fon are are taken from+Fonts 16x16xw.woff, 16x16xw.bdf, 16x16x.fnt, 8x8x.fnt and 8x8xb.fnt+are are derived from fonts taken from https://github.com/angband/angband, copyrighted by Leon Marrick, Sheldon Simms III and Nick McConnell and released by them under-GNU GPL version 2. Any further modifications by authors of LambdaHack+GNU GPL, version 2 or any later version (confirmed at+http://www.thangorodrim.net/development/opensource.html).+Any further modifications by authors of LambdaHack are also released under GNU GPL version 2. The licence file is at GameDefinition/fonts/LICENSE.16x16x in the source code tree.+Font 16x16xw.bdf is derived from 16x16x.fon by changing all but+a few glyphs, converting to BDF format, extending character set+and hacking the font file with bdftopcf and pcf2bdf to include+full bitmaps, not only non-zero portions, for otherwise SDL2-ttf+was not able to display the glyphs.+Font 16x16xw.woff was derived from 16x16xw.bdf by changing format+to TTF with bitsnpicas, faking descendent offsets to be 1 point lower+to prevent freetype from adding an extra pixel to the descendent,+tweaking with fontforge glyps 3 5 6 8 A a S s b d h to prevent antialiasing+of their vital parts when zoomed out, auto-hinting, manually simplifying+hints in some glyphs and converting to WOFF format. + Font Fix15Mono-Bold.woff is a modified version of https://github.com/mozilla/Fira/blob/master/ttf/FiraMono-Bold.ttf that is copyright 2012-2015, The Mozilla Foundation and Telefonica S.A.@@ -32,3 +47,6 @@      that should be fixed at some point) * set width of space, nbsp and # glyphs to 1170     (this is a hack to make DOM create square table cells)+* copy O to 0 (zero) and add the middle dot from the original zero+* randomly fix various errors and simplify with fontforge+* auto-generate hints with fontforge

@@ -1,22 +0,0 @@--- | Atomic game state transformations, their representation and semantics.------ See--- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.-module Game.LambdaHack.Atomic-  ( -- * Re-exported from "Game.LambdaHack.Atomic.CmdAtomic"-    CmdAtomic(..), UpdAtomic(..), SfxAtomic(..), SfxMsg(..)-    -- * Re-exported from "Game.LambdaHack.Atomic.HandleAtomicWrite"-  , handleUpdAtomic-    -- * Re-exported from "Game.LambdaHack.Atomic.PosAtomicRead"-  , PosAtomic(..), posUpdAtomic, posSfxAtomic, breakUpdAtomic-  , seenAtomicCli, seenAtomicSer-    -- * Re-exported from "Game.LambdaHack.Atomic.MonadStateWrite"-  , MonadStateWrite(..), AtomicFail(..), putState-  ) where--import Prelude ()--import Game.LambdaHack.Atomic.CmdAtomic-import Game.LambdaHack.Atomic.HandleAtomicWrite-import Game.LambdaHack.Atomic.MonadStateWrite-import Game.LambdaHack.Atomic.PosAtomicRead

@@ -1,255 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--- | A set of atomic commands shared by client and server.--- These are the largest building blocks that have no components--- that can be observed in isolation.------ We try to make atomic commands respect the laws of energy and mass--- conservation, unless they really can't, e.g., monster spawning.--- For example item removal from inventory is not an atomic command,--- but item dropped from the inventory to the ground is. This makes--- it easier to undo the commands. In principle, the commands are the only--- way to affect the basic game state ('State').------ See--- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.-module Game.LambdaHack.Atomic.CmdAtomic-  ( CmdAtomic(..), UpdAtomic(..), SfxAtomic(..), SfxMsg(..)-  , undoUpdAtomic, undoSfxAtomic, undoCmdAtomic-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import Data.Binary-import Data.Int (Int64)-import GHC.Generics (Generic)---- Dependence on ClientOptions is an anomaly. Instead, probably the raw--- 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.Common.Actor-import qualified Game.LambdaHack.Common.Dice as Dice-import           Game.LambdaHack.Common.Faction-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-import           Game.LambdaHack.Common.Perception-import           Game.LambdaHack.Common.Point-import           Game.LambdaHack.Common.ReqFailure-import           Game.LambdaHack.Common.State-import           Game.LambdaHack.Common.Time-import           Game.LambdaHack.Common.Vector-import           Game.LambdaHack.Content.ItemKind (ItemKind)-import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.TileKind (TileKind)---- | Abstract syntax of atomic commands, that is, atomic game state--- transformations.-data CmdAtomic =-    UpdAtomic UpdAtomic  -- ^ atomic updates-  | SfxAtomic SfxAtomic  -- ^ atomic special effects-  deriving (Show, Eq, Generic)--instance Binary CmdAtomic---- | Abstract syntax of atomic updates, that is, atomic commands--- that really change the 'State'. Most of them are an encoding of a game--- state diff, though they also carry some intentional hints--- that help clients determine whether and how to communicate it to players.-data UpdAtomic =-  -- Create/destroy actors and items.-    UpdCreateActor ActorId Actor [(ItemId, Item)]-  | UpdDestroyActor ActorId Actor [(ItemId, Item)]-  | UpdCreateItem ItemId Item ItemQuant Container-  | UpdDestroyItem ItemId Item ItemQuant Container-  | UpdSpotActor ActorId Actor [(ItemId, Item)]-  | UpdLoseActor ActorId Actor [(ItemId, Item)]-  | UpdSpotItem Bool ItemId Item ItemQuant Container-  | UpdLoseItem Bool ItemId Item ItemQuant Container-  | UpdSpotItemBag Container ItemBag [(ItemId, Item)]-  | UpdLoseItemBag Container ItemBag [(ItemId, Item)]-  -- Move actors and items.-  | UpdMoveActor ActorId Point Point-  | UpdWaitActor ActorId Bool-  | UpdDisplaceActor ActorId ActorId-  | UpdMoveItem ItemId Int ActorId CStore CStore-  -- Change actor attributes.-  | UpdRefillHP ActorId Int64-  | UpdRefillCalm ActorId Int64-  | UpdTrajectory ActorId (Maybe ([Vector], Speed)) (Maybe ([Vector], Speed))-  -- Change faction attributes.-  | UpdQuitFaction FactionId (Maybe Status) (Maybe Status)-  | UpdLeadFaction FactionId (Maybe ActorId) (Maybe ActorId)-  | UpdDiplFaction FactionId FactionId Diplomacy Diplomacy-  | UpdTacticFaction FactionId Tactic Tactic-  | UpdAutoFaction FactionId Bool-  | UpdRecordKill ActorId (ContentId ItemKind) Int-  -- Alter map.-  | UpdAlterTile LevelId Point (ContentId TileKind) (ContentId TileKind)-  | UpdAlterExplorable LevelId Int-  | UpdAlterGold Int-  | UpdSearchTile ActorId Point (ContentId TileKind)-  | UpdHideTile ActorId Point (ContentId TileKind)-  | UpdSpotTile LevelId [(Point, ContentId TileKind)]-  | UpdLoseTile LevelId [(Point, ContentId TileKind)]-  | UpdAlterSmell LevelId Point Time Time-  | UpdSpotSmell LevelId [(Point, Time)]-  | UpdLoseSmell LevelId [(Point, Time)]-  -- Assorted.-  | UpdTimeItem ItemId Container ItemTimer ItemTimer-  | UpdAgeGame [LevelId]-  | UpdUnAgeGame [LevelId]-  | UpdDiscover Container ItemId (ContentId ItemKind) IA.AspectRecord-  | UpdCover Container ItemId (ContentId ItemKind) IA.AspectRecord-  | UpdDiscoverKind Container ItemKindIx (ContentId ItemKind)-  | UpdCoverKind Container ItemKindIx (ContentId ItemKind)-  | UpdDiscoverAspect Container ItemId IA.AspectRecord-  | UpdCoverAspect Container ItemId IA.AspectRecord-  | UpdDiscoverServer ItemId IA.AspectRecord-  | UpdCoverServer ItemId IA.AspectRecord-  | UpdPerception LevelId Perception Perception-  | UpdRestart FactionId PerLid State Challenge ClientOptions-  | UpdRestartServer State-  | UpdResume FactionId PerLid-  | UpdResumeServer State-  | UpdKillExit FactionId-  | UpdWriteSave-  deriving (Show, Eq, Generic)--instance Binary UpdAtomic---- | Abstract syntax of atomic special effects, that is, atomic commands--- that only display special effects and don't change 'State'.-data SfxAtomic =-    SfxStrike ActorId ActorId ItemId CStore-  | SfxRecoil ActorId ActorId ItemId CStore-  | SfxSteal ActorId ActorId ItemId CStore-  | SfxRelease ActorId ActorId ItemId CStore-  | SfxProject ActorId ItemId CStore-  | SfxReceive ActorId ItemId CStore-  | SfxApply ActorId ItemId CStore-  | SfxCheck ActorId ItemId CStore-  | SfxTrigger ActorId Point-  | SfxShun ActorId Point-  | SfxEffect FactionId ActorId IK.Effect Int64-  | SfxMsgFid FactionId SfxMsg-  | SfxSortSlots-  | SfxCollideTile ActorId Point-  deriving (Show, Eq, Generic)--instance Binary SfxAtomic---- | Symbolic representation of text messages sent by server to clients--- and shown to players.-data SfxMsg =-    SfxUnexpected ReqFailure-  | SfxExpected Text ReqFailure-  | SfxLoudUpd Bool UpdAtomic-  | SfxLoudStrike Bool (ContentId ItemKind) Int-  | SfxLoudSummon Bool (GroupName ItemKind) Dice.Dice-  | SfxFizzles-  | SfxNothingHappens-  | SfxVoidDetection IK.DetectKind-  | SfxUnimpressed ActorId-  | SfxSummonLackCalm ActorId-  | SfxLevelNoMore-  | SfxLevelPushed-  | SfxBracedImmune ActorId-  | SfxEscapeImpossible-  | SfxStasisProtects-  | SfxTransImpossible-  | SfxIdentifyNothing-  | SfxPurposeNothing CStore-  | SfxPurposeTooFew Int Int-  | SfxPurposeUnique-  | SfxPurposeNotCommon-  | SfxColdFish-  | SfxTimerExtended LevelId ActorId ItemId CStore-  | SfxCollideActor LevelId ActorId ActorId-  deriving (Show, Eq, Generic)--instance Binary SfxMsg--undoUpdAtomic :: UpdAtomic -> Maybe UpdAtomic-undoUpdAtomic cmd = case cmd of-  UpdCreateActor aid body ais -> Just $ UpdDestroyActor aid body ais-  UpdDestroyActor aid body ais -> Just $ UpdCreateActor aid body ais-  UpdCreateItem iid item k c -> Just $ UpdDestroyItem iid item k c-  UpdDestroyItem iid item k c -> Just $ UpdCreateItem iid item k c-  UpdSpotActor aid body ais -> Just $ UpdLoseActor aid body ais-  UpdLoseActor aid body ais -> Just $ UpdSpotActor aid body ais-  UpdSpotItem verbose iid item k c -> Just $ UpdLoseItem verbose iid item k c-  UpdLoseItem verbose iid item k c -> Just $ UpdSpotItem verbose iid item k c-  UpdSpotItemBag c bag ais -> Just $ UpdLoseItemBag c bag ais-  UpdLoseItemBag c bag ais -> Just $ UpdSpotItemBag c bag ais-  UpdMoveActor aid fromP toP -> Just $ UpdMoveActor aid toP fromP-  UpdWaitActor aid toWait -> Just $ UpdWaitActor aid (not toWait)-  UpdDisplaceActor source target -> Just $ UpdDisplaceActor target source-  UpdMoveItem iid k aid c1 c2 -> Just $ UpdMoveItem iid k aid c2 c1-  UpdRefillHP aid n -> Just $ UpdRefillHP aid (-n)-  UpdRefillCalm aid n -> Just $ UpdRefillCalm aid (-n)-  UpdTrajectory aid fromT toT -> Just $ UpdTrajectory aid toT fromT-  UpdQuitFaction fid fromSt toSt -> Just $ UpdQuitFaction fid toSt fromSt-  UpdLeadFaction fid source target -> Just $ UpdLeadFaction fid target source-  UpdDiplFaction fid1 fid2 fromDipl toDipl ->-    Just $ UpdDiplFaction fid1 fid2 toDipl fromDipl-  UpdTacticFaction fid toT fromT -> Just $ UpdTacticFaction fid fromT toT-  UpdAutoFaction fid st -> Just $ UpdAutoFaction fid (not st)-  UpdRecordKill aid ikind k -> Just $ UpdRecordKill aid ikind (-k)-  UpdAlterTile lid p fromTile toTile ->-    Just $ UpdAlterTile lid p toTile fromTile-  UpdAlterExplorable lid delta -> Just $ UpdAlterExplorable lid (-delta)-  UpdAlterGold delta -> Just $ UpdAlterGold (-delta)-  UpdSearchTile aid p toTile -> Just $ UpdHideTile aid p toTile-  UpdHideTile aid p toTile -> Just $ UpdSearchTile aid p toTile-  UpdSpotTile lid ts -> Just $ UpdLoseTile lid ts-  UpdLoseTile lid ts -> Just $ UpdSpotTile lid ts-  UpdAlterSmell lid p fromSm toSm -> Just $ UpdAlterSmell lid p toSm fromSm-  UpdSpotSmell lid sms -> Just $ UpdLoseSmell lid sms-  UpdLoseSmell lid sms -> Just $ UpdSpotSmell lid sms-  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 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-  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-  UpdRestart{} -> Just cmd  -- here history ends; change direction-  UpdRestartServer{} -> Just cmd  -- here history ends; change direction-  UpdResume{} -> Nothing-  UpdResumeServer{} -> Nothing-  UpdKillExit{} -> Nothing-  UpdWriteSave -> Nothing--undoSfxAtomic :: SfxAtomic -> SfxAtomic-undoSfxAtomic cmd = case cmd of-  SfxStrike source target iid cstore -> SfxRecoil source target iid cstore-  SfxRecoil source target iid cstore -> SfxStrike source target iid cstore-  SfxSteal source target iid cstore -> SfxRelease source target iid cstore-  SfxRelease source target iid cstore -> SfxSteal source target iid cstore-  SfxProject aid iid cstore -> SfxReceive aid iid cstore-  SfxReceive aid iid cstore -> SfxProject aid iid cstore-  SfxApply aid iid cstore -> SfxCheck aid iid cstore-  SfxCheck aid iid cstore -> SfxApply aid iid cstore-  SfxTrigger aid p -> SfxShun aid p-  SfxShun aid p -> SfxTrigger aid p-  SfxEffect{} -> cmd  -- not ideal?-  SfxMsgFid{} -> cmd-  SfxSortSlots -> cmd-  SfxCollideTile{} -> cmd--undoCmdAtomic :: CmdAtomic -> Maybe CmdAtomic-undoCmdAtomic (UpdAtomic cmd) = UpdAtomic <$> undoUpdAtomic cmd-undoCmdAtomic (SfxAtomic sfx) = Just $ SfxAtomic $ undoSfxAtomic sfx

@@ -1,653 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Semantics of atomic commands shared by client and server.------ See--- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.-module Game.LambdaHack.Atomic.HandleAtomicWrite-  ( handleUpdAtomic-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , updCreateActor, updDestroyActor, updCreateItem, updDestroyItem-  , updSpotItemBag, updLoseItemBag-  , updMoveActor, updWaitActor, updDisplaceActor, updMoveItem-  , updRefillHP, updRefillCalm-  , updTrajectory, updQuitFaction, updLeadFaction-  , updDiplFaction, updTacticFaction, updAutoFaction, updRecordKill-  , updAlterTile, updAlterExplorable, updSearchTile, updSpotTile, updLoseTile-  , updAlterSmell, updSpotSmell, updLoseSmell, updTimeItem-  , updAgeGame, updUnAgeGame, ageLevel, updDiscover, updCover-  , updDiscoverKind, discoverKind, updCoverKind-  , updDiscoverAspect, discoverAspect, updCoverAspect-  , updDiscoverServer, updCoverServer-  , updRestart, updRestartServer, updResumeServer-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import qualified Data.EnumMap.Strict as EM-import           Data.Int (Int64)--import           Game.LambdaHack.Atomic.CmdAtomic-import           Game.LambdaHack.Atomic.MonadStateWrite-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Faction-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-import           Game.LambdaHack.Common.MonadStateRead-import           Game.LambdaHack.Common.Perception-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray-import           Game.LambdaHack.Common.State-import qualified Game.LambdaHack.Common.Tile as Tile-import           Game.LambdaHack.Common.Time-import           Game.LambdaHack.Common.Vector-import           Game.LambdaHack.Content.ItemKind (ItemKind)-import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.ModeKind-import           Game.LambdaHack.Content.TileKind (TileKind, unknownId)---- | The game-state semantics of atomic game commands.--- There is no corresponding definition for special effects (`SfxAtomic`),--- because they don't modify 'State'.------ For each of the commands, we are guaranteed that the client,--- the command is addressed to, perceives all the positions the command--- affects (as computed by 'Game.LambdaHack.Atomic.PosAtomicRead.posUpdAtomic').--- In the code for each semantic function we additonally verify--- the client is aware of any relevant items and/or actors and we throw--- the @AtomicFail@ exception if it's not.--- The server keeps copies of all clients' states and, before sending a command--- to a client, applies it to the client's state copy.--- If @AtomicFail@ is signalled, the command is ignored for that client.--- This enables simpler server code that addresses commands to all clients--- that can see it, even though not all are able to process it.-handleUpdAtomic :: MonadStateWrite m => UpdAtomic -> m ()-handleUpdAtomic cmd = case cmd of-  UpdCreateActor aid body ais -> updCreateActor aid body ais-  UpdDestroyActor aid body ais -> updDestroyActor aid body ais-  UpdCreateItem iid item kit c -> updCreateItem iid item kit c-  UpdDestroyItem iid item kit c -> updDestroyItem iid item kit c-  UpdSpotActor aid body ais -> updCreateActor aid body ais-  UpdLoseActor aid body ais -> updDestroyActor aid body ais-  UpdSpotItem _ iid item kit c -> updCreateItem iid item kit c-  UpdLoseItem _ iid item kit c -> updDestroyItem iid item kit c-  UpdSpotItemBag c bag ais -> updSpotItemBag c bag ais-  UpdLoseItemBag c bag ais -> updLoseItemBag c bag ais-  UpdMoveActor aid fromP toP -> updMoveActor aid fromP toP-  UpdWaitActor aid toWait -> updWaitActor aid toWait-  UpdDisplaceActor source target -> updDisplaceActor source target-  UpdMoveItem iid k aid c1 c2 -> updMoveItem iid k aid c1 c2-  UpdRefillHP aid n -> updRefillHP aid n-  UpdRefillCalm aid n -> updRefillCalm aid n-  UpdTrajectory aid fromT toT -> updTrajectory aid fromT toT-  UpdQuitFaction fid fromSt toSt -> updQuitFaction fid fromSt toSt-  UpdLeadFaction fid source target -> updLeadFaction fid source target-  UpdDiplFaction fid1 fid2 fromDipl toDipl ->-    updDiplFaction fid1 fid2 fromDipl toDipl-  UpdTacticFaction fid toT fromT -> updTacticFaction fid toT fromT-  UpdAutoFaction fid st -> updAutoFaction fid st-  UpdRecordKill aid ikind k -> updRecordKill aid ikind k-  UpdAlterTile lid p fromTile toTile -> updAlterTile lid p fromTile toTile-  UpdAlterExplorable lid delta -> updAlterExplorable lid delta-  UpdAlterGold delta -> updAlterGold delta-  UpdSearchTile aid p toTile -> updSearchTile aid p toTile-  UpdHideTile{} -> undefined-  UpdSpotTile lid ts -> updSpotTile lid ts-  UpdLoseTile lid ts -> updLoseTile lid ts-  UpdAlterSmell lid p fromSm toSm -> updAlterSmell lid p fromSm toSm-  UpdSpotSmell lid sms -> updSpotSmell lid sms-  UpdLoseSmell lid sms -> updLoseSmell lid sms-  UpdTimeItem iid c fromIt toIt -> updTimeItem iid c fromIt toIt-  UpdAgeGame lids -> updAgeGame lids-  UpdUnAgeGame lids -> updUnAgeGame lids-  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-  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 ->-    assert (not (nullPer outPer && nullPer inPer)) (return ())-  UpdRestart _ _ s _ _ -> updRestart s-  UpdRestartServer s -> updRestartServer s-  UpdResume{} -> return ()-  UpdResumeServer s -> updResumeServer s-  UpdKillExit{} -> return ()-  UpdWriteSave -> return ()---- Note: after this command, usually a new leader--- for the party should be elected (in case this actor is the only one alive).-updCreateActor :: MonadStateWrite m-               => ActorId -> Actor -> [(ItemId, Item)] -> m ()-updCreateActor aid body ais = do-  -- Add actor to @sactorD@.-  -- The exception is possible, e.g., when we teleport and so see our actor-  -- at the new location, but also the location is part of new perception,-  -- so @UpdSpotActor@ is sent.-  let f Nothing = Just body-      f (Just b) = assert (body == b `blame` (aid, body, b)) $-        atomicFail $ "actor already added" `showFailure` (aid, body, b)-  modifyState $ updateActorD $ EM.alter f aid-  -- Add actor to @sprio@.-  let g Nothing = Just [aid]-      g (Just l) =-#ifdef WITH_EXPENSIVE_ASSERTIONS-        -- Not so much expensive, as doubly impossible.-        assert (aid `notElem` l `blame` "actor already added"-                                `swith` (aid, body, l))-#endif-        (Just $ aid : l)-  updateLevel (blid body) $ updateActorMap (EM.alter g (bpos body))-  addAis ais-  aspectRecord <- getsState $ aspectRecordFromActor body-  modifyState $ updateActorAspect $ EM.insert aid aspectRecord---- If a leader dies, a new leader should be elected on the server--- before this command is executed (not checked).-updDestroyActor :: MonadStateWrite m-                => ActorId -> Actor -> [(ItemId, Item)] -> m ()-updDestroyActor aid body ais = do-  -- Assert that actor's items belong to @sitemD@. Do not remove those-  -- that do not appear anywhere else, for simplicity and speed.-  itemD <- getsState sitemD-  let match (iid, item) = itemsMatch (itemD EM.! iid) item-  let !_A = assert (allB match ais `blame` "destroyed actor items not found"-                    `swith` (aid, body, ais, itemD)) ()-  -- Remove actor from @sactorD@.-  let f Nothing = error $ "actor already removed" `showFailure` (aid, body)-      f (Just b) = assert (b == body `blame` "inconsistent destroyed actor body"-                                     `swith` (aid, body, b)) Nothing-  modifyState $ updateActorD $ EM.alter f aid-  -- Remove actor from @lactor@.-  let g Nothing = error $ "actor already removed" `showFailure` (aid, body)-      g (Just l) =-#ifdef WITH_EXPENSIVE_ASSERTIONS-        -- Not so much expensive, as doubly impossible.-        assert (aid `elem` l `blame` "actor already removed"-                             `swith` (aid, body, l))-#endif-        (let l2 = delete aid l-         in if null l2 then Nothing else Just l2)-  updateLevel (blid body) $ updateActorMap (EM.alter g (bpos body))-  modifyState $ updateActorAspect $ EM.delete aid---- Create a few copies of an item that is already registered for the dungeon--- (in @sitemRev@ field of @StateServer@).-updCreateItem :: MonadStateWrite m-              => ItemId -> Item -> ItemQuant -> Container -> m ()-updCreateItem iid item kit@(k, _) c = assert (k > 0) $ do-  addAis [(iid, item)]-  insertItemContainer iid kit c-  case c of-    CActor aid store ->-      when (store `elem` [CEqp, COrgan]) $ addItemToActorAspect iid item k aid-    _ -> return ()---- Destroy some copies (possibly not all) of an item.-updDestroyItem :: MonadStateWrite m-               => ItemId -> Item -> ItemQuant -> Container -> m ()-updDestroyItem iid item kit@(k, _) c = assert (k > 0) $ do-  deleteItemContainer iid kit c-  -- Do not remove the item from @sitemD@ nor from @sitemRev@-  -- nor from @DiscoveryAspect@, @ItemIxMap@, etc.-  -- It's incredibly costly and not particularly noticeable for the player.-  -- Moreover, copies of the item may reappear in the future-  -- and then we save computation and the player remembers past discovery.-  -- However, assert the item is registered in @sitemD@.-  itemD <- getsState sitemD-  let !_A = assert ((case iid `EM.lookup` itemD of-                        Nothing -> False-                        Just item0 -> itemsMatch item0 item)-                    `blame` "item already removed"-                    `swith` (iid, item, itemD)) ()-  case c of-    CActor aid store -> when (store `elem` [CEqp, COrgan])-                        $ addItemToActorAspect iid item (-k) aid-    _ -> return ()--updSpotItemBag :: MonadStateWrite m-               => Container -> ItemBag -> [(ItemId, Item)] -> m ()-updSpotItemBag c bag ais = assert (EM.size bag > 0-                                   && EM.size bag == length ais) $ do-  addAis ais-  insertBagContainer bag c-  case c of-    CActor aid store ->-      when (store `elem` [CEqp, COrgan]) $-        forM_ ais $ \(iid, item) ->-                      addItemToActorAspect iid item (fst $ bag EM.! iid) aid-    _ -> return ()--updLoseItemBag :: MonadStateWrite m-               => Container -> ItemBag -> [(ItemId, Item)] -> m ()-updLoseItemBag c bag ais = assert (EM.size bag > 0-                                   && EM.size bag == length ais) $ do-  deleteBagContainer bag c-  -- Do not remove the items from @sitemD@ nor from @sitemRev@,-  -- It's incredibly costly and not noticeable for the player.-  -- However, assert the items are registered in @sitemD@.-  itemD <- getsState sitemD-  let match (iid, item) = itemsMatch (itemD EM.! iid) item-  let !_A = assert (allB match ais `blame` "items already removed"-                                   `swith` (c, bag, ais, itemD)) ()-  case c of-    CActor aid store ->-      when (store `elem` [CEqp, COrgan]) $-        forM_ ais $ \(iid, item) ->-                      addItemToActorAspect iid item (- (fst $ bag EM.! iid)) aid-    _ -> return ()--updMoveActor :: MonadStateWrite m => ActorId -> Point -> Point -> m ()-updMoveActor aid fromP toP = assert (fromP /= toP) $ do-  body <- getsState $ getActorBody aid-  let !_A = assert (fromP == bpos body-                    `blame` "unexpected moved actor position"-                    `swith` (aid, fromP, toP, bpos body, body)) ()-      newBody = body {bpos = toP, boldpos = Just fromP}-  updateActor aid $ const newBody-  moveActorMap aid body newBody--updWaitActor :: MonadStateWrite m => ActorId -> Bool -> m ()-updWaitActor aid toWait = do-  b <- getsState $ getActorBody aid-  let !_A = assert (toWait /= bwait b-                    `blame` "unexpected waited actor time"-                    `swith` (aid, toWait, bwait b, b)) ()-  updateActor aid $ \body -> body {bwait = toWait}--updDisplaceActor :: MonadStateWrite m => ActorId -> ActorId -> m ()-updDisplaceActor source target = assert (source /= target) $ do-  sbody <- getsState $ getActorBody source-  tbody <- getsState $ getActorBody target-  let spos = bpos sbody-      tpos = bpos tbody-      snewBody = sbody {bpos = tpos, boldpos = Just spos}-      tnewBody = tbody {bpos = spos, boldpos = Just tpos}-  updateActor source $ const snewBody-  updateActor target $ const tnewBody-  moveActorMap source sbody snewBody-  moveActorMap target tbody tnewBody--updMoveItem :: MonadStateWrite m-            => ItemId -> Int -> ActorId -> CStore -> CStore-            -> m ()-updMoveItem iid k aid s1 s2 = assert (k > 0 && s1 /= s2) $ do-  b <- getsState $ getActorBody aid-  bag <- getsState $ getBodyStoreBag b s1-  case iid `EM.lookup` bag of-    Nothing -> error $ "" `showFailure` (iid, k, aid, s1, s2)-    Just (_, it) -> do-      deleteItemActor iid (k, take k it) aid s1-      insertItemActor iid (k, take k it) aid s2-  case s1 of-    CEqp -> case s2 of-      COrgan -> return ()-      _ -> do-        itemBase <- getsState $ getItemBody iid-        addItemToActorAspect iid itemBase (-k) aid-    COrgan -> case s2 of-      CEqp -> return ()-      _ -> do-        itemBase <- getsState $ getItemBody iid-        addItemToActorAspect iid itemBase (-k) aid-    _ ->-      when (s2 `elem` [CEqp, COrgan]) $ do-        itemBase <- getsState $ getItemBody iid-        addItemToActorAspect iid itemBase k aid--updRefillHP :: MonadStateWrite m => ActorId -> Int64 -> m ()-updRefillHP aid nRaw =-  updateActor aid $ \b ->-    -- Make rescue easier by not going into negative HP the first time.-    let newRawHP = bhp b + nRaw-        newHP = if bhp b <= 0 then newRawHP else max 0 newRawHP-        n = newHP - bhp b-    in b { bhp = newHP-         , bhpDelta = let oldD = bhpDelta b-                      in case compare n 0 of-                        EQ -> ResDelta { resCurrentTurn = (0, 0)-                                       , resPreviousTurn = resCurrentTurn oldD }-                        LT -> oldD {resCurrentTurn =-                                      ( fst (resCurrentTurn oldD) + n-                                      , snd (resCurrentTurn oldD) )}-                        GT -> oldD {resCurrentTurn =-                                      ( fst (resCurrentTurn oldD)-                                      , snd (resCurrentTurn oldD) + n )}-         }--updRefillCalm :: MonadStateWrite m => ActorId -> Int64 -> m ()-updRefillCalm aid n =-  updateActor aid $ \b ->-    b { bcalm = max 0 $ bcalm b + n-      , bcalmDelta = let oldD = bcalmDelta b-                     in case compare n 0 of-                       EQ -> ResDelta { resCurrentTurn = (0, 0)-                                      , resPreviousTurn = resCurrentTurn oldD }-                       LT -> oldD {resCurrentTurn =-                                     ( fst (resCurrentTurn oldD) + n-                                     , snd (resCurrentTurn oldD) )}-                       GT -> oldD {resCurrentTurn =-                                     ( fst (resCurrentTurn oldD)-                                     , snd (resCurrentTurn oldD) + n )}-      }--updTrajectory :: MonadStateWrite m-              => ActorId-              -> Maybe ([Vector], Speed)-              -> Maybe ([Vector], Speed)-              -> m ()-updTrajectory aid fromT toT = assert (fromT /= toT) $ do-  body <- getsState $ getActorBody aid-  let !_A = assert (fromT == btrajectory body-                    `blame` "unexpected actor trajectory"-                    `swith` (aid, fromT, toT, body)) ()-  updateActor aid $ \b -> b {btrajectory = toT}--updQuitFaction :: MonadStateWrite m-               => FactionId -> Maybe Status -> Maybe Status -> m ()-updQuitFaction fid fromSt toSt = do-  let !_A = assert (fromSt /= toSt `blame` (fid, fromSt, toSt)) ()-  fact <- getsState $ (EM.! fid) . sfactionD-  let !_A = assert (fromSt == gquit fact-                    `blame` "unexpected actor quit status"-                    `swith` (fid, fromSt, toSt, fact)) ()-  let adj fa = fa {gquit = toSt}-  updateFaction fid adj---- The previous leader is assumed to be alive.-updLeadFaction :: MonadStateWrite m-               => FactionId-               -> Maybe ActorId-               -> Maybe ActorId-               -> m ()-updLeadFaction fid source target = assert (source /= target) $ do-  fact <- getsState $ (EM.! fid) . sfactionD-  let !_A = assert (fleaderMode (gplayer fact) /= LeaderNull) ()-    -- @PosNone@ ensures this-  mtb <- getsState $ \s -> flip getActorBody s <$> target-  let !_A = assert (maybe True (not . bproj) mtb-                    `blame` (fid, source, target, mtb, fact)) ()-  let !_A = assert (source == gleader fact-                    `blame` "unexpected actor leader"-                    `swith` (fid, source, target, mtb, fact)) ()-  let adj fa = fa {_gleader = target}-  updateFaction fid adj--updDiplFaction :: MonadStateWrite m-               => FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()-updDiplFaction fid1 fid2 fromDipl toDipl =-  assert (fid1 /= fid2 && fromDipl /= toDipl) $ do-    fact1 <- getsState $ (EM.! fid1) . sfactionD-    fact2 <- getsState $ (EM.! fid2) . sfactionD-    let !_A = assert (fromDipl == EM.findWithDefault Unknown fid2 (gdipl fact1)-                      && fromDipl == EM.findWithDefault Unknown fid1 (gdipl fact2)-                      `blame` "unexpected actor diplomacy status"-                      `swith` (fid1, fid2, fromDipl, toDipl, fact1, fact2)) ()-    let adj fid fact = fact {gdipl = EM.insert fid toDipl (gdipl fact)}-    updateFaction fid1 (adj fid2)-    updateFaction fid2 (adj fid1)--updTacticFaction :: MonadStateWrite m => FactionId -> Tactic -> Tactic -> m ()-updTacticFaction fid toT fromT = do-  let adj fact =-        let player = gplayer fact-        in assert (ftactic player == fromT)-           $ fact {gplayer = player {ftactic = toT}}-  updateFaction fid adj--updAutoFaction :: MonadStateWrite m => FactionId -> Bool -> m ()-updAutoFaction fid st =-  updateFaction fid (\fact ->-    assert (isAIFact fact == not st)-    $ fact {gplayer = automatePlayer st (gplayer fact)})---- Record a given number (usually just 1, or -1 for undo) of actor kills--- for score calculation.-updRecordKill :: MonadStateWrite m-              => ActorId -> ContentId ItemKind -> Int -> m ()-updRecordKill aid ikind k = do-  b <- getsState $ getActorBody aid-  let !_A = assert (not (bproj b) `blame` (aid, b))-  let alterKind mn = let n = fromMaybe 0 mn + k-                     in if n == 0 then Nothing else Just n-      adjFact fact = fact {gvictims = EM.alter alterKind ikind-                                      $ gvictims fact}-  updateFaction (bfid b) adjFact-    -- The death of a dominated actor counts as the dominating faction's loss-    -- for score purposes, so human nor AI can't treat such actor as disposable,-    -- which means domination will not be as cruel, as frustrating,-    -- as it could be and there is a higher chance of getting back alive-    -- the actor, the human player has grown attached to.---- Alter an attribute (actually, the only, the defining attribute)--- of a visible tile. This is similar to e.g., @UpdTrajectory@.------ Removing and creating embedded items when altering a tile--- is done separately via @UpdCreateItem@ and @UpdDestroyItem@.-updAlterTile :: MonadStateWrite m-             => LevelId -> Point -> ContentId TileKind -> ContentId TileKind-             -> m ()-updAlterTile lid p fromTile toTile = assert (fromTile /= toTile) $ do-  COps{coTileSpeedup} <- getsState scops-  lvl <- getLevel lid-  let t = lvl `at` p-  if t /= fromTile-  then atomicFail "tile to alter is different than assumed"-  else do-    let adj ts = ts PointArray.// [(p, toTile)]-    updateLevel lid $ updateTile adj-    case ( Tile.isExplorable coTileSpeedup fromTile-         , Tile.isExplorable coTileSpeedup toTile ) of-      (False, True) -> updateLevel lid $ \lvl2 -> lvl2 {lseen = lseen lvl + 1}-      (True, False) -> updateLevel lid $ \lvl2 -> lvl2 {lseen = lseen lvl - 1}-      _ -> return ()--updAlterExplorable :: MonadStateWrite m => LevelId -> Int -> m ()-updAlterExplorable lid delta = assert (delta /= 0) $-  updateLevel lid $ \lvl -> lvl {lexpl = lexpl lvl + delta}--updAlterGold :: MonadStateWrite m => Int -> m ()-updAlterGold delta = assert (delta /= 0) $-  modifyState $ updateGold (+ delta)---- Showing to the client the embedded items, if any, is done elsewhere.-updSearchTile :: MonadStateWrite m-              => ActorId -> Point -> ContentId TileKind -> m ()-updSearchTile aid p toTile = do-  COps{cotile} <- getsState scops-  b <- getsState $ getActorBody aid-  lvl <- getLevel $ blid b-  let t = lvl `at` p-  if t == toTile-  then atomicFail "tile already searched"-  else assert (Just t == Tile.hideAs cotile toTile) $ do-    updLoseTile (blid b) [(p, t)]-    updSpotTile (blid b) [(p, toTile)]  -- not the hidden version this one time---- Notice previously invisible tiles. This is done in bulk,--- because it often involves dozens of tiles per move.--- We verify that the old tiles at the positions in question--- are indeed unknown.-updSpotTile :: MonadStateWrite m-            => LevelId -> [(Point, ContentId TileKind)] -> m ()-updSpotTile lid ts = assert (not $ null ts) $ do-  COps{coTileSpeedup} <- getsState scops-  let unk tileMap (p, _) = tileMap PointArray.! p == unknownId-      adj tileMap = assert (all (unk tileMap) ts) $ tileMap PointArray.// ts-  updateLevel lid $ updateTile adj-  let f (_, t1) = when (Tile.isExplorable coTileSpeedup t1) $-        updateLevel lid $ \lvl -> lvl {lseen = lseen lvl + 1}-  mapM_ f ts---- Stop noticing previously visible tiles. It verifies--- the state of the tiles before wiping them out.-updLoseTile :: MonadStateWrite m-            => LevelId -> [(Point, ContentId TileKind)] -> m ()-updLoseTile lid ts = assert (not $ null ts) $ do-  COps{coTileSpeedup} <- getsState scops-  let matches tileMap (p, ov) = tileMap PointArray.! p == ov-      tu = map (second (const unknownId)) ts-      adj tileMap = assert (all (matches tileMap) ts) $ tileMap PointArray.// tu-  updateLevel lid $ updateTile adj-  let f (_, t1) = when (Tile.isExplorable coTileSpeedup t1) $-        updateLevel lid $ \lvl -> lvl {lseen = lseen lvl - 1}-  mapM_ f ts--updAlterSmell :: MonadStateWrite m => LevelId -> Point -> Time -> Time -> m ()-updAlterSmell lid p fromSm' toSm' = do-  let fromSm = if fromSm' == timeZero then Nothing else Just fromSm'-      toSm = if toSm' == timeZero then Nothing else Just toSm'-      alt sm = assert (sm == fromSm `blame` "unexpected tile smell"-                                    `swith` (lid, p, fromSm, toSm, sm)) toSm-  updateLevel lid $ updateSmell $ EM.alter alt p--updSpotSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m ()-updSpotSmell lid sms = assert (not $ null sms) $ do-  let alt sm Nothing = Just sm-      alt sm (Just oldSm) = error $ "smell already added"-                                    `showFailure` (lid, sms, sm, oldSm)-      f (p, sm) = EM.alter (alt sm) p-      upd m = foldr f m sms-  updateLevel lid $ updateSmell upd--updLoseSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m ()-updLoseSmell lid sms = assert (not $ null sms) $ do-  let alt sm Nothing = error $ "smell already removed"-                               `showFailure` (lid, sms, sm)-      alt sm (Just oldSm) =-        assert (sm == oldSm `blame` "unexpected lost smell"-                            `swith` (lid, sms, sm, oldSm)) Nothing-      f (p, sm) = EM.alter (alt sm) p-      upd m = foldr f m sms-  updateLevel lid $ updateSmell upd--updTimeItem :: MonadStateWrite m-            => ItemId -> Container -> ItemTimer -> ItemTimer-            -> m ()-updTimeItem iid c fromIt toIt = assert (fromIt /= toIt) $ do-  bag <- getsState $ getContainerBag c-  case iid `EM.lookup` bag of-    Just (k, it) -> do-      let !_A = assert (fromIt == it `blame` (k, it, iid, c, fromIt, toIt)) ()-      deleteItemContainer iid (k, fromIt) c-      insertItemContainer iid (k, toIt) c-    Nothing -> error $ "" `showFailure` (bag, iid, c, fromIt, toIt)--updAgeGame :: MonadStateWrite m => [LevelId] -> m ()-updAgeGame lids = do-  modifyState $ updateTime $ flip timeShift (Delta timeClip)-  mapM_ (ageLevel (Delta timeClip)) lids--updUnAgeGame :: MonadStateWrite m => [LevelId] -> m ()-updUnAgeGame lids = do-  modifyState $ updateTime $ flip timeShift (timeDeltaReverse $ Delta timeClip)-  mapM_ (ageLevel (timeDeltaReverse $ Delta timeClip)) lids--ageLevel :: MonadStateWrite m => Delta Time -> LevelId -> m ()-ageLevel delta lid =-  updateLevel lid $ \lvl -> lvl {ltime = timeShift (ltime lvl) delta}--updDiscover :: MonadStateWrite m-            => 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 discoverAtMostAspect = do-        discoAspect <- getsState sdiscoAspect-        if kmIsConst || iid `EM.member` discoAspect-        then atomicFail "item already fully discovered"-        else discoverAspect iid aspectRecord-  case EM.lookup iid itemD of-    Nothing -> atomicFail "discovered item unheard of"-    Just item -> case jkind item of-      IdentityObvious _ -> discoverAtMostAspect-      IdentityCovered ix _ik -> case EM.lookup ix discoKind of-        Just{} -> discoverAtMostAspect-        Nothing -> do-          discoverKind ix ik-          unless kmIsConst $ discoverAspect iid aspectRecord-  resetActorAspect--updCover :: Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord -> m ()-updCover _c _iid _ik _aspectRecord = undefined--updDiscoverKind :: MonadStateWrite m-                => Container -> ItemKindIx -> ContentId ItemKind -> m ()-updDiscoverKind _c ix kmKind = do-  discoKind <- getsState sdiscoKind-  if ix `EM.member` discoKind-  then atomicFail "item kind already discovered"-  else do-    discoverKind ix kmKind-    resetActorAspect--discoverKind :: MonadStateWrite m => ItemKindIx -> ContentId ItemKind -> m ()-discoverKind ix kindId = do-  let f Nothing = Just kindId-      f Just{} = error $ "already discovered" `showFailure` (ix, kindId)-  modifyState $ updateDiscoKind $ \discoKind1 ->-    EM.alter f ix discoKind1--updCoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m ()-updCoverKind _c _ix _ik = undefined--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-    Nothing -> atomicFail "discovered item unheard of"-    Just item -> do-      -- Here the kind information is exact, hence @getItemKindIdServer@.-      kindId <- getsState $ getItemKindIdServer item-      discoAspect <- getsState sdiscoAspect-      let kmIsConst = IA.kmConst $ IK.getKindMean kindId coItemSpeedup-      if kmIsConst || iid `EM.member` discoAspect-      then atomicFail "item aspectRecord already discovered"-      else do-        discoverAspect iid aspectRecord-        resetActorAspect--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--updCoverAspect :: Container -> ItemId -> IA.AspectRecord -> m ()-updCoverAspect _c _iid _aspectRecord = undefined--updDiscoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()-updDiscoverServer iid aspectRecord =-  modifyState $ updateDiscoAspect $ \discoAspect1 ->-    EM.insert iid aspectRecord discoAspect1--updCoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()-updCoverServer iid aspectRecord =-  modifyState $ updateDiscoAspect $ \discoAspect1 ->-    assert (discoAspect1 EM.! iid == aspectRecord)-    $ EM.delete iid discoAspect1--updRestart :: MonadStateWrite m => State -> m ()-updRestart = putState--updRestartServer :: MonadStateWrite m => State -> m ()-updRestartServer = putState--updResumeServer :: MonadStateWrite m => State -> m ()-updResumeServer = putState

@@ -1,329 +0,0 @@--- | The monad for writing to the main game state.-module Game.LambdaHack.Atomic.MonadStateWrite-  ( MonadStateWrite(..), AtomicFail(..), atomicFail-  , putState, updateLevel, updateActor, updateFaction, moveActorMap-  , insertBagContainer, insertItemContainer, insertItemActor-  , deleteBagContainer, deleteItemContainer, deleteItemActor-  , addAis, itemsMatch, addItemToActorAspect, resetActorAspect-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , insertItemFloor, insertItemEmbed-  , insertItemOrgan, insertItemEqp, insertItemInv, insertItemSha-  , deleteItemFloor, deleteItemEmbed-  , deleteItemOrgan, deleteItemEqp, deleteItemInv, deleteItemSha-  , rmFromBag-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import qualified Control.Exception as Ex-import qualified Data.EnumMap.Strict as EM-import qualified Data.EnumSet as ES-import           Data.Key (mapWithKeyM_)--import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Faction-import           Game.LambdaHack.Common.Item-import qualified Game.LambdaHack.Common.ItemAspect as IA-import           Game.LambdaHack.Common.Level-import           Game.LambdaHack.Common.Misc-import           Game.LambdaHack.Common.MonadStateRead-import           Game.LambdaHack.Common.Point-import           Game.LambdaHack.Common.State-import qualified Game.LambdaHack.Content.ItemKind as IK---- | The monad for writing to the main game state. Atomic updates ('UpdAtomic')--- are given semantics in this monad.-class MonadStateRead m => MonadStateWrite m where-  modifyState :: (State -> State) -> m ()---- | Exception signifying that atomic action failed because--- the information it carries is inconsistent with the client's state,--- (e.g., because the client knows too little to understand the command--- or already deduced the state change from earlier commands--- or is confused, amnesiac or sees illusory actors or tiles).--- Whenever we know the failure is logically impossible,--- we don't throw the @AtomicFail@ exception, but insert a normal assertion--- or @error@ call, which are never caught nor handled.-newtype AtomicFail = AtomicFail String-  deriving Show--instance Ex.Exception AtomicFail--atomicFail :: String -> a-atomicFail = Ex.throw . AtomicFail--putState :: MonadStateWrite m => State -> m ()-putState s = modifyState (const s)---- INLIning offers no speedup, increases alloc and binary size.--- EM.alter not necessary, because levels not removed, so little risk--- of adjusting at absent index.-updateLevel :: MonadStateWrite m => LevelId -> (Level -> Level) -> m ()-updateLevel lid f = modifyState $ updateDungeon $ EM.adjust f lid---- INLIning doesn't help despite probably canceling the alt indirection.--- perhaps it's applied automatically due to INLINABLE.-updateActor :: MonadStateWrite m => ActorId -> (Actor -> Actor) -> m ()-updateActor aid f = do-  let alt Nothing = error $ "no body to update" `showFailure` aid-      alt (Just b) = Just $ f b-  modifyState $ updateActorD $ EM.alter alt aid--updateFaction :: MonadStateWrite m => FactionId -> (Faction -> Faction) -> m ()-updateFaction fid f = do-  let alt Nothing = error $ "no faction to update" `showFailure` fid-      alt (Just fact) = Just $ f fact-  modifyState $ updateFactionD $ EM.alter alt fid--moveActorMap :: MonadStateWrite m => ActorId -> Actor -> Actor -> m ()-moveActorMap aid body newBody = do-  let rmActor Nothing = error $ "actor already removed"-                                `showFailure` (aid, body)-      rmActor (Just l) =-#ifdef WITH_EXPENSIVE_ASSERTIONS-        assert (aid `elem` l `blame` "actor already removed"-                             `swith` (aid, body, l))-#endif-        (let l2 = delete aid l-         in if null l2 then Nothing else Just l2)-      addActor Nothing = Just [aid]-      addActor (Just l) =-#ifdef WITH_EXPENSIVE_ASSERTIONS-        assert (aid `notElem` l `blame` "actor already added"-                                `swith` (aid, body, l))-#endif-        (Just $ aid : l)-      updActor = EM.alter addActor (bpos newBody)-                 . EM.alter rmActor (bpos body)-  updateLevel (blid body) $ updateActorMap updActor--insertBagContainer :: MonadStateWrite m-                   => ItemBag -> Container -> m ()-insertBagContainer bag c = case c of-  CFloor lid pos -> do-    let alt Nothing = Just bag-        alt (Just bag2) = atomicFail $ "floor bag not empty"-                                       `showFailure` (bag2, lid, pos, bag)-    updateLevel lid $ updateFloor $ EM.alter alt pos-  CEmbed lid pos -> do-    let alt Nothing = Just bag-        alt (Just bag2) = atomicFail $ "embed bag not empty"-                                       `showFailure` (bag2, lid, pos, bag)-    updateLevel lid $ updateEmbed $ EM.alter alt pos-  CActor aid store ->-    -- Very unlikely case, so we prefer brevity over performance.-    mapWithKeyM_ (\iid kit -> insertItemActor iid kit aid store) bag-  CTrunk{} -> return ()--insertItemContainer :: MonadStateWrite m-                    => ItemId -> ItemQuant -> Container -> m ()-insertItemContainer iid kit c = case c of-  CFloor lid pos -> insertItemFloor iid kit lid pos-  CEmbed lid pos -> insertItemEmbed iid kit lid pos-  CActor aid store -> insertItemActor iid kit aid store-  CTrunk{} -> return ()---- New @kit@ lands at the front of the list.-insertItemFloor :: MonadStateWrite m-                => ItemId -> ItemQuant -> LevelId -> Point -> m ()-insertItemFloor iid kit lid pos =-  let bag = EM.singleton iid kit-      mergeBag = EM.insertWith (EM.unionWith mergeItemQuant) pos bag-  in updateLevel lid $ updateFloor mergeBag--insertItemEmbed :: MonadStateWrite m-                => ItemId -> ItemQuant -> LevelId -> Point -> m ()-insertItemEmbed iid kit lid pos =-  let bag = EM.singleton iid kit-      mergeBag = EM.insertWith (EM.unionWith mergeItemQuant) pos bag-  in updateLevel lid $ updateEmbed mergeBag--insertItemActor :: MonadStateWrite m-                => ItemId -> ItemQuant -> ActorId -> CStore -> m ()-insertItemActor iid kit aid cstore = case cstore of-  CGround -> do-    b <- getsState $ getActorBody aid-    insertItemFloor iid kit (blid b) (bpos b)-  COrgan -> insertItemOrgan iid kit aid-  CEqp -> insertItemEqp iid kit aid-  CInv -> insertItemInv iid kit aid-  CSha -> do-    b <- getsState $ getActorBody aid-    insertItemSha iid kit (bfid b)--insertItemOrgan :: MonadStateWrite m-                => ItemId -> ItemQuant -> ActorId -> m ()-insertItemOrgan iid kit aid = do-  itemKind <- getsState $ getIidKind iid-  let bag = EM.singleton iid kit-      upd = EM.unionWith mergeItemQuant bag-  updateActor aid $ \b ->-    b { borgan = upd (borgan b)-      , bweapon = if IK.isMelee itemKind then bweapon b + 1 else bweapon b }--insertItemEqp :: MonadStateWrite m-              => ItemId -> ItemQuant -> ActorId -> m ()-insertItemEqp iid kit aid = do-  itemKind <- getsState $ getIidKind iid-  let bag = EM.singleton iid kit-      upd = EM.unionWith mergeItemQuant bag-  updateActor aid $ \b ->-    b { beqp = upd (beqp b)-      , bweapon = if IK.isMelee itemKind then bweapon b + 1 else bweapon b }--insertItemInv :: MonadStateWrite m-              => ItemId -> ItemQuant -> ActorId -> m ()-insertItemInv iid kit aid = do-  let bag = EM.singleton iid kit-      upd = EM.unionWith mergeItemQuant bag-  updateActor aid $ \b -> b {binv = upd (binv b)}--insertItemSha :: MonadStateWrite m-              => ItemId -> ItemQuant -> FactionId -> m ()-insertItemSha iid kit fid = do-  let bag = EM.singleton iid kit-      upd = EM.unionWith mergeItemQuant bag-  updateFaction fid $ \fact -> fact {gsha = upd (gsha fact)}--deleteBagContainer :: MonadStateWrite m-                   => ItemBag -> Container -> m ()-deleteBagContainer bag c = case c of-  CFloor lid pos -> do-    let alt Nothing = atomicFail $ "floor bag already empty"-                                   `showFailure` (lid, pos, bag)-        alt (Just bag2) = assert (bag == bag2) Nothing-    updateLevel lid $ updateFloor $ EM.alter alt pos-  CEmbed lid pos -> do-    let alt Nothing = atomicFail $ "embed bag already empty"-                                   `showFailure` (lid, pos, bag)-        alt (Just bag2) = assert (bag == bag2 `blame` (bag, bag2)) Nothing-    updateLevel lid $ updateEmbed $ EM.alter alt pos-  CActor aid store ->-    -- Very unlikely case, so we prefer brevity over performance.-    mapWithKeyM_ (\iid kit -> deleteItemActor iid kit aid store) bag-  CTrunk{} -> error $ "" `showFailure` c--deleteItemContainer :: MonadStateWrite m-                    => ItemId -> ItemQuant -> Container -> m ()-deleteItemContainer iid kit c = case c of-  CFloor lid pos -> deleteItemFloor iid kit lid pos-  CEmbed lid pos -> deleteItemEmbed iid kit lid pos-  CActor aid store -> deleteItemActor iid kit aid store-  CTrunk{} -> error $ "" `showFailure` c--deleteItemFloor :: MonadStateWrite m-                => ItemId -> ItemQuant -> LevelId -> Point -> m ()-deleteItemFloor iid kit lid pos =-  let rmFromFloor (Just bag) =-        let nbag = rmFromBag kit iid bag-        in if EM.null nbag then Nothing else Just nbag-      rmFromFloor Nothing = error $ "item already removed"-                                    `showFailure` (iid, kit, lid, pos)-  in updateLevel lid $ updateFloor $ EM.alter rmFromFloor pos--deleteItemEmbed :: MonadStateWrite m-                => ItemId -> ItemQuant -> LevelId -> Point -> m ()-deleteItemEmbed iid kit lid pos =-  let rmFromFloor (Just bag) =-        let nbag = rmFromBag kit iid bag-        in if EM.null nbag then Nothing else Just nbag-      rmFromFloor Nothing = error $ "item already removed"-                                    `showFailure` (iid, kit, lid, pos)-  in updateLevel lid $ updateEmbed $ EM.alter rmFromFloor pos--deleteItemActor :: MonadStateWrite m-                => ItemId -> ItemQuant -> ActorId -> CStore -> m ()-deleteItemActor iid kit aid cstore = case cstore of-  CGround -> do-    b <- getsState $ getActorBody aid-    deleteItemFloor iid kit (blid b) (bpos b)-  COrgan -> deleteItemOrgan iid kit aid-  CEqp -> deleteItemEqp iid kit aid-  CInv -> deleteItemInv iid kit aid-  CSha -> do-    b <- getsState $ getActorBody aid-    deleteItemSha iid kit (bfid b)--deleteItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()-deleteItemOrgan iid kit aid = do-  itemKind <- getsState $ getIidKind iid-  updateActor aid $ \b ->-    b { borgan = rmFromBag kit iid (borgan b)-      , bweapon = if IK.isMelee itemKind then bweapon b - 1 else bweapon b }--deleteItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()-deleteItemEqp iid kit aid = do-  itemKind <- getsState $ getIidKind iid-  updateActor aid $ \b ->-    b { beqp = rmFromBag kit iid (beqp b)-      , bweapon = if IK.isMelee itemKind then bweapon b - 1 else bweapon b }--deleteItemInv :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()-deleteItemInv iid kit aid =-  updateActor aid $ \b -> b {binv = rmFromBag kit iid (binv b)}--deleteItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()-deleteItemSha iid kit fid =-  updateFaction fid $ \fact -> fact {gsha = rmFromBag kit iid (gsha fact)}---- Removing the part of the kit from the back of the list,--- so that @DestroyItem kit (CreateItem kit x) == x@.-rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag-rmFromBag kit@(k, rmIt) iid bag =-  let rfb Nothing = error $ "rm from empty slot" `showFailure` (k, iid, bag)-      rfb (Just (n, it)) =-        case compare n k of-          LT -> error $ "rm more than there is"-                        `showFailure` (n, kit, iid, bag)-          EQ -> assert (rmIt == it `blame` (rmIt, it, n, kit, iid, bag)) Nothing-          GT -> assert (rmIt == take k it-                        `blame` (rmIt, take k it, n, kit, iid, bag))-                $ Just (n - k, take (n - k) it)-  in EM.alter rfb iid bag---- Actor's items may or may not be already present in @sitemD@,--- regardless if they are already present otherwise in the dungeon.--- We re-add them all to save time determining which really need it.--- If collision occurs, pick the item found on easier level.-addAis :: MonadStateWrite m => [(ItemId, Item)] -> m ()-addAis ais = do-  let h item1 item2 =-        assert (itemsMatch item1 item2-                `blame` "inconsistent added items"-                `swith` (item1, item2, ais))-               item2 -- keep the first found level-  forM_ ais $ \(iid, item) -> do-    let f = case jkind item of-          IdentityObvious _ -> id-          IdentityCovered ix _ ->-            updateItemIxMap $ EM.insertWith ES.union ix (ES.singleton iid)-    modifyState $ f . updateItemD (EM.insertWith h iid item)--itemsMatch :: Item -> Item -> Bool-itemsMatch item1 item2 =-  jkind item1 == jkind item2-  -- Note that nothing else needs to be the same, since items are merged-  -- and clients have different views on dungeon items than the server.--addItemToActorAspect :: MonadStateWrite m-                     => ItemId -> Item -> Int -> ActorId -> m ()-addItemToActorAspect iid itemBase k aid = do-  arItem <- getsState $ aspectRecordFromItem iid itemBase-  let f arActor = IA.sumAspectRecord [(arActor, 1), (arItem, k)]-  modifyState $ updateActorAspect $ EM.adjust f aid--resetActorAspect :: MonadStateWrite m => m ()-resetActorAspect = do-  -- Each actor's equipment and organs would need to be inspected,-  -- the iid looked up, e.g., if it wasn't in old discoKind, but is in new,-  -- and then aspect record updated, so it's simpler and not much more-  -- expensive to generate new sactorAspect. Optimize only after profiling.-  -- Also note this doesn't get invoked on the server, because it bails out-  -- earlier, upon noticing the item is already fully known.-  actorAspect <- getsState actorAspectInDungeon-  modifyState $ updateActorAspect $ const actorAspect

@@ -1,265 +0,0 @@--- | Representation and computation of visiblity of atomic commands--- by clients.------ See--- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.-module Game.LambdaHack.Atomic.PosAtomicRead-  ( PosAtomic(..), posUpdAtomic, posSfxAtomic-  , breakUpdAtomic, seenAtomicCli, seenAtomicSer-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , posProjBody, singleAid, doubleAid, singleContainer-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import qualified Data.EnumSet as ES--import Game.LambdaHack.Atomic.CmdAtomic-import Game.LambdaHack.Common.Actor-import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.Faction-import Game.LambdaHack.Common.Level-import Game.LambdaHack.Common.Misc-import Game.LambdaHack.Common.MonadStateRead-import Game.LambdaHack.Common.Perception-import Game.LambdaHack.Common.Point---- All functions here that take an atomic action are executed--- in the state just before the action is executed.---- | The type representing visibility of atomic commands to factions,--- based on the position of the command, etc. Note that the server--- sees and smells all positions.-data PosAtomic =-    PosSight LevelId [Point]    -- ^ whomever sees all the positions, notices-  | PosFidAndSight [FactionId] LevelId [Point]-                                -- ^ observers and the faction notice-  | PosSmell LevelId [Point]    -- ^ whomever smells all the positions, notices-  | PosFid FactionId            -- ^ only the faction notices, server doesn't-  | PosFidAndSer (Maybe LevelId) FactionId-                                -- ^ faction and server notices-  | PosSer                      -- ^ only the server notices-  | PosAll                      -- ^ everybody notices-  | PosNone                     -- ^ never broadcasted, but sent manually-  deriving (Show, Eq)---- | Produce the positions where the atomic update takes place or, more--- generally, the conditions under which the update can be noticed by--- a client.------ The goal of this mechanics is to ensure that atomic commands involving--- some positions visible by a client convey similar information as the client--- would get by directly observing the changes--- of the portion of server state limited to the visible positions.--- Consequently, when the visible commands are later applied--- to the client's state, the state stays consistent--- --- in sync with the server state and correctly limited by visiblity.--- There is some wiggle room both in what "in sync" and--- "visible" means and how they propagate through time.------ E.g., @UpdDisplaceActor@ in a black room between two enemy actors,--- with only one actor carrying a 0-radius light would not be--- distinguishable by looking at the state (or the screen) from @UpdMoveActor@--- of the illuminated actor, hence such @UpdDisplaceActor@ should not be--- observable, but @UpdMoveActor@ in similar cotext would be--- (or the former should be perceived as the latter).--- However, to simplify, we assign as strict visibility--- requirements to @UpdMoveActor@ as to @UpdDisplaceActor@ and fall back--- to @UpdSpotActor@ (which provides minimal information that does not--- contradict state) if the visibility is lower.-posUpdAtomic :: MonadStateRead m => UpdAtomic -> m PosAtomic-posUpdAtomic cmd = case cmd of-  UpdCreateActor _ body _ -> return $! posProjBody body-  UpdDestroyActor _ body _ -> return $! posProjBody body-  UpdCreateItem _ _ _ c -> singleContainer c-  UpdDestroyItem _ _ _ c -> singleContainer c-  UpdSpotActor _ body _ -> return $! posProjBody body-  UpdLoseActor _ body _ -> return $! posProjBody body-  UpdSpotItem _ _ _ _ c -> singleContainer c-  UpdLoseItem _ _ _ _ c -> singleContainer c-  UpdSpotItemBag c _ _ -> singleContainer c-  UpdLoseItemBag c _ _ -> singleContainer c-  UpdMoveActor aid fromP toP -> do-    b <- getsState $ getActorBody aid-    -- Non-projectile actors are never totally isolated from envirnoment;-    -- they hear, feel air movement, etc.-    return $! if bproj b-              then PosSight (blid b) [fromP, toP]-              else PosFidAndSight [bfid b] (blid b) [fromP, toP]-  UpdWaitActor aid _ -> singleAid aid-  UpdDisplaceActor source target -> doubleAid source target-  UpdMoveItem _ _ _ _ CSha ->-    error $ "" `showFailure` cmd  -- shared stash is private-  UpdMoveItem _ _ _ CSha _ -> error $ "" `showFailure` cmd-  UpdMoveItem _ _ aid _ _ -> singleAid aid-  UpdRefillHP aid _ -> singleAid aid-  UpdRefillCalm aid _ -> singleAid aid-  UpdTrajectory aid _ _ -> singleAid aid-  UpdQuitFaction{} -> return PosAll-  UpdLeadFaction fid _ _ -> return $ PosFidAndSer Nothing fid-  UpdDiplFaction{} -> return PosAll-  UpdTacticFaction fid _ _ -> return $! PosFidAndSer Nothing fid-  UpdAutoFaction{} -> return PosAll-  UpdRecordKill aid _ _ -> singleAid aid-  UpdAlterTile lid p _ _ -> return $! PosSight lid [p]-  UpdAlterExplorable{} -> return PosAll-    -- Can't have @PosSight@, because we'd end up with many accessible-    -- unknown tiles, but the game reporting 'all seen'.-  UpdAlterGold{} -> return PosAll-  UpdSearchTile aid p _ -> do-    b <- getsState $ getActorBody aid-    return $! PosFidAndSight [bfid b] (blid b) [bpos b, p]-  UpdHideTile aid p _ -> do-    b <- getsState $ getActorBody aid-    return $! PosFidAndSight [bfid b] (blid b) [bpos b, p]-  UpdSpotTile lid ts -> do-    let ps = map fst ts-    return $! PosSight lid ps-  UpdLoseTile lid ts -> do-    let ps = map fst ts-    return $! PosSight lid ps-  UpdAlterSmell lid p _ _ -> return $! PosSmell lid [p]-  UpdSpotSmell lid sms -> do-    let ps = map fst sms-    return $! PosSmell lid ps-  UpdLoseSmell lid sms -> do-    let ps = map fst sms-    return $! PosSmell lid ps-  UpdTimeItem _ c _ _ -> singleContainer c-  UpdAgeGame _ -> return PosAll-  UpdUnAgeGame _ -> return PosAll-  UpdDiscover c _ _ _ -> singleContainer c-  UpdCover c _ _ _ -> singleContainer c-  UpdDiscoverKind c _ _ -> singleContainer c-  UpdCoverKind c _ _ -> singleContainer c-  UpdDiscoverAspect c _ _ -> singleContainer c-  UpdCoverAspect c _ _ -> singleContainer c-  UpdDiscoverServer{} -> return PosSer-  UpdCoverServer{} -> return PosSer-  UpdPerception{} -> return PosNone-  UpdRestart fid _ _ _ _ -> return $! PosFid fid-  UpdRestartServer _ -> return PosSer-  UpdResume _ _ -> return PosNone-  UpdResumeServer _ -> return PosSer-  UpdKillExit fid -> return $! PosFid fid-  UpdWriteSave -> return PosAll---- | Produce the positions where the atomic special effect takes place.-posSfxAtomic :: MonadStateRead m => SfxAtomic -> m PosAtomic-posSfxAtomic cmd = case cmd of-  SfxStrike _ _ _ CSha -> return PosNone  -- shared stash is private-  SfxStrike _ target _ _ -> singleAid target-  SfxRecoil _ _ _ CSha -> return PosNone  -- shared stash is private-  SfxRecoil _ target _ _ -> singleAid target-  SfxSteal _ _ _ CSha -> return PosNone  -- shared stash is private-  SfxSteal _ target _ _ -> singleAid target-  SfxRelease _ _ _ CSha -> return PosNone  -- shared stash is private-  SfxRelease _ target _ _ -> singleAid target-  SfxProject aid _ cstore -> singleContainer $ CActor aid cstore-  SfxReceive aid _ cstore -> singleContainer $ CActor aid cstore-  SfxApply aid _ cstore -> singleContainer $ CActor aid cstore-  SfxCheck aid _ cstore -> singleContainer $ CActor aid cstore-  SfxTrigger aid p -> do-    body <- getsState $ getActorBody aid-    if bproj body-    then return $! PosSight (blid body) [bpos body, p]-    else return $! PosFidAndSight [bfid body] (blid body) [bpos body, p]-  SfxShun aid p -> do-    body <- getsState $ getActorBody aid-    if bproj body-    then return $! PosSight (blid body) [bpos body, p]-    else return $! PosFidAndSight [bfid body] (blid body) [bpos body, p]-  SfxEffect _ aid _ _ -> singleAid aid  -- sometimes we don't see source, OK-  SfxMsgFid fid _ -> return $! PosFid fid-  SfxSortSlots -> return PosAll-  SfxCollideTile aid _ -> singleAid aid--posProjBody :: Actor -> PosAtomic-posProjBody body =-  if bproj body-  then PosSight (blid body) [bpos body]-  else PosFidAndSight [bfid body] (blid body) [bpos body]--singleAid :: MonadStateRead m => ActorId -> m PosAtomic-singleAid aid = do-  body <- getsState $ getActorBody aid-  return $! posProjBody body--doubleAid :: MonadStateRead m => ActorId -> ActorId -> m PosAtomic-doubleAid source target = do-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  -- No @PosFidAndSight@ instead of @PosSight@, because both positions-  -- need to be seen to have the enemy actor in client's state.-  return $! assert (blid sb == blid tb) $ PosSight (blid sb) [bpos sb, bpos tb]--singleContainer :: MonadStateRead m => Container -> m PosAtomic-singleContainer (CFloor lid p) = return $! PosSight lid [p]-singleContainer (CEmbed lid p) = return $! PosSight lid [p]-singleContainer (CActor aid CSha) = do  -- shared stash is private-  b <- getsState $ getActorBody aid-  return $! PosFidAndSer (Just $ blid b) (bfid b)-singleContainer (CActor aid _) = singleAid aid-singleContainer (CTrunk fid lid p) =-  return $! PosFidAndSight [fid] lid [p]---- | Decompose an atomic action that is outside a client's visiblity.--- The decomposed actions give less information that the original command,--- but some of them may fall within the visibility range of the client.--- The original action may give more information than even the total sum--- of all actions it's broken into. E.g., @UpdMoveActor@--- informs about the continued existence of the actor between--- moves vs popping out of existence and then back in.------ This is computed in server's @State@ from before performing the command.-breakUpdAtomic :: MonadStateRead m => UpdAtomic -> m [UpdAtomic]-breakUpdAtomic cmd = case cmd of-  UpdMoveActor aid fromP toP -> do-    -- We assume other factions don't see leaders and we know the actor's-    -- faction always sees the atomic command, so the leader doesn't-    -- need to be updated (or the actor is a projectile, hence not a leader).-    b <- getsState $ getActorBody aid-    ais <- getsState $ getCarriedAssocsAndTrunk b-    return [ UpdLoseActor aid b ais-           , UpdSpotActor aid b {bpos = toP, boldpos = Just fromP} ais ]-  UpdDisplaceActor source target -> do-    sb <- getsState $ getActorBody source-    sais <- getsState $ getCarriedAssocsAndTrunk sb-    tb <- getsState $ getActorBody target-    tais <- getsState $ getCarriedAssocsAndTrunk tb-    return [ UpdLoseActor source sb sais-           , UpdSpotActor source sb { bpos = bpos tb-                                    , boldpos = Just $ bpos sb } sais-           , UpdLoseActor target tb tais-           , UpdSpotActor target tb { bpos = bpos sb-                                    , boldpos = Just $ bpos tb } tais-           ]-  _ -> return []---- | Given the client, its perception and an atomic command, determine--- if the client notices the command.-seenAtomicCli :: Bool -> FactionId -> Perception -> PosAtomic -> Bool-seenAtomicCli knowEvents fid per posAtomic =-  case posAtomic of-    PosSight _ ps -> all (`ES.member` totalVisible per) ps || knowEvents-    PosFidAndSight fids _ ps ->-      fid `elem` fids || all (`ES.member` totalVisible per) ps || knowEvents-    PosSmell _ ps -> all (`ES.member` totalSmelled per) ps || knowEvents-    PosFid fid2 -> fid == fid2-    PosFidAndSer _ fid2 -> fid == fid2-    PosSer -> False-    PosAll -> True-    PosNone -> error $ "no position possible" `showFailure` fid---- | Determine whether the server would see a command that has--- the given visibilty conditions.-seenAtomicSer :: PosAtomic -> Bool-seenAtomicSer posAtomic =-  case posAtomic of-    PosFid _ -> False-    PosNone -> error $ "no position possible" `showFailure` posAtomic-    _ -> True

@@ -1,28 +0,0 @@--- | Semantics of responses that are sent from server to clients,--- in terms of client state transformations,--- and semantics of human commands and AI moves, in terms of requests--- to be sent from the client to the server.------ See--- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.-module Game.LambdaHack.Client-  ( -- * Re-exported from "Game.LambdaHack.Client.LoopM"-    loopCli-    -- * Re-exported from "Game.LambdaHack.Client.Request"-  , RequestAI, ReqAI(..), RequestUI, ReqUI(..), RequestTimed(..)-    -- * Re-exported from "Game.LambdaHack.Client.Response"-  , Response (..)-    -- * Re-exported from "Game.LambdaHack.Client.ClientOptions"-  , ClientOptions(..), defClientOptions-    -- * Re-exported from "Game.LambdaHack.Client.UI"-  , KeyKind-  , UIOptions, applyUIOptions, uCmdline, mkUIOptions-  ) where--import Prelude ()--import Game.LambdaHack.Client.ClientOptions-import Game.LambdaHack.Client.LoopM-import Game.LambdaHack.Client.Request-import Game.LambdaHack.Client.Response-import Game.LambdaHack.Client.UI

@@ -1,78 +0,0 @@--- | 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-  ( queryAI-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , pickActorAndAction-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import qualified Data.EnumMap.Strict as EM--import Game.LambdaHack.Client.AI.HandleAbilityM-import Game.LambdaHack.Client.AI.PickActorM-import Game.LambdaHack.Client.MonadClient-import Game.LambdaHack.Client.Request-import Game.LambdaHack.Client.State-import Game.LambdaHack.Common.Actor-import Game.LambdaHack.Common.Faction-import Game.LambdaHack.Common.MonadStateRead-import Game.LambdaHack.Common.Point-import Game.LambdaHack.Common.State---- | Handle the move of an actor under AI control (regardless if the whole--- faction is under human or computer control).-queryAI :: MonadClient m => ActorId -> m RequestAI-queryAI aid = do-  -- @sleader@ may be different from @gleader@ due to @stopPlayBack@,-  -- but only leaders may change faction leader, so we fix that:-  side <- getsClient sside-  mleader <- getsState $ gleader . (EM.! side) . sfactionD-  mleaderCli <- getsClient sleader-  unless (Just aid == mleader || mleader == mleaderCli) $-    -- @aid@ is not the leader, so he can't change leader-    modifyClient $ \cli -> cli {_sleader = mleader}-  (aidToMove, treq, oldFlee) <- pickActorAndAction Nothing aid-  (aidToMove2, treq2) <--    case treq of-      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-          { _sleader = mleader-          , sfleeD = case oldFlee of-              Just p -> EM.insert aidToMove p $ sfleeD cli-              Nothing -> EM.delete aidToMove $ sfleeD cli }-        (a, t, _) <- pickActorAndAction (Just (aidToMove, treq)) aid-        return (a, t)-      _ -> return (aidToMove, treq)-  return ( ReqAITimed treq2-         , if aidToMove2 /= aid then Just aidToMove2 else Nothing )---- | 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, 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 #-}-pickActorAndAction maid aid = do-  mleader <- getsClient sleader-  aidToMove <--    if mleader == Just aid-    then pickActorToMove (fst <$> maid)-    else do-      setTargetFromTactics aid-      return aid-  oldFlee <- getsClient $ EM.lookup aidToMove . sfleeD-  treq <- case maid of-    Just (aidOld, treqOld) | aidToMove == aidOld ->-      return treqOld  -- no better leader found-    _ -> pickAction aidToMove (isJust maid)-  return (aidToMove, treq, oldFlee)

@@ -1,337 +0,0 @@--- | Assorted conditions used later on in AI logic.-module Game.LambdaHack.Client.AI.ConditionM-  ( condAimEnemyPresentM-  , condAimEnemyRememberedM-  , condTgtNonmovingM-  , condAnyFoeAdjM-  , condAdjTriggerableM-  , meleeThreatDistList-  , condBlocksFriendsM-  , condFloorWeaponM-  , condNoEqpWeaponM-  , condCanProjectM-  , condProjectListM-  , benAvailableItems-  , hinders-  , condDesirableFloorItemM-  , benGroundItems-  , desirableItem-  , condSupport-  , condSoloM-  , condShineWouldBetrayM-  , fleeList-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import qualified Data.EnumMap.Strict as EM-import           Data.Ord--import           Game.LambdaHack.Client.Bfs-import           Game.LambdaHack.Client.CommonM-import           Game.LambdaHack.Client.MonadClient-import           Game.LambdaHack.Client.State-import qualified Game.LambdaHack.Common.Ability as Ability-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Faction-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-import           Game.LambdaHack.Common.MonadStateRead-import           Game.LambdaHack.Common.Point-import           Game.LambdaHack.Common.ReqFailure-import           Game.LambdaHack.Common.State-import qualified Game.LambdaHack.Common.Tile as Tile-import           Game.LambdaHack.Common.Time-import           Game.LambdaHack.Common.Vector-import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.ModeKind---- All conditions are (partially) lazy, because they are not always--- used in the strict monadic computations they are in.---- | Require that the target enemy is visible by the party.-condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool-condAimEnemyPresentM aid = do-  btarget <- getsClient $ getTarget aid-  return $ case btarget of-    Just (TEnemy _ permit) -> not permit-    _ -> False---- | Require that the target enemy is remembered on the actor's level.-condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool-condAimEnemyRememberedM aid = do-  b <- getsState $ getActorBody aid-  btarget <- getsClient $ getTarget aid-  return $ case btarget of-    Just (TPoint (TEnemyPos _ permit) lid _) -> lid == blid b && not permit-    _ -> False---- | Check if the target is nonmoving.-condTgtNonmovingM :: MonadClient m => ActorId -> m Bool-condTgtNonmovingM aid = do-  btarget <- getsClient $ getTarget aid-  case btarget of-    Just (TEnemy enemy _) -> do-      actorMaxSk <- maxActorSkillsClient enemy-      return $ EM.findWithDefault 0 Ability.AbMove actorMaxSk <= 0-    _ -> return False---- | Require that any non-dying foe is adjacent, except projectiles--- that (possibly) explode upon contact.-condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool-condAnyFoeAdjM aid = getsState $ anyFoeAdj aid---- | Require the actor stands adjacent to a triggerable tile (e.g., stairs).-condAdjTriggerableM :: MonadStateRead m => ActorId -> m Bool-condAdjTriggerableM aid = do-  b <- getsState $ getActorBody aid-  lvl <- getLevel $ blid b-  let hasTriggerable p = p `EM.member` lembed lvl-  return $ any hasTriggerable $ vicinityUnsafe $ bpos b---- | Produce the chess-distance-sorted list of non-low-HP,--- melee-cabable foes on the level. We don't consider path-distance,--- because we are interested in how soon the foe can close in to hit us,--- which can diverge greately from path distance for short distances,--- e.g., when terrain gets revealed. We don't consider non-moving actors,--- because they can't chase us and also because they can't be aggresive--- so to resolve the stalemate, the opposing AI has to be aggresive--- by ignoring them and closing in to melee distance.-meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))]-meleeThreatDistList aid s =-  let actorAspect = sactorAspect s-      b = getActorBody aid s-      allAtWar = foeRegularAssocs (bfid b) (blid b) s-      strongActor (aid2, b2) =-        let ar = actorAspect EM.! aid2-            actorMaxSkE = IA.aSkills ar-            nonmoving = EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0-        in not (hpTooLow b2 ar || nonmoving)-           && actorCanMelee actorAspect aid2 b2-      allThreats = filter strongActor allAtWar-      addDist (aid2, b2) = (chessDist (bpos b) (bpos b2), (aid2, b2))-  in sortBy (comparing fst) $ map addDist allThreats---- | Require the actor blocks the paths of any of his party members.-condBlocksFriendsM :: MonadClient m => ActorId -> m Bool-condBlocksFriendsM aid = do-  b <- getsState $ getActorBody aid-  targetD <- getsClient stargetD-  let blocked aid2 = aid2 /= aid &&-        case EM.lookup aid2 targetD of-          Just TgtAndPath{tapPath=AndPath{pathList=q : _}} | q == bpos b -> True-          _ -> False-  any blocked <$> getsState (fidActorRegularIds (bfid b) (blid b))---- | Require the actor stands over a weapon that would be auto-equipped.-condFloorWeaponM :: MonadStateRead m => ActorId -> m Bool-condFloorWeaponM aid =-  any (IK.isMelee . itemKind . snd) <$> getsState (fullAssocs aid [CGround])---- | Check whether the actor has no weapon in equipment.-condNoEqpWeaponM :: MonadStateRead m => ActorId -> m Bool-condNoEqpWeaponM aid =-  all (not . IK.isMelee . itemKind . snd) <$> getsState (fullAssocs aid [CEqp])---- | Require that the actor can project any items.-condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool-{-# INLINE condCanProjectM #-}-condCanProjectM skill aid =-  -- Compared to conditions in @projectItem@, range and charge are ignored,-  -- because they may change by the time the position for the fling is reached.-  not . null <$> condProjectListM skill aid--condProjectListM :: MonadClient m-                 => Int -> ActorId-                 -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]-{-# INLINE condProjectListM #-}-condProjectListM skill aid = do-  condShineWouldBetray <- condShineWouldBetrayM aid-  condAimEnemyPresent <- condAimEnemyPresentM aid-  discoBenefit <- getsClient sdiscoBenefit-  getsState $ projectList discoBenefit skill aid-                         condShineWouldBetray condAimEnemyPresent--projectList :: DiscoveryBenefit -> Int -> ActorId -> Bool -> Bool -> State-            -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]-projectList discoBenefit skill aid-            condShineWouldBetray condAimEnemyPresent s =-  let b = getActorBody aid s-      ar = getActorAspect aid s-      calmE = calmEnough b ar-      condNotCalmEnough = not calmE-      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltaSerious (bcalmDelta b)-      -- This detects if the value of keeping the item in eqp is in fact < 0.-      hind = hinders condShineWouldBetray condAimEnemyPresent-                     heavilyDistressed condNotCalmEnough ar-      q (Benefit{benInEqp, benFling}, _, _, itemFull, _) =-        benFling < 0-        && (not benInEqp  -- can't wear, so OK to risk losing or breaking-            || not (IK.isMelee $ itemKind itemFull)  -- anything else expendable-               && hind itemFull)  -- hinders now, so possibly often, so away!-        && permittedProjectAI skill calmE itemFull-      stores = [CEqp, CInv, CGround] ++ [CSha | calmE]-  in filter q $ benAvailableItems discoBenefit aid stores s---- | Produce the list of items with a given property available to the actor--- and the items' values.-benAvailableItems :: DiscoveryBenefit -> ActorId -> [CStore] -> State-                  -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]-benAvailableItems discoBenefit aid cstores s =-  let b = getActorBody aid s-      ben cstore bag =-        [ (discoBenefit EM.! iid, cstore, iid, itemToFull iid s, kit)-        | (iid, kit) <- EM.assocs bag]-      benCStore cs = ben cs $ getBodyStoreBag b cs s-  in concatMap benCStore cstores--hinders :: Bool -> Bool -> Bool -> Bool -> IA.AspectRecord -> ItemFull-        -> Bool-hinders condShineWouldBetray condAimEnemyPresent-        heavilyDistressed condNotCalmEnough-          -- guess that enemies have projectiles and used them now or recently-        ar itemFull =-  let itemShine = 0 < IA.aShine (aspectRecordFull itemFull)-      -- @condAnyFoeAdj@ is not checked, because it's transient and also item-      -- management is unlikely to happen during melee, anyway-      itemShineBad = condShineWouldBetray && itemShine-  in -- In the presence of enemies (seen, or unseen but distressing)-     -- actors want to hide in the dark.-     (condAimEnemyPresent || condNotCalmEnough || heavilyDistressed)-     && itemShineBad  -- even if it's a weapon, take it off-     -- Fast actors want to hit hard, because they hit much more often-     -- than receive hits.-     || gearSpeed ar > speedWalk-        && not (IK.isMelee $ itemKind itemFull)  -- in case it's the only weapon-        && 0 > IA.aHurtMelee (aspectRecordFull itemFull)---- | Require that the actor stands over a desirable item.-condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool-condDesirableFloorItemM aid = not . null <$> benGroundItems aid---- | Produce the list of items on the ground beneath the actor--- that are worth picking up.-benGroundItems :: MonadClient m-               => ActorId-               -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]-benGroundItems aid = do-  b <- getsState $ getActorBody aid-  fact <- getsState $ (EM.! bfid b) . sfactionD-  discoBenefit <- getsClient sdiscoBenefit-  let canEsc = fcanEscape (gplayer fact)-      isDesirable (ben, _, _, ItemFull{itemKind}, _) =-        desirableItem canEsc (benPickup ben) itemKind-  filter isDesirable-    <$> getsState (benAvailableItems discoBenefit aid [CGround])--desirableItem :: Bool -> Double -> IK.ItemKind -> Bool-desirableItem canEsc benPickup itemKind =-  if canEsc-  then benPickup > 0 || IK.Precious `elem` IK.ifeature itemKind-  else -- A hack to prevent monsters from picking up treasure meant for heroes.-       let preciousNotUseful = IK.isHumanTrinket itemKind-       in benPickup > 0 && not preciousNotUseful--condSupport :: MonadClient m => Int -> ActorId -> m Bool-{-# INLINE condSupport #-}-condSupport param aid = do-  btarget <- getsClient $ getTarget aid-  condAimEnemyPresent <- condAimEnemyPresentM aid-  condAimEnemyRemembered <- condAimEnemyRememberedM aid-  getsState $ strongSupport param aid btarget-                            condAimEnemyPresent condAimEnemyRemembered--strongSupport :: Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool-strongSupport param aid btarget condAimEnemyPresent condAimEnemyRemembered s =-  -- The smaller the area scanned for friends, the lower number required.-  let n = min 2 param - IA.aAggression ar-      actorAspect = sactorAspect s-      ar = actorAspect EM.! aid-      b = getActorBody aid s-      mtgtPos = case btarget of-        Nothing -> Nothing-        Just target -> aidTgtToPos aid (blid b) target s-      approaching b2 = case mtgtPos of-        Just tgtPos | condAimEnemyPresent || condAimEnemyRemembered ->-          chessDist (bpos b2) tgtPos <= 1 + param-        _ -> False-      closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)-                       in dist > 0 && (dist <= param || approaching b2)-      closeAndStrong (aid2, b2) = closeEnough b2-                                  && actorCanMelee actorAspect aid2 b2-      friends = friendRegularAssocs (bfid b) (blid b) s-      closeAndStrongFriends = filter closeAndStrong friends-  in not $ n > 0 && null (drop (n - 1) closeAndStrongFriends)-       -- optimized: length closeAndStrongFriends >= n--condSoloM :: MonadClient m => ActorId -> m Bool-condSoloM aid = do-  b <- getsState $ getActorBody aid-  let isSingleton [_] = True-      isSingleton _ = False-  isSingleton <$> getsState (friendRegularList (bfid b) (blid b))---- | Require that the actor stands in the dark and so would be betrayed--- by his own equipped light,-condShineWouldBetrayM :: MonadStateRead m => ActorId -> m Bool-condShineWouldBetrayM aid = do-  b <- getsState $ getActorBody aid-  aInAmbient <- getsState $ actorInAmbient b-  return $ not aInAmbient  -- tile is dark, so actor could hide---- | Produce a list of acceptable adjacent points to flee to.-fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)])-fleeList aid = do-  COps{coTileSpeedup} <- getsState scops-  mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  -- Prefer fleeing along the path to target, unless the target is a foe,-  -- in which case flee in the opposite direction.-  let etgtPath = case mtgtMPath of-        Just TgtAndPath{ tapPath=tapPath@AndPath{pathList}-                       , tapTgt } -> case tapTgt of-          TEnemy{} -> Left tapPath-          TPoint TEnemyPos{} _ _ -> Left tapPath-          _ -> Right pathList-        _ -> Right []-  b <- getsState $ getActorBody aid-  lvl@Level{lxsize, lysize} <- getLevel $ blid b-  s <- getState-  let posFoes = map bpos $ foeRegularList (bfid b) (blid b) s-      myVic = vicinity lxsize lysize $ bpos b-      dist p | null posFoes = 100-             | otherwise = minimum $ map (chessDist p) posFoes-      dVic = map (dist &&& id) myVic-      -- Flee, if possible. Direct access required; not enough time to open.-      -- Can't be occupied.-      accUnocc p = Tile.isWalkable coTileSpeedup (lvl `at` p)-                   && null (posToAssocs p (blid b) s)-      accVic = filter (accUnocc . snd) dVic-      gtVic = filter ((> dist (bpos b)) . fst) accVic-      eqVic = filter ((== dist (bpos b)) . fst) accVic-      ltVic = filter ((< dist (bpos b)) . fst) accVic-      rewardPath mult (d, p) = case etgtPath of-        Right tgtPath | p `elem` tgtPath ->-          (100 * mult * d, p)-        Right tgtPath | any (adjacent p) tgtPath ->-          (10 * mult * d, p)-        Left AndPath{pathGoal} | bpos b /= pathGoal ->-          let venemy = towards (bpos b) pathGoal-              vflee = towards (bpos b) p-              sq = euclidDistSqVector venemy vflee-              skew = case compare sq 2 of-                GT -> 100 * sq-                EQ -> 10 * sq-                LT -> sq  -- going towards enemy (but may escape adjacent foes)-          in (mult * skew * d, p)-        _ -> (mult * d, p)  -- far from target path or even on target goal-      goodVic = map (rewardPath 10000) gtVic-                ++ map (rewardPath 100) eqVic-      badVic = map (rewardPath 1) ltVic-  return (goodVic, badVic)

@@ -1,993 +0,0 @@--- | AI procedure for picking the best action for an actor.-module Game.LambdaHack.Client.AI.HandleAbilityM-  ( pickAction-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , actionStrategy-  , waitBlockNow, pickup, equipItems, toShare, yieldUnneeded, unEquipItems-  , groupByEqpSlot, bestByEqpSlot, harmful, meleeBlocker, meleeAny-  , trigger, projectItem, ApplyItemGroup, applyItem, flee-  , displaceFoe, displaceBlocker, displaceTgt-  , chase, moveTowards, moveOrRunAid-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import           Data.Either-import qualified Data.EnumMap.Lazy as LEM-import qualified Data.EnumMap.Strict as EM-import qualified Data.EnumSet as ES-import           Data.Function-import           Data.Ord-import           Data.Ratio--import           Game.LambdaHack.Client.AI.ConditionM-import           Game.LambdaHack.Client.AI.Strategy-import           Game.LambdaHack.Client.Bfs-import           Game.LambdaHack.Client.BfsM-import           Game.LambdaHack.Client.CommonM-import           Game.LambdaHack.Client.MonadClient-import           Game.LambdaHack.Client.Request-import           Game.LambdaHack.Client.State-import           Game.LambdaHack.Common.Ability-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Faction-import           Game.LambdaHack.Common.Frequency-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-import           Game.LambdaHack.Common.MonadStateRead-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray-import           Game.LambdaHack.Common.Random-import           Game.LambdaHack.Common.ReqFailure-import           Game.LambdaHack.Common.State-import qualified Game.LambdaHack.Common.Tile as Tile-import           Game.LambdaHack.Common.Time-import           Game.LambdaHack.Common.Vector-import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.ModeKind---- | Pick the most desirable AI ation for the actor.-pickAction :: MonadClient m => ActorId -> Bool -> m RequestTimed-{-# INLINE pickAction #-}-pickAction aid retry = do-  side <- getsClient sside-  body <- getsState $ getActorBody aid-  let !_A = assert (bfid body == side-                    `blame` "AI tries to move enemy actor"-                    `swith` (aid, bfid body, side)) ()-  let !_A = assert (isNothing (btrajectory body) && not (bproj body)-                    `blame` "AI gets to manually move its trajectory actors"-                    `swith` (aid, bfid body, side)) ()-  -- Reset fleeing flag. May then be set in @flee@.-  modifyClient $ \cli -> cli {sfleeD = EM.delete aid (sfleeD cli)}-  stratAction <- actionStrategy aid retry-  let bestAction = bestVariant stratAction-      !_A = assert (not (nullFreq bestAction)  -- equiv to nullStrategy-                    `blame` "no AI action for actor"-                    `swith` (stratAction, aid, body)) ()-  -- Run the AI: chose an action from those given by the AI strategy.-  rndToAction $ frequency bestAction---- AI strategy based on actor's sight, smell, etc.--- Never empty.-actionStrategy :: forall m. MonadClient m-               => ActorId -> Bool -> m (Strategy RequestTimed)-{-# INLINE actionStrategy #-}-actionStrategy aid retry = do-  body <- getsState $ getActorBody aid-  scondInMelee <- getsClient scondInMelee-  let condInMelee = scondInMelee LEM.! blid body-  condAimEnemyPresent <- condAimEnemyPresentM aid-  condAimEnemyRemembered <- condAimEnemyRememberedM aid-  condAnyFoeAdj <- condAnyFoeAdjM aid-  threatDistL <- getsState $ meleeThreatDistList aid-  (fleeL, badVic) <- fleeList aid-  condSupport1 <- condSupport 1 aid-  condSupport3 <- condSupport 3 aid-  condSolo <- condSoloM aid  -- solo fighters aggresive-  canDeAmbientL <- getsState $ canDeAmbientList body-  actorSk <- currentSkillsClient aid-  condCanProject <- condCanProjectM (EM.findWithDefault 0 AbProject actorSk) aid-  condAdjTriggerable <- condAdjTriggerableM aid-  condBlocksFriends <- condBlocksFriendsM aid-  condNoEqpWeapon <- condNoEqpWeaponM aid-  condEnoughGear <- condEnoughGearM aid-  condFloorWeapon <- condFloorWeaponM aid-  condDesirableFloorItem <- condDesirableFloorItemM aid-  condTgtNonmoving <- condTgtNonmovingM aid-  explored <- getsClient sexplored-  actorAspect <- getsState sactorAspect-  let ar = actorAspect EM.! aid-      lidExplored = ES.member (blid body) explored-      panicFleeL = fleeL ++ badVic-      condHpTooLow = hpTooLow body ar-      condNotCalmEnough = not (calmEnough body ar)-      speed1_5 = speedScale (3%2) (gearSpeed ar)-      condCanMelee = actorCanMelee actorAspect aid body-      condMeleeBad = not ((condSolo || condSupport1) && condCanMelee)-      condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL-      threatAdj = takeWhile ((== 1) . fst) threatDistL-      condManyThreatAdj = length threatAdj >= 2-      condFastThreatAdj =-        any (\(_, (aid2, _)) ->-              let ar2 = actorAspect EM.! aid2-              in gearSpeed ar2 > speed1_5)-        threatAdj-      heavilyDistressed =  -- actor hit by a proj or similarly distressed-        deltaSerious (bcalmDelta body)-      actorShines = IA.aShine ar > 0-      aCanDeLightL | actorShines = []-                   | otherwise = canDeAmbientL-      aCanDeLight = not $ null aCanDeLightL-      canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL-      actorMaxSk = IA.aSkills ar-      abInMaxSkill ab = EM.findWithDefault 0 ab actorMaxSk > 0-      runSkills = [AbMove, AbDisplace, AbAlter]-      stratToFreq :: Int-                  -> m (Strategy RequestTimed)-                  -> m (Frequency RequestTimed)-      stratToFreq scale mstrat = do-        st <- mstrat-        return $! if scale == 0-                  then mzero-                  else scaleFreq scale $ bestVariant st-      -- 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 RequestTimed), Bool)]-      prefix =-        [ ( [AbApply]-          , applyItem aid ApplyFirstAid-          , not condAnyFoeAdj && condHpTooLow)-        , ( [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-            && ((condNotCalmEnough || condHpTooLow)  -- flee-                && condMeleeBad && condThreat 1-                || (lidExplored || condEnoughGear)  -- explore-                   && not condDesirableFloorItem) )-        , ( [AbDisplace]-          , displaceFoe aid  -- only swap with an enemy to expose him-          , condAnyFoeAdj && condBlocksFriends)  -- later checks foe eligible-        , ( [AbMoveItem]-          , pickup aid True-          , condNoEqpWeapon  -- we assume organ weapons usually inferior-            && condFloorWeapon && not condHpTooLow-            && abInMaxSkill AbMelee )-        , ( [AbAlter]-          , trigger aid ViaEscape-          , condAdjTriggerable && not condAimEnemyPresent-            && not condDesirableFloorItem )  -- collect the last loot-        , ( 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,-            -- can fling at us and we can't well fling at them.-            not condFastThreatAdj-            && if | condThreat 1 ->-                      not condCanMelee-                      || condManyThreatAdj && not condSupport1 && not condSolo-                  | not condInMelee-                    && (condThreat 2 || condThreat 5 && canFleeFromLight) ->-                    -- Don't keep fleeing if just hit, because too close-                    -- to enemy to get out of his range, most likely,-                    -- and so melee him instead, unless can't melee at all.-                    not condCanMelee-                    || not condSupport3 && not condSolo && not heavilyDistressed-                  | condThreat 5 ->-                    -- Too far to flee from melee, too close from ranged,-                    -- not in ambient, so no point fleeing into dark; advance.-                    False-                  | otherwise ->-                    -- If I'm hit, they are still in range to fling at me,-                    -- even if I can't see them. And probably far away.-                    -- Too far to close in for melee; can't shoot; flee from-                    -- ranged attack and prepare ambush for later on.-                    not condInMelee-                    && heavilyDistressed-                    && (not condCanProject || canFleeFromLight) )-        , ( [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]-          , 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]-          , meleeAny aid-          , condAnyFoeAdj )  -- won't flee nor displace, so let it melee-        , ( runSkills-          , flee aid panicFleeL  -- ultimate panic mode, displaces foes-          , condAnyFoeAdj )-        ]-      -- Order doesn't matter, scaling does.-      -- These are flattened (taking only the best variant) and then summed,-      -- 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 RequestTimed), Bool)]-      distant =-        [ ( [AbMoveItem]-          , stratToFreq (if condInMelee then 2 else 20000)-            $ yieldUnneeded aid  -- 20000 to unequip ASAP, unless is thrown-          , True )-        , ( [AbMoveItem]-          , stratToFreq 1-            $ equipItems aid  -- doesn't take long, very useful if safe-          , not (condInMelee-                 || condDesirableFloorItem-                 || condNotCalmEnough-                 || heavilyDistressed) )-        , ( [AbProject]-          , stratToFreq (if condTgtNonmoving then 20 else 3)-              -- not too common, to leave missiles for pre-melee dance-            $ projectItem aid  -- equivalent of @condCanProject@ called inside-          , condAimEnemyPresent && not condInMelee )-        , ( [AbApply]-          , stratToFreq 1-            $ applyItem aid ApplyAll  -- use any potion or scroll-          , condAimEnemyPresent || condThreat 9 )  -- can affect enemies-        , ( runSkills-          , stratToFreq (if | condInMelee ->-                              400  -- friends pummeled by target, go to help-                            | not condAimEnemyPresent ->-                              2  -- if enemy only remembered, investigate anyway-                            | otherwise ->-                              20)-            $ chase aid (not condInMelee-                         && (condThreat 12 || heavilyDistressed)-                         && aCanDeLight) retry-          , condCanMelee-            && (if condInMelee then condAimEnemyPresent-                else (condAimEnemyPresent || condAimEnemyRemembered)-                     && (not (condThreat 2)-                         || heavilyDistressed  -- if under fire, do something!-                         || not condMeleeBad)-                       -- this results in animals in corridor never attacking-                       -- (unless distressed by, e.g., being hit by missiles),-                       -- because they can't swarm opponent, which is logical,-                       -- and in rooms they do attack, so not too boring;-                       -- two aliens attack always, because more aggressive-                     && not condDesirableFloorItem) )-        ]-      -- Order matters again.-      suffix =-        [ ( [AbMoveItem]-          , pickup aid False  -- e.g., to give to other party members-          , not condInMelee )-        , ( [AbMoveItem]-          , unEquipItems aid  -- late, because these items not bad-          , not condInMelee )-        , ( runSkills-          , chase aid (not condInMelee-                       && heavilyDistressed-                       && aCanDeLight) retry-          , if condInMelee then condCanMelee && condAimEnemyPresent-            else not (condThreat 2) || not condMeleeBad )-        ]-      fallback =-        [ ( [AbWait]-          , waitBlockNow-            -- Wait until friends sidestep; ensures strategy is never empty.-          , True )-        ]-  -- Check current, not maximal skills, since this can be a leader as well-  -- as non-leader action.-  let abInSkill ab = EM.findWithDefault 0 ab actorSk > 0-      checkAction :: ([Ability], m a, Bool) -> Bool-      checkAction (abts, _, cond) = any abInSkill abts && cond-      sumS abAction = do-        let as = filter checkAction abAction-        strats <- mapM (\(_, m, _) -> m) as-        return $! msum strats-      sumF abFreq = do-        let as = filter checkAction abFreq-        strats <- mapM (\(_, m, _) -> m) as-        return $! msum strats-      combineDistant as = liftFrequency <$> sumF as-  sumPrefix <- sumS prefix-  comDistant <- combineDistant distant-  sumSuffix <- sumS suffix-  sumFallback <- sumS fallback-  return $! sumPrefix .| comDistant .| sumSuffix .| sumFallback--waitBlockNow :: MonadClient m => m (Strategy RequestTimed)-waitBlockNow = return $! returN "wait" ReqWait--pickup :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)-pickup aid onlyWeapon = do-  benItemL <- benGroundItems aid-  b <- getsState $ getActorBody aid-  -- This calmE is outdated when one of the items increases max Calm-  -- (e.g., in pickup, which handles many items at once), but this is OK,-  -- the server accepts item movement based on calm at the start, not end-  -- or in the middle.-  -- The calmE is inaccurate also if an item not IDed, but that's intended-  -- and the server will ignore and warn (and content may avoid that,-  -- e.g., making all rings identified)-  ar <- getsState $ getActorAspect aid-  let calmE = calmEnough b ar-      isWeapon (_, _, _, itemFull, _) = IK.isMelee $ itemKind itemFull-      filterWeapon | onlyWeapon = filter isWeapon-                   | otherwise = id-      prepareOne (oldN, l4)-                 (Benefit{benInEqp}, _, iid, ItemFull{itemKind}, (itemK, _)) =-        let prep newN toCStore = (newN, (iid, itemK, CGround, toCStore) : l4)-            n = oldN + itemK-        in if | calmE && IK.goesIntoSha itemKind && not onlyWeapon ->-                prep oldN CSha-              | benInEqp && eqpOverfull b n ->-                if onlyWeapon then (oldN, l4)-                else prep oldN (if calmE then CSha else CInv)-              | benInEqp ->-                prep n CEqp-              | not onlyWeapon ->-                prep oldN CInv-              | otherwise -> (oldN, l4)-      (_, prepared) = foldl' prepareOne (0, []) $ filterWeapon benItemL-  return $! if null prepared then reject-            else returN "pickup" $ ReqMoveItems prepared---- This only concerns items that can be equipped, that is with a slot--- 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)-equipItems aid = do-  body <- getsState $ getActorBody aid-  ar <- getsState $ getActorAspect aid-  let calmE = calmEnough body ar-  eqpAssocs <- getsState $ kitAssocs aid [CEqp]-  invAssocs <- getsState $ kitAssocs aid [CInv]-  shaAssocs <- getsState $ kitAssocs aid [CSha]-  condShineWouldBetray <- condShineWouldBetrayM aid-  condAimEnemyPresent <- condAimEnemyPresentM aid-  discoBenefit <- getsClient sdiscoBenefit-  let improve :: CStore-              -> (Int, [(ItemId, Int, CStore, CStore)])-              -> ( IA.EqpSlot-                 , ( [(Int, (ItemId, ItemFullKit))]-                   , [(Int, (ItemId, ItemFullKit))] ) )-              -> (Int, [(ItemId, Int, CStore, CStore)])-      improve fromCStore (oldN, l4) (slot, (bestInv, bestEqp)) =-        let n = 1 + oldN-        in case (bestInv, bestEqp) of-          ((_, (iidInv, _)) : _, []) | not (eqpOverfull body n) ->-            (n, (iidInv, 1, fromCStore, CEqp) : l4)-          ((vInv, (iidInv, _)) : _, (vEqp, _) : _)-            | vInv > vEqp && not (eqpOverfull body n)-              -- Only add random minor boosts if one slot remains free-              -- for major boosts, to avoid wield/unwield loops.-              -- All slots may be taken only via adding major boosts.-              || not (toShare slot) && not (eqpOverfull body (n + 1)) ->-                (n, (iidInv, 1, fromCStore, CEqp) : l4)-          _ -> (oldN, l4)-      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltaSerious (bcalmDelta body)-      -- We filter out unneeded items. In particular, we ignore them in eqp-      -- when comparing to items we may want to equip, so that the unneeded-      -- but powerful items don't fool us.-      -- In any case, the unneeded items should be removed from equip-      -- in @yieldUnneeded@ earlier or soon after this check.-      -- In other stores we need to filter, for otherwise we'd have-      -- a loop of equip/yield.-      filterNeeded (_, (itemFull, _)) =-        not $ hinders condShineWouldBetray condAimEnemyPresent-                      heavilyDistressed (not calmE) ar itemFull-      bestThree = bestByEqpSlot discoBenefit-                                (filter filterNeeded eqpAssocs)-                                (filter filterNeeded invAssocs)-                                (filter filterNeeded shaAssocs)-      bEqpInv = foldl' (improve CInv) (0, [])-                $ map (\(slot, (eqp, inv, _)) ->-                        (slot, (inv, eqp))) bestThree-      bEqpBoth | calmE =-                   foldl' (improve CSha) bEqpInv-                   $ map (\(slot, (eqp, _, sha)) ->-                           (slot, (sha, eqp))) bestThree-               | otherwise = bEqpInv-      (_, prepared) = bEqpBoth-  return $! if null prepared-            then reject-            else returN "equipItems" $ ReqMoveItems prepared--toShare :: IA.EqpSlot -> Bool-toShare IA.EqpSlotMiscBonus = False-toShare IA.EqpSlotMiscAbility = False-toShare _ = True--yieldUnneeded :: MonadClient m => ActorId -> m (Strategy RequestTimed)-yieldUnneeded aid = do-  body <- getsState $ getActorBody aid-  ar <- getsState $ getActorAspect aid-  let calmE = calmEnough body ar-  eqpAssocs <- getsState $ kitAssocs aid [CEqp]-  condShineWouldBetray <- condShineWouldBetrayM aid-  condAimEnemyPresent <- condAimEnemyPresentM aid-  discoBenefit <- getsClient sdiscoBenefit-  -- Here and in @unEquipItems@ AI may hide from the human player,-  -- in shared stash, the Ring of Speed And Bleeding,-  -- which is a bit harsh, but fair. However any subsequent such-  -- rings will not be picked up at all, so the human player-  -- doesn't lose much fun. Additionally, if AI learns alchemy later on,-  -- they can repair the ring, wield it, drop at death and it's-  -- in play again.-  let heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltaSerious (bcalmDelta body)-      csha = if calmE then CSha else CInv-      yieldSingleUnneeded (iidEqp, (itemEqp, (itemK, _))) =-        if | harmful discoBenefit iidEqp ->-             [(iidEqp, itemK, CEqp, CInv)]  -- harmful not shared-           | hinders condShineWouldBetray condAimEnemyPresent-                     heavilyDistressed (not calmE) ar itemEqp ->-             [(iidEqp, itemK, CEqp, csha)]-           | otherwise -> []-      yieldAllUnneeded = concatMap yieldSingleUnneeded eqpAssocs-  return $! if null yieldAllUnneeded-            then reject-            else returN "yieldUnneeded" $ ReqMoveItems yieldAllUnneeded---- This only concerns items that can be equipped, that is with a slot--- 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)-unEquipItems aid = do-  body <- getsState $ getActorBody aid-  ar <- getsState $ getActorAspect aid-  let calmE = calmEnough body ar-  eqpAssocs <- getsState $ kitAssocs aid [CEqp]-  invAssocs <- getsState $ kitAssocs aid [CInv]-  shaAssocs <- getsState $ kitAssocs aid [CSha]-  condShineWouldBetray <- condShineWouldBetrayM aid-  condAimEnemyPresent <- condAimEnemyPresentM aid-  discoBenefit <- getsClient sdiscoBenefit-  let improve :: CStore -> ( IA.EqpSlot-                           , ( [(Int, (ItemId, ItemFullKit))]-                             , [(Int, (ItemId, ItemFullKit))] ) )-              -> [(ItemId, Int, CStore, CStore)]-      improve fromCStore (slot, (bestSha, bestEOrI)) =-        case bestEOrI of-          _ | not (toShare slot)-              && fromCStore == CEqp-              && not (eqpOverfull body 1) ->  -- keep minor boosts up to M-1-            []-          ((vEOrI, (iidEOrI, bei)) : _) | (toShare slot || fromCStore == CInv)-                                          && getK bei > 1-                                          && betterThanSha vEOrI bestSha ->-            -- To share the best items with others, if they care.-            [(iidEOrI, getK bei - 1, fromCStore, CSha)]-          (_ : (vEOrI, (iidEOrI, bei)) : _) | (toShare slot-                                               || fromCStore == CInv)-                                              && betterThanSha vEOrI bestSha ->-            -- To share the second best items with others, if they care.-            [(iidEOrI, getK bei, fromCStore, CSha)]-          ((vEOrI, (_, _)) : _) | fromCStore == CEqp-                                  && eqpOverfull body 1-                                  && worseThanSha vEOrI bestSha ->-            -- To make place in eqp for an item better than any ours.-            -- Even a minor boost is removed only if sha has a better one.-            [(fst $ snd $ last bestEOrI, 1, fromCStore, CSha)]-          _ -> []-      getK (_, (itemK, _)) = itemK-      betterThanSha _ [] = True-      betterThanSha vEOrI ((vSha, _) : _) = vEOrI > vSha-      worseThanSha _ [] = False-      worseThanSha vEOrI ((vSha, _) : _) = vEOrI < vSha-      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltaSerious (bcalmDelta body)-      -- Here we don't need to filter out items that hinder (except in sha)-      -- because they are moved to sha and will be equipped by another actor-      -- at another time, where hindering will be completely different.-      -- If they hinder and we unequip them, all the better.-      -- We filter sha to consider only eligible items in @worseThanSha@.-      filterNeeded (_, (itemFull, _)) =-        not $ hinders condShineWouldBetray condAimEnemyPresent-                      heavilyDistressed (not calmE) ar itemFull-      bestThree = bestByEqpSlot discoBenefit eqpAssocs invAssocs-                                (filter filterNeeded shaAssocs)-      bInvSha = concatMap-                  (improve CInv . (\(slot, (_, inv, sha)) ->-                                    (slot, (sha, inv)))) bestThree-      bEqpSha = concatMap-                  (improve CEqp . (\(slot, (eqp, _, sha)) ->-                                    (slot, (sha, eqp)))) bestThree-      prepared = if calmE then bInvSha ++ bEqpSha else []-  return $! if null prepared-            then reject-            else returN "unEquipItems" $ ReqMoveItems prepared--groupByEqpSlot :: [(ItemId, ItemFullKit)]-               -> EM.EnumMap IA.EqpSlot [(ItemId, ItemFullKit)]-groupByEqpSlot is =-  let f (iid, itemFullKit) = case IK.getEqpSlot $ itemKind $ fst itemFullKit of-        Nothing -> Nothing-        Just es -> Just (es, [(iid, itemFullKit)])-      withES = mapMaybe f is-  in EM.fromListWith (++) withES--bestByEqpSlot :: DiscoveryBenefit-              -> [(ItemId, ItemFullKit)]-              -> [(ItemId, ItemFullKit)]-              -> [(ItemId, ItemFullKit)]-              -> [(IA.EqpSlot-                  , ( [(Int, (ItemId, ItemFullKit))]-                    , [(Int, (ItemId, ItemFullKit))]-                    , [(Int, (ItemId, ItemFullKit))] ) )]-bestByEqpSlot discoBenefit eqpAssocs invAssocs shaAssocs =-  let eqpMap = EM.map (\g -> (g, [], [])) $ groupByEqpSlot eqpAssocs-      invMap = EM.map (\g -> ([], g, [])) $ groupByEqpSlot invAssocs-      shaMap = EM.map (\g -> ([], [], g)) $ groupByEqpSlot shaAssocs-      appendThree (g1, g2, g3) (h1, h2, h3) = (g1 ++ h1, g2 ++ h2, g3 ++ h3)-      eqpInvShaMap = EM.unionsWith appendThree [eqpMap, invMap, shaMap]-      bestSingle = strongestSlot discoBenefit-      bestThree eqpSlot (g1, g2, g3) = (bestSingle eqpSlot g1,-                                        bestSingle eqpSlot g2,-                                        bestSingle eqpSlot g3)-  in EM.assocs $ EM.mapWithKey bestThree eqpInvShaMap--harmful :: DiscoveryBenefit -> ItemId -> Bool-harmful discoBenefit iid =-  -- Items that are known, perhaps recently discovered, and it's now revealed-  -- they should not be kept in equipment, should be unequipped-  -- (either they are harmful or they waste eqp space).-  not $ benInEqp $ discoBenefit EM.! iid---- Everybody melees in a pinch, even though some prefer ranged attacks.-meleeBlocker :: MonadClient m => ActorId -> m (Strategy RequestTimed)-meleeBlocker aid = do-  b <- getsState $ getActorBody aid-  actorAspect <- getsState sactorAspect-  let ar = actorAspect EM.! aid-  fact <- getsState $ (EM.! bfid b) . sfactionD-  actorSk <- currentSkillsClient aid-  mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  case mtgtMPath of-    Just TgtAndPath{ tapTgt=TEnemy{}-                   , tapPath=AndPath{pathList=q : _, pathGoal} }-      | q == pathGoal -> return reject  -- not a real blocker, but goal enemy-    Just TgtAndPath{tapPath=AndPath{pathList=q : _, pathGoal}} -> do-      -- We prefer the goal position, so that we can kill the foe and enter it,-      -- but we accept any @q@ as well.-      let maim | adjacent (bpos b) pathGoal = Just pathGoal-               | adjacent (bpos b) q = Just q-               | otherwise = Nothing  -- MeleeDistant-      lBlocker <- case maim of-        Nothing -> return []-        Just aim -> getsState $ posToAssocs aim (blid b)-      case lBlocker of-        (aid2, body2) : _ -> do-          let ar2 = actorAspect EM.! aid2-          -- 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, 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-               || isFriend (bfid b) fact (bfid body2) -- don't start a war-                  && EM.findWithDefault 0 AbDisplace actorSk <= 0  -- can't disp-                  && EM.findWithDefault 0 AbMove actorSk > 0  -- blocked move-                  && 3 * bhp body2 < bhp b  -- only get rid of weak friends-                  && gearSpeed ar2 <= gearSpeed ar -> do-               mel <- maybeToList <$> pickWeaponClient aid aid2-               return $! liftFrequency $ uniformFreq "melee in the way" mel-             | otherwise -> return reject-        [] -> return reject-    _ -> return reject  -- probably no path to the enemy, if any---- Everybody melees in a pinch, skills and weapons allowing,--- even though some prefer ranged attacks.-meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed)-meleeAny aid = do-  b <- getsState $ getActorBody aid-  fact <- getsState $ (EM.! bfid b) . sfactionD-  adjacentAssocs <- getsState $ actorAdjacentAssocs b-  let foe (_, b2) =-        not (bproj b2) && isFoe (bfid b) fact (bfid b2) && bhp b2 > 0-      adjFoes = filter foe adjacentAssocs-  btarget <- getsClient $ getTarget aid-  mtarget <- case btarget of-    Just (TEnemy aid2 _) -> do-      b2 <- getsState $ getActorBody aid2-      return $! if adjacent (bpos b2) (bpos b) && foe (aid2, b2)-                then Just (aid2, b2)-                else Nothing-    _ -> return Nothing-  let adjTargets = maybe adjFoes return mtarget-  mels <- mapM (pickWeaponClient aid . fst) adjTargets-  let freq = uniformFreq "melee adjacent" $ catMaybes mels-  return $! liftFrequency freq---- The level the actor is on is either explored or the actor already--- has a weapon equipped, so no need to explore further, he tries to find--- enemies on other levels.--- We don't verify any embedded item is targeted by the actor, but at least--- the actor doesn't target a visible enemy at this point.-trigger :: MonadClient m-        => ActorId -> FleeViaStairsOrEscape-        -> m (Strategy RequestTimed)-trigger aid fleeVia = do-  b <- getsState $ getActorBody aid-  lvl <- getLevel (blid b)-  let f pos = case EM.lookup pos $ lembed lvl of-        Nothing -> Nothing-        Just bag -> Just (pos, bag)-      pbags = mapMaybe f $ vicinityUnsafe (bpos b)-  efeat <- embedBenefit fleeVia aid pbags-  return $! liftFrequency $ toFreq "trigger"-    [ (ceiling benefit, ReqAlter pos)-    | (benefit, (pos, _)) <- efeat ]--projectItem :: MonadClient m => ActorId -> m (Strategy RequestTimed)-projectItem aid = do-  btarget <- getsClient $ getTarget aid-  b <- getsState $ getActorBody aid-  mfpos <- case btarget of-    Nothing -> return Nothing-    Just target -> getsState $ aidTgtToPos aid (blid b) target-  seps <- getsClient seps-  case (btarget, mfpos) of-    (_, Just fpos) | adjacent (bpos b) fpos -> return reject-    (Just TEnemy{}, Just fpos) -> do-      mnewEps <- makeLine False b fpos seps-      case mnewEps of-        Just newEps -> do-          actorSk <- currentSkillsClient aid-          let skill = EM.findWithDefault 0 AbProject actorSk-          -- ProjectAimOnself, ProjectBlockActor, ProjectBlockTerrain-          -- and no actors or obstacles along the path.-          benList <- condProjectListM skill aid-          localTime <- getsState $ getLocalTime (blid b)-          let coeff CGround = 2  -- pickup turn saved-              coeff COrgan = error $ "" `showFailure` benList-              coeff CEqp = 100000  -- must hinder currently-              coeff CInv = 1-              coeff CSha = 1-              fRanged (Benefit{benFling}, cstore, iid, itemFull, kit) =-                -- We assume if the item has a timeout, most effects are under-                -- Recharging, so no point projecting if not recharged.-                -- This changes in time, so recharging is not included-                -- in @condProjectListM@, but checked here, just before fling.-                let recharged = hasCharge localTime itemFull kit-                    trange = IK.totalRange $ itemKind itemFull-                    bestRange =-                      chessDist (bpos b) fpos + 2  -- margin for fleeing-                    rangeMult =  -- penalize wasted or unsafely low range-                      10 + max 0 (10 - abs (trange - bestRange))-                    benR = coeff cstore * benFling-                in if trange >= chessDist (bpos b) fpos && recharged-                   then Just ( - ceiling (benR * fromIntegral rangeMult / 10)-                             , ReqProject fpos newEps iid cstore )-                   else Nothing-              benRanged = mapMaybe fRanged benList-          return $! liftFrequency $ toFreq "projectItem" benRanged-        _ -> return reject-    _ -> return reject--data ApplyItemGroup = ApplyAll | ApplyFirstAid-  deriving Eq--applyItem :: MonadClient m-          => ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)-applyItem aid applyGroup = do-  actorSk <- currentSkillsClient aid-  b <- getsState $ getActorBody aid-  condShineWouldBetray <- condShineWouldBetrayM aid-  condAimEnemyPresent <- condAimEnemyPresentM aid-  localTime <- getsState $ getLocalTime (blid b)-  ar <- getsState $ getActorAspect aid-  let calmE = calmEnough b ar-      condNotCalmEnough = not calmE-      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltaSerious (bcalmDelta b)-      skill = EM.findWithDefault 0 AbApply actorSk-      -- This detects if the value of keeping the item in eqp is in fact < 0.-      hind = hinders condShineWouldBetray condAimEnemyPresent-                     heavilyDistressed condNotCalmEnough ar-      permittedActor itemFull kit =-        either (const False) id-        $ permittedApply localTime skill calmE itemFull kit-      -- Both effects tweak items, which is only situationally beneficial-      -- and not really the best idea while in combat.-      getTweak IK.PolyItem = True-      getTweak IK.Identify = True-      getTweak (IK.OneOf l) = any getTweak l-      getTweak (IK.Recharging eff) = getTweak eff-      getTweak (IK.Composite l) = any getTweak l-      getTweak _ = False-      q (Benefit{benInEqp}, _, _, itemFull@ItemFull{itemKind}, kit) =-        let durable = IK.Durable `elem` IK.ifeature itemKind-        in (not benInEqp  -- can't wear, so OK to break-            || durable  -- can wear, but can't break, even better-            || not (IK.isMelee itemKind)  -- anything else expendable-               && hind itemFull)  -- hinders now, so possibly often, so away!-           && permittedActor itemFull kit-           && not (any getTweak $ IK.ieffects itemKind)-           && not (IK.isHumanTrinket itemKind)  -- hack for elixir of youth-      -- Organs are not taken into account, because usually they are either-      -- melee items, so harmful, or periodic, so charging between activations.-      -- The case of a weak weapon curing poison is too rare to incur overhead.-      stores = [CEqp, CInv, CGround] ++ [CSha | calmE]-  discoBenefit <- getsClient sdiscoBenefit-  benList <- getsState $ benAvailableItems discoBenefit aid stores-  getKind <- getsState $ flip getIidKind-  let (myBadGrps, myGoodGrps) = partitionEithers $ mapMaybe (\iid ->-        let itemKind = getKind iid-        in if IK.isTmpCondition itemKind-           then Just $ if benInEqp (discoBenefit EM.! iid)-                       then Left $ toGroupName $ IK.iname itemKind-                         -- conveniently, @iname@ matches @ifreq@-                       else Right $ toGroupName $ IK.iname itemKind-           else Nothing) (EM.keys $ borgan b)-      coeff CGround = 2  -- pickup turn saved-      coeff COrgan = error $ "" `showFailure` benList-      coeff CEqp = 1-      coeff CInv = 1-      coeff CSha = 1-      fTool benAv@(Benefit{benApply}, cstore, iid, ItemFull{itemKind}, _) =-        let -- Don't include @Ascend@ nor @Teleport@, because maybe no foe near.-            -- Don't include @OneOf@ because other effects may kill you.-            getHP (IK.RefillHP p) | p > 0 = True-            getHP (IK.Recharging eff) = getHP eff-            getHP (IK.Composite l) = any getHP l-            getHP _ = False-            heals = any getHP $ IK.ieffects itemKind-            dropsGrps = IK.getDropOrgans itemKind-            dropsBadOrgans =-              not (null myBadGrps)-              && toGroupName "condition" `elem` dropsGrps-                 || not (null (dropsGrps `intersect` myBadGrps))-            dropsGoodOrgans =-              not (null myGoodGrps)-              && toGroupName "condition" `elem` dropsGrps-                 || not (null (dropsGrps `intersect` myGoodGrps))-            wastesDrop = null myBadGrps && not (null dropsGrps)-            durable = IK.Durable `elem` IK.ifeature itemKind-            situationalBenApply | dropsBadOrgans = benApply + 20-                                | wastesDrop = benApply - 10-                                | otherwise = benApply-            benR = ceiling situationalBenApply-                   * if cstore == CEqp && not durable-                     then 1000  -- must hinder currently-                     else coeff cstore-            canApply = situationalBenApply > 0 && case applyGroup of-              ApplyFirstAid -> q benAv && heals-              ApplyAll -> q benAv-                          && not dropsGoodOrgans-                          && (dropsBadOrgans-                              || not (hpEnough b ar && heals))-        in if canApply-           then Just (benR, ReqApply iid cstore)-           else Nothing-      benTool = mapMaybe fTool benList-  return $! liftFrequency $ toFreq "applyItem" benTool---- If low on health or alone, flee in panic, close to the path to target--- 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 RequestTimed)-flee aid fleeL = do-  b <- getsState $ getActorBody aid-  -- Regardless if fleeing accomplished, mark the need.-  modifyClient $ \cli -> cli {sfleeD = EM.insert aid (bpos b) (sfleeD cli)}-  let vVic = map (second (`vectorToFrom` bpos b)) fleeL-      str = liftFrequency $ toFreq "flee" vVic-  mapStrategyM (moveOrRunAid aid) str---- 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 RequestTimed)-displaceFoe aid = do-  COps{coTileSpeedup} <- getsState scops-  b <- getsState $ getActorBody aid-  lvl <- getLevel $ blid b-  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)-        -- DisplaceProjectiles-      adjFoes = filter foe adjacentAssocs-      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-        actorMaxSk <- maxActorSkillsClient aid2-        dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk-          -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported-        let nFrOld = nFriends body2-        return $! if walkable (bpos body2) && dEnemy && nFrOld < nFrNew-                     && notLooping b (bpos body2)-                  then Just (nFrOld * nFrOld, ReqDisplace aid2)-                  else Nothing-  foes <- mapM qualifyActor adjFoes-  return $! liftFrequency $ toFreq "displaceFoe" $ catMaybes foes--displaceBlocker :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)-displaceBlocker aid retry = do-  b <- getsState $ getActorBody aid-  mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  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-      displaceTgt aid q retry-    _ -> return reject  -- goal reached--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-  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-      [] -> return reject-      [(aid2, b2)] | Just aid2 /= mleader -> do-        mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD-        enemyTgt <- condAimEnemyPresentM aid-        enemyPos <- condAimEnemyRememberedM aid-        enemyTgt2 <- condAimEnemyPresentM aid2-        enemyPos2 <- condAimEnemyRememberedM aid2-        case mtgtMPath of-          Just TgtAndPath{tapPath=AndPath{pathList=q : _}}-            | q == source  -- friend wants to swap-              || retry  -- desperate-                 && not (boldpos b == Just target  -- and no displace loop-                         && not (waitedLastTurn b))-              || (enemyTgt || enemyPos) && not (enemyTgt2 || enemyPos2) ->-                 -- 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" $ 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" $ ReqDisplace aid2-            else return reject-      _ -> return reject  -- DisplaceProjectiles or trying to displace leader-  else return reject--chase :: MonadClient m => ActorId -> Bool -> Bool -> m (Strategy RequestTimed)-chase aid avoidAmbient retry = do-  COps{coTileSpeedup} <- getsState scops-  body <- getsState $ getActorBody aid-  fact <- getsState $ (EM.! bfid body) . sfactionD-  mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  lvl <- getLevel $ blid body-  let isAmbient pos = Tile.isLit coTileSpeedup (lvl `at` pos)-                      && Tile.isWalkable coTileSpeedup (lvl `at` pos)-                        -- if solid, will be altered and perhaps darkened-  str <- case mtgtMPath of-    Just TgtAndPath{tapPath=AndPath{pathList=q : _, ..}}-      | pathGoal == bpos body -> return reject  -- shortcut and just to be sure-      | not $ avoidAmbient && isAmbient q ->-      -- With no leader, the goal is vague, so permit arbitrary detours.-      moveTowards aid q pathGoal (fleaderMode (gplayer fact) == LeaderNull-                                  || retry)-    _ -> return reject  -- goal reached or banned ambient lit tile-  if avoidAmbient && nullStrategy str-  then chase aid False retry-  else mapStrategyM (moveOrRunAid aid) str--moveTowards :: MonadClient m-            => ActorId -> Point -> Point -> Bool -> m (Strategy Vector)-moveTowards aid target goal relaxed = do-  b <- getsState $ getActorBody aid-  actorSk <- currentSkillsClient aid-  let source = bpos b-      alterSkill = EM.findWithDefault 0 AbAlter actorSk-      !_A = assert (source == bpos b-                    `blame` (source, bpos b, aid, b, goal)) ()-      !_B = assert (adjacent source target-                    `blame` (source, target, aid, b, goal)) ()-  fact <- getsState $ (EM.! bfid b) . sfactionD-  salter <- getsClient salter-  noFriends <- getsState $ \s p -> all (isFoe (bfid b) fact . bfid . snd)-                                       (posToAssocs p (blid b) s)-  let lalter = salter EM.! blid b-      -- Only actors with AbAlter can search for hidden doors, etc.-      enterableHere p = alterSkill >= fromEnum (lalter PointArray.! p)-  if noFriends target && enterableHere target then-    return $! returN "moveTowards adjacent" $ target `vectorToFrom` source-  else do-    let goesBack p = Just p == boldpos b-        nonincreasing p = chessDist source goal >= chessDist p goal-        isSensible | relaxed = \p -> noFriends p-                                     && enterableHere p-                   | otherwise = \p -> nonincreasing p-                                       && not (goesBack p)-                                       && noFriends p-                                       && enterableHere p-        sensible = [ ((goesBack p, chessDist p goal), v)-                   | v <- moves, let p = source `shift` v, isSensible p ]-        sorted = sortBy (comparing fst) sensible-        groups = map (map snd) $ groupBy ((==) `on` fst) sorted-        freqs = map (liftFrequency . uniformFreq "moveTowards") groups-    return $! foldr (.|) reject freqs---- 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 RequestTimed)-moveOrRunAid source dir = do-  COps{coTileSpeedup} <- getsState scops-  sb <- getsState $ getActorBody source-  actorSk <- currentSkillsClient source-  let lid = blid sb-  lvl <- getLevel lid-  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-  -- We start by checking actors at the target position,-  -- which gives a partial information (actors can be invisible),-  -- as opposed to accessibility (and items) which are always accurate-  -- (tiles can't be invisible).-  tgts <- getsState $ posToAssocs tpos lid-  case tgts of-    [(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-        -- 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,342 +0,0 @@--- | Picking the AI actor to move and refreshing leader and non-leader targets.-module Game.LambdaHack.Client.AI.PickActorM-  ( pickActorToMove, setTargetFromTactics-  ) where--import Prelude ()--import Game.LambdaHack.Common.Prelude--import qualified Data.EnumMap.Lazy as LEM-import qualified Data.EnumMap.Strict as EM-import           Data.Ratio--import           Game.LambdaHack.Client.AI.ConditionM-import           Game.LambdaHack.Client.AI.PickTargetM-import           Game.LambdaHack.Client.Bfs-import           Game.LambdaHack.Client.BfsM-import           Game.LambdaHack.Client.MonadClient-import           Game.LambdaHack.Client.State-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Faction-import           Game.LambdaHack.Common.Frequency-import qualified Game.LambdaHack.Common.ItemAspect as IA-import           Game.LambdaHack.Common.Misc-import           Game.LambdaHack.Common.MonadStateRead-import           Game.LambdaHack.Common.Point-import           Game.LambdaHack.Common.Random-import           Game.LambdaHack.Common.State-import           Game.LambdaHack.Common.Time-import           Game.LambdaHack.Content.ModeKind---- | Pick a new leader from among the actors on the current level.--- Refresh the target of the new leader, even if unchanged.-pickActorToMove :: MonadClient m => Maybe ActorId -> m ActorId-{-# INLINE pickActorToMove #-}-pickActorToMove maidToAvoid = do-  actorAspect <- getsState sactorAspect-  mleader <- getsClient sleader-  let oldAid = fromMaybe (error $ "" `showFailure` maidToAvoid) mleader-  oldBody <- getsState $ getActorBody oldAid-  let side = bfid oldBody-      arena = blid oldBody-  fact <- getsState $ (EM.! side) . sfactionD-  -- Find our actors on the current level only.-  ours <- getsState $ filter (isNothing . btrajectory . snd)-                      . fidActorRegularAssocs side arena-  let pickOld = do-        void $ refreshTarget (oldAid, oldBody)-        return oldAid-  case ours of-    _ | -- Keep the leader: faction discourages client leader change on level,-        -- so will only be changed if waits (maidToAvoid)-        -- to avoid wasting his higher mobility.-        -- This is OK for monsters even if in melee, because both having-        -- a meleeing actor a leader (and higher DPS) and rescuing actor-        -- a leader (and so faster to get in melee range) is good.-        -- And we are guaranteed that only the two classes of actors are-        -- not waiting, with some exceptions (urgent unequip, flee via starts,-        -- melee-less trying to flee, first aid, etc.).-        snd (autoDungeonLevel fact) && isNothing maidToAvoid-      -> pickOld-    [] -> error $ "" `showFailure` (oldAid, oldBody)-    [_] -> pickOld  -- Keep the leader: he is alone on the level.-    _ -> do-      -- At this point we almost forget who the old leader was-      -- and treat all party actors the same, eliminating candidates-      -- until we can't distinguish them any more, at which point we prefer-      -- the old leader, if he is among the best candidates-      -- (to make the AI appear more human-like and easier to observe).-      let refresh aidBody = do-            mtgt <- refreshTarget aidBody-            return (aidBody, mtgt)-          goodGeneric (_, Nothing) = Nothing-          goodGeneric (_, Just TgtAndPath{tapPath=NoPath}) = Nothing-            -- this case means melee-less heroes adjacent to foes, etc.-            -- will never flee if melee is happening; but this is rare;-            -- this also ensures even if a lone actor melees and nobody-            -- can come to rescue, he will become and remain the leader,-            -- because otherwise an explorer would need to become a leader-            -- and fighter will be 1 clip slower for the whole fight,-            -- just for a few turns of exploration in return;-            ---            -- also note that when the fighter then becomes a leader-            -- he may gain quite a lot of time via @swapTime@,-            -- and so be able to get a double blow on opponents-            -- or a safe blow and a withdraw (but only once); this is a mild-            -- exploit that encourages ambush camping (with a non-leader),-            -- but it's also a rather fun exploit and a straightforward-            -- consequence of the game mechanics, so it's OK for now-          goodGeneric ((aid, b), Just tgt) = case maidToAvoid of-            Nothing | not (aid == oldAid && waitedLastTurn b) ->-              -- Not the old leader that was stuck last turn-              -- because he is likely to be still stuck.-              Just ((aid, b), tgt)-            Just aidToAvoid | aid /= aidToAvoid ->-              -- Not an attempted leader stuck this turn.-              Just ((aid, b), tgt)-            _ -> Nothing-      oursTgtRaw <- mapM refresh ours-      scondInMelee <- getsClient scondInMelee-      fleeD <- getsClient sfleeD-      let oursTgt = mapMaybe goodGeneric oursTgtRaw-          -- This should be kept in sync with @actionStrategy@.-          actorVulnerable ((aid, body), _) = do-            let condInMelee = scondInMelee LEM.! blid body-                ar = fromMaybe (error $ "" `showFailure` aid)-                               (EM.lookup aid actorAspect)-            threatDistL <- getsState $ meleeThreatDistList aid-            (fleeL, _) <- fleeList aid-            condSupport1 <- condSupport 1 aid-            condSupport3 <- condSupport 3 aid-            condSolo <- condSoloM aid  -- solo fighters aggresive-            canDeAmbientL <- getsState $ canDeAmbientList body-            let condCanFlee = not (null fleeL)-                speed1_5 = speedScale (3%2) (gearSpeed ar)-                condCanMelee = actorCanMelee actorAspect aid body-                condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL-                threatAdj = takeWhile ((== 1) . fst) threatDistL-                condManyThreatAdj = length threatAdj >= 2-                condFastThreatAdj =-                  any (\(_, (aid2, _)) ->-                    let ar2 = actorAspect EM.! aid2-                    in gearSpeed ar2 > speed1_5)-                  threatAdj-                heavilyDistressed =-                  -- Actor hit by a projectile or similarly distressed.-                  deltaSerious (bcalmDelta body)-                actorShines = IA.aShine ar > 0-                aCanDeLightL | actorShines = []-                             | otherwise = canDeAmbientL-                canFleeFromLight =-                  not $ null $ aCanDeLightL `intersect` map snd fleeL-            return $!-              -- This is a part of the condition for @flee@ in @HandleAbilityM@.-              not condFastThreatAdj-              && if | condThreat 1 ->-                        not condCanMelee-                        || condManyThreatAdj && not condSupport1 && not condSolo-                    | not condInMelee-                      && (condThreat 2 || condThreat 5 && canFleeFromLight) ->-                      not condCanMelee-                      || not condSupport3 && not condSolo-                         && not heavilyDistressed-                    -- not used: | condThreat 5 -> False-                    -- because actor should be picked anyway, to try to melee-                    | otherwise ->-                      not condInMelee-                      && heavilyDistressed-                      && not (EM.member aid fleeD)-                      -- Make him a leader even if can't delight, etc.-                      -- because he may instead take off light or otherwise-                      -- cope with being pummeled by projectiles.-                      -- He is still vulnerable, just not necessarily needs-                      -- to flee, but may cover himself otherwise.-                      -- && (not condCanProject || canFleeFromLight)-              && condCanFlee-          actorFled ((aid, _), _) = EM.member aid fleeD-          actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _-                                      , tapPath=NoPath }) =-            return False-          actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _-                                      , tapPath=AndPath{pathLen} })-            | pathLen <= 2 =-            return False  -- noise probably due to fleeing target-          actorHearning ((_aid, b), _) = do-            allFoes <- getsState $ foeRegularList side (blid b)-            let closeFoes = filter ((<= 3) . chessDist (bpos b) . bpos) allFoes-                mildlyDistressed = deltaMild (bcalmDelta b)-            return $! mildlyDistressed  -- e.g., actor hears an enemy-                      && null closeFoes  -- the enemy not visible; a trap!-          -- AI has to be prudent and not lightly waste leader for meleeing,-          -- even if his target is distant-          actorMeleeing ((aid, _), _) = condAnyFoeAdjM aid-      (oursVulnerable, oursSafe) <- partitionM actorVulnerable oursTgt-      let (oursFled, oursNotFled) = partition actorFled oursSafe-      (oursMeleeing, oursNotMeleeing) <- partitionM actorMeleeing oursNotFled-      (oursHearing, oursNotHearing) <- partitionM actorHearning oursNotMeleeing-      let actorRanged ((aid, body), _) =-            not $ actorCanMelee actorAspect aid body-          targetTEnemy (_, TgtAndPath{tapTgt=TEnemy _ permit}) =-            not permit-          targetTEnemy-            ( (_, b)-            , TgtAndPath{tapTgt=TPoint (TEnemyPos _ permit) lid _} ) =-              lid == blid b && not permit-          targetTEnemy _ = False-          actorNoSupport ((aid, _), _) = do-            threatDistL <- getsState $ meleeThreatDistList aid-            condSupport2 <- condSupport 2 aid-            let condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL-            -- If foes far, friends may still come, so we let him move.-            -- The net effect is that lone heroes close to foes freeze-            -- until support comes.-            return $! condThreat 5 && not condSupport2-          (oursRanged, oursNotRanged) = partition actorRanged oursNotHearing-          (oursTEnemyAll, oursOther) = partition targetTEnemy oursNotRanged-          notSwapReady abt@((_, b), _)-                       (ab2, Just t2@TgtAndPath{tapPath=-                                       AndPath{pathList=q : _}}) =-            let source = bpos b-                tenemy = targetTEnemy abt-                tenemy2 = targetTEnemy (ab2, t2)-            -- Copied from 'displaceTowards':-            in not (q == source  -- friend wants to swap-                    || tenemy && not tenemy2)-          notSwapReady _ _ = True-          -- These are not necessarily stuck (perhaps can go around),-          -- but their current path is blocked by friends.-          targetBlocked abt@((aid, _), TgtAndPath{tapPath}) = case tapPath of-            AndPath{pathList= q : _} ->-              any (\abt2@((aid2, body2), _) ->-                     aid2 /= aid  -- in case pushed on goal-                     && bpos body2 == q-                     && notSwapReady abt abt2)-                  oursTgtRaw-            _ -> False-          (oursTEnemyBlocked, oursTEnemy) =-            partition targetBlocked oursTEnemyAll-      (oursNoSupportRaw, oursSupportRaw) <--        if length oursTEnemy <= 2-        then return ([], oursTEnemy)-        else partitionM actorNoSupport oursTEnemy-      let (oursNoSupport, oursSupport) =-            if length oursSupportRaw <= 1  -- make sure picks random enough-            then ([], oursTEnemy)-            else (oursNoSupportRaw, oursSupportRaw)-          (oursBlocked, oursPos) =-            partition targetBlocked $ oursRanged ++ oursOther-          -- Lower overhead is better.-          overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int-          overheadOurs ((aid, _), TgtAndPath{tapPath=NoPath}) =-            100 + if aid == oldAid then 1 else 0-          overheadOurs abt@( (aid, b)-                           , TgtAndPath{tapPath=AndPath{pathLen=d,pathGoal}} ) =-            -- Keep proper formation. Too dense and exploration takes-            -- too long; too sparse and actors fight alone.-            -- Note that right now, while we set targets separately for each-            -- hero, perhaps on opposite borders of the map,-            -- we can't help that sometimes heroes are separated.-            let maxSpread = 3 + length ours-                pDist p = minimum [ chessDist (bpos b2) p-                                  | (aid2, b2) <- ours, aid2 /= aid]-                aidDist = pDist (bpos b)-                -- Negative, if the goal gets us closer to the party.-                diffDist = pDist pathGoal - aidDist-                -- If actor already at goal or equidistant, count it as closer.-                sign = if diffDist <= 0 then -1 else 1-                formationValue =-                  sign * (abs diffDist `max` maxSpread)-                  * (aidDist `max` maxSpread) ^ (2 :: Int)-                fightValue | targetTEnemy abt =-                  - fromEnum (bhp b `div` (10 * oneM))-                           | otherwise = 0-            in formationValue `div` 3 + fightValue-               + (if targetBlocked abt then 5 else 0)-               + (case d of-                    0 -> -400 -- do your thing ASAP and retarget-                    1 -> -200 -- prevent others from occupying the tile-                    _ -> if d < 8 then d `div` 4 else 2 + d `div` 10)-               + (if aid == oldAid then 1 else 0)-          positiveOverhead ab =-            let ov = 200 - overheadOurs ab-            in if ov <= 0 then 1 else ov-          candidates = [ oursVulnerable-                       , oursSupport-                       , oursNoSupport-                       , oursPos-                       , oursFled  -- if just fled, keep him safe, out of action-                       , oursMeleeing ++ oursTEnemyBlocked-                           -- make melee a leader to displace or at least melee-                           -- without overhead if all others blocked-                       , oursHearing-                       , oursBlocked-                       ]-      case filter (not . null) candidates of-        l : _ -> do-          let freq = toFreq "candidates for AI leader"-                     $ map (positiveOverhead &&& id) l-          ((aid, b), _) <- rndToAction $ frequency freq-          s <- getState-          modifyClient $ updateLeader aid s-          -- When you become a leader, stop following old leader, but follow-          -- his target, if still valid, to avoid distraction.-          let condInMelee = scondInMelee LEM.! blid b-          when (ftactic (gplayer fact) `elem` [TFollow, TFollowNoItems]-                && not condInMelee) $-            void $ refreshTarget (aid, b)-          return aid-        _ -> return oldAid---- | Inspect the tactics of the actor and set his target according to it.-setTargetFromTactics :: MonadClient m => ActorId -> m ()-{-# INLINE setTargetFromTactics #-}-setTargetFromTactics oldAid = do-  mleader <- getsClient sleader-  let !_A = assert (mleader /= Just oldAid) ()-  oldBody <- getsState $ getActorBody oldAid-  scondInMelee <- getsClient scondInMelee-  let condInMelee = scondInMelee LEM.! blid oldBody-  let side = bfid oldBody-      arena = blid oldBody-  fact <- getsState $ (EM.! side) . sfactionD-  let explore = void $ refreshTarget (oldAid, oldBody)-      setPath mtgt = case mtgt of-        Nothing -> return False-        Just TgtAndPath{tapTgt} -> do-          tap <- createPath oldAid tapTgt-          case tap of-            TgtAndPath{tapPath=NoPath} -> return False-            _ -> do-              modifyClient $ \cli ->-                cli {stargetD = EM.insert oldAid tap (stargetD cli)}-              return True-      follow = case mleader of-        -- If no leader at all (forced @TFollow@ tactic on an actor-        -- from a leaderless faction), fall back to @TExplore@.-        Nothing -> explore-        Just leader -> do-          onLevel <- getsState $ memActor leader arena-          -- If leader not on this level, fall back to @TExplore@.-          if not onLevel || condInMelee then explore-          else do-            -- Copy over the leader's target, if any, or follow his bpos.-            mtgt <- getsClient $ EM.lookup leader . stargetD-            tgtPathSet <- setPath mtgt-            let enemyPath = Just TgtAndPath{ tapTgt = TEnemy leader True-                                           , tapPath = NoPath }-            unless tgtPathSet $ do-               enemyPathSet <- setPath enemyPath-               unless enemyPathSet-                 -- If no path even to the leader himself, explore.-                 explore-  case ftactic $ gplayer fact of-    TExplore -> explore-    TFollow -> follow-    TFollowNoItems -> follow-    TMeleeAndRanged -> explore  -- needs to find ranged targets-    TMeleeAdjacent -> explore  -- probably not needed, but may change-    TBlock -> return ()  -- no point refreshing target-    TRoam -> explore  -- @TRoam@ is checked again inside @explore@-    TPatrol -> explore  -- WIP