LambdaHack 0.9.5.0 → 0.10.2.0

raw patch · 165 files changed

+26581/−17255 lines, 165 filesdep +file-embeddep +ghcjs-basedep +int-castdep −randomdep ~base-compatdep ~containersdep ~textbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: file-embed, ghcjs-base, int-cast, open-browser, splitmix, tasty, tasty-hunit, th-lift-instances

Dependencies removed: random

Dependency ranges changed: base-compat, containers, text, transformers

API changes (from Hackage documentation)

- Client.UI.Content.Input: closeDoorTriggers :: [TriggerTile]

- Game.LambdaHack.Atomic: UpdTacticFaction :: FactionId -> Tactic -> Tactic -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdTacticFaction :: FactionId -> Tactic -> Tactic -> UpdAtomic

- Game.LambdaHack.Atomic.HandleAtomicWrite: updTacticFaction :: MonadStateWrite m => FactionId -> Tactic -> Tactic -> m ()

- Game.LambdaHack.Atomic.MonadStateWrite: addAis :: MonadStateWrite m => [(ItemId, Item)] -> m ()

- Game.LambdaHack.Atomic.MonadStateWrite: deleteItemInv :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()

- Game.LambdaHack.Atomic.MonadStateWrite: deleteItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()

- Game.LambdaHack.Atomic.MonadStateWrite: insertItemInv :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()

- Game.LambdaHack.Atomic.MonadStateWrite: insertItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()

- Game.LambdaHack.Atomic.PosAtomicRead: singleContainer :: MonadStateRead m => Container -> m PosAtomic

- Game.LambdaHack.Client: ClientOptions :: Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Bool -> Bool -> Bool -> Maybe Text -> Maybe FilePath -> String -> Bool -> Bool -> Bool -> Bool -> Maybe Int -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> ClientOptions

- Game.LambdaHack.Client: ReqUITactic :: Tactic -> ReqUI

- Game.LambdaHack.Client: [sbenchmark] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sdbgMsgCli] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sdisableAutoYes] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sdlBitmapSizeAdd] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [sdlFontFile] :: ClientOptions -> Maybe Text

- Game.LambdaHack.Client: [sdlScalableSizeAdd] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [sexposeActors] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sexposeItems] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sexposePlaces] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sfontDir] :: ClientOptions -> Maybe FilePath

- Game.LambdaHack.Client: [sfrontendLazy] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sfrontendNull] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sfrontendTeletype] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [sgtkFontFamily] :: ClientOptions -> Maybe Text

- Game.LambdaHack.Client: [slogPriority] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [smaxFps] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [snewGameCli] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [snoAnim] :: ClientOptions -> Maybe Bool

- Game.LambdaHack.Client: [sprintEachScreen] :: ClientOptions -> Bool

- Game.LambdaHack.Client: [ssavePrefixCli] :: ClientOptions -> String

- Game.LambdaHack.Client: [sscalableFontSize] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [sstopAfterFrames] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [sstopAfterSeconds] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client: [stitle] :: ClientOptions -> Maybe Text

- Game.LambdaHack.Client: data ClientOptions

- Game.LambdaHack.Client: defClientOptions :: ClientOptions

- Game.LambdaHack.Client.AI.ConditionM: condAimEnemyNoMeleeM :: MonadClient m => ActorId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: condInMeleeM :: MonadClient m => LevelId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: condSoloM :: MonadClient m => ActorId -> m Bool

- Game.LambdaHack.Client.AI.PickActorM: setTargetFromTactics :: MonadClient m => ActorId -> m ()

- Game.LambdaHack.Client.AI.Strategy: renameStrategy :: Text -> Strategy a -> Strategy a

- Game.LambdaHack.Client.Bfs: actorsAvoidedDist :: Int

- Game.LambdaHack.Client.ClientOptions: ClientOptions :: Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Bool -> Bool -> Bool -> Maybe Text -> Maybe FilePath -> String -> Bool -> Bool -> Bool -> Bool -> Maybe Int -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> ClientOptions

- Game.LambdaHack.Client.ClientOptions: [sbenchmark] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sdbgMsgCli] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sdisableAutoYes] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sdlBitmapSizeAdd] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [sdlFontFile] :: ClientOptions -> Maybe Text

- Game.LambdaHack.Client.ClientOptions: [sdlScalableSizeAdd] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [sexposeActors] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sexposeItems] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sexposePlaces] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sfontDir] :: ClientOptions -> Maybe FilePath

- Game.LambdaHack.Client.ClientOptions: [sfrontendLazy] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sfrontendNull] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sfrontendTeletype] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [sgtkFontFamily] :: ClientOptions -> Maybe Text

- Game.LambdaHack.Client.ClientOptions: [slogPriority] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [smaxFps] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [snewGameCli] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [snoAnim] :: ClientOptions -> Maybe Bool

- Game.LambdaHack.Client.ClientOptions: [sprintEachScreen] :: ClientOptions -> Bool

- Game.LambdaHack.Client.ClientOptions: [ssavePrefixCli] :: ClientOptions -> String

- Game.LambdaHack.Client.ClientOptions: [sscalableFontSize] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [sstopAfterFrames] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [sstopAfterSeconds] :: ClientOptions -> Maybe Int

- Game.LambdaHack.Client.ClientOptions: [stitle] :: ClientOptions -> Maybe Text

- Game.LambdaHack.Client.ClientOptions: data ClientOptions

- Game.LambdaHack.Client.ClientOptions: defClientOptions :: ClientOptions

- Game.LambdaHack.Client.ClientOptions: instance Data.Binary.Class.Binary Game.LambdaHack.Client.ClientOptions.ClientOptions

- Game.LambdaHack.Client.ClientOptions: instance GHC.Classes.Eq Game.LambdaHack.Client.ClientOptions.ClientOptions

- Game.LambdaHack.Client.ClientOptions: instance GHC.Generics.Generic Game.LambdaHack.Client.ClientOptions.ClientOptions

- Game.LambdaHack.Client.ClientOptions: instance GHC.Show.Show Game.LambdaHack.Client.ClientOptions.ClientOptions

- Game.LambdaHack.Client.HandleAtomicM: restartClient :: MonadClientSetup m => m ()

- Game.LambdaHack.Client.MonadClient: rndToActionForget :: MonadClientRead m => Rnd a -> m a

- Game.LambdaHack.Client.Request: ReqUITactic :: Tactic -> ReqUI

- Game.LambdaHack.Client.State: [snxtScenario] :: StateClient -> Int

- Game.LambdaHack.Client.State: instance GHC.Classes.Ord Game.LambdaHack.Client.State.TGoal

- Game.LambdaHack.Client.State: instance GHC.Classes.Ord Game.LambdaHack.Client.State.Target

- Game.LambdaHack.Client.UI: [shintMode] :: SessionUI -> HintMode

- Game.LambdaHack.Client.UI: [slastPlay] :: SessionUI -> [KM]

- Game.LambdaHack.Client.UI: [slastRecord] :: SessionUI -> LastRecord

- Game.LambdaHack.Client.UI: promptAdd :: MonadClientUI m => Text -> m ()

- Game.LambdaHack.Client.UI.ActorUI: ppCStoreWownW :: Bool -> CStore -> Part -> [Part]

- Game.LambdaHack.Client.UI.ActorUI: ppContainerWownW :: (ActorId -> Part) -> Bool -> Container -> [Part]

- Game.LambdaHack.Client.UI.Content.Input: descTs :: [TriggerTile] -> Text

- Game.LambdaHack.Client.UI.Content.Screen: [rmainMenuArt] :: ScreenContent -> Text

- Game.LambdaHack.Client.UI.Content.Screen: [rmoveKeysScreen] :: ScreenContent -> [String]

- Game.LambdaHack.Client.UI.DisplayAtomicM: aidVerbMU0 :: MonadClientUI m => MsgClass -> ActorId -> Part -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: spotItem :: MonadClientUI m => Bool -> ItemId -> ItemQuant -> Container -> m ()

- Game.LambdaHack.Client.UI.EffectDescription: DetailNone :: DetailLevel

- Game.LambdaHack.Client.UI.Frame: [singleFrame] :: SingleFrame -> Array AttrCharW32

- Game.LambdaHack.Client.UI.Frame: newtype SingleFrame

- Game.LambdaHack.Client.UI.Frame: overlayFrameWithLines :: ScreenContent -> Bool -> Overlay -> PreFrame -> PreFrame

- Game.LambdaHack.Client.UI.FrameM: renderFrames :: MonadClientUI m => LevelId -> Animation -> m PreFrames

- Game.LambdaHack.Client.UI.Frontend.Sdl: [satlas] :: FrontendSession -> IORef FontAtlas

- Game.LambdaHack.Client.UI.Frontend.Sdl: [sfont] :: FrontendSession -> Font

- Game.LambdaHack.Client.UI.HandleHelperM: memberBack :: MonadClientUI m => Bool -> m MError

- Game.LambdaHack.Client.UI.HandleHelperM: placeParts :: (EnumSet LevelId, Int, Int, Int) -> [Part]

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterTile :: MonadClientUI m => [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: artWithVersion :: MonadClientUI m => m [String]

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: challengesMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: guessAlter :: COps -> [TriggerTile] -> ContentId TileKind -> Text

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: nxtGameMode :: COps -> Int -> ModeKind

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: tacticHuman :: MonadClientUI m => m (FailOrCmd ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanLocalM: memberBackHuman :: MonadClientUI m => m MError

- Game.LambdaHack.Client.UI.HandleHumanM: cmdAction :: (MonadClient m, MonadClientUI m) => HumanCmd -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanM: cmdHumanSem :: (MonadClient m, MonadClientUI m) => HumanCmd -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HumanCmd: ChallengesMenu :: HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: CmdNoHelp :: CmdCategory

- Game.LambdaHack.Client.UI.HumanCmd: MemberBack :: HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: Tactic :: HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: TriggerTile :: Part -> Part -> Feature -> TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: [ttfeature] :: TriggerTile -> Feature

- Game.LambdaHack.Client.UI.HumanCmd: [ttobject] :: TriggerTile -> Part

- Game.LambdaHack.Client.UI.HumanCmd: [ttverb] :: TriggerTile -> Part

- Game.LambdaHack.Client.UI.HumanCmd: data TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance Control.DeepSeq.NFData Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance GHC.Read.Read Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.HumanCmd: instance GHC.Show.Show Game.LambdaHack.Client.UI.HumanCmd.TriggerTile

- Game.LambdaHack.Client.UI.ItemDescription: partItemWsR :: FactionId -> FactionDict -> Bool -> Int -> Time -> ItemFull -> ItemQuant -> Part

- Game.LambdaHack.Client.UI.ItemSlot: partyItemSet :: SLore -> FactionId -> Maybe Actor -> State -> EnumSet ItemId

- Game.LambdaHack.Client.UI.Key: dirLaptopKey :: [Key]

- Game.LambdaHack.Client.UI.Key: dirLaptopShiftKey :: [Key]

- Game.LambdaHack.Client.UI.Key: mkKP :: Char -> KM

- Game.LambdaHack.Client.UI.MonadClientUI: leaderTgtToPos :: MonadClientUI m => m (Maybe Point)

- Game.LambdaHack.Client.UI.MonadClientUI: mapStartY :: Y

- Game.LambdaHack.Client.UI.MonadClientUI: partActorLeaderFun :: MonadClientUI m => m (ActorId -> Part)

- Game.LambdaHack.Client.UI.Msg: MsgAction :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgActorSpot :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgAdmin :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgAlert :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgAtFeet :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgBecome :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgDeath :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgDeathBad :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgDeathGood :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgDeathThreat :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgDiplomacy :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgDone :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgEffect :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgFirstEnemySpot :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgFocus :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgHeard :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgHeardClose :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgItemDestruction :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgItemDisco :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgItemMove :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgItemSpot :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgLandscape :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgLeader :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgLonger :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgLongerUs :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMacro :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMelee :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMeleeInterestingUs :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMeleeInterestingWe :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMeleePowerfulUs :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMeleePowerfulWe :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMeleeUs :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgMisc :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgNoLonger :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgNumeric :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgOutcome :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgPlot :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgPrompt :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgRanged :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgRangedPowerfulUs :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgRangedPowerfulWe :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgRangedUs :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgRare :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgRunStop :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgSpam :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgTileDisco :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgVeryRare :: MsgClass

- Game.LambdaHack.Client.UI.Msg: MsgWarning :: MsgClass

- Game.LambdaHack.Client.UI.Msg: attrLineToU :: AttrLine -> UAttrLine

- Game.LambdaHack.Client.UI.Msg: bindsPronouns :: MsgClass -> Bool

- Game.LambdaHack.Client.UI.Msg: data RepMsgN

- Game.LambdaHack.Client.UI.Msg: instance Control.DeepSeq.NFData Game.LambdaHack.Client.UI.Msg.MsgClass

- Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.RepMsgN

- Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Msg.MsgClass

- Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.RepMsgN

- Game.LambdaHack.Client.UI.Msg: instance GHC.Read.Read Game.LambdaHack.Client.UI.Msg.MsgClass

- Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.RepMsgN

- Game.LambdaHack.Client.UI.Msg: isDisplayed :: MsgClass -> Bool

- Game.LambdaHack.Client.UI.Msg: isSavedToHistory :: MsgClass -> Bool

- Game.LambdaHack.Client.UI.Msg: nullReport :: Report -> Bool

- Game.LambdaHack.Client.UI.Msg: snocReport :: Report -> Msg -> Int -> Report

- Game.LambdaHack.Client.UI.Msg: type UAttrLine = Vector Word32

- Game.LambdaHack.Client.UI.Msg: uToAttrLine :: UAttrLine -> AttrLine

- Game.LambdaHack.Client.UI.MsgM: msgAdd0 :: MonadClientUI m => MsgClass -> Text -> m ()

- Game.LambdaHack.Client.UI.MsgM: promptAdd :: MonadClientUI m => Text -> m ()

- Game.LambdaHack.Client.UI.MsgM: promptAdd0 :: MonadClientUI m => Text -> m ()

- Game.LambdaHack.Client.UI.Overlay: ColorBW :: ColorMode

- Game.LambdaHack.Client.UI.Overlay: ColorFull :: ColorMode

- Game.LambdaHack.Client.UI.Overlay: data ColorMode

- Game.LambdaHack.Client.UI.Overlay: glueLines :: Overlay -> Overlay -> Overlay

- Game.LambdaHack.Client.UI.Overlay: indentSplitAttrLine :: X -> AttrLine -> [AttrLine]

- Game.LambdaHack.Client.UI.Overlay: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Overlay.ColorMode

- Game.LambdaHack.Client.UI.Overlay: splitAttrLine :: X -> AttrLine -> Overlay

- Game.LambdaHack.Client.UI.Overlay: type AttrLine = [AttrCharW32]

- Game.LambdaHack.Client.UI.Overlay: type IntOverlay = [(Int, AttrLine)]

- Game.LambdaHack.Client.UI.Overlay: updateLines :: Int -> (AttrLine -> AttrLine) -> Overlay -> Overlay

- Game.LambdaHack.Client.UI.SessionUI: HintAbsent :: HintMode

- Game.LambdaHack.Client.UI.SessionUI: HintShown :: HintMode

- Game.LambdaHack.Client.UI.SessionUI: HintWiped :: HintMode

- Game.LambdaHack.Client.UI.SessionUI: LastRecord :: [KM] -> [KM] -> Int -> LastRecord

- Game.LambdaHack.Client.UI.SessionUI: [currentKeys] :: LastRecord -> [KM]

- Game.LambdaHack.Client.UI.SessionUI: [freeSpace] :: LastRecord -> Int

- Game.LambdaHack.Client.UI.SessionUI: [previousKeys] :: LastRecord -> [KM]

- Game.LambdaHack.Client.UI.SessionUI: [shintMode] :: SessionUI -> HintMode

- Game.LambdaHack.Client.UI.SessionUI: [slastPlay] :: SessionUI -> [KM]

- Game.LambdaHack.Client.UI.SessionUI: [slastRecord] :: SessionUI -> LastRecord

- Game.LambdaHack.Client.UI.SessionUI: data HintMode

- Game.LambdaHack.Client.UI.SessionUI: data LastRecord

- Game.LambdaHack.Client.UI.SessionUI: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.SessionUI.HintMode

- Game.LambdaHack.Client.UI.SessionUI: instance GHC.Enum.Bounded Game.LambdaHack.Client.UI.SessionUI.HintMode

- Game.LambdaHack.Client.UI.SessionUI: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.SessionUI.HintMode

- Game.LambdaHack.Client.UI.SessionUI: newtype AimMode

- Game.LambdaHack.Client.UI.SlideshowM: reportToSlideshowKeep :: MonadClientUI m => [KM] -> m Slideshow

- Game.LambdaHack.Client.UI.UIOptions: [uGtkFontFamily] :: UIOptions -> Text

- Game.LambdaHack.Client.UI.UIOptions: [uLaptop] :: UIOptions -> Bool

- Game.LambdaHack.Client.UI.UIOptions: [uScalableFontSize] :: UIOptions -> Int

- Game.LambdaHack.Client.UI.UIOptions: [uSdlBitmapSizeAdd] :: UIOptions -> Int

- Game.LambdaHack.Client.UI.UIOptions: [uSdlFontFile] :: UIOptions -> Text

- Game.LambdaHack.Client.UI.UIOptions: [uSdlScalableSizeAdd] :: UIOptions -> Int

- Game.LambdaHack.Common.Actor: [binv] :: Actor -> ItemBag

- Game.LambdaHack.Common.Actor: hpEnough :: Actor -> Skills -> Bool

- Game.LambdaHack.Common.ActorState: canDeAmbientList :: Actor -> State -> [Point]

- Game.LambdaHack.Common.ActorState: combinedFromLore :: SLore -> FactionId -> State -> ItemBag

- Game.LambdaHack.Common.ActorState: combinedInv :: FactionId -> State -> ItemBag

- Game.LambdaHack.Common.ActorState: getActorAssocsK :: ActorId -> CStore -> State -> [(ItemId, (Item, ItemQuant))]

- Game.LambdaHack.Common.ActorState: getCarriedIidCStore :: Actor -> [(ItemId, CStore)]

- Game.LambdaHack.Common.ActorState: mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant

- Game.LambdaHack.Common.Faction: [gsha] :: Faction -> ItemBag

- Game.LambdaHack.Common.Faction: instance GHC.Classes.Ord Game.LambdaHack.Common.Faction.Diplomacy

- Game.LambdaHack.Common.HighScore: instance GHC.Show.Show Game.LambdaHack.Common.HighScore.ScoreRecord

- Game.LambdaHack.Common.Item: instance Data.Hashable.Class.Hashable Game.LambdaHack.Common.Item.Item

- Game.LambdaHack.Common.Item: type ItemTimer = [Time]

- Game.LambdaHack.Common.ItemAspect: [aHideAs] :: AspectRecord -> Maybe (GroupName ItemKind)

- Game.LambdaHack.Common.ItemAspect: goesIntoInv :: AspectRecord -> Bool

- Game.LambdaHack.Common.ItemAspect: goesIntoSha :: AspectRecord -> Bool

- Game.LambdaHack.Common.ItemAspect: instance GHC.Generics.Generic Game.LambdaHack.Common.ItemAspect.KindMean

- Game.LambdaHack.Common.PointArray: forceA :: UnboxRepClass c => Array c -> Array c

- Game.LambdaHack.Common.PointArray: fromListA :: UnboxRepClass c => X -> Y -> [c] -> Array c

- Game.LambdaHack.Common.PointArray: generateA :: UnboxRepClass c => X -> Y -> (Point -> c) -> Array c

- Game.LambdaHack.Common.PointArray: generateMA :: (Monad m, UnboxRepClass c) => X -> Y -> (Point -> m c) -> m (Array c)

- Game.LambdaHack.Common.PointArray: ifoldMA' :: (Monad m, UnboxRepClass c) => (a -> Point -> c -> m a) -> a -> Array c -> m a

- Game.LambdaHack.Common.PointArray: ifoldrA :: UnboxRepClass c => (Point -> c -> a -> a) -> a -> Array c -> a

- Game.LambdaHack.Common.PointArray: minIndexA :: UnboxRepClass c => Array c -> Point

- Game.LambdaHack.Common.PointArray: minLastIndexA :: UnboxRepClass c => Array c -> Point

- Game.LambdaHack.Common.PointArray: replicateMA :: (Monad m, UnboxRepClass c) => X -> Y -> m c -> m (Array c)

- Game.LambdaHack.Common.PointArray: safeSetA :: UnboxRepClass c => c -> Array c -> Array c

- Game.LambdaHack.Common.PointArray: sizeA :: Array c -> (X, Y)

- Game.LambdaHack.Common.PointArray: unsafeSetA :: UnboxRepClass c => c -> Array c -> Array c

- Game.LambdaHack.Common.PointArray: unsafeUpdateA :: UnboxRepClass c => Array c -> [(Point, c)] -> ()

- Game.LambdaHack.Common.PointArray: unsafeWriteA :: UnboxRepClass c => Array c -> Point -> c -> ()

- Game.LambdaHack.Common.PointArray: unsafeWriteManyA :: UnboxRepClass c => Array c -> [Point] -> c -> ()

- Game.LambdaHack.Common.ReqFailure: TriggerNothing :: ReqFailure

- Game.LambdaHack.Common.ReqFailure: instance Data.Binary.Class.Binary Game.LambdaHack.Common.ReqFailure.ReqFailure

- Game.LambdaHack.Common.ReqFailure: instance GHC.Generics.Generic Game.LambdaHack.Common.ReqFailure.ReqFailure

- Game.LambdaHack.Common.RingBuffer: uncons :: RingBuffer a -> Maybe (a, RingBuffer a)

- Game.LambdaHack.Common.Tile: hasFeature :: ContentData TileKind -> Feature -> ContentId TileKind -> Bool

- Game.LambdaHack.Common.Time: speedZero :: Speed

- Game.LambdaHack.Common.Types: ppContainer :: Container -> Text

- Game.LambdaHack.Common.Vector: _moveTexts :: [Text]

- Game.LambdaHack.Common.Vector: isDiagonal :: Vector -> Bool

- Game.LambdaHack.Content.CaveKind: [cextraStairs] :: CaveKind -> Dice

- Game.LambdaHack.Content.ItemKind: ActivateInv :: Char -> Effect

- Game.LambdaHack.Content.ItemKind: Composite :: [Effect] -> Effect

- Game.LambdaHack.Content.ItemKind: DropBestWeapon :: Effect

- Game.LambdaHack.Content.ItemKind: HideAs :: GroupName ItemKind -> Aspect

- Game.LambdaHack.Content.ItemKind: getMandatoryHideAsFromKind :: ItemKind -> Maybe (GroupName ItemKind)

- Game.LambdaHack.Content.ItemKind: hardwiredItemGroups :: [GroupName ItemKind]

- Game.LambdaHack.Content.ItemKind: instance Data.Binary.Class.Binary Game.LambdaHack.Content.ItemKind.DetectKind

- Game.LambdaHack.Content.ItemKind: instance Data.Binary.Class.Binary Game.LambdaHack.Content.ItemKind.Effect

- Game.LambdaHack.Content.ItemKind: instance Data.Binary.Class.Binary Game.LambdaHack.Content.ItemKind.TimerDice

- Game.LambdaHack.Content.ItemKind: instance GHC.Generics.Generic Game.LambdaHack.Content.ItemKind.Aspect

- Game.LambdaHack.Content.ItemKind: instance GHC.Generics.Generic Game.LambdaHack.Content.ItemKind.DetectKind

- Game.LambdaHack.Content.ItemKind: instance GHC.Generics.Generic Game.LambdaHack.Content.ItemKind.Effect

- Game.LambdaHack.Content.ItemKind: instance GHC.Generics.Generic Game.LambdaHack.Content.ItemKind.ItemKind

- Game.LambdaHack.Content.ItemKind: instance GHC.Generics.Generic Game.LambdaHack.Content.ItemKind.TimerDice

- Game.LambdaHack.Content.ModeKind: [ftactic] :: Player -> Tactic

- Game.LambdaHack.Content.ModeKind: genericEndMessages :: [(Outcome, Text)]

- Game.LambdaHack.Content.ModeKind: hardwiredModeGroups :: [GroupName ModeKind]

- Game.LambdaHack.Content.ModeKind: horrorGroup :: GroupName ItemKind

- Game.LambdaHack.Content.ModeKind: instance GHC.Classes.Ord Game.LambdaHack.Content.ModeKind.AutoLeader

- Game.LambdaHack.Content.ModeKind: instance GHC.Classes.Ord Game.LambdaHack.Content.ModeKind.HiIndeterminant

- Game.LambdaHack.Content.ModeKind: instance GHC.Classes.Ord Game.LambdaHack.Content.ModeKind.LeaderMode

- Game.LambdaHack.Content.PlaceKind: PEnd :: ContentId PlaceKind -> PlaceEntry

- Game.LambdaHack.Content.RuleKind: [rfontDir] :: RuleContent -> FilePath

- Game.LambdaHack.Content.TileKind: hardwiredTileGroups :: [GroupName TileKind]

- Game.LambdaHack.Content.TileKind: instance Control.DeepSeq.NFData Game.LambdaHack.Content.TileKind.Feature

- Game.LambdaHack.Content.TileKind: instance Data.Binary.Class.Binary Game.LambdaHack.Content.TileKind.Feature

- Game.LambdaHack.Content.TileKind: instance Data.Hashable.Class.Hashable Game.LambdaHack.Content.TileKind.Feature

- Game.LambdaHack.Content.TileKind: instance GHC.Classes.Ord Game.LambdaHack.Content.TileKind.Feature

- Game.LambdaHack.Content.TileKind: instance GHC.Generics.Generic Game.LambdaHack.Content.TileKind.Feature

- Game.LambdaHack.Core.Dice: instance Data.Binary.Class.Binary Game.LambdaHack.Core.Dice.Dice

- Game.LambdaHack.Core.Dice: instance Data.Binary.Class.Binary Game.LambdaHack.Core.Dice.DiceXY

- Game.LambdaHack.Core.Dice: instance Data.Hashable.Class.Hashable Game.LambdaHack.Core.Dice.AbsDepth

- Game.LambdaHack.Core.Dice: instance GHC.Generics.Generic Game.LambdaHack.Core.Dice.Dice

- Game.LambdaHack.Core.Dice: instance GHC.Generics.Generic Game.LambdaHack.Core.Dice.DiceXY

- Game.LambdaHack.Core.Dice: meanDiceXY :: DiceXY -> (Double, Double)

- Game.LambdaHack.Core.Frequency: maxFreq :: Ord a => Frequency a -> Maybe a

- Game.LambdaHack.Core.Frequency: minFreq :: Ord a => Frequency a -> Maybe a

- Game.LambdaHack.Core.Frequency: mostFreq :: Frequency a -> Maybe a

- Game.LambdaHack.Core.Frequency: renameFreq :: Text -> Frequency a -> Frequency a

- Game.LambdaHack.Core.Frequency: setFreq :: Eq a => Frequency a -> a -> Int -> Frequency a

- Game.LambdaHack.Core.Prelude: foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b

- Game.LambdaHack.Core.Prelude: foldl1 :: Foldable t => (a -> a -> a) -> t a -> a

- Game.LambdaHack.Core.Prelude: fromIntegral :: (Integral a, Num b) => a -> b

- Game.LambdaHack.Core.Prelude: instance (Data.Hashable.Class.Hashable k, GHC.Classes.Eq k, Data.Binary.Class.Binary k, Data.Binary.Class.Binary v) => Data.Binary.Class.Binary (Data.HashMap.Base.HashMap k v)

- Game.LambdaHack.Core.Random: random :: Random a => Rnd a

- Game.LambdaHack.Definition.Ability: compactSkills :: EnumMap Skill Int -> EnumMap Skill Int

- Game.LambdaHack.Definition.Ability: data Tactic

- Game.LambdaHack.Definition.Ability: describeTactic :: Tactic -> Text

- Game.LambdaHack.Definition.Ability: instance Data.Binary.Class.Binary Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance Data.Hashable.Class.Hashable Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance GHC.Classes.Eq Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance GHC.Classes.Ord Game.LambdaHack.Definition.Ability.Flag

- Game.LambdaHack.Definition.Ability: instance GHC.Classes.Ord Game.LambdaHack.Definition.Ability.Skill

- Game.LambdaHack.Definition.Ability: instance GHC.Classes.Ord Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance GHC.Enum.Bounded Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance GHC.Enum.Enum Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance GHC.Generics.Generic Game.LambdaHack.Definition.Ability.Flags

- Game.LambdaHack.Definition.Ability: instance GHC.Generics.Generic Game.LambdaHack.Definition.Ability.Skills

- Game.LambdaHack.Definition.Ability: instance GHC.Generics.Generic Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: instance GHC.Show.Show Game.LambdaHack.Definition.Ability.Tactic

- Game.LambdaHack.Definition.Ability: nameTactic :: Tactic -> Text

- Game.LambdaHack.Definition.Ability: tacticSkills :: Tactic -> Skills

- Game.LambdaHack.Definition.Color: attrEnumFromW32 :: AttrCharW32 -> Int

- Game.LambdaHack.Definition.Color: instance Data.Hashable.Class.Hashable Game.LambdaHack.Definition.Color.Color

- Game.LambdaHack.Definition.Color: instance GHC.Classes.Ord Game.LambdaHack.Definition.Color.Attr

- Game.LambdaHack.Definition.Color: instance GHC.Classes.Ord Game.LambdaHack.Definition.Color.AttrChar

- Game.LambdaHack.Definition.Color: instance GHC.Generics.Generic Game.LambdaHack.Definition.Color.Highlight

- Game.LambdaHack.Definition.Color: retAttrW32 :: AttrCharW32

- Game.LambdaHack.Definition.Defs: CInv :: CStore

- Game.LambdaHack.Definition.Defs: CSha :: CStore

- Game.LambdaHack.Definition.Defs: data GroupName a

- Game.LambdaHack.Definition.Defs: fromGroupName :: GroupName a -> Text

- Game.LambdaHack.Definition.Defs: instance Data.String.IsString (Game.LambdaHack.Definition.Defs.GroupName a)

- Game.LambdaHack.Definition.Defs: instance GHC.Generics.Generic (Game.LambdaHack.Definition.Defs.ContentId c)

- Game.LambdaHack.Definition.Defs: instance GHC.Generics.Generic (Game.LambdaHack.Definition.Defs.GroupName a)

- Game.LambdaHack.Definition.Defs: toGroupName :: Text -> GroupName a

- Game.LambdaHack.Definition.Flavour: instance Data.Hashable.Class.Hashable Game.LambdaHack.Definition.Flavour.Flavour

- Game.LambdaHack.Server.CommonM: moveStores :: MonadServerAtomic m => Bool -> ActorId -> CStore -> CStore -> m ()

- Game.LambdaHack.Server.EndM: dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()

- Game.LambdaHack.Server.EndM: endOrLoop :: (MonadServerAtomic m, MonadServerComm m) => m () -> (Maybe (GroupName ModeKind) -> m ()) -> m ()

- Game.LambdaHack.Server.EndM: gameExit :: (MonadServerAtomic m, MonadServerComm m) => m ()

- Game.LambdaHack.Server.EndM: writeSaveAll :: MonadServerAtomic m => Bool -> m ()

- Game.LambdaHack.Server.HandleEffectM: dropAllItems :: MonadServerAtomic m => ActorId -> Actor -> m ()

- Game.LambdaHack.Server.HandleEffectM: effectActivateInv :: MonadServerAtomic m => m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectComposite :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> [Effect] -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectDropBestWeapon :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectTransformContainer :: forall m. MonadServerAtomic m => m () -> ItemId -> Char -> Container -> (ItemId -> ItemQuant -> m ()) -> m UseResult

- Game.LambdaHack.Server.HandleRequestM: reqTactic :: MonadServerAtomic m => FactionId -> Tactic -> m ()

- Game.LambdaHack.Server.ItemM: createLevelItem :: MonadServerAtomic m => Point -> LevelId -> m ()

- Game.LambdaHack.Server.ItemM: embedItem :: MonadServerAtomic m => LevelId -> Point -> ContentId TileKind -> m ()

+ Content.CaveKind: groupNames :: [GroupName CaveKind]

+ Content.CaveKind: groupNamesSingleton :: [GroupName CaveKind]

+ Content.CaveKind: pattern CAVE_AMBUSH :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_ARENA :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_BATTLE :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_BRAWL :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_EMPTY :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_ESCAPE :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_HUNT :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_LABORATORY :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_MINE :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_NOISE :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_OUTERMOST :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_RAID :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_ROGUE :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_SAFARI_1 :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_SAFARI_2 :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_SAFARI_3 :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_SHALLOW_ROGUE :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_SHOOTOUT :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_SMOKING :: GroupName CaveKind

+ Content.CaveKind: pattern CAVE_ZOO :: GroupName CaveKind

+ Content.ItemKind: groupNames :: [GroupName ItemKind]

+ Content.ItemKind: groupNamesSingleton :: [GroupName ItemKind]

+ Content.ItemKind: pattern ARMOR_LOOSE :: GroupName ItemKind

+ Content.ItemKind: pattern CHIC_GEAR :: GroupName ItemKind

+ Content.ItemKind: pattern CLOTHING_MISC :: GroupName ItemKind

+ Content.ItemKind: pattern EDIBLE_PLANT :: GroupName ItemKind

+ Content.ItemKind: pattern HARPOON :: GroupName ItemKind

+ Content.ItemKind: pattern RING_OF_OPPORTUNITY_GRENADIER :: GroupName ItemKind

+ Content.ItemKindActor: actorsGN :: [GroupName ItemKind]

+ Content.ItemKindActor: actorsGNSingleton :: [GroupName ItemKind]

+ Content.ItemKindActor: pattern ADD_NOCTO_1 :: GroupName ItemKind

+ Content.ItemKindActor: pattern ADD_SIGHT :: GroupName ItemKind

+ Content.ItemKindActor: pattern AMBUSHER_HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern ANIMAL :: GroupName ItemKind

+ Content.ItemKindActor: pattern ANY_ARROW :: GroupName ItemKind

+ Content.ItemKindActor: pattern ARMOR_RANGED :: GroupName ItemKind

+ Content.ItemKindActor: pattern BRAWLER_HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern CIVILIAN :: GroupName ItemKind

+ Content.ItemKindActor: pattern ESCAPIST_HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern FIREPROOF_CLOTH :: GroupName ItemKind

+ Content.ItemKindActor: pattern GEM :: GroupName ItemKind

+ Content.ItemKindActor: pattern HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern IMMOBILE_ANIMAL :: GroupName ItemKind

+ Content.ItemKindActor: pattern LIGHT_ATTENUATOR :: GroupName ItemKind

+ Content.ItemKindActor: pattern MOBILE_ANIMAL :: GroupName ItemKind

+ Content.ItemKindActor: pattern MOBILE_MONSTER :: GroupName ItemKind

+ Content.ItemKindActor: pattern MONSTER :: GroupName ItemKind

+ Content.ItemKindActor: pattern RANGER_HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern RING_OF_OPPORTUNITY_SNIPER :: GroupName ItemKind

+ Content.ItemKindActor: pattern SCOUT_HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern SCOUT_MONSTER :: GroupName ItemKind

+ Content.ItemKindActor: pattern SOLDIER_HERO :: GroupName ItemKind

+ Content.ItemKindActor: pattern STARTING_ARMOR :: GroupName ItemKind

+ Content.ItemKindActor: pattern STARTING_WEAPON :: GroupName ItemKind

+ Content.ItemKindActor: pattern S_WOODEN_TORCH :: GroupName ItemKind

+ Content.ItemKindActor: pattern WEAK_ARROW :: GroupName ItemKind

+ Content.ItemKindBlast: blastBonusStatOf :: GroupName ItemKind -> GroupName ItemKind

+ Content.ItemKindBlast: blastNoStatOf :: GroupName ItemKind -> GroupName ItemKind

+ Content.ItemKindBlast: blastsGN :: [GroupName ItemKind]

+ Content.ItemKindBlast: blastsGNSingleton :: [GroupName ItemKind]

+ Content.ItemKindBlast: pattern ARMOR_MISC :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_ANTIDOTE_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_ANTI_SLOW_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_BOILING_WATER :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_BURNING_OIL_2 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_BURNING_OIL_3 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_BURNING_OIL_4 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_CALMING_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_CONCUSSION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_DEFENSELESSNESS_RUNOUT :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_DENSE_SHOWER :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_DISTORTION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_DISTRESSING_ODOR :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_EYE_DROP :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_EYE_SHINE :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FIRECRACKER :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_BURNING_OIL_2 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_BURNING_OIL_3 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_BURNING_OIL_4 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_CONCUSSION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_FLASH :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_FRAGMENTATION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FOCUSED_GLASS_HAIL :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_FRAGMENTATION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_GLASS_HAIL :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_GLUE :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_HASTE_SPRAY :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_HEALING_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_HEALING_MIST_2 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_IRON_FILING :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_MELEE_PROTECTIVE_BALM :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_PHEROMONE :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_PING_PLASH :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_POISON_CLOUD :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_RANGE_PROTECTIVE_BALM :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_RESOLUTION_DUST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_SLEEP_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_SLOWNESS_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_SMELLY_DROPLET :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_SMOKE :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_SPARSE_SHOWER :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_VIOLENT_BURNING_OIL_2 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_VIOLENT_BURNING_OIL_3 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_VIOLENT_BURNING_OIL_4 :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_VIOLENT_CONCUSSION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_VIOLENT_FLASH :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_VIOLENT_FRAGMENTATION :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_WASTE :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_WHISKEY_SPRAY :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_WOUNDING_MIST :: GroupName ItemKind

+ Content.ItemKindBlast: pattern S_YOUTH_SPRINKLE :: GroupName ItemKind

+ Content.ItemKindEmbed: embedsGN :: [GroupName ItemKind]

+ Content.ItemKindEmbed: embedsGNSingleton :: [GroupName ItemKind]

+ Content.ItemKindEmbed: pattern BIG_FIRE :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern DOORWAY_TRAP :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern DOORWAY_TRAP_UNKNOWN :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern ESCAPE :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern FROST :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern FROZEN_GROUND :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern LECTERN :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern OBSCENE_PICTOGRAM :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern RUBBLE :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern SCRATCH_ON_WALL :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern SHALLOW_WATER :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern SIGNAGE :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern SMALL_FIRE :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern STAIRS_DOWN :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern STAIRS_TRAP_DOWN :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern STAIRS_TRAP_UP :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern STAIRS_UP :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern STRAIGHT_PATH :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern SUBTLE_FRESCO :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern S_SANDSTONE_ROCK :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern TREASURE_CACHE :: GroupName ItemKind

+ Content.ItemKindEmbed: pattern TREASURE_CACHE_TRAP :: GroupName ItemKind

+ Content.ItemKindOrgan: organsGN :: [GroupName ItemKind]

+ Content.ItemKindOrgan: organsGNSingleton :: [GroupName ItemKind]

+ Content.ItemKindOrgan: pattern SCAVENGER :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_ANIMAL_BRAIN :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_ANTLER :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_ARMORED_SKIN :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_ARSENIC_FISSURE :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_ARSENIC_VENT :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_BARK :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_BEE_STING :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_BOILING_FISSURE :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_BOILING_VENT :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_EAR_3 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_EAR_6 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_EAR_8 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_EYE_3 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_EYE_6 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_EYE_8 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_FIST :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_FOOT :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_HOOKED_CLAW :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_HORN :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_HUGE_TAIL :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_INSECT_MORTALITY :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_JAW :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_LARGE_JAW :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_LARGE_TAIL :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_LASH :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_LEFT_TORSION :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_LIP :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_NOSTRIL :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_PUPIL :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_RATLLE :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_RHINO_HORN :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_RIGHT_TORSION :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SAPIENT_BRAIN :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SCENT_GLAND :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SCREECHING_BEAK :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SMALL_CLAW :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SMALL_JAW :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SNOUT :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SPEED_GLAND_10 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SPEED_GLAND_5 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_STING :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SULFUR_FISSURE :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_SULFUR_VENT :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_TENTACLE :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_THORN :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_TIP :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_TOOTH :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_VENOM_FANG :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_VENOM_TOOTH :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_VISION_12 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_VISION_16 :: GroupName ItemKind

+ Content.ItemKindOrgan: pattern S_VISION_6 :: GroupName ItemKind

+ Content.ItemKindTemporary: bonusStatGN :: [GroupName ItemKind]

+ Content.ItemKindTemporary: noStatGN :: [GroupName ItemKind]

+ Content.ItemKindTemporary: pattern S_BLIND :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_DEAF :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_DEAFENED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_DEFENSELESS :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_DISPOSSESSED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_DRUNK :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_FAR_SIGHTED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_FOUL_SMELLING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_FRENZIED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_HASTED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_IMMOBILE :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_IMPATIENT :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_IRREPLACEABLE :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_KEEN_SMELLING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MELEE_DEFLECTING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_COMBATIVE :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_DISPLACING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_MOBILE :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_MODIFYING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_PATIENT :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_PRACTICAL :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_PROJECTING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_MORE_TIDY :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_PACIFIED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_PARSIMONIOUS :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_POISONED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_POISON_RESISTANT :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_PROTECTED_FROM_MELEE :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_PROTECTED_FROM_RANGED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_RANGED_DEFLECTING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_REGENERATING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_RESOLUTE :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_RETAINING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_ROSE_SMELLING :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_SHINY_EYED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_SLOWED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_SLOW_RESISTANT :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_STRENGTHENED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_WEAKENED :: GroupName ItemKind

+ Content.ItemKindTemporary: pattern S_WITHHOLDING :: GroupName ItemKind

+ Content.ItemKindTemporary: temporariesGNSingleton :: [GroupName ItemKind]

+ Content.ModeKind: groupNames :: [GroupName ModeKind]

+ Content.ModeKind: groupNamesSingleton :: [GroupName ModeKind]

+ Content.ModeKind: pattern AMBUSH :: GroupName ModeKind

+ Content.ModeKind: pattern BATTLE :: GroupName ModeKind

+ Content.ModeKind: pattern BATTLE_DEFENSE :: GroupName ModeKind

+ Content.ModeKind: pattern BATTLE_SURVIVAL :: GroupName ModeKind

+ Content.ModeKind: pattern BRAWL :: GroupName ModeKind

+ Content.ModeKind: pattern BURNING :: GroupName ModeKind

+ Content.ModeKind: pattern CRAWL :: GroupName ModeKind

+ Content.ModeKind: pattern CRAWL_EMPTY :: GroupName ModeKind

+ Content.ModeKind: pattern CRAWL_SURVIVAL :: GroupName ModeKind

+ Content.ModeKind: pattern DEFENSE :: GroupName ModeKind

+ Content.ModeKind: pattern DEFENSE_EMPTY :: GroupName ModeKind

+ Content.ModeKind: pattern DIG :: GroupName ModeKind

+ Content.ModeKind: pattern ESCAPE :: GroupName ModeKind

+ Content.ModeKind: pattern FOGGY :: GroupName ModeKind

+ Content.ModeKind: pattern HUNT :: GroupName ModeKind

+ Content.ModeKind: pattern LONG :: GroupName ModeKind

+ Content.ModeKind: pattern NIGHT :: GroupName ModeKind

+ Content.ModeKind: pattern PERILOUS :: GroupName ModeKind

+ Content.ModeKind: pattern RAID :: GroupName ModeKind

+ Content.ModeKind: pattern RANGED :: GroupName ModeKind

+ Content.ModeKind: pattern SAFARI :: GroupName ModeKind

+ Content.ModeKind: pattern SAFARI_SURVIVAL :: GroupName ModeKind

+ Content.ModeKind: pattern SEE :: GroupName ModeKind

+ Content.ModeKind: pattern SHOOTOUT :: GroupName ModeKind

+ Content.ModeKind: pattern SHORT :: GroupName ModeKind

+ Content.ModeKind: pattern ZOO :: GroupName ModeKind

+ Content.PlaceKind: groupNames :: [GroupName PlaceKind]

+ Content.PlaceKind: groupNamesSingleton :: [GroupName PlaceKind]

+ Content.PlaceKind: pattern AMBUSH :: GroupName PlaceKind

+ Content.PlaceKind: pattern ARENA :: GroupName PlaceKind

+ Content.PlaceKind: pattern BATTLE :: GroupName PlaceKind

+ Content.PlaceKind: pattern BRAWL :: GroupName PlaceKind

+ Content.PlaceKind: pattern CLOSED_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern EMPTY :: GroupName PlaceKind

+ Content.PlaceKind: pattern ESCAPE :: GroupName PlaceKind

+ Content.PlaceKind: pattern GATED_CLOSED_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern GATED_OPEN_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern GATED_TINY_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern INDOOR_ESCAPE_DOWN :: GroupName PlaceKind

+ Content.PlaceKind: pattern INDOOR_ESCAPE_UP :: GroupName PlaceKind

+ Content.PlaceKind: pattern LABORATORY :: GroupName PlaceKind

+ Content.PlaceKind: pattern MINE :: GroupName PlaceKind

+ Content.PlaceKind: pattern NOISE :: GroupName PlaceKind

+ Content.PlaceKind: pattern OPEN_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern OUTDOOR_CLOSED_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern OUTDOOR_ESCAPE_DOWN :: GroupName PlaceKind

+ Content.PlaceKind: pattern OUTDOOR_TINY_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern OUTDOOR_WALLED_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern ROGUE :: GroupName PlaceKind

+ Content.PlaceKind: pattern SHOOTOUT :: GroupName PlaceKind

+ Content.PlaceKind: pattern TINY_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern WALLED_STAIRCASE :: GroupName PlaceKind

+ Content.PlaceKind: pattern ZOO :: GroupName PlaceKind

+ Content.TileKind: groupNames :: [GroupName TileKind]

+ Content.TileKind: groupNamesSingleton :: [GroupName TileKind]

+ Content.TileKind: pattern AMBUSH_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern AMBUSH_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern ARENA_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern ARENA_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern BATTLE_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern BATTLE_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern BRAWL_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern BUSH_CLUMP_DARK :: GroupName TileKind

+ Content.TileKind: pattern BUSH_CLUMP_LIT :: GroupName TileKind

+ Content.TileKind: pattern CACHE :: GroupName TileKind

+ Content.TileKind: pattern DAMP_FLOOR_DARK :: GroupName TileKind

+ Content.TileKind: pattern DAMP_FLOOR_LIT :: GroupName TileKind

+ Content.TileKind: pattern DIRT_DARK :: GroupName TileKind

+ Content.TileKind: pattern DIRT_LIT :: GroupName TileKind

+ Content.TileKind: pattern EMPTY_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern EMPTY_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern ESCAPE_DOWN :: GroupName TileKind

+ Content.TileKind: pattern ESCAPE_OUTDOOR_DOWN :: GroupName TileKind

+ Content.TileKind: pattern ESCAPE_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern ESCAPE_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern ESCAPE_UP :: GroupName TileKind

+ Content.TileKind: pattern FILLER_WALL :: GroupName TileKind

+ Content.TileKind: pattern FLOOR_ARENA_DARK :: GroupName TileKind

+ Content.TileKind: pattern FLOOR_ARENA_LIT :: GroupName TileKind

+ Content.TileKind: pattern FLOOR_CORRIDOR_DARK :: GroupName TileKind

+ Content.TileKind: pattern FLOOR_CORRIDOR_LIT :: GroupName TileKind

+ Content.TileKind: pattern FOG_CLUMP_DARK :: GroupName TileKind

+ Content.TileKind: pattern FOG_CLUMP_LIT :: GroupName TileKind

+ Content.TileKind: pattern GATED_STAIRCASE_DOWN :: GroupName TileKind

+ Content.TileKind: pattern GATED_STAIRCASE_UP :: GroupName TileKind

+ Content.TileKind: pattern GLASSHOUSE_HORIZONTAL_DARK :: GroupName TileKind

+ Content.TileKind: pattern GLASSHOUSE_HORIZONTAL_LIT :: GroupName TileKind

+ Content.TileKind: pattern GLASSHOUSE_VERTICAL_DARK :: GroupName TileKind

+ Content.TileKind: pattern GLASSHOUSE_VERTICAL_LIT :: GroupName TileKind

+ Content.TileKind: pattern LAB_TRAIL_LIT :: GroupName TileKind

+ Content.TileKind: pattern NOISE_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern ORDINARY_STAIRCASE_DOWN :: GroupName TileKind

+ Content.TileKind: pattern ORDINARY_STAIRCASE_UP :: GroupName TileKind

+ Content.TileKind: pattern OUTDOOR_OUTER_FENCE :: GroupName TileKind

+ Content.TileKind: pattern POWER_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern POWER_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern RECT_WINDOWS_HORIZONTAL_DARK :: GroupName TileKind

+ Content.TileKind: pattern RECT_WINDOWS_HORIZONTAL_LIT :: GroupName TileKind

+ Content.TileKind: pattern RECT_WINDOWS_VERTICAL_DARK :: GroupName TileKind

+ Content.TileKind: pattern RECT_WINDOWS_VERTICAL_LIT :: GroupName TileKind

+ Content.TileKind: pattern SAFE_TRAIL_LIT :: GroupName TileKind

+ Content.TileKind: pattern SHOOTOUT_SET_LIT :: GroupName TileKind

+ Content.TileKind: pattern SIGNBOARD :: GroupName TileKind

+ Content.TileKind: pattern SMOKE_CLUMP_DARK :: GroupName TileKind

+ Content.TileKind: pattern SMOKE_CLUMP_LIT :: GroupName TileKind

+ Content.TileKind: pattern STAIRCASE_DOWN :: GroupName TileKind

+ Content.TileKind: pattern STAIRCASE_OUTDOOR_DOWN :: GroupName TileKind

+ Content.TileKind: pattern STAIRCASE_OUTDOOR_UP :: GroupName TileKind

+ Content.TileKind: pattern STAIRCASE_UP :: GroupName TileKind

+ Content.TileKind: pattern STAIR_TERMINAL_DARK :: GroupName TileKind

+ Content.TileKind: pattern STAIR_TERMINAL_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_BUSH_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_FLOOR_ACTOR_DARK :: GroupName TileKind

+ Content.TileKind: pattern S_FLOOR_ACTOR_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_FLOOR_ASHES_DARK :: GroupName TileKind

+ Content.TileKind: pattern S_FLOOR_ASHES_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_FOG_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_LAMP_POST :: GroupName TileKind

+ Content.TileKind: pattern S_PULPIT :: GroupName TileKind

+ Content.TileKind: pattern S_SHADED_GROUND :: GroupName TileKind

+ Content.TileKind: pattern S_SMOKE_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_TREE_DARK :: GroupName TileKind

+ Content.TileKind: pattern S_TREE_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_WALL_HORIZONTAL_LIT :: GroupName TileKind

+ Content.TileKind: pattern S_WALL_LIT :: GroupName TileKind

+ Content.TileKind: pattern TRAIL_LIT :: GroupName TileKind

+ Content.TileKind: pattern TREE_SHADE_WALKABLE_DARK :: GroupName TileKind

+ Content.TileKind: pattern TREE_SHADE_WALKABLE_LIT :: GroupName TileKind

+ Content.TileKind: pattern ZOO_SET_DARK :: GroupName TileKind

+ Content.TileKind: pattern ZOO_SET_LIT :: GroupName TileKind

+ Game.LambdaHack.Atomic: HearCollideTile :: HearMsg

+ Game.LambdaHack.Atomic: PosSightLevels :: [(LevelId, Point)] -> PosAtomic

+ Game.LambdaHack.Atomic: SfxExpectedEmbed :: ItemId -> LevelId -> ReqFailure -> SfxMsg

+ Game.LambdaHack.Atomic: SfxItemApplied :: ItemId -> Container -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxItemYield :: ItemId -> Int -> LevelId -> SfxMsg

+ Game.LambdaHack.Atomic: SfxNoItemsForTile :: [[(Int, GroupName ItemKind)]] -> SfxMsg

+ Game.LambdaHack.Atomic: SfxReadyGoods :: SfxMsg

+ Game.LambdaHack.Atomic: UpdDoctrineFaction :: FactionId -> Doctrine -> Doctrine -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdLoseStashFaction :: Bool -> FactionId -> LevelId -> Point -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdRegisterItems :: [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdSpotStashFaction :: Bool -> FactionId -> LevelId -> Point -> UpdAtomic

+ Game.LambdaHack.Atomic: iidSfxAtomic :: SfxAtomic -> [ItemId]

+ Game.LambdaHack.Atomic: iidUpdAtomic :: UpdAtomic -> [ItemId]

+ Game.LambdaHack.Atomic: lidOfPos :: PosAtomic -> Maybe LevelId

+ Game.LambdaHack.Atomic.CmdAtomic: HearCollideTile :: HearMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxExpectedEmbed :: ItemId -> LevelId -> ReqFailure -> SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxItemApplied :: ItemId -> Container -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxItemYield :: ItemId -> Int -> LevelId -> SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxNoItemsForTile :: [[(Int, GroupName ItemKind)]] -> SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxReadyGoods :: SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: UpdDoctrineFaction :: FactionId -> Doctrine -> Doctrine -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdLoseStashFaction :: Bool -> FactionId -> LevelId -> Point -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdRegisterItems :: [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdSpotStashFaction :: Bool -> FactionId -> LevelId -> Point -> UpdAtomic

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updDoctrineFaction :: MonadStateWrite m => FactionId -> Doctrine -> Doctrine -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updLoseStashFaction :: MonadStateWrite m => FactionId -> LevelId -> Point -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updRegisterItems :: MonadStateWrite m => [(ItemId, Item)] -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updSpotStashFaction :: MonadStateWrite m => FactionId -> LevelId -> Point -> m ()

+ Game.LambdaHack.Atomic.MonadStateWrite: deleteItemStash :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()

+ Game.LambdaHack.Atomic.MonadStateWrite: insertItemStash :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()

+ Game.LambdaHack.Atomic.PosAtomicRead: PosSightLevels :: [(LevelId, Point)] -> PosAtomic

+ Game.LambdaHack.Atomic.PosAtomicRead: iidSfxAtomic :: SfxAtomic -> [ItemId]

+ Game.LambdaHack.Atomic.PosAtomicRead: iidUpdAtomic :: UpdAtomic -> [ItemId]

+ Game.LambdaHack.Atomic.PosAtomicRead: lidOfPos :: PosAtomic -> Maybe LevelId

+ Game.LambdaHack.Atomic.PosAtomicRead: pointsProjBody :: Actor -> [Point] -> PosAtomic

+ Game.LambdaHack.Atomic.PosAtomicRead: singleContainerActor :: MonadStateRead m => Container -> m PosAtomic

+ Game.LambdaHack.Atomic.PosAtomicRead: singleContainerStash :: MonadStateRead m => Container -> m PosAtomic

+ Game.LambdaHack.Client: ReqUIDoctrine :: Doctrine -> ReqUI

+ Game.LambdaHack.Client.AI.ConditionM: condAimEnemyOrRememberedM :: MonadClient m => ActorId -> m Bool

+ Game.LambdaHack.Client.AI.ConditionM: condAimEnemyOrStashM :: MonadClient m => ActorId -> m Bool

+ Game.LambdaHack.Client.AI.ConditionM: condAimEnemyTargetedM :: MonadClient m => ActorId -> m Bool

+ Game.LambdaHack.Client.AI.ConditionM: condAloneM :: MonadClient m => [(ActorId, Actor)] -> ActorId -> m Bool

+ Game.LambdaHack.Client.AI.PickActorM: setTargetFromDoctrines :: MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> m ()

+ Game.LambdaHack.Client.Bfs: distanceBfs :: BfsDistance -> Maybe Int

+ Game.LambdaHack.Client.Bfs: maskBfs :: BfsDistance -> BfsDistance

+ Game.LambdaHack.Client.BfsM: closestHideout :: MonadClient m => ActorId -> m (Maybe (Point, Int))

+ Game.LambdaHack.Client.BfsM: closestStashes :: MonadClient m => ActorId -> m [(Int, (FactionId, Point))]

+ Game.LambdaHack.Client.BfsM: oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)]

+ Game.LambdaHack.Client.HandleAtomicM: invalidateInMeleeDueToItem :: MonadClient m => ActorId -> CStore -> m ()

+ Game.LambdaHack.Client.MonadClient: condInMeleeM :: MonadClient m => LevelId -> m Bool

+ Game.LambdaHack.Client.MonadClient: dumpTextFile :: MonadClientRead m => Text -> FilePath -> m FilePath

+ Game.LambdaHack.Client.Preferences: capStat :: Double -> Double

+ Game.LambdaHack.Client.Request: ReqUIDoctrine :: Doctrine -> ReqUI

+ Game.LambdaHack.Client.State: THideout :: TGoal

+ Game.LambdaHack.Client.State: TStash :: FactionId -> TGoal

+ Game.LambdaHack.Client.State: [scampings] :: StateClient -> EnumSet (ContentId ModeKind)

+ Game.LambdaHack.Client.State: [srestarts] :: StateClient -> EnumSet (ContentId ModeKind)

+ Game.LambdaHack.Client.UI: [schosenLore] :: SessionUI -> ChosenLore

+ Game.LambdaHack.Client.UI: [scurTutorial] :: SessionUI -> Bool

+ Game.LambdaHack.Client.UI: [smacroFrame] :: SessionUI -> KeyMacroFrame

+ Game.LambdaHack.Client.UI: [smacroStack] :: SessionUI -> [KeyMacroFrame]

+ Game.LambdaHack.Client.UI: [snxtScenario] :: SessionUI -> Int

+ Game.LambdaHack.Client.UI: [snxtTutorial] :: SessionUI -> Bool

+ Game.LambdaHack.Client.UI: [soverrideTut] :: SessionUI -> Maybe Bool

+ Game.LambdaHack.Client.UI: [srandomUI] :: SessionUI -> SMGen

+ Game.LambdaHack.Client.UI: [sturnDisplayed] :: SessionUI -> Bool

+ Game.LambdaHack.Client.UI: [susedHints] :: SessionUI -> Set Msg

+ Game.LambdaHack.Client.UI: [sxhairGoTo] :: SessionUI -> Maybe Target

+ Game.LambdaHack.Client.UI: clientPrintUI :: MonadClientUI m => Text -> m ()

+ Game.LambdaHack.Client.UI.Animation: twirlSplashShort :: (Point, Point) -> Color -> Color -> Animation

+ Game.LambdaHack.Client.UI.Animation: vanish :: Point -> Animation

+ Game.LambdaHack.Client.UI.Content.Input: macroRun25 :: [String]

+ Game.LambdaHack.Client.UI.Content.Input: memberCycle :: Direction -> [CmdCategory] -> CmdTriple

+ Game.LambdaHack.Client.UI.Content.Input: memberCycleLevel :: Direction -> [CmdCategory] -> CmdTriple

+ Game.LambdaHack.Client.UI.Content.Input: mouseMMBMute :: CmdTriple

+ Game.LambdaHack.Client.UI.Content.Input: repeatLastTriple :: Int -> [CmdCategory] -> CmdTriple

+ Game.LambdaHack.Client.UI.Content.Screen: [rFontFiles] :: ScreenContent -> [(FilePath, ByteString)]

+ Game.LambdaHack.Client.UI.Content.Screen: [rwebAddress] :: ScreenContent -> String

+ Game.LambdaHack.Client.UI.Content.Screen: [rwrap] :: ScreenContent -> X

+ Game.LambdaHack.Client.UI.DisplayAtomicM: itemAidDistinctMU :: (MonadClient m, MonadClientUI m) => MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: itemVerbMUGeneral :: MonadClientUI m => Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text

+ Game.LambdaHack.Client.UI.DisplayAtomicM: itemVerbMUShort :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ItemId -> ItemQuant -> Part -> Container -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: manyItemsAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ActorId -> Part -> [(ItemId, ItemQuant)] -> (Int -> Either (Maybe Int) Int) -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: mitemAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: ppHearDistanceAdjective :: Maybe Int -> Text

+ Game.LambdaHack.Client.UI.DisplayAtomicM: ppHearDistanceAdverb :: Maybe Int -> Text

+ Game.LambdaHack.Client.UI.DisplayAtomicM: ppHearMsg :: MonadClientUI m => Maybe Int -> HearMsg -> m Text

+ Game.LambdaHack.Client.UI.DisplayAtomicM: spotItemBag :: forall m. (MonadClient m, MonadClientUI m) => Bool -> Container -> ItemBag -> m ()

+ Game.LambdaHack.Client.UI.EffectDescription: activationFlagToObject :: ActivationFlag -> Text

+ Game.LambdaHack.Client.UI.EffectDescription: conditionToObject :: Condition -> Text

+ Game.LambdaHack.Client.UI.EffectDescription: defaultDetailLevel :: DetailLevel

+ Game.LambdaHack.Client.UI.EffectDescription: describeCrafting :: [(Int, GroupName ItemKind)] -> [(Int, GroupName ItemKind)] -> Effect -> (Text, Text, Text)

+ Game.LambdaHack.Client.UI.EffectDescription: describeToolsAlternative :: [[(Int, GroupName ItemKind)]] -> Text

+ Game.LambdaHack.Client.UI.EffectDescription: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.EffectDescription.DetailLevel

+ Game.LambdaHack.Client.UI.EffectDescription: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.EffectDescription.DetailLevel

+ Game.LambdaHack.Client.UI.EffectDescription: instance GHC.Show.Show Game.LambdaHack.Client.UI.EffectDescription.DetailLevel

+ Game.LambdaHack.Client.UI.Frame: ColorBW :: ColorMode

+ Game.LambdaHack.Client.UI.Frame: ColorFull :: ColorMode

+ Game.LambdaHack.Client.UI.Frame: [singleArray] :: SingleFrame -> Array AttrCharW32

+ Game.LambdaHack.Client.UI.Frame: [singleMonoOverlay] :: SingleFrame -> OverlaySpace

+ Game.LambdaHack.Client.UI.Frame: [singlePropOverlay] :: SingleFrame -> OverlaySpace

+ Game.LambdaHack.Client.UI.Frame: data ColorMode

+ Game.LambdaHack.Client.UI.Frame: data SingleFrame

+ Game.LambdaHack.Client.UI.Frame: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Frame.ColorMode

+ Game.LambdaHack.Client.UI.Frame: truncateOverlay :: Bool -> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace

+ Game.LambdaHack.Client.UI.Frame: type OverlaySpace = [(PointUI, AttrString)]

+ Game.LambdaHack.Client.UI.Frame: type PreFrame3 = (PreFrame, (OverlaySpace, OverlaySpace))

+ Game.LambdaHack.Client.UI.Frame: type PreFrames3 = [Maybe PreFrame3]

+ Game.LambdaHack.Client.UI.FrameM: addToMacro :: Map KM CmdTriple -> KM -> KeyMacroFrame -> KeyMacroFrame

+ Game.LambdaHack.Client.UI.FrameM: dropEmptyMacroFrames :: KeyMacroFrame -> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])

+ Game.LambdaHack.Client.UI.FrameM: lastMacroFrame :: KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame

+ Game.LambdaHack.Client.UI.FrameM: oneLineBasicFrame :: MonadClientUI m => LevelId -> DisplayFont -> m PreFrame3

+ Game.LambdaHack.Client.UI.FrameM: renderAnimFrames :: MonadClientUI m => Bool -> LevelId -> Animation -> m PreFrames3

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [mapFontIsBitmap] :: FrontendSession -> Bool

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [sbasicTexture] :: FrontendSession -> IORef Texture

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [sboldFont] :: FrontendSession -> Maybe Font

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [smonoAtlas] :: FrontendSession -> IORef FontAtlas

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [smonoFont] :: FrontendSession -> Maybe Font

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [spropFont] :: FrontendSession -> Maybe Font

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [squareAtlas] :: FrontendSession -> IORef FontAtlas

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [squareFontSize] :: FrontendSession -> Int

+ Game.LambdaHack.Client.UI.Frontend.Sdl: [squareFont] :: FrontendSession -> Font

+ Game.LambdaHack.Client.UI.HandleHelperM: describeMode :: MonadClientUI m => Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)

+ Game.LambdaHack.Client.UI.HandleHelperM: displayItemLorePointedAt :: (MonadClient m, MonadClientUI m) => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int -> SingleItemSlots -> Bool -> m KM

+ Game.LambdaHack.Client.UI.HandleHelperM: guardItemSize :: Actor -> State -> Int

+ Game.LambdaHack.Client.UI.HandleHelperM: guardItemVerbs :: Actor -> State -> [Part]

+ Game.LambdaHack.Client.UI.HandleHelperM: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.HandleHelperM.FailError

+ Game.LambdaHack.Client.UI.HandleHelperM: lookAtStash :: MonadClientUI m => LevelId -> Point -> m Text

+ Game.LambdaHack.Client.UI.HandleHelperM: memberCycleLevel :: (MonadClient m, MonadClientUI m) => Bool -> Direction -> m MError

+ Game.LambdaHack.Client.UI.HandleHelperM: modesOverlay :: MonadClientUI m => m OKX

+ Game.LambdaHack.Client.UI.HandleHelperM: nxtGameMode :: COps -> Int -> (ContentId ModeKind, ModeKind)

+ Game.LambdaHack.Client.UI.HandleHelperM: ppContainerWownW :: MonadClientUI m => (ActorId -> m Part) -> Bool -> Container -> m [Part]

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterCommon :: (MonadClient m, MonadClientUI m) => Bool -> Point -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: challengeMenuHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: closeDirHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: closeTileAtPos :: (MonadClient m, MonadClientUI m) => Point -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: doctrineHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameGoodsToggle :: MonadClient m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameKeeperToggle :: MonadClient m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameTutorialToggle :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: goToXhairExplorationMode :: (MonadClient m, MonadClientUI m) => Bool -> Bool -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: goToXhairGoTo :: (MonadClient m, MonadClientUI m) => Bool -> Bool -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: msgAddDone :: (MonadClient m, MonadClientUI m) => Point -> Text -> m ()

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: pickPoint :: (MonadClient m, MonadClientUI m) => Text -> m (Maybe Point)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: processTileActions :: forall m. (MonadClient m, MonadClientUI m) => Bool -> ActorId -> Point -> [TileAction] -> m (FailOrCmd ())

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: verifyToolEffect :: (MonadClient m, MonadClientUI m) => LevelId -> CStore -> ItemFull -> m (FailOrCmd ())

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemDialogModeLore :: (MonadClient m, MonadClientUI m) => m (Maybe ResultItemDialogMode)

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: detailCycleHuman :: (MonadClient m, MonadClientUI m) => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: macroHumanTransition :: [KM] -> KeyMacroFrame -> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: markAnimHuman :: MonadClient m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: memberCycleLevelHuman :: (MonadClient m, MonadClientUI m) => Direction -> m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: overrideTutHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: repeatHumanTransition :: Int -> KeyMacroFrame -> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: repeatLastHuman :: MonadClientUI m => Int -> m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: xhairPointerMuteHuman :: (MonadClient m, MonadClientUI m) => m ()

+ Game.LambdaHack.Client.UI.HandleHumanM: cmdSemInCxtOfKM :: (MonadClient m, MonadClientUI m) => KM -> HumanCmd -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanM: cmdSemantics :: (MonadClient m, MonadClientUI m) => HumanCmd -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanM: restrictedCmdSemInCxtOfKM :: (MonadClient m, MonadClientUI m) => KM -> HumanCmd -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanM: updateKeyLast :: KM -> HumanCmd -> KeyMacroFrame -> KeyMacroFrame

+ Game.LambdaHack.Client.UI.HumanCmd: ChallengeMenu :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: CloseDir :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: DetailCycle :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: Doctrine :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: GameGoodsToggle :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: GameKeeperToggle :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: GameTutorialToggle :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: MarkAnim :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: MemberCycleLevel :: Direction -> HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: OverrideTut :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: RepeatLast :: Int -> HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: XhairPointerMute :: HumanCmd

+ Game.LambdaHack.Client.UI.InventoryM: DefItemKey :: Either Text KM -> Bool -> (Either KM SlotChar -> m (Either Text ResultItemDialogMode)) -> DefItemKey m

+ Game.LambdaHack.Client.UI.InventoryM: IAll :: ItemDialogState

+ Game.LambdaHack.Client.UI.InventoryM: ISuitable :: ItemDialogState

+ Game.LambdaHack.Client.UI.InventoryM: RLore :: SLore -> ItemId -> ItemBag -> SingleItemSlots -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: RModes :: Int -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: ROrgans :: ItemId -> ItemBag -> SingleItemSlots -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: ROwned :: ItemId -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: RPlaces :: Int -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: RSkills :: Int -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: RStore :: CStore -> [ItemId] -> ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: [defAction] :: DefItemKey m -> Either KM SlotChar -> m (Either Text ResultItemDialogMode)

+ Game.LambdaHack.Client.UI.InventoryM: [defCond] :: DefItemKey m -> Bool

+ Game.LambdaHack.Client.UI.InventoryM: [defLabel] :: DefItemKey m -> Either Text KM

+ Game.LambdaHack.Client.UI.InventoryM: accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag

+ Game.LambdaHack.Client.UI.InventoryM: data DefItemKey m

+ Game.LambdaHack.Client.UI.InventoryM: data ItemDialogState

+ Game.LambdaHack.Client.UI.InventoryM: data ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: getItem :: (MonadClient m, MonadClientUI m) => m Suitability -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> ItemDialogMode -> [ItemDialogMode] -> Bool -> Bool -> m (Either Text ResultItemDialogMode)

+ Game.LambdaHack.Client.UI.InventoryM: instance GHC.Show.Show Game.LambdaHack.Client.UI.InventoryM.ResultItemDialogMode

+ Game.LambdaHack.Client.UI.InventoryM: keyOfEKM :: Int -> Either [KM] SlotChar -> Maybe KM

+ Game.LambdaHack.Client.UI.InventoryM: runDefItemKey :: (MonadClient m, MonadClientUI m) => [(KM, DefItemKey m)] -> DefItemKey m -> OKX -> [KM] -> Text -> ItemDialogMode -> m (Either Text ResultItemDialogMode)

+ Game.LambdaHack.Client.UI.InventoryM: slotsOfItemDialogMode :: MonadClientUI m => ItemDialogMode -> m SingleItemSlots

+ Game.LambdaHack.Client.UI.InventoryM: storeItemPrompt :: FactionId -> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text

+ Game.LambdaHack.Client.UI.InventoryM: transition :: forall m. (MonadClient m, MonadClientUI m) => m Suitability -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> Bool -> Int -> ItemDialogMode -> [ItemDialogMode] -> ItemDialogState -> m (Either Text ResultItemDialogMode)

+ Game.LambdaHack.Client.UI.ItemDescription: partItemWsDetail :: DetailLevel -> Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemWsLong :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemWsShort :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemWsShortest :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.Key: AltShift :: Modifier

+ Game.LambdaHack.Client.UI.Key: dirLeftHandKey :: [Key]

+ Game.LambdaHack.Client.UI.Key: dirLeftHandShiftKey :: [Key]

+ Game.LambdaHack.Client.UI.MonadClientUI: computeChosenLore :: MonadClientUI m => m ([(ActorId, Actor)], [(ItemId, ItemQuant)])

+ Game.LambdaHack.Client.UI.MonadClientUI: debugPossiblyPrintUI :: MonadClientUI m => Text -> m ()

+ Game.LambdaHack.Client.UI.MonadClientUI: getFontSetup :: MonadClientUI m => m FontSetup

+ Game.LambdaHack.Client.UI.MonadClientUI: miniHintAimingBare :: Text

+ Game.LambdaHack.Client.UI.MonadClientUI: miniHintAimingLore :: Text

+ Game.LambdaHack.Client.UI.MonadClientUI: rndToActionUI :: MonadClientUI m => Rnd a -> m a

+ Game.LambdaHack.Client.UI.MonadClientUI: setXHairFromGUI :: MonadClientUI m => Maybe Target -> m ()

+ Game.LambdaHack.Client.UI.MonadClientUI: tryOpenBrowser :: MonadClientUI m => String -> m Bool

+ Game.LambdaHack.Client.UI.Msg: MsgActionAlert :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgActionComplete :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgActionMajor :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgActionWarning :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgAtFeetMinor :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgBackdropFocus :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgBackdropInfo :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgBadMiscEvent :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgBookKeeping :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgDeathBoring :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgDeathDeafeat :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgDeathVictory :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgEffectMedium :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgFactionIntel :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgFinalOutcome :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgGoodMiscEvent :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgHeardFaraway :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgHeardNearby :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgHeardOutside :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgInnerWorkSpam :: MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: MsgItemDiscovery :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgItemMovement :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgItemRuination :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMacroOperation :: MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: MsgMeleeComplexUs :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMeleeComplexWe :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMeleeMightyUs :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMeleeMightyWe :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMeleeNormalUs :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMeleeOthers :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgMiscellanous :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgNeutralEvent :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgNumericReport :: MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: MsgPlotExposition :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgPointmanSwap :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgPromptAction :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgPromptActors :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgPromptGeneric :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgPromptItems :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgPromptMention :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgPromptModify :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgRangedMightyUs :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgRangedMightyWe :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgRangedNormalUs :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgRangedOthers :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgRiskOfDeath :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgRunStopReason :: MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: MsgSpecialEvent :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgSpottedActor :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgSpottedItem :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgSpottedThreat :: MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: MsgStatusBadUs :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusBenign :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusGoodUs :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusLongThem :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusLongerUs :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusOthers :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusSleep :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgStatusStopThem :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgStatusStopUs :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgStatusWakeup :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgStatusWarning :: MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: MsgTerrainReveal :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: MsgTutorialHint :: MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: addEolToNewReport :: History -> History

+ Game.LambdaHack.Client.UI.Msg: attrStringToU :: AttrString -> UAttrString

+ Game.LambdaHack.Client.UI.Msg: class MsgShared a

+ Game.LambdaHack.Client.UI.Msg: data MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: data MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: data MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: data MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: data MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: data MsgPrototype

+ Game.LambdaHack.Client.UI.Msg: data RepMsgNK

+ Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.Msg.RepMsgNK

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.Msg

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.MsgClass

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Classes.Ord Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Bounded Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Bounded Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Bounded Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Bounded Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Bounded Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.Msg.RepMsgNK

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.MsgClassDistinct

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: instance GHC.Show.Show Game.LambdaHack.Client.UI.Msg.RepMsgNK

+ Game.LambdaHack.Client.UI.Msg: instance Game.LambdaHack.Client.UI.Msg.MsgShared Game.LambdaHack.Client.UI.Msg.MsgClassIgnore

+ Game.LambdaHack.Client.UI.Msg: instance Game.LambdaHack.Client.UI.Msg.MsgShared Game.LambdaHack.Client.UI.Msg.MsgClassSave

+ Game.LambdaHack.Client.UI.Msg: instance Game.LambdaHack.Client.UI.Msg.MsgShared Game.LambdaHack.Client.UI.Msg.MsgClassShow

+ Game.LambdaHack.Client.UI.Msg: instance Game.LambdaHack.Client.UI.Msg.MsgShared Game.LambdaHack.Client.UI.Msg.MsgClassShowAndSave

+ Game.LambdaHack.Client.UI.Msg: nullRepMsgNK :: RepMsgNK -> Bool

+ Game.LambdaHack.Client.UI.Msg: nullVisibleReport :: Report -> Bool

+ Game.LambdaHack.Client.UI.Msg: scrapRepetitionSingle :: (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)] -> (Bool, [(AttrString, Int)], [(AttrString, Int)])

+ Game.LambdaHack.Client.UI.Msg: scrapsRepeats :: MsgClass -> Bool

+ Game.LambdaHack.Client.UI.Msg: toMsgDistinct :: [(String, Color)] -> MsgClassDistinct -> Text -> Text -> Msg

+ Game.LambdaHack.Client.UI.Msg: toMsgShared :: MsgShared a => [(String, Color)] -> a -> Text -> Msg

+ Game.LambdaHack.Client.UI.Msg: tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass)

+ Game.LambdaHack.Client.UI.Msg: tutorialHint :: MsgClass -> Bool

+ Game.LambdaHack.Client.UI.Msg: type UAttrString = Vector Word32

+ Game.LambdaHack.Client.UI.Msg: uToAttrString :: UAttrString -> AttrString

+ Game.LambdaHack.Client.UI.MsgM: msgAddDistinct :: (MonadClient m, MonadClientUI m) => MsgClassDistinct -> (Text, Text) -> m ()

+ Game.LambdaHack.Client.UI.MsgM: msgLnAdd :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> Text -> m ()

+ Game.LambdaHack.Client.UI.Overlay: (<\:>) :: AttrString -> AttrString -> AttrString

+ Game.LambdaHack.Client.UI.Overlay: attrLine :: AttrLine -> AttrString

+ Game.LambdaHack.Client.UI.Overlay: attrStringToAL :: AttrString -> AttrLine

+ Game.LambdaHack.Client.UI.Overlay: blankAttrString :: Int -> AttrString

+ Game.LambdaHack.Client.UI.Overlay: data AttrLine

+ Game.LambdaHack.Client.UI.Overlay: firstParagraph :: AttrString -> AttrLine

+ Game.LambdaHack.Client.UI.Overlay: indentSplitAttrString :: Int -> AttrString -> [AttrLine]

+ Game.LambdaHack.Client.UI.Overlay: indentSplitAttrString2 :: Bool -> Int -> AttrString -> [AttrLine]

+ Game.LambdaHack.Client.UI.Overlay: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Overlay.AttrLine

+ Game.LambdaHack.Client.UI.Overlay: instance GHC.Show.Show Game.LambdaHack.Client.UI.Overlay.AttrLine

+ Game.LambdaHack.Client.UI.Overlay: offsetOverlay :: [AttrLine] -> Overlay

+ Game.LambdaHack.Client.UI.Overlay: offsetOverlayX :: [(Int, AttrLine)] -> Overlay

+ Game.LambdaHack.Client.UI.Overlay: splitAttrString :: Int -> Int -> AttrString -> [AttrLine]

+ Game.LambdaHack.Client.UI.Overlay: stringToAS :: String -> AttrString

+ Game.LambdaHack.Client.UI.Overlay: textFgToAS :: Color -> Text -> AttrString

+ Game.LambdaHack.Client.UI.Overlay: textToAS :: Text -> AttrString

+ Game.LambdaHack.Client.UI.Overlay: type AttrString = [AttrCharW32]

+ Game.LambdaHack.Client.UI.Overlay: updateLine :: Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay

+ Game.LambdaHack.Client.UI.PointUI: PointSquare :: Int -> Int -> PointSquare

+ Game.LambdaHack.Client.UI.PointUI: PointUI :: Int -> Int -> PointUI

+ Game.LambdaHack.Client.UI.PointUI: data PointSquare

+ Game.LambdaHack.Client.UI.PointUI: data PointUI

+ Game.LambdaHack.Client.UI.PointUI: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.PointUI.PointSquare

+ Game.LambdaHack.Client.UI.PointUI: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.PointUI.PointUI

+ Game.LambdaHack.Client.UI.PointUI: instance GHC.Show.Show Game.LambdaHack.Client.UI.PointUI.PointSquare

+ Game.LambdaHack.Client.UI.PointUI: instance GHC.Show.Show Game.LambdaHack.Client.UI.PointUI.PointUI

+ Game.LambdaHack.Client.UI.PointUI: mapStartY :: Int

+ Game.LambdaHack.Client.UI.PointUI: mapToSquare :: Point -> PointSquare

+ Game.LambdaHack.Client.UI.PointUI: squareToMap :: PointSquare -> Point

+ Game.LambdaHack.Client.UI.PointUI: squareToUI :: PointSquare -> PointUI

+ Game.LambdaHack.Client.UI.PointUI: uiToSquare :: PointUI -> PointSquare

+ Game.LambdaHack.Client.UI.SessionUI: ChosenLore :: [(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore

+ Game.LambdaHack.Client.UI.SessionUI: ChosenNothing :: ChosenLore

+ Game.LambdaHack.Client.UI.SessionUI: KeyMacro :: [KM] -> KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: KeyMacroFrame :: Either [KM] KeyMacro -> KeyMacro -> Maybe KM -> KeyMacroFrame

+ Game.LambdaHack.Client.UI.SessionUI: [detailLevel] :: AimMode -> DetailLevel

+ Game.LambdaHack.Client.UI.SessionUI: [keyLast] :: KeyMacroFrame -> Maybe KM

+ Game.LambdaHack.Client.UI.SessionUI: [keyMacroBuffer] :: KeyMacroFrame -> Either [KM] KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: [keyPending] :: KeyMacroFrame -> KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: [schosenLore] :: SessionUI -> ChosenLore

+ Game.LambdaHack.Client.UI.SessionUI: [scurTutorial] :: SessionUI -> Bool

+ Game.LambdaHack.Client.UI.SessionUI: [smacroFrame] :: SessionUI -> KeyMacroFrame

+ Game.LambdaHack.Client.UI.SessionUI: [smacroStack] :: SessionUI -> [KeyMacroFrame]

+ Game.LambdaHack.Client.UI.SessionUI: [snxtScenario] :: SessionUI -> Int

+ Game.LambdaHack.Client.UI.SessionUI: [snxtTutorial] :: SessionUI -> Bool

+ Game.LambdaHack.Client.UI.SessionUI: [soverrideTut] :: SessionUI -> Maybe Bool

+ Game.LambdaHack.Client.UI.SessionUI: [srandomUI] :: SessionUI -> SMGen

+ Game.LambdaHack.Client.UI.SessionUI: [sturnDisplayed] :: SessionUI -> Bool

+ Game.LambdaHack.Client.UI.SessionUI: [susedHints] :: SessionUI -> Set Msg

+ Game.LambdaHack.Client.UI.SessionUI: [sxhairGoTo] :: SessionUI -> Maybe Target

+ Game.LambdaHack.Client.UI.SessionUI: [unKeyMacro] :: KeyMacro -> [KM]

+ Game.LambdaHack.Client.UI.SessionUI: cycleOverrideTut :: SessionUI -> SessionUI

+ Game.LambdaHack.Client.UI.SessionUI: data AimMode

+ Game.LambdaHack.Client.UI.SessionUI: data ChosenLore

+ Game.LambdaHack.Client.UI.SessionUI: data KeyMacroFrame

+ Game.LambdaHack.Client.UI.SessionUI: emptyMacroFrame :: KeyMacroFrame

+ Game.LambdaHack.Client.UI.SessionUI: instance Data.Binary.Class.Binary Game.LambdaHack.Client.UI.SessionUI.KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: instance GHC.Base.Monoid Game.LambdaHack.Client.UI.SessionUI.KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: instance GHC.Base.Semigroup Game.LambdaHack.Client.UI.SessionUI.KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.SessionUI.KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: instance GHC.Generics.Generic Game.LambdaHack.Client.UI.SessionUI.AimMode

+ Game.LambdaHack.Client.UI.SessionUI: instance GHC.Show.Show Game.LambdaHack.Client.UI.SessionUI.KeyMacro

+ Game.LambdaHack.Client.UI.SessionUI: instance GHC.Show.Show Game.LambdaHack.Client.UI.SessionUI.KeyMacroFrame

+ Game.LambdaHack.Client.UI.SessionUI: newtype KeyMacro

+ Game.LambdaHack.Client.UI.Slideshow: ButtonWidth :: DisplayFont -> Int -> ButtonWidth

+ Game.LambdaHack.Client.UI.Slideshow: FontSetup :: DisplayFont -> DisplayFont -> DisplayFont -> FontSetup

+ Game.LambdaHack.Client.UI.Slideshow: [buttonFont] :: ButtonWidth -> DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: [buttonWidth] :: ButtonWidth -> Int

+ Game.LambdaHack.Client.UI.Slideshow: [monoFont] :: FontSetup -> DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: [propFont] :: FontSetup -> DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: [squareFont] :: FontSetup -> DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap

+ Game.LambdaHack.Client.UI.Slideshow: data ButtonWidth

+ Game.LambdaHack.Client.UI.Slideshow: data DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: data FontSetup

+ Game.LambdaHack.Client.UI.Slideshow: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Slideshow.ButtonWidth

+ Game.LambdaHack.Client.UI.Slideshow: instance GHC.Classes.Eq Game.LambdaHack.Client.UI.Slideshow.DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: instance GHC.Enum.Enum Game.LambdaHack.Client.UI.Slideshow.DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: instance GHC.Show.Show Game.LambdaHack.Client.UI.Slideshow.ButtonWidth

+ Game.LambdaHack.Client.UI.Slideshow: instance GHC.Show.Show Game.LambdaHack.Client.UI.Slideshow.DisplayFont

+ Game.LambdaHack.Client.UI.Slideshow: isMonoFont :: DisplayFont -> Bool

+ Game.LambdaHack.Client.UI.Slideshow: isSquareFont :: DisplayFont -> Bool

+ Game.LambdaHack.Client.UI.Slideshow: maxYofOverlay :: Overlay -> Int

+ Game.LambdaHack.Client.UI.Slideshow: monoFontSetup :: FontSetup

+ Game.LambdaHack.Client.UI.Slideshow: multiFontSetup :: FontSetup

+ Game.LambdaHack.Client.UI.Slideshow: singleFontSetup :: FontSetup

+ Game.LambdaHack.Client.UI.Slideshow: textSize :: DisplayFont -> [a] -> Int

+ Game.LambdaHack.Client.UI.Slideshow: type FontOverlayMap = EnumMap DisplayFont Overlay

+ Game.LambdaHack.Client.UI.SlideshowM: reportToSlideshowKeepHalt :: MonadClientUI m => Bool -> [KM] -> m Slideshow

+ Game.LambdaHack.Client.UI.UIOptions: [uAllFontsScale] :: UIOptions -> Double

+ Game.LambdaHack.Client.UI.UIOptions: [uChosenFontset] :: UIOptions -> Text

+ Game.LambdaHack.Client.UI.UIOptions: [uFonts] :: UIOptions -> [(Text, FontDefinition)]

+ Game.LambdaHack.Client.UI.UIOptions: [uFontsets] :: UIOptions -> [(Text, FontSet)]

+ Game.LambdaHack.Client.UI.UIOptions: [uFullscreenMode] :: UIOptions -> FullscreenMode

+ Game.LambdaHack.Client.UI.UIOptions: [uHistory1PerLine] :: UIOptions -> Bool

+ Game.LambdaHack.Client.UI.UIOptions: [uLeftHand] :: UIOptions -> Bool

+ Game.LambdaHack.Client.UI.UIOptions: [uScreen1PerLine] :: UIOptions -> Bool

+ Game.LambdaHack.Common.Actor: [bnumber] :: Actor -> Maybe Int

+ Game.LambdaHack.Common.Actor: [bweapBenign] :: Actor -> Int

+ Game.LambdaHack.Common.Actor: actorCanMeleeToHarm :: ActorMaxSkills -> ActorId -> Actor -> Bool

+ Game.LambdaHack.Common.Actor: actorWorthChasing :: ActorMaxSkills -> ActorId -> Actor -> Bool

+ Game.LambdaHack.Common.Actor: actorWorthKilling :: ActorMaxSkills -> ActorId -> Actor -> Bool

+ Game.LambdaHack.Common.Actor: calmFull :: Actor -> Skills -> Bool

+ Game.LambdaHack.Common.Actor: deltasSeriousThisTurn :: ResDelta -> Bool

+ Game.LambdaHack.Common.Actor: getCarriedIidCStore :: Actor -> [(ItemId, CStore)]

+ Game.LambdaHack.Common.Actor: getCarriedIidsAndTrunk :: Actor -> [ItemId]

+ Game.LambdaHack.Common.ActorState: anyHarmfulFoeAdj :: ActorMaxSkills -> ActorId -> State -> Bool

+ Game.LambdaHack.Common.ActorState: getFactionStashBag :: FactionId -> State -> ItemBag

+ Game.LambdaHack.Common.ActorState: tileAlterable :: LevelId -> Point -> State -> Bool

+ Game.LambdaHack.Common.ClientOptions: BigBorderlessWindow :: FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: ClientOptions :: Maybe Text -> Maybe Double -> [(Text, FontDefinition)] -> [(Text, FontSet)] -> Maybe FullscreenMode -> Maybe Int -> Maybe Double -> Bool -> Maybe Bool -> Bool -> Bool -> Maybe String -> String -> Bool -> Bool -> Bool -> Bool -> Maybe Int -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> ClientOptions

+ Game.LambdaHack.Common.ClientOptions: ModeChange :: FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: NotFullscreen :: FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: [sallFontsScale] :: ClientOptions -> Maybe Double

+ Game.LambdaHack.Common.ClientOptions: [sbenchmark] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [schosenFontset] :: ClientOptions -> Maybe Text

+ Game.LambdaHack.Common.ClientOptions: [sdbgMsgCli] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sdisableAutoYes] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sexposeActors] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sexposeItems] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sexposePlaces] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sfonts] :: ClientOptions -> [(Text, FontDefinition)]

+ Game.LambdaHack.Common.ClientOptions: [sfontsets] :: ClientOptions -> [(Text, FontSet)]

+ Game.LambdaHack.Common.ClientOptions: [sfrontendLazy] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sfrontendNull] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sfrontendTeletype] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [sfullscreenMode] :: ClientOptions -> Maybe FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: [slogPriority] :: ClientOptions -> Maybe Int

+ Game.LambdaHack.Common.ClientOptions: [smaxFps] :: ClientOptions -> Maybe Double

+ Game.LambdaHack.Common.ClientOptions: [snewGameCli] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [snoAnim] :: ClientOptions -> Maybe Bool

+ Game.LambdaHack.Common.ClientOptions: [sprintEachScreen] :: ClientOptions -> Bool

+ Game.LambdaHack.Common.ClientOptions: [ssavePrefixCli] :: ClientOptions -> String

+ Game.LambdaHack.Common.ClientOptions: [sstopAfterFrames] :: ClientOptions -> Maybe Int

+ Game.LambdaHack.Common.ClientOptions: [sstopAfterSeconds] :: ClientOptions -> Maybe Int

+ Game.LambdaHack.Common.ClientOptions: [stitle] :: ClientOptions -> Maybe String

+ Game.LambdaHack.Common.ClientOptions: data ClientOptions

+ Game.LambdaHack.Common.ClientOptions: data FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: defClientOptions :: ClientOptions

+ Game.LambdaHack.Common.ClientOptions: instance Control.DeepSeq.NFData Game.LambdaHack.Common.ClientOptions.FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: instance Data.Binary.Class.Binary Game.LambdaHack.Common.ClientOptions.ClientOptions

+ Game.LambdaHack.Common.ClientOptions: instance Data.Binary.Class.Binary Game.LambdaHack.Common.ClientOptions.FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Classes.Eq Game.LambdaHack.Common.ClientOptions.ClientOptions

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Classes.Eq Game.LambdaHack.Common.ClientOptions.FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Generics.Generic Game.LambdaHack.Common.ClientOptions.ClientOptions

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Generics.Generic Game.LambdaHack.Common.ClientOptions.FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Read.Read Game.LambdaHack.Common.ClientOptions.FullscreenMode

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Show.Show Game.LambdaHack.Common.ClientOptions.ClientOptions

+ Game.LambdaHack.Common.ClientOptions: instance GHC.Show.Show Game.LambdaHack.Common.ClientOptions.FullscreenMode

+ Game.LambdaHack.Common.Faction: [cgoods] :: Challenge -> Bool

+ Game.LambdaHack.Common.Faction: [ckeeper] :: Challenge -> Bool

+ Game.LambdaHack.Common.Faction: [gstash] :: Faction -> Maybe (LevelId, Point)

+ Game.LambdaHack.Common.Faction: [gteamCont] :: Faction -> Maybe TeamContinuity

+ Game.LambdaHack.Common.Faction: ppContainer :: FactionDict -> Container -> Text

+ Game.LambdaHack.Common.Faction: tshowChallenge :: Challenge -> Text

+ Game.LambdaHack.Common.HighScore: getDate :: ScoreRecord -> POSIXTime

+ Game.LambdaHack.Common.HighScore: getStatus :: ScoreRecord -> Status

+ Game.LambdaHack.Common.Item: charging :: Time -> ItemTimer -> Bool

+ Game.LambdaHack.Common.Item: countIidConsumed :: ItemFullKit -> [(Bool, Int, GroupName ItemKind)] -> (Int, Int, [(Bool, Int, GroupName ItemKind)])

+ Game.LambdaHack.Common.Item: createItemTimer :: Time -> Delta Time -> ItemTimer

+ Game.LambdaHack.Common.Item: data ItemTimer

+ Game.LambdaHack.Common.Item: deltaOfItemTimer :: Time -> ItemTimer -> Delta Time

+ Game.LambdaHack.Common.Item: instance Data.Binary.Class.Binary Game.LambdaHack.Common.Item.ItemTimer

+ Game.LambdaHack.Common.Item: instance GHC.Classes.Eq Game.LambdaHack.Common.Item.ItemTimer

+ Game.LambdaHack.Common.Item: instance GHC.Show.Show Game.LambdaHack.Common.Item.ItemTimer

+ Game.LambdaHack.Common.Item: itemTimerZero :: ItemTimer

+ Game.LambdaHack.Common.Item: listToolsToConsume :: [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [((CStore, Bool), (ItemId, ItemFullKit))]

+ Game.LambdaHack.Common.Item: mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant

+ Game.LambdaHack.Common.Item: quantSingle :: ItemQuant

+ Game.LambdaHack.Common.Item: shiftItemTimer :: Delta Time -> ItemTimer -> ItemTimer

+ Game.LambdaHack.Common.Item: subtractIidfromGrps :: (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)]) -> ((CStore, Bool), (ItemId, ItemFullKit)) -> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])

+ Game.LambdaHack.Common.Item: toItemKindIx :: Word16 -> ItemKindIx

+ Game.LambdaHack.Common.Item: type ItemTimers = [ItemTimer]

+ Game.LambdaHack.Common.ItemAspect: [aPresentAs] :: AspectRecord -> Maybe (GroupName ItemKind)

+ Game.LambdaHack.Common.Kind: [isClosableTab] :: TileSpeedup -> Tab Bool

+ Game.LambdaHack.Common.Kind: [isHideoutTab] :: TileSpeedup -> Tab Bool

+ Game.LambdaHack.Common.Kind: [isModifiableWithTab] :: TileSpeedup -> Tab Bool

+ Game.LambdaHack.Common.Kind: [isOpenableTab] :: TileSpeedup -> Tab Bool

+ Game.LambdaHack.Common.Misc: FontMapBitmap :: Text -> Int -> FontDefinition

+ Game.LambdaHack.Common.Misc: FontMapScalable :: Text -> Int -> HintingMode -> Int -> FontDefinition

+ Game.LambdaHack.Common.Misc: FontMonospace :: Text -> Int -> HintingMode -> FontDefinition

+ Game.LambdaHack.Common.Misc: FontProportional :: Text -> Int -> HintingMode -> FontDefinition

+ Game.LambdaHack.Common.Misc: FontSet :: Text -> Text -> Text -> Text -> Text -> FontSet

+ Game.LambdaHack.Common.Misc: HintingHeavy :: HintingMode

+ Game.LambdaHack.Common.Misc: HintingLight :: HintingMode

+ Game.LambdaHack.Common.Misc: [fontMapBitmap] :: FontSet -> Text

+ Game.LambdaHack.Common.Misc: [fontMapScalable] :: FontSet -> Text

+ Game.LambdaHack.Common.Misc: [fontMono] :: FontSet -> Text

+ Game.LambdaHack.Common.Misc: [fontPropBold] :: FontSet -> Text

+ Game.LambdaHack.Common.Misc: [fontPropRegular] :: FontSet -> Text

+ Game.LambdaHack.Common.Misc: data FontDefinition

+ Game.LambdaHack.Common.Misc: data FontSet

+ Game.LambdaHack.Common.Misc: data HintingMode

+ Game.LambdaHack.Common.Misc: instance Control.DeepSeq.NFData Game.LambdaHack.Common.Misc.FontDefinition

+ Game.LambdaHack.Common.Misc: instance Control.DeepSeq.NFData Game.LambdaHack.Common.Misc.FontSet

+ Game.LambdaHack.Common.Misc: instance Control.DeepSeq.NFData Game.LambdaHack.Common.Misc.HintingMode

+ Game.LambdaHack.Common.Misc: instance Data.Binary.Class.Binary Game.LambdaHack.Common.Misc.FontDefinition

+ Game.LambdaHack.Common.Misc: instance Data.Binary.Class.Binary Game.LambdaHack.Common.Misc.FontSet

+ Game.LambdaHack.Common.Misc: instance Data.Binary.Class.Binary Game.LambdaHack.Common.Misc.HintingMode

+ Game.LambdaHack.Common.Misc: instance GHC.Classes.Eq Game.LambdaHack.Common.Misc.FontDefinition

+ Game.LambdaHack.Common.Misc: instance GHC.Classes.Eq Game.LambdaHack.Common.Misc.FontSet

+ Game.LambdaHack.Common.Misc: instance GHC.Classes.Eq Game.LambdaHack.Common.Misc.HintingMode

+ Game.LambdaHack.Common.Misc: instance GHC.Generics.Generic Game.LambdaHack.Common.Misc.FontDefinition

+ Game.LambdaHack.Common.Misc: instance GHC.Generics.Generic Game.LambdaHack.Common.Misc.FontSet

+ Game.LambdaHack.Common.Misc: instance GHC.Generics.Generic Game.LambdaHack.Common.Misc.HintingMode

+ Game.LambdaHack.Common.Misc: instance GHC.Read.Read Game.LambdaHack.Common.Misc.FontDefinition

+ Game.LambdaHack.Common.Misc: instance GHC.Read.Read Game.LambdaHack.Common.Misc.FontSet

+ Game.LambdaHack.Common.Misc: instance GHC.Read.Read Game.LambdaHack.Common.Misc.HintingMode

+ Game.LambdaHack.Common.Misc: instance GHC.Show.Show Game.LambdaHack.Common.Misc.FontDefinition

+ Game.LambdaHack.Common.Misc: instance GHC.Show.Show Game.LambdaHack.Common.Misc.FontSet

+ Game.LambdaHack.Common.Misc: instance GHC.Show.Show Game.LambdaHack.Common.Misc.HintingMode

+ Game.LambdaHack.Common.ReqFailure: CloseClosed :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: CloseDistant :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: CloseNonClosable :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: CloseNothing :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: ItemOverStash :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: MeleeNotWeapon :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: MoveUnskilledAsleep :: ReqFailure

+ Game.LambdaHack.Common.ReqFailure: ProjectFinderKeeper :: ReqFailure

+ Game.LambdaHack.Common.Save: bkpAllSaves :: RuleContent -> ClientOptions -> IO Bool

+ Game.LambdaHack.Common.Tile: EmbedAction :: (ItemId, ItemQuant) -> TileAction

+ Game.LambdaHack.Common.Tile: ToAction :: GroupName TileKind -> TileAction

+ Game.LambdaHack.Common.Tile: WithAction :: [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction

+ Game.LambdaHack.Common.Tile: data TileAction

+ Game.LambdaHack.Common.Tile: instance GHC.Show.Show Game.LambdaHack.Common.Tile.TileAction

+ Game.LambdaHack.Common.Tile: isHideout :: TileSpeedup -> ContentId TileKind -> Bool

+ Game.LambdaHack.Common.Tile: parseTileAction :: Bool -> Bool -> [(ItemKind, (ItemId, ItemQuant))] -> Feature -> Maybe TileAction

+ Game.LambdaHack.Common.Time: timeRecent5 :: Time -> Time -> Bool

+ Game.LambdaHack.Content.CaveKind: [cmaxStairsNum] :: CaveKind -> Dice

+ Game.LambdaHack.Content.CaveKind: [cskip] :: CaveKind -> [Int]

+ Game.LambdaHack.Content.CaveKind: mandatoryGroups :: [GroupName CaveKind]

+ Game.LambdaHack.Content.CaveKind: pattern DEFAULT_RANDOM :: GroupName CaveKind

+ Game.LambdaHack.Content.ItemKind: AndEffect :: Effect -> Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: AtMostOneOf :: [Effect] -> Effect

+ Game.LambdaHack.Content.ItemKind: CalmGeq :: Int -> Condition

+ Game.LambdaHack.Content.ItemKind: CalmLeq :: Int -> Condition

+ Game.LambdaHack.Content.ItemKind: ConsumeItems :: [(Int, GroupName ItemKind)] -> [(Int, GroupName ItemKind)] -> Effect

+ Game.LambdaHack.Content.ItemKind: DestroyItem :: Int -> Int -> CStore -> GroupName ItemKind -> Effect

+ Game.LambdaHack.Content.ItemKind: DetectStash :: DetectKind

+ Game.LambdaHack.Content.ItemKind: Discharge :: Int -> Dice -> Effect

+ Game.LambdaHack.Content.ItemKind: HpGeq :: Int -> Condition

+ Game.LambdaHack.Content.ItemKind: HpLeq :: Int -> Condition

+ Game.LambdaHack.Content.ItemKind: IfThenElse :: Condition -> Effect -> Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: NopEffect :: Effect

+ Game.LambdaHack.Content.ItemKind: OnCombine :: Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: OnUser :: Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: OrEffect :: Effect -> Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: PresentAs :: GroupName ItemKind -> Aspect

+ Game.LambdaHack.Content.ItemKind: Recharge :: Int -> Dice -> Effect

+ Game.LambdaHack.Content.ItemKind: SeqEffect :: [Effect] -> Effect

+ Game.LambdaHack.Content.ItemKind: TriggeredBy :: ActivationFlag -> Condition

+ Game.LambdaHack.Content.ItemKind: Unless :: Condition -> Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: VerbMsgFail :: Text -> Text -> Effect

+ Game.LambdaHack.Content.ItemKind: When :: Condition -> Effect -> Effect

+ Game.LambdaHack.Content.ItemKind: alwaysDudEffect :: Effect -> Bool

+ Game.LambdaHack.Content.ItemKind: data Condition

+ Game.LambdaHack.Content.ItemKind: forDamageEffect :: Effect -> Bool

+ Game.LambdaHack.Content.ItemKind: getMandatoryPresentAsFromKind :: ItemKind -> Maybe (GroupName ItemKind)

+ Game.LambdaHack.Content.ItemKind: instance GHC.Classes.Eq Game.LambdaHack.Content.ItemKind.Condition

+ Game.LambdaHack.Content.ItemKind: instance GHC.Show.Show Game.LambdaHack.Content.ItemKind.Condition

+ Game.LambdaHack.Content.ItemKind: isDamagingKind :: ItemKind -> Bool

+ Game.LambdaHack.Content.ItemKind: mandatoryGroups :: [GroupName ItemKind]

+ Game.LambdaHack.Content.ItemKind: mandatoryGroupsSingleton :: [GroupName ItemKind]

+ Game.LambdaHack.Content.ItemKind: onCombineEffect :: Effect -> Bool

+ Game.LambdaHack.Content.ItemKind: onSmashOrCombineEffect :: Effect -> Bool

+ Game.LambdaHack.Content.ItemKind: orEffect :: Effect -> Bool

+ Game.LambdaHack.Content.ItemKind: pattern ANY_FLASK :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern ANY_GLASS :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern ANY_JEWELRY :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern ANY_POTION :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern ANY_SCROLL :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern AQUATIC :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern COMMON_ITEM :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern CONDITION :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern CRAWL_ITEM :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern EXPLOSIVE :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern HORROR :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern MOBILE :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_ASLEEP :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_BONUS_HP :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_BRACED :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_CURRENCY :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_FRAGRANCE :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_IMPRESSED :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_SINGLE_SPARK :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern S_SPARK :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern TREASURE :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern UNREPORTED_INVENTORY :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: pattern VALUABLE :: GroupName ItemKind

+ Game.LambdaHack.Content.ItemKind: strengthOnCombine :: ItemKind -> [Effect]

+ Game.LambdaHack.Content.ModeKind: TeamContinuity :: Int -> TeamContinuity

+ Game.LambdaHack.Content.ModeKind: [fdoctrine] :: Player -> Doctrine

+ Game.LambdaHack.Content.ModeKind: [mhint] :: ModeKind -> Text

+ Game.LambdaHack.Content.ModeKind: [mreason] :: ModeKind -> Text

+ Game.LambdaHack.Content.ModeKind: [mrules] :: ModeKind -> Text

+ Game.LambdaHack.Content.ModeKind: [mtutorial] :: ModeKind -> Bool

+ Game.LambdaHack.Content.ModeKind: deafeatOutcomes :: [Outcome]

+ Game.LambdaHack.Content.ModeKind: endMessageOutcome :: Outcome -> Text

+ Game.LambdaHack.Content.ModeKind: instance Data.Binary.Class.Binary Game.LambdaHack.Content.ModeKind.TeamContinuity

+ Game.LambdaHack.Content.ModeKind: instance GHC.Classes.Eq Game.LambdaHack.Content.ModeKind.TeamContinuity

+ Game.LambdaHack.Content.ModeKind: instance GHC.Classes.Ord Game.LambdaHack.Content.ModeKind.TeamContinuity

+ Game.LambdaHack.Content.ModeKind: instance GHC.Enum.Enum Game.LambdaHack.Content.ModeKind.TeamContinuity

+ Game.LambdaHack.Content.ModeKind: instance GHC.Generics.Generic Game.LambdaHack.Content.ModeKind.TeamContinuity

+ Game.LambdaHack.Content.ModeKind: instance GHC.Show.Show Game.LambdaHack.Content.ModeKind.TeamContinuity

+ Game.LambdaHack.Content.ModeKind: mandatoryGroups :: [GroupName ModeKind]

+ Game.LambdaHack.Content.ModeKind: nameOutcomePast :: Outcome -> Text

+ Game.LambdaHack.Content.ModeKind: nameOutcomeVerb :: Outcome -> Text

+ Game.LambdaHack.Content.ModeKind: newtype TeamContinuity

+ Game.LambdaHack.Content.ModeKind: pattern CAMPAIGN_SCENARIO :: GroupName ModeKind

+ Game.LambdaHack.Content.ModeKind: pattern INSERT_COIN :: GroupName ModeKind

+ Game.LambdaHack.Content.ModeKind: pattern NO_CONFIRMS :: GroupName ModeKind

+ Game.LambdaHack.Content.ModeKind: screensave :: AutoLeader -> ModeKind -> ModeKind

+ Game.LambdaHack.Content.ModeKind: teamExplorer :: TeamContinuity

+ Game.LambdaHack.Content.ModeKind: victoryOutcomes :: [Outcome]

+ Game.LambdaHack.Content.PlaceKind: PExists :: ContentId PlaceKind -> PlaceEntry

+ Game.LambdaHack.Content.TileKind: ChangeWith :: ProjectileTriggers -> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature

+ Game.LambdaHack.Content.TileKind: CloseWith :: ProjectileTriggers -> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature

+ Game.LambdaHack.Content.TileKind: OpenWith :: ProjectileTriggers -> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature

+ Game.LambdaHack.Content.TileKind: ProjNo :: ProjectileTriggers

+ Game.LambdaHack.Content.TileKind: ProjYes :: ProjectileTriggers

+ Game.LambdaHack.Content.TileKind: data ProjectileTriggers

+ Game.LambdaHack.Content.TileKind: instance GHC.Classes.Eq Game.LambdaHack.Content.TileKind.ProjectileTriggers

+ Game.LambdaHack.Content.TileKind: instance GHC.Show.Show Game.LambdaHack.Content.TileKind.ProjectileTriggers

+ Game.LambdaHack.Content.TileKind: mandatoryGroups :: [GroupName TileKind]

+ Game.LambdaHack.Content.TileKind: mandatoryGroupsSingleton :: [GroupName TileKind]

+ Game.LambdaHack.Content.TileKind: pattern AQUATIC :: GroupName TileKind

+ Game.LambdaHack.Content.TileKind: pattern LEGEND_DARK :: GroupName TileKind

+ Game.LambdaHack.Content.TileKind: pattern LEGEND_LIT :: GroupName TileKind

+ Game.LambdaHack.Content.TileKind: pattern S_BASIC_OUTER_FENCE :: GroupName TileKind

+ Game.LambdaHack.Content.TileKind: pattern S_UNKNOWN_OUTER_FENCE :: GroupName TileKind

+ Game.LambdaHack.Content.TileKind: pattern S_UNKNOWN_SPACE :: GroupName TileKind

+ Game.LambdaHack.Core.Frequency: maxBoundInt32 :: Int

+ Game.LambdaHack.Core.Prelude: (<$!>) :: Monad m => (a -> b) -> m a -> m b

+ Game.LambdaHack.Core.Prelude: (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c

+ Game.LambdaHack.Core.Prelude: (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c

+ Game.LambdaHack.Core.Prelude: ap :: Monad m => m (a -> b) -> m a -> m b

+ Game.LambdaHack.Core.Prelude: class Monad m => MonadFail (m :: Type -> Type)

+ Game.LambdaHack.Core.Prelude: class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type)

+ Game.LambdaHack.Core.Prelude: comparing :: Ord a => (b -> a) -> b -> b -> Ordering

+ Game.LambdaHack.Core.Prelude: filterM :: Applicative m => (a -> m Bool) -> [a] -> m [a]

+ Game.LambdaHack.Core.Prelude: foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b

+ Game.LambdaHack.Core.Prelude: foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()

+ Game.LambdaHack.Core.Prelude: forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)

+ Game.LambdaHack.Core.Prelude: forM_ :: (Foldable t, Monad m) => t a -> (a -> m ()) -> m ()

+ Game.LambdaHack.Core.Prelude: forever :: Applicative f => f a -> f b

+ Game.LambdaHack.Core.Prelude: fromIntegralWrap :: (Integral a, Num b) => a -> b

+ Game.LambdaHack.Core.Prelude: guard :: Alternative f => Bool -> f ()

+ Game.LambdaHack.Core.Prelude: instance (Data.Hashable.Class.Hashable k, GHC.Classes.Eq k, Data.Binary.Class.Binary k, Data.Binary.Class.Binary v) => Data.Binary.Class.Binary (Data.HashMap.Internal.HashMap k v)

+ Game.LambdaHack.Core.Prelude: int64ToDouble :: Int64 -> Double

+ Game.LambdaHack.Core.Prelude: intCast :: (Integral a, Integral b, IsIntSubType a b ~ 'True) => a -> b

+ Game.LambdaHack.Core.Prelude: intToDouble :: Int -> Double

+ Game.LambdaHack.Core.Prelude: join :: Monad m => m (m a) -> m a

+ Game.LambdaHack.Core.Prelude: liftM :: Monad m => (a1 -> r) -> m a1 -> m r

+ Game.LambdaHack.Core.Prelude: liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r

+ Game.LambdaHack.Core.Prelude: liftM3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r

+ Game.LambdaHack.Core.Prelude: liftM4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r

+ Game.LambdaHack.Core.Prelude: liftM5 :: Monad m => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r

+ Game.LambdaHack.Core.Prelude: mapAndUnzipM :: Applicative m => (a -> m (b, c)) -> [a] -> m ([b], [c])

+ Game.LambdaHack.Core.Prelude: mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a

+ Game.LambdaHack.Core.Prelude: mplus :: MonadPlus m => m a -> m a -> m a

+ Game.LambdaHack.Core.Prelude: msum :: (Foldable t, MonadPlus m) => t (m a) -> m a

+ Game.LambdaHack.Core.Prelude: mzero :: MonadPlus m => m a

+ Game.LambdaHack.Core.Prelude: replicateM :: Applicative m => Int -> m a -> m [a]

+ Game.LambdaHack.Core.Prelude: replicateM_ :: Applicative m => Int -> m a -> m ()

+ Game.LambdaHack.Core.Prelude: singleton :: a -> [a]

+ Game.LambdaHack.Core.Prelude: toIntegralCrash :: (Integral a, Integral b, Bits a, Bits b) => a -> b

+ Game.LambdaHack.Core.Prelude: unless :: Applicative f => Bool -> f () -> f ()

+ Game.LambdaHack.Core.Prelude: void :: Functor f => f a -> f ()

+ Game.LambdaHack.Core.Prelude: when :: Applicative f => Bool -> f () -> f ()

+ Game.LambdaHack.Core.Prelude: zipWithM :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c]

+ Game.LambdaHack.Core.Prelude: zipWithM_ :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m ()

+ Game.LambdaHack.Core.Random: nextRandom :: forall a. Integral a => a -> SMGen -> (a, SMGen)

+ Game.LambdaHack.Core.Random: randomR0 :: Integral a => a -> Rnd a

+ Game.LambdaHack.Core.Random: randomWord32 :: Rnd Word32

+ Game.LambdaHack.Core.Random: shuffleExcept :: Vector Word16 -> Int -> [Word16] -> Rnd [Word16]

+ Game.LambdaHack.Definition.Ability: ActivationConsume :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationEmbed :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationMeleeable :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationOnCombine :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationOnSmash :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationPeriodic :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationProjectile :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationTrigger :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationUnderMelee :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: ActivationUnderRanged :: ActivationFlag

+ Game.LambdaHack.Definition.Ability: Benign :: Flag

+ Game.LambdaHack.Definition.Ability: MetaGame :: Flag

+ Game.LambdaHack.Definition.Ability: MinorAspects :: Flag

+ Game.LambdaHack.Definition.Ability: SkDeflectMelee :: Skill

+ Game.LambdaHack.Definition.Ability: SkDeflectRanged :: Skill

+ Game.LambdaHack.Definition.Ability: UnderMelee :: Flag

+ Game.LambdaHack.Definition.Ability: UnderRanged :: Flag

+ Game.LambdaHack.Definition.Ability: data ActivationFlag

+ Game.LambdaHack.Definition.Ability: data Doctrine

+ Game.LambdaHack.Definition.Ability: describeDoctrine :: Doctrine -> Text

+ Game.LambdaHack.Definition.Ability: doctrineSkills :: Doctrine -> Skills

+ Game.LambdaHack.Definition.Ability: instance Data.Binary.Class.Binary Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: instance Data.Hashable.Class.Hashable Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: instance GHC.Classes.Eq Game.LambdaHack.Definition.Ability.ActivationFlag

+ Game.LambdaHack.Definition.Ability: instance GHC.Classes.Eq Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: instance GHC.Enum.Bounded Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: instance GHC.Enum.Enum Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: instance GHC.Generics.Generic Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: instance GHC.Show.Show Game.LambdaHack.Definition.Ability.ActivationFlag

+ Game.LambdaHack.Definition.Ability: instance GHC.Show.Show Game.LambdaHack.Definition.Ability.Doctrine

+ Game.LambdaHack.Definition.Ability: nameDoctrine :: Doctrine -> Text

+ Game.LambdaHack.Definition.Color: HighlightBrown :: Highlight

+ Game.LambdaHack.Definition.Color: HighlightCyan :: Highlight

+ Game.LambdaHack.Definition.Color: cBadEvent :: Color

+ Game.LambdaHack.Definition.Color: cBoring :: Color

+ Game.LambdaHack.Definition.Color: cGameOver :: Color

+ Game.LambdaHack.Definition.Color: cGoodEvent :: Color

+ Game.LambdaHack.Definition.Color: cGraveRisk :: Color

+ Game.LambdaHack.Definition.Color: cGreed :: Color

+ Game.LambdaHack.Definition.Color: cIdentification :: Color

+ Game.LambdaHack.Definition.Color: cMeta :: Color

+ Game.LambdaHack.Definition.Color: cNeutralEvent :: Color

+ Game.LambdaHack.Definition.Color: cRareNeutralEvent :: Color

+ Game.LambdaHack.Definition.Color: cRisk :: Color

+ Game.LambdaHack.Definition.Color: cSleep :: Color

+ Game.LambdaHack.Definition.Color: cTutorialHint :: Color

+ Game.LambdaHack.Definition.Color: cVeryBadEvent :: Color

+ Game.LambdaHack.Definition.Color: cVeryGoodEvent :: Color

+ Game.LambdaHack.Definition.Color: cVista :: Color

+ Game.LambdaHack.Definition.Color: cWakeUp :: Color

+ Game.LambdaHack.Definition.Color: nbspAttrW32 :: AttrCharW32

+ Game.LambdaHack.Definition.Color: spaceCursorAttrW32 :: AttrCharW32

+ Game.LambdaHack.Definition.Color: trimmedLineAttrW32 :: AttrCharW32

+ Game.LambdaHack.Definition.Defs: Backward :: Direction

+ Game.LambdaHack.Definition.Defs: CStash :: CStore

+ Game.LambdaHack.Definition.Defs: Forward :: Direction

+ Game.LambdaHack.Definition.Defs: GroupName :: Text -> GroupName a

+ Game.LambdaHack.Definition.Defs: MModes :: ItemDialogMode

+ Game.LambdaHack.Definition.Defs: [fromGroupName] :: GroupName a -> Text

+ Game.LambdaHack.Definition.Defs: data Direction

+ Game.LambdaHack.Definition.Defs: instance Control.DeepSeq.NFData Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: instance Data.Binary.Class.Binary Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: instance GHC.Classes.Eq Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: instance GHC.Classes.Ord Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: instance GHC.Generics.Generic Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: instance GHC.Read.Read Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: instance GHC.Show.Show Game.LambdaHack.Definition.Defs.Direction

+ Game.LambdaHack.Definition.Defs: newtype GroupName a

+ Game.LambdaHack.Definition.Flavour: zipStory :: [Color] -> [Flavour]

+ Game.LambdaHack.Server: [sassertExplored] :: ServerOptions -> Maybe Int

+ Game.LambdaHack.Server: [sstopAfterGameOver] :: ServerOptions -> Bool

+ Game.LambdaHack.Server.BroadcastAtomic: cmdItemsFromIids :: [ItemId] -> State -> State -> [UpdAtomic]

+ Game.LambdaHack.Server.CommonM: addNonProjectile :: MonadServerAtomic m => Bool -> ItemId -> ItemFullKit -> FactionId -> Point -> LevelId -> Time -> m ActorId

+ Game.LambdaHack.Server.CommonM: verifyCaches :: MonadServer m => m ()

+ Game.LambdaHack.Server.CommonM: writeSaveAll :: MonadServerAtomic m => Bool -> Bool -> m ()

+ Game.LambdaHack.Server.Fov: perceptionFromPTotalNoStash :: FovLucid -> CacheBeforeLucid -> Perception

+ Game.LambdaHack.Server.HandleAtomicM: levelOfStash :: MonadStateRead m => ActorId -> m LevelId

+ Game.LambdaHack.Server.HandleAtomicM: validateFloor :: MonadServer m => ItemId -> LevelId -> m ()

+ Game.LambdaHack.Server.HandleAtomicM: validateFloorBag :: MonadServer m => ItemBag -> LevelId -> m ()

+ Game.LambdaHack.Server.HandleEffectM: EffApplyFlags :: EffToUse -> Bool -> Bool -> Bool -> ActivationFlag -> Bool -> EffApplyFlags

+ Game.LambdaHack.Server.HandleEffectM: EffBare :: EffToUse

+ Game.LambdaHack.Server.HandleEffectM: EffBareAndOnCombine :: EffToUse

+ Game.LambdaHack.Server.HandleEffectM: EffOnCombine :: EffToUse

+ Game.LambdaHack.Server.HandleEffectM: [effActivation] :: EffApplyFlags -> ActivationFlag

+ Game.LambdaHack.Server.HandleEffectM: [effKineticPerformed] :: EffApplyFlags -> Bool

+ Game.LambdaHack.Server.HandleEffectM: [effMayDestroy] :: EffApplyFlags -> Bool

+ Game.LambdaHack.Server.HandleEffectM: [effToUse] :: EffApplyFlags -> EffToUse

+ Game.LambdaHack.Server.HandleEffectM: [effUseAllCopies] :: EffApplyFlags -> Bool

+ Game.LambdaHack.Server.HandleEffectM: [effVoluntary] :: EffApplyFlags -> Bool

+ Game.LambdaHack.Server.HandleEffectM: consumeItems :: MonadServerAtomic m => ActorId -> EnumMap CStore ItemBag -> [(CStore, (ItemId, ItemFull))] -> m ()

+ Game.LambdaHack.Server.HandleEffectM: data EffApplyFlags

+ Game.LambdaHack.Server.HandleEffectM: data EffToUse

+ Game.LambdaHack.Server.HandleEffectM: dropAllEquippedItems :: MonadServerAtomic m => ActorId -> Actor -> m ()

+ Game.LambdaHack.Server.HandleEffectM: effectAndEffect :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> ActorId -> Effect -> Effect -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectAndEffectSem :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> Effect -> Effect -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectAtMostOneOf :: MonadServerAtomic m => (Effect -> m UseResult) -> [Effect] -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectConsumeItems :: MonadServerAtomic m => m () -> ItemId -> ActorId -> [(Int, GroupName ItemKind)] -> [(Int, GroupName ItemKind)] -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectDestroyItem :: MonadServerAtomic m => m () -> Int -> Int -> CStore -> ActorId -> GroupName ItemKind -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectIfThenElse :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> ActorId -> Condition -> Effect -> Effect -> ActivationFlag -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectOrEffect :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> FactionId -> Effect -> Effect -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectRecharge :: forall m. MonadServerAtomic m => Bool -> m () -> ItemId -> Int -> Dice -> ActorId -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectSeqEffect :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> [Effect] -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectUnless :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectVerbMsgFail :: MonadServerAtomic m => m () -> ActorId -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectWhen :: forall m. MonadServerAtomic m => (Effect -> m UseResult) -> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: instance GHC.Classes.Eq Game.LambdaHack.Server.HandleEffectM.EffToUse

+ Game.LambdaHack.Server.HandleRequestM: affectStash :: MonadServerAtomic m => Actor -> m ()

+ Game.LambdaHack.Server.HandleRequestM: reqDoctrine :: MonadServerAtomic m => FactionId -> Doctrine -> m ()

+ Game.LambdaHack.Server.ItemM: createCaveItem :: MonadServerAtomic m => Point -> LevelId -> m ()

+ Game.LambdaHack.Server.ItemM: createEmbedItem :: MonadServerAtomic m => LevelId -> Point -> GroupName ItemKind -> m ()

+ Game.LambdaHack.Server.ItemM: embedItemOnPos :: MonadServerAtomic m => LevelId -> Point -> ContentId TileKind -> m ()

+ Game.LambdaHack.Server.ItemM: moveStashIfNeeded :: MonadStateRead m => Container -> m [UpdAtomic]

+ Game.LambdaHack.Server.ItemRev: NewItem :: ItemKnown -> ItemFull -> ItemQuant -> NewItem

+ Game.LambdaHack.Server.ItemRev: NoNewItem :: NewItem

+ Game.LambdaHack.Server.ItemRev: data NewItem

+ Game.LambdaHack.Server.LoopM: dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()

+ Game.LambdaHack.Server.PeriodicM: endOrLoop :: (MonadServerAtomic m, MonadServerComm m) => m () -> (Maybe (GroupName ModeKind) -> m ()) -> m ()

+ Game.LambdaHack.Server.PeriodicM: gameExit :: (MonadServerAtomic m, MonadServerComm m) => m ()

+ Game.LambdaHack.Server.ServerOptions: [sassertExplored] :: ServerOptions -> Maybe Int

+ Game.LambdaHack.Server.ServerOptions: [sstopAfterGameOver] :: ServerOptions -> Bool

+ Game.LambdaHack.Server.State: [stcounter] :: StateServer -> EnumMap TeamContinuity Int

+ Game.LambdaHack.Server.State: [steamGearCur] :: StateServer -> GearOfTeams

+ Game.LambdaHack.Server.State: [steamGear] :: StateServer -> GearOfTeams

+ Game.LambdaHack.Server.State: type GearOfTeams = EnumMap TeamContinuity (IntMap [(GroupName ItemKind, ContentId ItemKind)])

- Game.LambdaHack.Atomic: HearUpd :: Bool -> UpdAtomic -> HearMsg

+ Game.LambdaHack.Atomic: HearUpd :: UpdAtomic -> HearMsg

- Game.LambdaHack.Atomic: PosFidAndSer :: Maybe LevelId -> FactionId -> PosAtomic

+ Game.LambdaHack.Atomic: PosFidAndSer :: FactionId -> PosAtomic

- Game.LambdaHack.Atomic: PosFidAndSight :: [FactionId] -> LevelId -> [Point] -> PosAtomic

+ Game.LambdaHack.Atomic: PosFidAndSight :: FactionId -> LevelId -> [Point] -> PosAtomic

- Game.LambdaHack.Atomic: SfxApply :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxApply :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxCheck :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxCheck :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxCollideActor :: LevelId -> ActorId -> ActorId -> SfxMsg

+ Game.LambdaHack.Atomic: SfxCollideActor :: ActorId -> ActorId -> SfxMsg

- Game.LambdaHack.Atomic: SfxEffect :: FactionId -> ActorId -> Effect -> Int64 -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxEffect :: FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic

- Game.LambdaHack.Atomic: SfxFizzles :: SfxMsg

+ Game.LambdaHack.Atomic: SfxFizzles :: ItemId -> Container -> SfxMsg

- Game.LambdaHack.Atomic: SfxNothingHappens :: SfxMsg

+ Game.LambdaHack.Atomic: SfxNothingHappens :: ItemId -> Container -> SfxMsg

- Game.LambdaHack.Atomic: SfxProject :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxProject :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxReceive :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxReceive :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxRecoil :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxRecoil :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxRelease :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxRelease :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxShun :: ActorId -> Point -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxShun :: ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic

- Game.LambdaHack.Atomic: SfxSteal :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxSteal :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxStrike :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxStrike :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic: SfxTimerExtended :: LevelId -> ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg

+ Game.LambdaHack.Atomic: SfxTimerExtended :: ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg

- Game.LambdaHack.Atomic: SfxTrigger :: ActorId -> Point -> SfxAtomic

+ Game.LambdaHack.Atomic: SfxTrigger :: ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic

- Game.LambdaHack.Atomic: UpdAgeGame :: [LevelId] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdAgeGame :: EnumSet LevelId -> UpdAtomic

- Game.LambdaHack.Atomic: UpdCreateItem :: ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdCreateItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic: UpdDestroyItem :: ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdDestroyItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic: UpdHearFid :: FactionId -> HearMsg -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdHearFid :: FactionId -> Maybe Int -> HearMsg -> UpdAtomic

- Game.LambdaHack.Atomic: UpdLoseActor :: ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdLoseActor :: ActorId -> Actor -> UpdAtomic

- Game.LambdaHack.Atomic: UpdLoseItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdLoseItem :: Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic: UpdLoseItemBag :: Container -> ItemBag -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdLoseItemBag :: Bool -> Container -> ItemBag -> UpdAtomic

- Game.LambdaHack.Atomic: UpdRestart :: FactionId -> PerLid -> State -> Challenge -> ClientOptions -> StdGen -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdRestart :: FactionId -> PerLid -> State -> Challenge -> ClientOptions -> SMGen -> UpdAtomic

- Game.LambdaHack.Atomic: UpdSpotActor :: ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdSpotActor :: ActorId -> Actor -> UpdAtomic

- Game.LambdaHack.Atomic: UpdSpotItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdSpotItem :: Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic: UpdSpotItemBag :: Container -> ItemBag -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdSpotItemBag :: Bool -> Container -> ItemBag -> UpdAtomic

- Game.LambdaHack.Atomic: UpdTimeItem :: ItemId -> Container -> ItemTimer -> ItemTimer -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdTimeItem :: ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic

- Game.LambdaHack.Atomic: UpdUnAgeGame :: [LevelId] -> UpdAtomic

+ Game.LambdaHack.Atomic: UpdUnAgeGame :: EnumSet LevelId -> UpdAtomic

- Game.LambdaHack.Atomic: seenAtomicCli :: Bool -> FactionId -> Perception -> PosAtomic -> Bool

+ Game.LambdaHack.Atomic: seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool

- Game.LambdaHack.Atomic.CmdAtomic: HearUpd :: Bool -> UpdAtomic -> HearMsg

+ Game.LambdaHack.Atomic.CmdAtomic: HearUpd :: UpdAtomic -> HearMsg

- Game.LambdaHack.Atomic.CmdAtomic: SfxApply :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxApply :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxCheck :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxCheck :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxCollideActor :: LevelId -> ActorId -> ActorId -> SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxCollideActor :: ActorId -> ActorId -> SfxMsg

- Game.LambdaHack.Atomic.CmdAtomic: SfxEffect :: FactionId -> ActorId -> Effect -> Int64 -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxEffect :: FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxFizzles :: SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxFizzles :: ItemId -> Container -> SfxMsg

- Game.LambdaHack.Atomic.CmdAtomic: SfxNothingHappens :: SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxNothingHappens :: ItemId -> Container -> SfxMsg

- Game.LambdaHack.Atomic.CmdAtomic: SfxProject :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxProject :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxReceive :: ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxReceive :: ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxRecoil :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxRecoil :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxRelease :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxRelease :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxShun :: ActorId -> Point -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxShun :: ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxSteal :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxSteal :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxStrike :: ActorId -> ActorId -> ItemId -> CStore -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxStrike :: ActorId -> ActorId -> ItemId -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: SfxTimerExtended :: LevelId -> ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg

+ Game.LambdaHack.Atomic.CmdAtomic: SfxTimerExtended :: ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg

- Game.LambdaHack.Atomic.CmdAtomic: SfxTrigger :: ActorId -> Point -> SfxAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: SfxTrigger :: ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdAgeGame :: [LevelId] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdAgeGame :: EnumSet LevelId -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdCreateItem :: ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdCreateItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdDestroyItem :: ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdDestroyItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdHearFid :: FactionId -> HearMsg -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdHearFid :: FactionId -> Maybe Int -> HearMsg -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdLoseActor :: ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdLoseActor :: ActorId -> Actor -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdLoseItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdLoseItem :: Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdLoseItemBag :: Container -> ItemBag -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdLoseItemBag :: Bool -> Container -> ItemBag -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdRestart :: FactionId -> PerLid -> State -> Challenge -> ClientOptions -> StdGen -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdRestart :: FactionId -> PerLid -> State -> Challenge -> ClientOptions -> SMGen -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdSpotActor :: ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdSpotActor :: ActorId -> Actor -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdSpotItem :: Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdSpotItem :: Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdSpotItemBag :: Container -> ItemBag -> [(ItemId, Item)] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdSpotItemBag :: Bool -> Container -> ItemBag -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdTimeItem :: ItemId -> Container -> ItemTimer -> ItemTimer -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdTimeItem :: ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic

- Game.LambdaHack.Atomic.CmdAtomic: UpdUnAgeGame :: [LevelId] -> UpdAtomic

+ Game.LambdaHack.Atomic.CmdAtomic: UpdUnAgeGame :: EnumSet LevelId -> UpdAtomic

- Game.LambdaHack.Atomic.HandleAtomicWrite: updAgeGame :: MonadStateWrite m => [LevelId] -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updAgeGame :: MonadStateWrite m => EnumSet LevelId -> m ()

- Game.LambdaHack.Atomic.HandleAtomicWrite: updLoseItemBag :: MonadStateWrite m => Container -> ItemBag -> [(ItemId, Item)] -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updLoseItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()

- Game.LambdaHack.Atomic.HandleAtomicWrite: updSpotItemBag :: MonadStateWrite m => Container -> ItemBag -> [(ItemId, Item)] -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updSpotItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()

- Game.LambdaHack.Atomic.HandleAtomicWrite: updTimeItem :: MonadStateWrite m => ItemId -> Container -> ItemTimer -> ItemTimer -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updTimeItem :: MonadStateWrite m => ItemId -> Container -> ItemTimers -> ItemTimers -> m ()

- Game.LambdaHack.Atomic.HandleAtomicWrite: updUnAgeGame :: MonadStateWrite m => [LevelId] -> m ()

+ Game.LambdaHack.Atomic.HandleAtomicWrite: updUnAgeGame :: MonadStateWrite m => EnumSet LevelId -> m ()

- Game.LambdaHack.Atomic.PosAtomicRead: PosFidAndSer :: Maybe LevelId -> FactionId -> PosAtomic

+ Game.LambdaHack.Atomic.PosAtomicRead: PosFidAndSer :: FactionId -> PosAtomic

- Game.LambdaHack.Atomic.PosAtomicRead: PosFidAndSight :: [FactionId] -> LevelId -> [Point] -> PosAtomic

+ Game.LambdaHack.Atomic.PosAtomicRead: PosFidAndSight :: FactionId -> LevelId -> [Point] -> PosAtomic

- Game.LambdaHack.Atomic.PosAtomicRead: seenAtomicCli :: Bool -> FactionId -> Perception -> PosAtomic -> Bool

+ Game.LambdaHack.Atomic.PosAtomicRead: seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool

- Game.LambdaHack.Client: mkUIOptions :: COps -> Bool -> IO UIOptions

+ Game.LambdaHack.Client: mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions

- Game.LambdaHack.Client.AI: pickActorAndAction :: MonadClient m => Maybe ActorId -> ActorId -> m (ActorId, RequestTimed, Maybe Point)

+ Game.LambdaHack.Client.AI: pickActorAndAction :: MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> Maybe ActorId -> ActorId -> m (ActorId, RequestTimed, Maybe (Point, Time))

- Game.LambdaHack.Client.AI.ConditionM: condAdjTriggerableM :: MonadClient m => ActorId -> m Bool

+ Game.LambdaHack.Client.AI.ConditionM: condAdjTriggerableM :: MonadClient m => Skills -> ActorId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: condProjectListM :: MonadClient m => Int -> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]

+ Game.LambdaHack.Client.AI.ConditionM: condProjectListM :: MonadClient m => Int -> ActorId -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]

- Game.LambdaHack.Client.AI.ConditionM: condSupport :: MonadClient m => Int -> ActorId -> m Bool

+ Game.LambdaHack.Client.AI.ConditionM: condSupport :: MonadClient m => [(ActorId, Actor)] -> Int -> ActorId -> m Bool

- Game.LambdaHack.Client.AI.ConditionM: fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)])

+ Game.LambdaHack.Client.AI.ConditionM: fleeList :: MonadClient m => [(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])

- Game.LambdaHack.Client.AI.ConditionM: hinders :: Bool -> Bool -> Bool -> Bool -> Skills -> ItemFull -> Bool

+ Game.LambdaHack.Client.AI.ConditionM: hinders :: Bool -> Bool -> Skills -> ItemFull -> Bool

- Game.LambdaHack.Client.AI.ConditionM: meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))]

+ Game.LambdaHack.Client.AI.ConditionM: meleeThreatDistList :: [(ActorId, Actor)] -> ActorId -> State -> [(Int, (ActorId, Actor))]

- Game.LambdaHack.Client.AI.PickActionM: actionStrategy :: forall m. MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: actionStrategy :: forall m. MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> Bool -> m (Strategy RequestTimed)

- Game.LambdaHack.Client.AI.PickActionM: applyItem :: MonadClient m => ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: applyItem :: MonadClient m => Skills -> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)

- Game.LambdaHack.Client.AI.PickActionM: bestByEqpSlot :: DiscoveryBenefit -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]

+ Game.LambdaHack.Client.AI.PickActionM: bestByEqpSlot :: DiscoveryBenefit -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]

- Game.LambdaHack.Client.AI.PickActionM: chase :: MonadClient m => ActorId -> Bool -> Bool -> m (Strategy RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: chase :: MonadClient m => Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)

- Game.LambdaHack.Client.AI.PickActionM: flee :: MonadClient m => ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: flee :: MonadClient m => Skills -> ActorId -> Bool -> [(Int, Point)] -> m (Strategy RequestTimed)

- Game.LambdaHack.Client.AI.PickActionM: meleeBlocker :: MonadClient m => ActorId -> m (Strategy RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: meleeBlocker :: MonadClient m => Skills -> ActorId -> m (Strategy RequestTimed)

- Game.LambdaHack.Client.AI.PickActionM: moveOrRunAid :: MonadClient m => ActorId -> Vector -> m (Maybe RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: moveOrRunAid :: MonadClient m => Skills -> ActorId -> Vector -> m (Maybe RequestTimed)

- Game.LambdaHack.Client.AI.PickActionM: moveTowards :: MonadClient m => ActorId -> Point -> Point -> Bool -> m (Strategy Vector)

+ Game.LambdaHack.Client.AI.PickActionM: moveTowards :: MonadClient m => Skills -> ActorId -> Bool -> Point -> Point -> Bool -> m (Strategy Vector)

- Game.LambdaHack.Client.AI.PickActionM: pickAction :: MonadClient m => ActorId -> Bool -> m RequestTimed

+ Game.LambdaHack.Client.AI.PickActionM: pickAction :: MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> Bool -> m RequestTimed

- Game.LambdaHack.Client.AI.PickActionM: projectItem :: MonadClient m => ActorId -> m (Strategy RequestTimed)

+ Game.LambdaHack.Client.AI.PickActionM: projectItem :: MonadClient m => Skills -> ActorId -> m (Strategy RequestTimed)

- Game.LambdaHack.Client.AI.PickActorM: pickActorToMove :: MonadClient m => Maybe ActorId -> m ActorId

+ Game.LambdaHack.Client.AI.PickActorM: pickActorToMove :: MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> Maybe ActorId -> m ActorId

- Game.LambdaHack.Client.AI.PickTargetM: computeTarget :: forall m. MonadClient m => ActorId -> m (Maybe TgtAndPath)

+ Game.LambdaHack.Client.AI.PickTargetM: computeTarget :: forall m. MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> m (Maybe TgtAndPath)

- Game.LambdaHack.Client.AI.PickTargetM: refreshTarget :: MonadClient m => (ActorId, Actor) -> m (Maybe TgtAndPath)

+ Game.LambdaHack.Client.AI.PickTargetM: refreshTarget :: MonadClient m => [(ActorId, Actor)] -> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)

- Game.LambdaHack.Client.Bfs: findPathBfs :: BigActorMap -> Array Word8 -> (PointI -> Bool) -> Point -> Point -> Int -> Array BfsDistance -> Maybe AndPath

+ Game.LambdaHack.Client.Bfs: findPathBfs :: EnumSet Point -> Array Word8 -> (PointI -> Bool) -> Point -> Point -> Int -> Array BfsDistance -> Maybe AndPath

- Game.LambdaHack.Client.BfsM: invalidateBfsPathLid :: MonadClient m => LevelId -> Point -> m ()

+ Game.LambdaHack.Client.BfsM: invalidateBfsPathLid :: MonadClient m => Actor -> m ()

- Game.LambdaHack.Client.CommonM: makeLine :: MonadStateRead m => Bool -> Actor -> Point -> Int -> m (Maybe Int)

+ Game.LambdaHack.Client.CommonM: makeLine :: Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int

- Game.LambdaHack.Client.State: StateClient :: Int -> EnumMap ActorId TgtAndPath -> EnumMap ActorId Point -> EnumSet LevelId -> EnumMap ActorId BfsAndPath -> () -> DiscoveryBenefit -> PerLid -> AlterLid -> StdGen -> Maybe ActorId -> FactionId -> Bool -> Challenge -> Challenge -> Int -> Int -> EnumMap LevelId Bool -> EnumMap (ContentId ModeKind) (Map Challenge Int) -> ClientOptions -> (PrimArray PointI, PrimArray PointI) -> StateClient

+ Game.LambdaHack.Client.State: StateClient :: Int -> EnumMap ActorId TgtAndPath -> EnumMap ActorId (Point, Time) -> EnumSet LevelId -> EnumMap ActorId BfsAndPath -> () -> DiscoveryBenefit -> PerLid -> AlterLid -> SMGen -> Maybe ActorId -> FactionId -> Bool -> Challenge -> Challenge -> Int -> EnumMap LevelId Bool -> EnumMap (ContentId ModeKind) (Map Challenge Int) -> EnumSet (ContentId ModeKind) -> EnumSet (ContentId ModeKind) -> ClientOptions -> (PrimArray PointI, PrimArray PointI) -> StateClient

- Game.LambdaHack.Client.State: [sfleeD] :: StateClient -> EnumMap ActorId Point

+ Game.LambdaHack.Client.State: [sfleeD] :: StateClient -> EnumMap ActorId (Point, Time)

- Game.LambdaHack.Client.State: [srandom] :: StateClient -> StdGen

+ Game.LambdaHack.Client.State: [srandom] :: StateClient -> SMGen

- Game.LambdaHack.Client.UI: SessionUI :: Maybe Target -> ActorDictUI -> ItemDictUI -> ItemSlots -> Maybe (CStore, CStore) -> ChanFrontend -> CCUI -> UIOptions -> Maybe AimMode -> Bool -> Maybe (ItemId, CStore, Bool) -> EnumSet ActorId -> Maybe RunParams -> History -> Point -> LastRecord -> [KM] -> EnumSet ActorId -> Int -> Bool -> Bool -> Bool -> Map String Int -> Bool -> HintMode -> Bool -> POSIXTime -> POSIXTime -> Time -> Int -> Int -> SessionUI

+ Game.LambdaHack.Client.UI: SessionUI :: Maybe Target -> Maybe Target -> ActorDictUI -> ItemDictUI -> ItemSlots -> Maybe (CStore, CStore) -> ChanFrontend -> CCUI -> UIOptions -> Maybe AimMode -> Bool -> Maybe (ItemId, CStore, Bool) -> EnumSet ActorId -> Maybe RunParams -> History -> PointUI -> KeyMacroFrame -> [KeyMacroFrame] -> EnumSet ActorId -> Int -> Bool -> Bool -> Bool -> Int -> Bool -> Bool -> Maybe Bool -> Set Msg -> Map String Int -> ChosenLore -> Bool -> Bool -> Bool -> POSIXTime -> POSIXTime -> Time -> Int -> Int -> SMGen -> SessionUI

- Game.LambdaHack.Client.UI: [spointer] :: SessionUI -> Point

+ Game.LambdaHack.Client.UI: [spointer] :: SessionUI -> PointUI

- Game.LambdaHack.Client.UI: displayRespSfxAtomicUI :: MonadClientUI m => SfxAtomic -> m ()

+ Game.LambdaHack.Client.UI: displayRespSfxAtomicUI :: (MonadClient m, MonadClientUI m) => SfxAtomic -> m ()

- Game.LambdaHack.Client.UI: displayRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m ()

+ Game.LambdaHack.Client.UI: displayRespUpdAtomicUI :: (MonadClient m, MonadClientUI m) => UpdAtomic -> m ()

- Game.LambdaHack.Client.UI: mkUIOptions :: COps -> Bool -> IO UIOptions

+ Game.LambdaHack.Client.UI: mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions

- Game.LambdaHack.Client.UI.Animation: actorX :: ScreenContent -> Point -> Animation

+ Game.LambdaHack.Client.UI.Animation: actorX :: Point -> Animation

- Game.LambdaHack.Client.UI.Animation: blockHit :: ScreenContent -> (Point, Point) -> Color -> Color -> Animation

+ Game.LambdaHack.Client.UI.Animation: blockHit :: (Point, Point) -> Color -> Color -> Animation

- Game.LambdaHack.Client.UI.Animation: blockMiss :: ScreenContent -> (Point, Point) -> Animation

+ Game.LambdaHack.Client.UI.Animation: blockMiss :: (Point, Point) -> Animation

- Game.LambdaHack.Client.UI.Animation: deathBody :: ScreenContent -> Point -> Animation

+ Game.LambdaHack.Client.UI.Animation: deathBody :: Point -> Animation

- Game.LambdaHack.Client.UI.Animation: mapPosToOffset :: ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32])

+ Game.LambdaHack.Client.UI.Animation: mapPosToOffset :: (Point, AttrCharW32) -> (PointUI, AttrString)

- Game.LambdaHack.Client.UI.Animation: mzipPairs :: ScreenContent -> (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32) -> IntOverlay

+ Game.LambdaHack.Client.UI.Animation: mzipPairs :: (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace

- Game.LambdaHack.Client.UI.Animation: mzipSingleton :: ScreenContent -> Point -> Maybe AttrCharW32 -> IntOverlay

+ Game.LambdaHack.Client.UI.Animation: mzipSingleton :: Point -> Maybe AttrCharW32 -> OverlaySpace

- Game.LambdaHack.Client.UI.Animation: renderAnim :: PreFrame -> Animation -> PreFrames

+ Game.LambdaHack.Client.UI.Animation: renderAnim :: Int -> PreFrame -> Animation -> PreFrames

- Game.LambdaHack.Client.UI.Animation: shortDeathBody :: ScreenContent -> Point -> Animation

+ Game.LambdaHack.Client.UI.Animation: shortDeathBody :: Point -> Animation

- Game.LambdaHack.Client.UI.Animation: subtleHit :: ScreenContent -> Point -> Animation

+ Game.LambdaHack.Client.UI.Animation: subtleHit :: (Point, Point) -> Animation

- Game.LambdaHack.Client.UI.Animation: swapPlaces :: ScreenContent -> (Point, Point) -> Animation

+ Game.LambdaHack.Client.UI.Animation: swapPlaces :: (Point, Point) -> Animation

- Game.LambdaHack.Client.UI.Animation: teleport :: ScreenContent -> (Point, Point) -> Animation

+ Game.LambdaHack.Client.UI.Animation: teleport :: (Point, Point) -> Animation

- Game.LambdaHack.Client.UI.Animation: twirlSplash :: ScreenContent -> (Point, Point) -> Color -> Color -> Animation

+ Game.LambdaHack.Client.UI.Animation: twirlSplash :: (Point, Point) -> Color -> Color -> Animation

- Game.LambdaHack.Client.UI.Content.Input: makeData :: UIOptions -> InputContentRaw -> InputContent

+ Game.LambdaHack.Client.UI.Content.Input: makeData :: Maybe UIOptions -> InputContentRaw -> InputContent

- Game.LambdaHack.Client.UI.Content.Input: repeatTriple :: Int -> CmdTriple

+ Game.LambdaHack.Client.UI.Content.Input: repeatTriple :: Int -> [CmdCategory] -> CmdTriple

- Game.LambdaHack.Client.UI.Content.Screen: ScreenContent :: X -> Y -> Text -> [String] -> [String] -> EnumMap Char Text -> ScreenContent

+ Game.LambdaHack.Client.UI.Content.Screen: ScreenContent :: X -> Y -> X -> String -> ([String], [[String]]) -> EnumMap Char Text -> [(FilePath, ByteString)] -> ScreenContent

- Game.LambdaHack.Client.UI.Content.Screen: [rintroScreen] :: ScreenContent -> [String]

+ Game.LambdaHack.Client.UI.Content.Screen: [rintroScreen] :: ScreenContent -> ([String], [[String]])

- Game.LambdaHack.Client.UI.DisplayAtomicM: aidVerbDuplicateMU :: MonadClientUI m => MsgClass -> ActorId -> Part -> m Bool

+ Game.LambdaHack.Client.UI.DisplayAtomicM: aidVerbDuplicateMU :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ActorId -> Part -> m Bool

- Game.LambdaHack.Client.UI.DisplayAtomicM: aidVerbMU :: MonadClientUI m => MsgClass -> ActorId -> Part -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: aidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ActorId -> Part -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: createActorUI :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> Actor -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: destroyActorUI :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> Actor -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: discover :: MonadClientUI m => Container -> ItemId -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: discover :: (MonadClient m, MonadClientUI m) => Container -> ItemId -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: displaceActorUI :: (MonadClient m, MonadClientUI m) => ActorId -> ActorId -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: displayGameOverAnalytics :: MonadClientUI m => FactionAnalytics -> GenerationAnalytics -> m KM

+ Game.LambdaHack.Client.UI.DisplayAtomicM: displayGameOverAnalytics :: (MonadClient m, MonadClientUI m) => FactionAnalytics -> GenerationAnalytics -> m KM

- Game.LambdaHack.Client.UI.DisplayAtomicM: displayGameOverLoot :: MonadClientUI m => (ItemBag, Int) -> GenerationAnalytics -> m KM

+ Game.LambdaHack.Client.UI.DisplayAtomicM: displayGameOverLoot :: (MonadClient m, MonadClientUI m) => (ItemBag, Int) -> GenerationAnalytics -> m KM

- Game.LambdaHack.Client.UI.DisplayAtomicM: displayRespSfxAtomicUI :: MonadClientUI m => SfxAtomic -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: displayRespSfxAtomicUI :: (MonadClient m, MonadClientUI m) => SfxAtomic -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: displayRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: displayRespUpdAtomicUI :: (MonadClient m, MonadClientUI m) => UpdAtomic -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: itemAidVerbMU :: MonadClientUI m => MsgClass -> ActorId -> Part -> ItemId -> Either (Maybe Int) Int -> CStore -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: itemAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: itemVerbMU :: MonadClientUI m => MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: itemVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> ItemId -> ItemQuant -> Part -> Container -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: lookAtMove :: MonadClientUI m => ActorId -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: lookAtMove :: (MonadClient m, MonadClientUI m) => ActorId -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: moveActor :: (MonadClient m, MonadClientUI m) => ActorId -> Point -> Point -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: moveItemUI :: MonadClientUI m => ItemId -> Int -> ActorId -> CStore -> CStore -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: moveItemUI :: (MonadClient m, MonadClientUI m) => ItemId -> Int -> ActorId -> CStore -> CStore -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: ppSfxMsg :: MonadClientUI m => SfxMsg -> m (Maybe (MsgClass, Text))

+ Game.LambdaHack.Client.UI.DisplayAtomicM: ppSfxMsg :: MonadClientUI m => SfxMsg -> m (Maybe (Either (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))

- Game.LambdaHack.Client.UI.DisplayAtomicM: quitFactionUI :: MonadClientUI m => FactionId -> Maybe Status -> Maybe (FactionAnalytics, GenerationAnalytics) -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: quitFactionUI :: (MonadClient m, MonadClientUI m) => FactionId -> Maybe Status -> Maybe (FactionAnalytics, GenerationAnalytics) -> m ()

- Game.LambdaHack.Client.UI.DisplayAtomicM: strike :: MonadClientUI m => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()

+ Game.LambdaHack.Client.UI.DisplayAtomicM: strike :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> ActorId -> ItemId -> m ()

- Game.LambdaHack.Client.UI.DrawM: drawArenaStatus :: COps -> Level -> Int -> AttrLine

+ Game.LambdaHack.Client.UI.DrawM: drawArenaStatus :: COps -> Level -> Int -> AttrString

- Game.LambdaHack.Client.UI.DrawM: drawFrameStatus :: MonadClientUI m => LevelId -> m AttrLine

+ Game.LambdaHack.Client.UI.DrawM: drawFrameStatus :: MonadClientUI m => LevelId -> m AttrString

- Game.LambdaHack.Client.UI.DrawM: drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrLine

+ Game.LambdaHack.Client.UI.DrawM: drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrString

- Game.LambdaHack.Client.UI.DrawM: drawLeaderStatus :: MonadClientUI m => Int -> m AttrLine

+ Game.LambdaHack.Client.UI.DrawM: drawLeaderStatus :: MonadClientUI m => Int -> m AttrString

- Game.LambdaHack.Client.UI.DrawM: drawSelected :: MonadClientUI m => LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)

+ Game.LambdaHack.Client.UI.DrawM: drawSelected :: MonadClientUI m => LevelId -> Int -> EnumSet ActorId -> m (Int, AttrString)

- Game.LambdaHack.Client.UI.DrawM: targetDescXhair :: MonadClientUI m => m (Maybe Text, Maybe (Text, Watchfulness))

+ Game.LambdaHack.Client.UI.DrawM: targetDescXhair :: MonadClientUI m => m (Maybe Text, Maybe Text, Maybe Watchfulness)

- Game.LambdaHack.Client.UI.Frame: SingleFrame :: Array AttrCharW32 -> SingleFrame

+ Game.LambdaHack.Client.UI.Frame: SingleFrame :: Array AttrCharW32 -> OverlaySpace -> OverlaySpace -> SingleFrame

- Game.LambdaHack.Client.UI.Frame: overlayFrame :: IntOverlay -> PreFrame -> PreFrame

+ Game.LambdaHack.Client.UI.Frame: overlayFrame :: Int -> OverlaySpace -> PreFrame -> PreFrame

- Game.LambdaHack.Client.UI.Frame: truncateAttrLine :: X -> AttrLine -> X -> AttrLine

+ Game.LambdaHack.Client.UI.Frame: truncateAttrLine :: Bool -> Int -> Int -> AttrLine -> AttrString

- Game.LambdaHack.Client.UI.Frame: type Frame = (FrameBase, FrameForall)

+ Game.LambdaHack.Client.UI.Frame: type Frame = ((FrameBase, FrameForall), (OverlaySpace, OverlaySpace))

- Game.LambdaHack.Client.UI.FrameM: drawOverlay :: MonadClientUI m => ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame

+ Game.LambdaHack.Client.UI.FrameM: drawOverlay :: MonadClientUI m => ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3

- Game.LambdaHack.Client.UI.FrameM: promptGetKey :: MonadClientUI m => ColorMode -> Overlay -> Bool -> [KM] -> m KM

+ Game.LambdaHack.Client.UI.FrameM: promptGetKey :: (MonadClient m, MonadClientUI m) => ColorMode -> FontOverlayMap -> Bool -> [KM] -> m KM

- Game.LambdaHack.Client.UI.FrameM: pushFrame :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.FrameM: pushFrame :: MonadClientUI m => Bool -> m ()

- Game.LambdaHack.Client.UI.FrameM: stopPlayBack :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.FrameM: stopPlayBack :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.Frontend: data FrontReq :: * -> *

+ Game.LambdaHack.Client.UI.Frontend: data FrontReq :: Type -> Type

- Game.LambdaHack.Client.UI.Frontend: defaultMaxFps :: Int

+ Game.LambdaHack.Client.UI.Frontend: defaultMaxFps :: Double

- Game.LambdaHack.Client.UI.Frontend: frontendName :: String

+ Game.LambdaHack.Client.UI.Frontend: frontendName :: ClientOptions -> String

- Game.LambdaHack.Client.UI.Frontend.Common: saveKMP :: RawFrontend -> Modifier -> Key -> Point -> IO ()

+ Game.LambdaHack.Client.UI.Frontend.Common: saveKMP :: RawFrontend -> Modifier -> Key -> PointUI -> IO ()

- Game.LambdaHack.Client.UI.Frontend.Sdl: FrontendSession :: Window -> Renderer -> Font -> IORef FontAtlas -> IORef Texture -> IORef SingleFrame -> IORef Bool -> IORef Bool -> MVar SingleFrame -> MVar () -> FrontendSession

+ Game.LambdaHack.Client.UI.Frontend.Sdl: FrontendSession :: Window -> Renderer -> Font -> Int -> Bool -> Maybe Font -> Maybe Font -> Maybe Font -> IORef FontAtlas -> IORef FontAtlas -> IORef Texture -> IORef Texture -> IORef SingleFrame -> IORef Bool -> IORef Bool -> MVar SingleFrame -> MVar () -> FrontendSession

- Game.LambdaHack.Client.UI.Frontend.Sdl: drawFrame :: ClientOptions -> FrontendSession -> SingleFrame -> IO ()

+ Game.LambdaHack.Client.UI.Frontend.Sdl: drawFrame :: ScreenContent -> ClientOptions -> FrontendSession -> SingleFrame -> IO ()

- Game.LambdaHack.Client.UI.HandleHelperM: displayItemLore :: MonadClientUI m => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int -> SingleItemSlots -> m Bool

+ Game.LambdaHack.Client.UI.HandleHelperM: displayItemLore :: (MonadClient m, MonadClientUI m) => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int -> SingleItemSlots -> m Bool

- Game.LambdaHack.Client.UI.HandleHelperM: itemOverlay :: MonadClientUI m => SingleItemSlots -> LevelId -> ItemBag -> m OKX

+ Game.LambdaHack.Client.UI.HandleHelperM: itemOverlay :: MonadClientUI m => SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX

- Game.LambdaHack.Client.UI.HandleHelperM: lookAtActors :: MonadClientUI m => Point -> LevelId -> m Text

+ Game.LambdaHack.Client.UI.HandleHelperM: lookAtActors :: MonadClientUI m => Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)

- Game.LambdaHack.Client.UI.HandleHelperM: lookAtItems :: MonadClientUI m => Bool -> Point -> ActorId -> m Text

+ Game.LambdaHack.Client.UI.HandleHelperM: lookAtItems :: MonadClientUI m => Bool -> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)

- Game.LambdaHack.Client.UI.HandleHelperM: lookAtPosition :: MonadClientUI m => LevelId -> Point -> m Text

+ Game.LambdaHack.Client.UI.HandleHelperM: lookAtPosition :: MonadClientUI m => LevelId -> Point -> m [(MsgClassShow, Text)]

- Game.LambdaHack.Client.UI.HandleHelperM: lookAtTile :: MonadClientUI m => Bool -> Point -> ActorId -> LevelId -> m Text

+ Game.LambdaHack.Client.UI.HandleHelperM: lookAtTile :: MonadClientUI m => Bool -> Point -> ActorId -> LevelId -> Maybe Person -> m (Text, Text, [(Int, Part)])

- Game.LambdaHack.Client.UI.HandleHelperM: memberCycle :: MonadClientUI m => Bool -> m MError

+ Game.LambdaHack.Client.UI.HandleHelperM: memberCycle :: (MonadClient m, MonadClientUI m) => Bool -> Direction -> m MError

- Game.LambdaHack.Client.UI.HandleHelperM: pickLeader :: MonadClientUI m => Bool -> ActorId -> m Bool

+ Game.LambdaHack.Client.UI.HandleHelperM: pickLeader :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> m Bool

- Game.LambdaHack.Client.UI.HandleHelperM: pickLeaderWithPointer :: MonadClientUI m => m MError

+ Game.LambdaHack.Client.UI.HandleHelperM: pickLeaderWithPointer :: (MonadClient m, MonadClientUI m) => m MError

- Game.LambdaHack.Client.UI.HandleHelperM: pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int)

+ Game.LambdaHack.Client.UI.HandleHelperM: pickNumber :: (MonadClient m, MonadClientUI m) => Bool -> Int -> m (Either MError Int)

- Game.LambdaHack.Client.UI.HandleHelperM: placesOverlay :: MonadClientRead m => m OKX

+ Game.LambdaHack.Client.UI.HandleHelperM: placesOverlay :: MonadClientUI m => m OKX

- Game.LambdaHack.Client.UI.HandleHelperM: skillsOverlay :: MonadClientRead m => ActorId -> m OKX

+ Game.LambdaHack.Client.UI.HandleHelperM: skillsOverlay :: MonadClientUI m => ActorId -> m OKX

- Game.LambdaHack.Client.UI.HandleHelperM: viewLoreItems :: MonadClientUI m => String -> SingleItemSlots -> ItemBag -> Text -> (Int -> SingleItemSlots -> m Bool) -> m KM

+ Game.LambdaHack.Client.UI.HandleHelperM: viewLoreItems :: (MonadClient m, MonadClientUI m) => String -> SingleItemSlots -> ItemBag -> Text -> (Int -> SingleItemSlots -> m Bool) -> Bool -> m KM

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterDirHuman :: MonadClientUI m => [TriggerTile] -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterDirHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterTileAtPos :: MonadClientUI m => [TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterTileAtPos :: (MonadClient m, MonadClientUI m) => Point -> m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterWithPointerHuman :: MonadClientUI m => [TriggerTile] -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: alterWithPointerHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: applyHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: applyHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: applyItem :: MonadClientUI m => (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: applyItem :: (MonadClient m, MonadClientUI m) => (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: automateHuman :: MonadClientUI m => m (FailOrCmd ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: automateHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: automateToggleHuman :: MonadClientUI m => m (FailOrCmd ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: automateToggleHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: byAreaHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> [(CmdArea, HumanCmd)] -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: byAreaHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> [(CmdArea, HumanCmd)] -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: chooseItemMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> ItemDialogMode -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: chooseItemMenuHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> ItemDialogMode -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: dashboardHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: dashboardHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameDropHuman :: MonadClientUI m => m ReqUI

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameDropHuman :: (MonadClient m, MonadClientUI m) => m ReqUI

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameExitHuman :: MonadClientUI m => m ReqUI

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameExitHuman :: Monad m => m ReqUI

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameQuitHuman :: MonadClientUI m => m (FailOrCmd ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameQuitHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameRestartHuman :: MonadClientUI m => m (FailOrCmd ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameRestartHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameSaveHuman :: MonadClientUI m => m ReqUI

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameSaveHuman :: (MonadClient m, MonadClientUI m) => m ReqUI

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameScenarioIncr :: MonadClient m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: gameScenarioIncr :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: generateMenu :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> [(KM, (Text, HumanCmd))] -> [String] -> String -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: generateMenu :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> [(DisplayFont, [AttrLine])] -> [(KM, (Text, HumanCmd))] -> [String] -> String -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: helpHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: helpHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: hintHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: hintHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: itemMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: itemMenuHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: mainMenuAutoOffHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: mainMenuAutoOffHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: mainMenuAutoOnHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: mainMenuAutoOnHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: mainMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: mainMenuHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveItemHuman :: forall m. MonadClientUI m => [CStore] -> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveItemHuman :: forall m. (MonadClient m, MonadClientUI m) => [CStore] -> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveItems :: forall m. MonadClientUI m => [CStore] -> (CStore, [(ItemId, ItemFullKit)]) -> CStore -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveItems :: forall m. (MonadClient m, MonadClientUI m) => [CStore] -> (CStore, [(ItemId, ItemQuant)]) -> CStore -> m RequestTimed

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveOrSelectItem :: forall m. MonadClientUI m => [CStore] -> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveOrSelectItem :: forall m. (MonadClient m, MonadClientUI m) => [CStore] -> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveSearchAlter :: MonadClientUI m => Bool -> Vector -> m (FailOrCmd RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: moveSearchAlter :: (MonadClient m, MonadClientUI m) => Bool -> Vector -> m (FailOrCmd RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: runOnceAheadHuman :: MonadClientUI m => m (Either MError RequestTimed)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: runOnceAheadHuman :: (MonadClient m, MonadClientUI m) => m (Either MError RequestTimed)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: selectItemsToMove :: forall m. MonadClientUI m => [CStore] -> CStore -> Maybe Part -> Bool -> m (FailOrCmd (CStore, [(ItemId, ItemFullKit)]))

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: selectItemsToMove :: forall m. (MonadClient m, MonadClientUI m) => [CStore] -> CStore -> Maybe Text -> Bool -> m (FailOrCmd (CStore, [(ItemId, ItemQuant)]))

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: settingsMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: settingsMenuHuman :: (MonadClient m, MonadClientUI m) => (KM -> HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: verifyAlters :: MonadClientUI m => LevelId -> Point -> m (FailOrCmd ())

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: verifyAlters :: forall m. (MonadClient m, MonadClientUI m) => Bool -> ActorId -> Point -> m (FailOrCmd ())

- Game.LambdaHack.Client.UI.HandleHumanGlobalM: verifyEscape :: MonadClientUI m => m (FailOrCmd ())

+ Game.LambdaHack.Client.UI.HandleHumanGlobalM: verifyEscape :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ())

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimAscendHuman :: MonadClientUI m => Int -> m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimAscendHuman :: (MonadClient m, MonadClientUI m) => Int -> m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimEnemyHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimEnemyHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimFloorHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimFloorHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimItemHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimItemHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimPointerEnemyHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimPointerEnemyHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimPointerFloorHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimPointerFloorHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: aimTgtHuman :: MonadClientUI m => m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: aimTgtHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: allHistoryHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: allHistoryHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemApplyHuman :: forall m. MonadClientUI m => [TriggerItem] -> m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemApplyHuman :: forall m. (MonadClient m, MonadClientUI m) => [TriggerItem] -> m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemDialogMode :: MonadClientUI m => ItemDialogMode -> m (FailOrCmd ItemDialogMode)

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemDialogMode :: (MonadClient m, MonadClientUI m) => Bool -> ItemDialogMode -> m (FailOrCmd ItemDialogMode)

- Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemHuman :: MonadClientUI m => ItemDialogMode -> m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: chooseItemHuman :: (MonadClient m, MonadClientUI m) => ItemDialogMode -> m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: doLook :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: doLook :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: eitherHistory :: forall m. MonadClientUI m => Bool -> m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: eitherHistory :: forall m. (MonadClient m, MonadClientUI m) => Bool -> m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: endAimingMsg :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: endAimingMsg :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: epsIncrHuman :: (MonadClient m, MonadClientUI m) => Bool -> m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: epsIncrHuman :: (MonadClient m, MonadClientUI m) => Direction -> m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: lastHistoryHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: lastHistoryHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: macroHuman :: MonadClientUI m => [String] -> m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: macroHuman :: (MonadClient m, MonadClientUI m) => [String] -> m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: memberCycleHuman :: MonadClientUI m => m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: memberCycleHuman :: (MonadClient m, MonadClientUI m) => Direction -> m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: moveXhairHuman :: (MonadClient m, MonadClientUI m) => Vector -> Int -> m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: permittedApplyClient :: MonadClientUI m => m (ItemFull -> ItemQuant -> Either ReqFailure Bool)

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: permittedApplyClient :: MonadClientUI m => m (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)

- Game.LambdaHack.Client.UI.HandleHumanLocalM: pickLeaderHuman :: MonadClientUI m => Int -> m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: pickLeaderHuman :: (MonadClient m, MonadClientUI m) => Int -> m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: pickLeaderWithPointerHuman :: MonadClientUI m => m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: pickLeaderWithPointerHuman :: (MonadClient m, MonadClientUI m) => m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: printScreenHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: printScreenHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: recordHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: recordHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: selectActorHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: selectActorHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: selectAid :: MonadClientUI m => ActorId -> m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: selectAid :: (MonadClient m, MonadClientUI m) => ActorId -> m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: selectNoneHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: selectNoneHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: selectWithPointerHuman :: MonadClientUI m => m MError

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: selectWithPointerHuman :: (MonadClient m, MonadClientUI m) => m MError

- Game.LambdaHack.Client.UI.HandleHumanLocalM: xhairPointerEnemyHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: xhairPointerEnemyHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HandleHumanLocalM: xhairPointerFloorHuman :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.HandleHumanLocalM: xhairPointerFloorHuman :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.HumanCmd: AlterDir :: [TriggerTile] -> HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: AlterDir :: HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: AlterWithPointer :: [TriggerTile] -> HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: AlterWithPointer :: HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: EpsIncr :: Bool -> HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: EpsIncr :: Direction -> HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: MemberCycle :: HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: MemberCycle :: Direction -> HumanCmd

- Game.LambdaHack.Client.UI.HumanCmd: MoveItem :: [CStore] -> CStore -> Maybe Part -> Bool -> HumanCmd

+ Game.LambdaHack.Client.UI.HumanCmd: MoveItem :: [CStore] -> CStore -> Maybe Text -> Bool -> HumanCmd

- Game.LambdaHack.Client.UI.InventoryM: SuitsSomething :: (ItemFull -> ItemQuant -> Bool) -> Suitability

+ Game.LambdaHack.Client.UI.InventoryM: SuitsSomething :: (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability

- Game.LambdaHack.Client.UI.InventoryM: getFull :: MonadClientUI m => m Suitability -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> [CStore] -> [CStore] -> Bool -> Bool -> m (Either Text ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))

+ Game.LambdaHack.Client.UI.InventoryM: getFull :: (MonadClient m, MonadClientUI m) => m Suitability -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> [CStore] -> Bool -> Bool -> m (Either Text (CStore, [(ItemId, ItemQuant)]))

- Game.LambdaHack.Client.UI.InventoryM: getGroupItem :: MonadClientUI m => m Suitability -> Text -> Text -> [CStore] -> [CStore] -> m (Either Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))

+ Game.LambdaHack.Client.UI.InventoryM: getGroupItem :: (MonadClient m, MonadClientUI m) => m Suitability -> Text -> Text -> Text -> Text -> [CStore] -> m (Either Text (CStore, ItemId))

- Game.LambdaHack.Client.UI.InventoryM: getStoreItem :: MonadClientUI m => (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text) -> ItemDialogMode -> m (Either Text (ItemId, ItemBag, SingleItemSlots), (ItemDialogMode, Either KM SlotChar))

+ Game.LambdaHack.Client.UI.InventoryM: getStoreItem :: (MonadClient m, MonadClientUI m) => ItemDialogMode -> m (Either Text ResultItemDialogMode)

- Game.LambdaHack.Client.UI.ItemDescription: itemDesc :: Bool -> FactionId -> FactionDict -> Int -> CStore -> Time -> LevelId -> ItemFull -> ItemQuant -> AttrLine

+ Game.LambdaHack.Client.UI.ItemDescription: itemDesc :: Int -> Bool -> FactionId -> FactionDict -> Int -> CStore -> Time -> LevelId -> ItemFull -> ItemQuant -> AttrString

- Game.LambdaHack.Client.UI.ItemDescription: partItem :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

+ Game.LambdaHack.Client.UI.ItemDescription: partItem :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

- Game.LambdaHack.Client.UI.ItemDescription: partItemHigh :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

+ Game.LambdaHack.Client.UI.ItemDescription: partItemHigh :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> ([Text], Part, Part)

- Game.LambdaHack.Client.UI.ItemDescription: partItemMediumAW :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemMediumAW :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> Part

- Game.LambdaHack.Client.UI.ItemDescription: partItemN :: FactionId -> FactionDict -> Bool -> DetailLevel -> Int -> Time -> ItemFull -> ItemQuant -> (Part, Part)

+ Game.LambdaHack.Client.UI.ItemDescription: partItemN :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel -> Int -> Time -> ItemFull -> ItemQuant -> (Part, Part)

- Game.LambdaHack.Client.UI.ItemDescription: partItemShort :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

+ Game.LambdaHack.Client.UI.ItemDescription: partItemShort :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

- Game.LambdaHack.Client.UI.ItemDescription: partItemShortAW :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemShortAW :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> Part

- Game.LambdaHack.Client.UI.ItemDescription: partItemShortWownW :: FactionId -> FactionDict -> Part -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemShortWownW :: Int -> FactionId -> FactionDict -> Part -> Time -> ItemFull -> ItemQuant -> Part

- Game.LambdaHack.Client.UI.ItemDescription: partItemShortest :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

+ Game.LambdaHack.Client.UI.ItemDescription: partItemShortest :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)

- Game.LambdaHack.Client.UI.ItemDescription: partItemWs :: FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemWs :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

- Game.LambdaHack.Client.UI.ItemDescription: partItemWsRanged :: FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> Part

+ Game.LambdaHack.Client.UI.ItemDescription: partItemWsRanged :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel -> Int -> Int -> Time -> ItemFull -> ItemQuant -> Part

- Game.LambdaHack.Client.UI.ItemDescription: textAllPowers :: DetailLevel -> Bool -> ItemFull -> ([Text], [Text])

+ Game.LambdaHack.Client.UI.ItemDescription: textAllPowers :: Int -> DetailLevel -> Bool -> ItemFull -> ([Text], [Text], [Text])

- Game.LambdaHack.Client.UI.Key: KMP :: KM -> Point -> KMP

+ Game.LambdaHack.Client.UI.Key: KMP :: KM -> PointUI -> KMP

- Game.LambdaHack.Client.UI.Key: [kmpPointer] :: KMP -> Point

+ Game.LambdaHack.Client.UI.Key: [kmpPointer] :: KMP -> PointUI

- Game.LambdaHack.Client.UI.Key: handleDir :: Bool -> Bool -> KM -> Maybe Vector

+ Game.LambdaHack.Client.UI.Key: handleDir :: [Key] -> KM -> Maybe Vector

- Game.LambdaHack.Client.UI.KeyBindings: keyHelp :: COps -> CCUI -> Int -> [(Text, OKX)]

+ Game.LambdaHack.Client.UI.KeyBindings: keyHelp :: CCUI -> FontSetup -> [(Text, OKX)]

- Game.LambdaHack.Client.UI.KeyBindings: okxsN :: InputContent -> Int -> Int -> (HumanCmd -> Bool) -> Bool -> CmdCategory -> [Text] -> [Text] -> OKX

+ Game.LambdaHack.Client.UI.KeyBindings: okxsN :: InputContent -> DisplayFont -> DisplayFont -> Int -> Int -> (HumanCmd -> Bool) -> Bool -> CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX

- Game.LambdaHack.Client.UI.MonadClientUI: connFrontendFrontKey :: MonadClientUI m => [KM] -> PreFrame -> m KM

+ Game.LambdaHack.Client.UI.MonadClientUI: connFrontendFrontKey :: MonadClientUI m => [KM] -> PreFrame3 -> m KM

- Game.LambdaHack.Client.UI.MonadClientUI: defaultHistory :: MonadClientUI m => m History

+ Game.LambdaHack.Client.UI.MonadClientUI: defaultHistory :: (MonadClient m, MonadClientUI m) => m History

- Game.LambdaHack.Client.UI.MonadClientUI: displayFrames :: MonadClientUI m => LevelId -> PreFrames -> m ()

+ Game.LambdaHack.Client.UI.MonadClientUI: displayFrames :: MonadClientUI m => LevelId -> PreFrames3 -> m ()

- Game.LambdaHack.Client.UI.MonadClientUI: getReportUI :: MonadClientUI m => m Report

+ Game.LambdaHack.Client.UI.MonadClientUI: getReportUI :: MonadClientUI m => Bool -> m Report

- Game.LambdaHack.Client.UI.MonadClientUI: revCmdMap :: MonadClientUI m => m (KM -> HumanCmd -> KM)

+ Game.LambdaHack.Client.UI.MonadClientUI: revCmdMap :: MonadClientUI m => m (HumanCmd -> KM)

- Game.LambdaHack.Client.UI.Msg: MsgActionMinor :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgActionMinor :: MsgClassShowAndSave

- Game.LambdaHack.Client.UI.Msg: MsgAtFeetMajor :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgAtFeetMajor :: MsgClassShowAndSave

- Game.LambdaHack.Client.UI.Msg: MsgEffectMajor :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgEffectMajor :: MsgClassShowAndSave

- Game.LambdaHack.Client.UI.Msg: MsgEffectMinor :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgEffectMinor :: MsgClassShowAndSave

- Game.LambdaHack.Client.UI.Msg: MsgItemCreation :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgItemCreation :: MsgClassShowAndSave

- Game.LambdaHack.Client.UI.Msg: MsgPromptFocus :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgPromptFocus :: MsgClassShow

- Game.LambdaHack.Client.UI.Msg: MsgStopPlayback :: MsgClass

+ Game.LambdaHack.Client.UI.Msg: MsgStopPlayback :: MsgClassIgnore

- Game.LambdaHack.Client.UI.Msg: addToReport :: History -> Msg -> Int -> Time -> (History, Bool)

+ Game.LambdaHack.Client.UI.Msg: addToReport :: Set Msg -> Bool -> Bool -> History -> Msg -> Time -> (Set Msg, History, Bool)

- Game.LambdaHack.Client.UI.Msg: archiveReport :: History -> History

+ Game.LambdaHack.Client.UI.Msg: archiveReport :: Bool -> History -> History

- Game.LambdaHack.Client.UI.Msg: lengthHistory :: History -> Int

+ Game.LambdaHack.Client.UI.Msg: lengthHistory :: Bool -> History -> Int

- Game.LambdaHack.Client.UI.Msg: renderHistory :: History -> [AttrLine]

+ Game.LambdaHack.Client.UI.Msg: renderHistory :: Bool -> History -> [AttrString]

- Game.LambdaHack.Client.UI.Msg: renderRepetition :: RepMsgN -> AttrLine

+ Game.LambdaHack.Client.UI.Msg: renderRepetition :: (AttrString, Int) -> AttrString

- Game.LambdaHack.Client.UI.Msg: renderReport :: Report -> AttrLine

+ Game.LambdaHack.Client.UI.Msg: renderReport :: Bool -> Report -> [AttrString]

- Game.LambdaHack.Client.UI.Msg: renderTimeReport :: Time -> Report -> [AttrLine]

+ Game.LambdaHack.Client.UI.Msg: renderTimeReport :: Bool -> Time -> Report -> [AttrString]

- Game.LambdaHack.Client.UI.Msg: renderWholeReport :: Report -> AttrLine

+ Game.LambdaHack.Client.UI.Msg: renderWholeReport :: [(AttrString, Int)] -> [AttrString] -> [AttrString]

- Game.LambdaHack.Client.UI.Msg: toMsg :: Maybe (EnumMap MsgClass Color) -> MsgClass -> Text -> Msg

+ Game.LambdaHack.Client.UI.Msg: toMsg :: [(String, Color)] -> MsgPrototype -> Msg

- Game.LambdaHack.Client.UI.MsgM: msgAdd :: MonadClientUI m => MsgClass -> Text -> m ()

+ Game.LambdaHack.Client.UI.MsgM: msgAdd :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> Text -> m ()

- Game.LambdaHack.Client.UI.MsgM: msgAddDuplicate :: MonadClientUI m => Text -> MsgClass -> Int -> m Bool

+ Game.LambdaHack.Client.UI.MsgM: msgAddDuplicate :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> Text -> m Bool

- Game.LambdaHack.Client.UI.MsgM: promptMainKeys :: MonadClientUI m => m ()

+ Game.LambdaHack.Client.UI.MsgM: promptMainKeys :: (MonadClient m, MonadClientUI m) => m ()

- Game.LambdaHack.Client.UI.Overlay: (<+:>) :: AttrLine -> AttrLine -> AttrLine

+ Game.LambdaHack.Client.UI.Overlay: (<+:>) :: AttrString -> AttrString -> AttrString

- Game.LambdaHack.Client.UI.Overlay: emptyAttrLine :: Int -> AttrLine

+ Game.LambdaHack.Client.UI.Overlay: emptyAttrLine :: AttrLine

- Game.LambdaHack.Client.UI.Overlay: infixr 6 <+:>

+ Game.LambdaHack.Client.UI.Overlay: infixr 6 <\:>

- Game.LambdaHack.Client.UI.Overlay: linesAttr :: AttrLine -> Overlay

+ Game.LambdaHack.Client.UI.Overlay: linesAttr :: AttrString -> [AttrLine]

- Game.LambdaHack.Client.UI.Overlay: splitAttrPhrase :: X -> AttrLine -> Overlay

+ Game.LambdaHack.Client.UI.Overlay: splitAttrPhrase :: Int -> Int -> AttrLine -> [AttrLine]

- Game.LambdaHack.Client.UI.Overlay: type Overlay = [AttrLine]

+ Game.LambdaHack.Client.UI.Overlay: type Overlay = [(PointUI, AttrLine)]

- Game.LambdaHack.Client.UI.SessionUI: AimMode :: LevelId -> AimMode

+ Game.LambdaHack.Client.UI.SessionUI: AimMode :: LevelId -> DetailLevel -> AimMode

- Game.LambdaHack.Client.UI.SessionUI: SessionUI :: Maybe Target -> ActorDictUI -> ItemDictUI -> ItemSlots -> Maybe (CStore, CStore) -> ChanFrontend -> CCUI -> UIOptions -> Maybe AimMode -> Bool -> Maybe (ItemId, CStore, Bool) -> EnumSet ActorId -> Maybe RunParams -> History -> Point -> LastRecord -> [KM] -> EnumSet ActorId -> Int -> Bool -> Bool -> Bool -> Map String Int -> Bool -> HintMode -> Bool -> POSIXTime -> POSIXTime -> Time -> Int -> Int -> SessionUI

+ Game.LambdaHack.Client.UI.SessionUI: SessionUI :: Maybe Target -> Maybe Target -> ActorDictUI -> ItemDictUI -> ItemSlots -> Maybe (CStore, CStore) -> ChanFrontend -> CCUI -> UIOptions -> Maybe AimMode -> Bool -> Maybe (ItemId, CStore, Bool) -> EnumSet ActorId -> Maybe RunParams -> History -> PointUI -> KeyMacroFrame -> [KeyMacroFrame] -> EnumSet ActorId -> Int -> Bool -> Bool -> Bool -> Int -> Bool -> Bool -> Maybe Bool -> Set Msg -> Map String Int -> ChosenLore -> Bool -> Bool -> Bool -> POSIXTime -> POSIXTime -> Time -> Int -> Int -> SMGen -> SessionUI

- Game.LambdaHack.Client.UI.SessionUI: [spointer] :: SessionUI -> Point

+ Game.LambdaHack.Client.UI.SessionUI: [spointer] :: SessionUI -> PointUI

- Game.LambdaHack.Client.UI.Slideshow: highSlideshow :: X -> Y -> ScoreTable -> Int -> Text -> TimeZone -> Slideshow

+ Game.LambdaHack.Client.UI.Slideshow: highSlideshow :: FontSetup -> Int -> Int -> ScoreTable -> Int -> Text -> TimeZone -> Slideshow

- Game.LambdaHack.Client.UI.Slideshow: keysOKX :: Y -> X -> X -> [KM] -> OKX

+ Game.LambdaHack.Client.UI.Slideshow: keysOKX :: DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])

- Game.LambdaHack.Client.UI.Slideshow: splitOKX :: X -> Y -> AttrLine -> [KM] -> OKX -> [OKX]

+ Game.LambdaHack.Client.UI.Slideshow: splitOKX :: FontSetup -> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]

- Game.LambdaHack.Client.UI.Slideshow: splitOverlay :: X -> Y -> Report -> [KM] -> OKX -> Slideshow

+ Game.LambdaHack.Client.UI.Slideshow: splitOverlay :: FontSetup -> Bool -> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow

- Game.LambdaHack.Client.UI.Slideshow: toSlideshow :: [OKX] -> Slideshow

+ Game.LambdaHack.Client.UI.Slideshow: toSlideshow :: FontSetup -> [OKX] -> Slideshow

- Game.LambdaHack.Client.UI.Slideshow: type KYX = (Either [KM] SlotChar, (Y, X, X))

+ Game.LambdaHack.Client.UI.Slideshow: type KYX = (Either [KM] SlotChar, (PointUI, ButtonWidth))

- Game.LambdaHack.Client.UI.Slideshow: type OKX = (Overlay, [KYX])

+ Game.LambdaHack.Client.UI.Slideshow: type OKX = (FontOverlayMap, [KYX])

- Game.LambdaHack.Client.UI.Slideshow: wrapOKX :: Y -> X -> X -> [(KM, String)] -> OKX

+ Game.LambdaHack.Client.UI.Slideshow: wrapOKX :: DisplayFont -> Int -> Int -> Int -> [(KM, String)] -> (Overlay, [KYX])

- Game.LambdaHack.Client.UI.SlideshowM: displayChoiceScreen :: forall m. MonadClientUI m => String -> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)

+ Game.LambdaHack.Client.UI.SlideshowM: displayChoiceScreen :: forall m. (MonadClient m, MonadClientUI m) => String -> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)

- Game.LambdaHack.Client.UI.SlideshowM: displayMore :: MonadClientUI m => ColorMode -> Text -> m ()

+ Game.LambdaHack.Client.UI.SlideshowM: displayMore :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m ()

- Game.LambdaHack.Client.UI.SlideshowM: displayMoreKeep :: MonadClientUI m => ColorMode -> Text -> m ()

+ Game.LambdaHack.Client.UI.SlideshowM: displayMoreKeep :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m ()

- Game.LambdaHack.Client.UI.SlideshowM: displaySpaceEsc :: MonadClientUI m => ColorMode -> Text -> m Bool

+ Game.LambdaHack.Client.UI.SlideshowM: displaySpaceEsc :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m Bool

- Game.LambdaHack.Client.UI.SlideshowM: displayYesNo :: MonadClientUI m => ColorMode -> Text -> m Bool

+ Game.LambdaHack.Client.UI.SlideshowM: displayYesNo :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m Bool

- Game.LambdaHack.Client.UI.SlideshowM: getConfirms :: MonadClientUI m => ColorMode -> [KM] -> Slideshow -> m KM

+ Game.LambdaHack.Client.UI.SlideshowM: getConfirms :: (MonadClient m, MonadClientUI m) => ColorMode -> [KM] -> Slideshow -> m KM

- Game.LambdaHack.Client.UI.SlideshowM: overlayToSlideshow :: MonadClientUI m => Y -> [KM] -> OKX -> m Slideshow

+ Game.LambdaHack.Client.UI.SlideshowM: overlayToSlideshow :: MonadClientUI m => Int -> [KM] -> OKX -> m Slideshow

- Game.LambdaHack.Client.UI.UIOptions: UIOptions :: [(KM, CmdTriple)] -> [(Int, (Text, Text))] -> Bool -> Bool -> Text -> Text -> Int -> Int -> Int -> Int -> Int -> Bool -> Int -> Maybe [(MsgClass, Color)] -> [String] -> UIOptions

+ Game.LambdaHack.Client.UI.UIOptions: UIOptions :: [(KM, CmdTriple)] -> [(Int, (Text, Text))] -> Bool -> Bool -> Text -> Double -> Bool -> Bool -> Int -> Double -> Bool -> Int -> [(String, Color)] -> [String] -> [(Text, FontDefinition)] -> [(Text, FontSet)] -> FullscreenMode -> UIOptions

- Game.LambdaHack.Client.UI.UIOptions: [uMaxFps] :: UIOptions -> Int

+ Game.LambdaHack.Client.UI.UIOptions: [uMaxFps] :: UIOptions -> Double

- Game.LambdaHack.Client.UI.UIOptions: [uMessageColors] :: UIOptions -> Maybe [(MsgClass, Color)]

+ Game.LambdaHack.Client.UI.UIOptions: [uMessageColors] :: UIOptions -> [(String, Color)]

- Game.LambdaHack.Client.UI.UIOptionsParse: mkUIOptions :: COps -> Bool -> IO UIOptions

+ Game.LambdaHack.Client.UI.UIOptionsParse: mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions

- Game.LambdaHack.Common.Actor: Actor :: ItemId -> Int64 -> ResDelta -> Int64 -> ResDelta -> Point -> Maybe Point -> LevelId -> FactionId -> Maybe ([Vector], Speed) -> ItemBag -> ItemBag -> ItemBag -> Int -> Watchfulness -> Bool -> Actor

+ Game.LambdaHack.Common.Actor: Actor :: ItemId -> Maybe Int -> Int64 -> ResDelta -> Int64 -> ResDelta -> Point -> Maybe Point -> LevelId -> FactionId -> Maybe ([Vector], Speed) -> ItemBag -> ItemBag -> Int -> Int -> Watchfulness -> Bool -> Actor

- Game.LambdaHack.Common.Actor: actorTemplate :: ItemId -> Int64 -> Int64 -> Point -> LevelId -> FactionId -> Bool -> Actor

+ Game.LambdaHack.Common.Actor: actorTemplate :: ItemId -> Maybe Int -> Int64 -> Int64 -> Point -> LevelId -> FactionId -> Bool -> Actor

- Game.LambdaHack.Common.ActorState: getActorAssocs :: ActorId -> CStore -> State -> [(ItemId, Item)]

+ Game.LambdaHack.Common.ActorState: getActorAssocs :: ActorId -> CStore -> State -> [(ItemId, (Item, ItemQuant))]

- Game.LambdaHack.Common.ActorState: inMelee :: FactionId -> LevelId -> State -> Bool

+ Game.LambdaHack.Common.ActorState: inMelee :: ActorMaxSkills -> FactionId -> LevelId -> State -> Bool

- Game.LambdaHack.Common.ActorState: mapActorItems_ :: Monad m => (CStore -> ItemId -> ItemQuant -> m a) -> Actor -> State -> m ()

+ Game.LambdaHack.Common.ActorState: mapActorItems_ :: Monad m => (CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State -> m ()

- Game.LambdaHack.Common.Faction: Challenge :: Int -> Bool -> Bool -> Challenge

+ Game.LambdaHack.Common.Faction: Challenge :: Int -> Bool -> Bool -> Bool -> Bool -> Challenge

- Game.LambdaHack.Common.Faction: Faction :: Text -> Color -> Player -> [(Int, Int, GroupName ItemKind)] -> Dipl -> Maybe Status -> Maybe ActorId -> ItemBag -> EnumMap (ContentId ItemKind) Int -> EnumMap (ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int)) -> Faction

+ Game.LambdaHack.Common.Faction: Faction :: Text -> Color -> Player -> Maybe TeamContinuity -> [(Int, Int, GroupName ItemKind)] -> Dipl -> Maybe Status -> Maybe ActorId -> Maybe (LevelId, Point) -> EnumMap (ContentId ItemKind) Int -> EnumMap (ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int)) -> Faction

- Game.LambdaHack.Common.Item: hasCharge :: Time -> ItemFull -> ItemQuant -> Bool

+ Game.LambdaHack.Common.Item: hasCharge :: Time -> ItemQuant -> Bool

- Game.LambdaHack.Common.Item: ncharges :: Time -> ItemFull -> ItemQuant -> Int

+ Game.LambdaHack.Common.Item: ncharges :: Time -> ItemQuant -> Int

- Game.LambdaHack.Common.Item: strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time -> [(ItemId, ItemFullKit)] -> [(Double, (Int, (ItemId, ItemFullKit)))]

+ Game.LambdaHack.Common.Item: strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time -> [(ItemId, ItemFullKit)] -> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]

- Game.LambdaHack.Common.Item: type ItemQuant = (Int, ItemTimer)

+ Game.LambdaHack.Common.Item: type ItemQuant = (Int, ItemTimers)

- Game.LambdaHack.Common.Kind: TileSpeedup :: Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Word8 -> Tab Word8 -> TileSpeedup

+ Game.LambdaHack.Common.Kind: TileSpeedup :: Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Bool -> Tab Word8 -> Tab Word8 -> TileSpeedup

- Game.LambdaHack.Common.Level: sortEmbeds :: COps -> (ItemId -> ItemKind) -> ContentId TileKind -> ItemBag -> [(ItemId, ItemQuant)]

+ Game.LambdaHack.Common.Level: sortEmbeds :: COps -> ContentId TileKind -> [(ItemKind, (ItemId, ItemQuant))] -> [(ItemId, ItemQuant)]

- Game.LambdaHack.Common.MonadStateRead: pickWeaponM :: MonadStateRead m => Bool -> Maybe DiscoveryBenefit -> [(ItemId, ItemFullKit)] -> Skills -> ActorId -> m [(Double, (Int, (ItemId, ItemFullKit)))]

+ Game.LambdaHack.Common.MonadStateRead: pickWeaponM :: MonadStateRead m => Bool -> Maybe DiscoveryBenefit -> [(ItemId, ItemFullKit)] -> Skills -> ActorId -> m [(Double, Bool, Int, Int, ItemId, ItemFullKit)]

- Game.LambdaHack.Common.ReqFailure: permittedApply :: Time -> Int -> Bool -> ItemFull -> ItemQuant -> Either ReqFailure Bool

+ Game.LambdaHack.Common.ReqFailure: permittedApply :: Time -> Int -> Bool -> Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool

- Game.LambdaHack.Common.Save: restoreGame :: Binary a => COps -> FilePath -> IO (Maybe a)

+ Game.LambdaHack.Common.Save: restoreGame :: Binary a => RuleContent -> ClientOptions -> FilePath -> IO (Maybe a)

- Game.LambdaHack.Common.Save: saveNameCli :: COps -> FactionId -> String

+ Game.LambdaHack.Common.Save: saveNameCli :: RuleContent -> FactionId -> String

- Game.LambdaHack.Common.Save: saveNameSer :: COps -> String

+ Game.LambdaHack.Common.Save: saveNameSer :: RuleContent -> String

- Game.LambdaHack.Common.Tile: isClosable :: ContentData TileKind -> ContentId TileKind -> Bool

+ Game.LambdaHack.Common.Tile: isClosable :: TileSpeedup -> ContentId TileKind -> Bool

- Game.LambdaHack.Common.Tile: isOpenable :: ContentData TileKind -> ContentId TileKind -> Bool

+ Game.LambdaHack.Common.Tile: isOpenable :: TileSpeedup -> ContentId TileKind -> Bool

- Game.LambdaHack.Content.CaveKind: CaveKind :: Char -> Text -> Freqs CaveKind -> X -> Y -> DiceXY -> DiceXY -> DiceXY -> Dice -> Dice -> Rational -> Rational -> Int -> Dice -> Chance -> Chance -> Int -> Int -> Freqs ItemKind -> Dice -> Freqs ItemKind -> Freqs PlaceKind -> Bool -> Bool -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> Bool -> GroupName TileKind -> GroupName TileKind -> Freqs PlaceKind -> Freqs PlaceKind -> Freqs PlaceKind -> Text -> CaveKind

+ Game.LambdaHack.Content.CaveKind: CaveKind :: Char -> Text -> Freqs CaveKind -> X -> Y -> DiceXY -> DiceXY -> DiceXY -> Dice -> Dice -> Rational -> Rational -> Chance -> Chance -> Int -> Int -> Freqs ItemKind -> Dice -> Freqs ItemKind -> Freqs PlaceKind -> Bool -> Bool -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> Bool -> GroupName TileKind -> GroupName TileKind -> Int -> Dice -> Freqs PlaceKind -> Freqs PlaceKind -> Freqs PlaceKind -> [Int] -> Text -> CaveKind

- Game.LambdaHack.Content.CaveKind: makeData :: ContentData ItemKind -> ContentData PlaceKind -> ContentData TileKind -> [CaveKind] -> ContentData CaveKind

+ Game.LambdaHack.Content.CaveKind: makeData :: [CaveKind] -> [GroupName CaveKind] -> [GroupName CaveKind] -> ContentData CaveKind

- Game.LambdaHack.Content.CaveKind: validateAll :: ContentData ItemKind -> ContentData PlaceKind -> ContentData TileKind -> [CaveKind] -> ContentData CaveKind -> [Text]

+ Game.LambdaHack.Content.CaveKind: validateAll :: [CaveKind] -> ContentData CaveKind -> [Text]

- Game.LambdaHack.Content.ItemKind: CreateItem :: CStore -> GroupName ItemKind -> TimerDice -> Effect

+ Game.LambdaHack.Content.ItemKind: CreateItem :: Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect

- Game.LambdaHack.Content.ItemKind: VerbMsg :: Text -> Effect

+ Game.LambdaHack.Content.ItemKind: VerbMsg :: Text -> Text -> Effect

- Game.LambdaHack.Content.ItemKind: VerbNoLonger :: Text -> Effect

+ Game.LambdaHack.Content.ItemKind: VerbNoLonger :: Text -> Text -> Effect

- Game.LambdaHack.Content.ItemKind: boostItemKindList :: StdGen -> [ItemKind] -> [ItemKind]

+ Game.LambdaHack.Content.ItemKind: boostItemKindList :: SMGen -> [ItemKind] -> [ItemKind]

- Game.LambdaHack.Content.ItemKind: makeData :: [ItemKind] -> ContentData ItemKind

+ Game.LambdaHack.Content.ItemKind: makeData :: [ItemKind] -> [GroupName ItemKind] -> [GroupName ItemKind] -> ContentData ItemKind

- Game.LambdaHack.Content.ModeKind: ModeKind :: Char -> Text -> Freqs ModeKind -> Roster -> Caves -> [(Outcome, Text)] -> Text -> ModeKind

+ Game.LambdaHack.Content.ModeKind: ModeKind :: Char -> Text -> Freqs ModeKind -> Bool -> Roster -> Caves -> [(Outcome, Text)] -> Text -> Text -> Text -> Text -> ModeKind

- Game.LambdaHack.Content.ModeKind: Player :: Text -> [GroupName ItemKind] -> Skills -> Bool -> Bool -> HiCondPoly -> Bool -> Tactic -> LeaderMode -> Bool -> Player

+ Game.LambdaHack.Content.ModeKind: Player :: Text -> [GroupName ItemKind] -> Skills -> Bool -> Bool -> HiCondPoly -> Bool -> Doctrine -> LeaderMode -> Bool -> Player

- Game.LambdaHack.Content.ModeKind: Roster :: [(Player, [(Int, Dice, GroupName ItemKind)])] -> [(Text, Text)] -> [(Text, Text)] -> Roster

+ Game.LambdaHack.Content.ModeKind: Roster :: [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])] -> [(Text, Text)] -> [(Text, Text)] -> Roster

- Game.LambdaHack.Content.ModeKind: [rosterList] :: Roster -> [(Player, [(Int, Dice, GroupName ItemKind)])]

+ Game.LambdaHack.Content.ModeKind: [rosterList] :: Roster -> [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]

- Game.LambdaHack.Content.ModeKind: makeData :: ContentData CaveKind -> ContentData ItemKind -> [ModeKind] -> ContentData ModeKind

+ Game.LambdaHack.Content.ModeKind: makeData :: [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind] -> ContentData ModeKind

- Game.LambdaHack.Content.ModeKind: validateAll :: ContentData CaveKind -> ContentData ItemKind -> [ModeKind] -> ContentData ModeKind -> [Text]

+ Game.LambdaHack.Content.ModeKind: validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]

- Game.LambdaHack.Content.PlaceKind: makeData :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind

+ Game.LambdaHack.Content.PlaceKind: makeData :: [PlaceKind] -> [GroupName PlaceKind] -> [GroupName PlaceKind] -> ContentData PlaceKind

- Game.LambdaHack.Content.PlaceKind: validateAll :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind -> [Text]

+ Game.LambdaHack.Content.PlaceKind: validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]

- Game.LambdaHack.Content.RuleKind: RuleContent :: Text -> X -> Y -> FilePath -> Version -> FilePath -> String -> Int -> Int -> FilePath -> Int -> [Text] -> Char -> RuleContent

+ Game.LambdaHack.Content.RuleKind: RuleContent :: String -> X -> Y -> Version -> FilePath -> (String, Config) -> Int -> Int -> FilePath -> Int -> [Text] -> Char -> RuleContent

- Game.LambdaHack.Content.RuleKind: [rcfgUIDefault] :: RuleContent -> String

+ Game.LambdaHack.Content.RuleKind: [rcfgUIDefault] :: RuleContent -> (String, Config)

- Game.LambdaHack.Content.RuleKind: [rtitle] :: RuleContent -> Text

+ Game.LambdaHack.Content.RuleKind: [rtitle] :: RuleContent -> String

- Game.LambdaHack.Content.TileKind: makeData :: ContentData ItemKind -> [TileKind] -> ContentData TileKind

+ Game.LambdaHack.Content.TileKind: makeData :: [TileKind] -> [GroupName TileKind] -> [GroupName TileKind] -> ContentData TileKind

- Game.LambdaHack.Content.TileKind: validateAll :: ContentData ItemKind -> [TileKind] -> ContentData TileKind -> [Text]

+ Game.LambdaHack.Content.TileKind: validateAll :: [TileKind] -> ContentData TileKind -> [Text]

- Game.LambdaHack.Core.Prelude: (!!) :: () => [a] -> Int -> a

+ Game.LambdaHack.Core.Prelude: (!!) :: [a] -> Int -> a

- Game.LambdaHack.Core.Prelude: ($!) :: () => (a -> b) -> a -> b

+ Game.LambdaHack.Core.Prelude: ($!) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b

- Game.LambdaHack.Core.Prelude: ($) :: () => (a -> b) -> a -> b

+ Game.LambdaHack.Core.Prelude: ($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b

- Game.LambdaHack.Core.Prelude: (++) :: () => [a] -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: (++) :: [a] -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: (.) :: () => (b -> c) -> (a -> b) -> a -> c

+ Game.LambdaHack.Core.Prelude: (.) :: (b -> c) -> (a -> b) -> a -> c

- Game.LambdaHack.Core.Prelude: asTypeOf :: () => a -> a -> a

+ Game.LambdaHack.Core.Prelude: asTypeOf :: a -> a -> a

- Game.LambdaHack.Core.Prelude: assert :: () => Bool -> a -> a

+ Game.LambdaHack.Core.Prelude: assert :: Bool -> a -> a

- Game.LambdaHack.Core.Prelude: break :: () => (a -> Bool) -> [a] -> ([a], [a])

+ Game.LambdaHack.Core.Prelude: break :: (a -> Bool) -> [a] -> ([a], [a])

- Game.LambdaHack.Core.Prelude: const :: () => a -> b -> a

+ Game.LambdaHack.Core.Prelude: const :: a -> b -> a

- Game.LambdaHack.Core.Prelude: curry :: () => ((a, b) -> c) -> a -> b -> c

+ Game.LambdaHack.Core.Prelude: curry :: ((a, b) -> c) -> a -> b -> c

- Game.LambdaHack.Core.Prelude: cycle :: () => [a] -> [a]

+ Game.LambdaHack.Core.Prelude: cycle :: [a] -> [a]

- Game.LambdaHack.Core.Prelude: deleteBy :: () => (a -> a -> Bool) -> a -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: deleteFirstsBy :: () => (a -> a -> Bool) -> [a] -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: drop :: () => Int -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: drop :: Int -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: dropWhile :: () => (a -> Bool) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: dropWhile :: (a -> Bool) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: dropWhileEnd :: () => (a -> Bool) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: dropWhileEnd :: (a -> Bool) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: either :: () => (a -> c) -> (b -> c) -> Either a b -> c

+ Game.LambdaHack.Core.Prelude: either :: (a -> c) -> (b -> c) -> Either a b -> c

- Game.LambdaHack.Core.Prelude: error :: HasCallStack => [Char] -> a

+ Game.LambdaHack.Core.Prelude: error :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => [Char] -> a

- Game.LambdaHack.Core.Prelude: errorWithoutStackTrace :: () => [Char] -> a

+ Game.LambdaHack.Core.Prelude: errorWithoutStackTrace :: forall (r :: RuntimeRep) (a :: TYPE r). [Char] -> a

- Game.LambdaHack.Core.Prelude: fail :: Monad m => String -> m a

+ Game.LambdaHack.Core.Prelude: fail :: MonadFail m => String -> m a

- Game.LambdaHack.Core.Prelude: filter :: () => (a -> Bool) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: filter :: (a -> Bool) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: findIndex :: () => (a -> Bool) -> [a] -> Maybe Int

+ Game.LambdaHack.Core.Prelude: findIndex :: (a -> Bool) -> [a] -> Maybe Int

- Game.LambdaHack.Core.Prelude: findIndices :: () => (a -> Bool) -> [a] -> [Int]

+ Game.LambdaHack.Core.Prelude: findIndices :: (a -> Bool) -> [a] -> [Int]

- Game.LambdaHack.Core.Prelude: flip :: () => (a -> b -> c) -> b -> a -> c

+ Game.LambdaHack.Core.Prelude: flip :: (a -> b -> c) -> b -> a -> c

- Game.LambdaHack.Core.Prelude: foldl1' :: () => (a -> a -> a) -> [a] -> a

+ Game.LambdaHack.Core.Prelude: foldl1' :: (a -> a -> a) -> [a] -> a

- Game.LambdaHack.Core.Prelude: fst :: () => (a, b) -> a

+ Game.LambdaHack.Core.Prelude: fst :: (a, b) -> a

- Game.LambdaHack.Core.Prelude: groupBy :: () => (a -> a -> Bool) -> [a] -> [[a]]

+ Game.LambdaHack.Core.Prelude: groupBy :: (a -> a -> Bool) -> [a] -> [[a]]

- Game.LambdaHack.Core.Prelude: head :: () => [a] -> a

+ Game.LambdaHack.Core.Prelude: head :: [a] -> a

- Game.LambdaHack.Core.Prelude: id :: () => a -> a

+ Game.LambdaHack.Core.Prelude: id :: a -> a

- Game.LambdaHack.Core.Prelude: init :: () => [a] -> [a]

+ Game.LambdaHack.Core.Prelude: init :: [a] -> [a]

- Game.LambdaHack.Core.Prelude: inits :: () => [a] -> [[a]]

+ Game.LambdaHack.Core.Prelude: inits :: [a] -> [[a]]

- Game.LambdaHack.Core.Prelude: insertBy :: () => (a -> a -> Ordering) -> a -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: intercalate :: () => [a] -> [[a]] -> [a]

+ Game.LambdaHack.Core.Prelude: intercalate :: [a] -> [[a]] -> [a]

- Game.LambdaHack.Core.Prelude: intersectBy :: () => (a -> a -> Bool) -> [a] -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: intersperse :: () => a -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: intersperse :: a -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: ioError :: () => IOError -> IO a

+ Game.LambdaHack.Core.Prelude: ioError :: IOError -> IO a

- Game.LambdaHack.Core.Prelude: iterate :: () => (a -> a) -> a -> [a]

+ Game.LambdaHack.Core.Prelude: iterate :: (a -> a) -> a -> [a]

- Game.LambdaHack.Core.Prelude: iterate' :: () => (a -> a) -> a -> [a]

+ Game.LambdaHack.Core.Prelude: iterate' :: (a -> a) -> a -> [a]

- Game.LambdaHack.Core.Prelude: last :: () => [a] -> a

+ Game.LambdaHack.Core.Prelude: last :: [a] -> a

- Game.LambdaHack.Core.Prelude: map :: () => (a -> b) -> [a] -> [b]

+ Game.LambdaHack.Core.Prelude: map :: (a -> b) -> [a] -> [b]

- Game.LambdaHack.Core.Prelude: mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()

+ Game.LambdaHack.Core.Prelude: mapM_ :: (Foldable t, Monad m) => (a -> m ()) -> t a -> m ()

- Game.LambdaHack.Core.Prelude: maybe :: () => b -> (a -> b) -> Maybe a -> b

+ Game.LambdaHack.Core.Prelude: maybe :: b -> (a -> b) -> Maybe a -> b

- Game.LambdaHack.Core.Prelude: nubBy :: () => (a -> a -> Bool) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: nubBy :: (a -> a -> Bool) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: partition :: () => (a -> Bool) -> [a] -> ([a], [a])

+ Game.LambdaHack.Core.Prelude: partition :: (a -> Bool) -> [a] -> ([a], [a])

- Game.LambdaHack.Core.Prelude: permutations :: () => [a] -> [[a]]

+ Game.LambdaHack.Core.Prelude: permutations :: [a] -> [[a]]

- Game.LambdaHack.Core.Prelude: readParen :: () => Bool -> ReadS a -> ReadS a

+ Game.LambdaHack.Core.Prelude: readParen :: Bool -> ReadS a -> ReadS a

- Game.LambdaHack.Core.Prelude: repeat :: () => a -> [a]

+ Game.LambdaHack.Core.Prelude: repeat :: a -> [a]

- Game.LambdaHack.Core.Prelude: replicate :: () => Int -> a -> [a]

+ Game.LambdaHack.Core.Prelude: replicate :: Int -> a -> [a]

- Game.LambdaHack.Core.Prelude: reverse :: () => [a] -> [a]

+ Game.LambdaHack.Core.Prelude: reverse :: [a] -> [a]

- Game.LambdaHack.Core.Prelude: scanl :: () => (b -> a -> b) -> b -> [a] -> [b]

+ Game.LambdaHack.Core.Prelude: scanl :: (b -> a -> b) -> b -> [a] -> [b]

- Game.LambdaHack.Core.Prelude: scanl' :: () => (b -> a -> b) -> b -> [a] -> [b]

+ Game.LambdaHack.Core.Prelude: scanl' :: (b -> a -> b) -> b -> [a] -> [b]

- Game.LambdaHack.Core.Prelude: scanl1 :: () => (a -> a -> a) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: scanl1 :: (a -> a -> a) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: scanr :: () => (a -> b -> b) -> b -> [a] -> [b]

+ Game.LambdaHack.Core.Prelude: scanr :: (a -> b -> b) -> b -> [a] -> [b]

- Game.LambdaHack.Core.Prelude: scanr1 :: () => (a -> a -> a) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: scanr1 :: (a -> a -> a) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: seq :: () => a -> b -> b

+ Game.LambdaHack.Core.Prelude: seq :: a -> b -> b

- Game.LambdaHack.Core.Prelude: snd :: () => (a, b) -> b

+ Game.LambdaHack.Core.Prelude: snd :: (a, b) -> b

- Game.LambdaHack.Core.Prelude: sortBy :: () => (a -> a -> Ordering) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: sortBy :: (a -> a -> Ordering) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: span :: () => (a -> Bool) -> [a] -> ([a], [a])

+ Game.LambdaHack.Core.Prelude: span :: (a -> Bool) -> [a] -> ([a], [a])

- Game.LambdaHack.Core.Prelude: splitAt :: () => Int -> [a] -> ([a], [a])

+ Game.LambdaHack.Core.Prelude: splitAt :: Int -> [a] -> ([a], [a])

- Game.LambdaHack.Core.Prelude: subsequences :: () => [a] -> [[a]]

+ Game.LambdaHack.Core.Prelude: subsequences :: [a] -> [[a]]

- Game.LambdaHack.Core.Prelude: swith :: () => String -> v -> (String, v)

+ Game.LambdaHack.Core.Prelude: swith :: String -> v -> (String, v)

- Game.LambdaHack.Core.Prelude: tail :: () => [a] -> [a]

+ Game.LambdaHack.Core.Prelude: tail :: [a] -> [a]

- Game.LambdaHack.Core.Prelude: tails :: () => [a] -> [[a]]

+ Game.LambdaHack.Core.Prelude: tails :: [a] -> [[a]]

- Game.LambdaHack.Core.Prelude: take :: () => Int -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: take :: Int -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: takeWhile :: () => (a -> Bool) -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: takeWhile :: (a -> Bool) -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: transpose :: () => [[a]] -> [[a]]

+ Game.LambdaHack.Core.Prelude: transpose :: [[a]] -> [[a]]

- Game.LambdaHack.Core.Prelude: uncons :: () => [a] -> Maybe (a, [a])

+ Game.LambdaHack.Core.Prelude: uncons :: [a] -> Maybe (a, [a])

- Game.LambdaHack.Core.Prelude: uncurry :: () => (a -> b -> c) -> (a, b) -> c

+ Game.LambdaHack.Core.Prelude: uncurry :: (a -> b -> c) -> (a, b) -> c

- Game.LambdaHack.Core.Prelude: undefined :: HasCallStack => a

+ Game.LambdaHack.Core.Prelude: undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a

- Game.LambdaHack.Core.Prelude: unfoldr :: () => (b -> Maybe (a, b)) -> b -> [a]

+ Game.LambdaHack.Core.Prelude: unfoldr :: (b -> Maybe (a, b)) -> b -> [a]

- Game.LambdaHack.Core.Prelude: unionBy :: () => (a -> a -> Bool) -> [a] -> [a] -> [a]

+ Game.LambdaHack.Core.Prelude: unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]

- Game.LambdaHack.Core.Prelude: until :: () => (a -> Bool) -> (a -> a) -> a -> a

+ Game.LambdaHack.Core.Prelude: until :: (a -> Bool) -> (a -> a) -> a -> a

- Game.LambdaHack.Core.Prelude: unzip :: () => [(a, b)] -> ([a], [b])

+ Game.LambdaHack.Core.Prelude: unzip :: [(a, b)] -> ([a], [b])

- Game.LambdaHack.Core.Prelude: unzip3 :: () => [(a, b, c)] -> ([a], [b], [c])

+ Game.LambdaHack.Core.Prelude: unzip3 :: [(a, b, c)] -> ([a], [b], [c])

- Game.LambdaHack.Core.Prelude: unzip4 :: () => [(a, b, c, d)] -> ([a], [b], [c], [d])

+ Game.LambdaHack.Core.Prelude: unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d])

- Game.LambdaHack.Core.Prelude: unzip5 :: () => [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])

+ Game.LambdaHack.Core.Prelude: unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])

- Game.LambdaHack.Core.Prelude: unzip6 :: () => [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])

+ Game.LambdaHack.Core.Prelude: unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])

- Game.LambdaHack.Core.Prelude: unzip7 :: () => [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])

+ Game.LambdaHack.Core.Prelude: unzip7 :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])

- Game.LambdaHack.Core.Prelude: zip :: () => [a] -> [b] -> [(a, b)]

+ Game.LambdaHack.Core.Prelude: zip :: [a] -> [b] -> [(a, b)]

- Game.LambdaHack.Core.Prelude: zip3 :: () => [a] -> [b] -> [c] -> [(a, b, c)]

+ Game.LambdaHack.Core.Prelude: zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]

- Game.LambdaHack.Core.Prelude: zip4 :: () => [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]

+ Game.LambdaHack.Core.Prelude: zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]

- Game.LambdaHack.Core.Prelude: zip5 :: () => [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]

+ Game.LambdaHack.Core.Prelude: zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]

- Game.LambdaHack.Core.Prelude: zip6 :: () => [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]

+ Game.LambdaHack.Core.Prelude: zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]

- Game.LambdaHack.Core.Prelude: zip7 :: () => [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]

+ Game.LambdaHack.Core.Prelude: zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]

- Game.LambdaHack.Core.Prelude: zipWith :: () => (a -> b -> c) -> [a] -> [b] -> [c]

+ Game.LambdaHack.Core.Prelude: zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]

- Game.LambdaHack.Core.Prelude: zipWith3 :: () => (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]

+ Game.LambdaHack.Core.Prelude: zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]

- Game.LambdaHack.Core.Prelude: zipWith4 :: () => (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]

+ Game.LambdaHack.Core.Prelude: zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]

- Game.LambdaHack.Core.Prelude: zipWith5 :: () => (a -> b -> c -> d -> e -> f) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]

+ Game.LambdaHack.Core.Prelude: zipWith5 :: (a -> b -> c -> d -> e -> f) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]

- Game.LambdaHack.Core.Prelude: zipWith6 :: () => (a -> b -> c -> d -> e -> f -> g) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]

+ Game.LambdaHack.Core.Prelude: zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]

- Game.LambdaHack.Core.Prelude: zipWith7 :: () => (a -> b -> c -> d -> e -> f -> g -> h) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]

+ Game.LambdaHack.Core.Prelude: zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]

- Game.LambdaHack.Core.Random: randomR :: Random a => (a, a) -> Rnd a

+ Game.LambdaHack.Core.Random: randomR :: Integral a => (a, a) -> Rnd a

- Game.LambdaHack.Core.Random: rollFreq :: Show a => Frequency a -> StdGen -> (a, StdGen)

+ Game.LambdaHack.Core.Random: rollFreq :: Show a => Frequency a -> SMGen -> (a, SMGen)

- Game.LambdaHack.Core.Random: type Rnd a = State StdGen a

+ Game.LambdaHack.Core.Random: type Rnd a = State SMGen a

- Game.LambdaHack.Definition.Ability: TBlock :: Tactic

+ Game.LambdaHack.Definition.Ability: TBlock :: Doctrine

- Game.LambdaHack.Definition.Ability: TExplore :: Tactic

+ Game.LambdaHack.Definition.Ability: TExplore :: Doctrine

- Game.LambdaHack.Definition.Ability: TFollow :: Tactic

+ Game.LambdaHack.Definition.Ability: TFollow :: Doctrine

- Game.LambdaHack.Definition.Ability: TFollowNoItems :: Tactic

+ Game.LambdaHack.Definition.Ability: TFollowNoItems :: Doctrine

- Game.LambdaHack.Definition.Ability: TMeleeAdjacent :: Tactic

+ Game.LambdaHack.Definition.Ability: TMeleeAdjacent :: Doctrine

- Game.LambdaHack.Definition.Ability: TMeleeAndRanged :: Tactic

+ Game.LambdaHack.Definition.Ability: TMeleeAndRanged :: Doctrine

- Game.LambdaHack.Definition.Ability: TPatrol :: Tactic

+ Game.LambdaHack.Definition.Ability: TPatrol :: Doctrine

- Game.LambdaHack.Definition.Ability: TRoam :: Tactic

+ Game.LambdaHack.Definition.Ability: TRoam :: Doctrine

- Game.LambdaHack.Definition.Ability: scaleSkills :: Int -> EnumMap Skill Int -> EnumMap Skill Int

+ Game.LambdaHack.Definition.Ability: scaleSkills :: Skills -> Int -> Skills

- Game.LambdaHack.Definition.ContentData: makeContentData :: Show c => String -> (c -> Text) -> (c -> Freqs c) -> (c -> [Text]) -> ([c] -> ContentData c -> [Text]) -> [c] -> ContentData c

+ Game.LambdaHack.Definition.ContentData: makeContentData :: Show c => String -> (c -> Text) -> (c -> Freqs c) -> (c -> [Text]) -> ([c] -> ContentData c -> [Text]) -> [c] -> [GroupName c] -> [GroupName c] -> ContentData c

- Game.LambdaHack.Server: ServerOptions :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe (GroupName ModeKind) -> Bool -> Bool -> Maybe StdGen -> Maybe StdGen -> Bool -> Challenge -> Bool -> String -> Bool -> Bool -> ClientOptions -> ServerOptions

+ Game.LambdaHack.Server: ServerOptions :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe (GroupName ModeKind) -> Bool -> Bool -> Maybe SMGen -> Maybe SMGen -> Bool -> Challenge -> Bool -> String -> Bool -> Maybe Int -> Bool -> Bool -> ClientOptions -> ServerOptions

- Game.LambdaHack.Server: [sdungeonRng] :: ServerOptions -> Maybe StdGen

+ Game.LambdaHack.Server: [sdungeonRng] :: ServerOptions -> Maybe SMGen

- Game.LambdaHack.Server: [smainRng] :: ServerOptions -> Maybe StdGen

+ Game.LambdaHack.Server: [smainRng] :: ServerOptions -> Maybe SMGen

- Game.LambdaHack.Server.BroadcastAtomic: hearSfxAtomic :: MonadServer m => [(ActorId, Actor)] -> SfxAtomic -> m (Maybe (HearMsg, [ActorId]))

+ Game.LambdaHack.Server.BroadcastAtomic: hearSfxAtomic :: MonadServer m => SfxAtomic -> m (Maybe (HearMsg, Bool, Point))

- Game.LambdaHack.Server.BroadcastAtomic: hearUpdAtomic :: MonadStateRead m => [(ActorId, Actor)] -> UpdAtomic -> m (Maybe [ActorId])

+ Game.LambdaHack.Server.BroadcastAtomic: hearUpdAtomic :: MonadStateRead m => UpdAtomic -> m (Bool, Maybe Point)

- Game.LambdaHack.Server.CommonM: addCondition :: MonadServerAtomic m => GroupName ItemKind -> ActorId -> m ()

+ Game.LambdaHack.Server.CommonM: addCondition :: MonadServerAtomic m => Bool -> GroupName ItemKind -> ActorId -> m ()

- Game.LambdaHack.Server.CommonM: projectFail :: MonadServerAtomic m => ActorId -> ActorId -> Point -> Int -> Bool -> ItemId -> CStore -> Bool -> m (Maybe ReqFailure)

+ Game.LambdaHack.Server.CommonM: projectFail :: MonadServerAtomic m => ActorId -> ActorId -> Point -> Point -> Int -> Bool -> ItemId -> CStore -> Bool -> m (Maybe ReqFailure)

- Game.LambdaHack.Server.DungeonGen: buildLevel :: COps -> ServerOptions -> Int -> GroupName CaveKind -> Int -> AbsDepth -> [(Point, Text)] -> Rnd (Level, [(Point, Text)])

+ Game.LambdaHack.Server.DungeonGen: buildLevel :: COps -> ServerOptions -> LevelId -> ContentId CaveKind -> CaveKind -> Int -> Int -> AbsDepth -> [(Point, Text)] -> Rnd (Level, [(Point, Text)])

- Game.LambdaHack.Server.DungeonGen: placeDownStairs :: Text -> Bool -> ServerOptions -> Int -> CaveKind -> Area -> [Point] -> [Point] -> Rnd (Maybe Point)

+ Game.LambdaHack.Server.DungeonGen: placeDownStairs :: Text -> Bool -> ServerOptions -> LevelId -> CaveKind -> Area -> [Point] -> [Point] -> Rnd (Maybe Point)

- Game.LambdaHack.Server.DungeonGen.Cave: buildCave :: COps -> AbsDepth -> AbsDepth -> Area -> Int -> ContentId CaveKind -> (X, Y) -> EnumMap Point SpecialArea -> [Point] -> Rnd Cave

+ Game.LambdaHack.Server.DungeonGen.Cave: buildCave :: COps -> AbsDepth -> AbsDepth -> Area -> Word32 -> ContentId CaveKind -> (X, Y) -> EnumMap Point SpecialArea -> [Point] -> Rnd Cave

- Game.LambdaHack.Server.DungeonGen.Cave: pickOpening :: COps -> CaveKind -> TileMapEM -> ContentId TileKind -> Int -> Point -> (ContentId TileKind, ContentId TileKind, ContentId PlaceKind) -> Rnd (ContentId TileKind)

+ Game.LambdaHack.Server.DungeonGen.Cave: pickOpening :: COps -> CaveKind -> TileMapEM -> ContentId TileKind -> Word32 -> Point -> (ContentId TileKind, ContentId TileKind, ContentId PlaceKind) -> Rnd (ContentId TileKind)

- Game.LambdaHack.Server.DungeonGen.Place: buildPlace :: COps -> CaveKind -> Bool -> ContentId TileKind -> ContentId TileKind -> AbsDepth -> AbsDepth -> Int -> Area -> Maybe Area -> Freqs PlaceKind -> Rnd Place

+ Game.LambdaHack.Server.DungeonGen.Place: buildPlace :: COps -> CaveKind -> Bool -> ContentId TileKind -> ContentId TileKind -> AbsDepth -> AbsDepth -> Word32 -> Area -> Maybe Area -> Freqs PlaceKind -> Rnd Place

- Game.LambdaHack.Server.DungeonGen.Place: isChancePos :: Int -> Int -> Int -> Point -> Bool

+ Game.LambdaHack.Server.DungeonGen.Place: isChancePos :: Int -> Int -> Word32 -> Point -> Bool

- Game.LambdaHack.Server.Fov: perceptionFromPTotal :: FovLucid -> CacheBeforeLucid -> Perception

+ Game.LambdaHack.Server.Fov: perceptionFromPTotal :: FactionId -> LevelId -> FovLucid -> CacheBeforeLucid -> State -> Perception

- Game.LambdaHack.Server.HandleAtomicM: itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> [CStore] -> Bool

+ Game.LambdaHack.Server.HandleAtomicM: itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> Bool

- Game.LambdaHack.Server.HandleEffectM: dominateFidSfx :: MonadServerAtomic m => ActorId -> ActorId -> FactionId -> m Bool

+ Game.LambdaHack.Server.HandleEffectM: dominateFidSfx :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> FactionId -> m Bool

- Game.LambdaHack.Server.HandleEffectM: dropCStoreItem :: MonadServerAtomic m => Bool -> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()

+ Game.LambdaHack.Server.HandleEffectM: dropCStoreItem :: MonadServerAtomic m => Bool -> Bool -> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectAndDestroy :: MonadServerAtomic m => Bool -> Bool -> Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> ItemFull -> Bool -> m ()

+ Game.LambdaHack.Server.HandleEffectM: effectAndDestroy :: MonadServerAtomic m => EffApplyFlags -> ActorId -> ActorId -> ItemId -> Container -> ItemFull -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectAndDestroyAndAddKill :: MonadServerAtomic m => Bool -> ActorId -> Bool -> Bool -> Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> ItemFull -> Bool -> m ()

+ Game.LambdaHack.Server.HandleEffectM: effectAndDestroyAndAddKill :: MonadServerAtomic m => EffApplyFlags -> ActorId -> ActorId -> ActorId -> ItemId -> Container -> ItemFull -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectAscend :: MonadServerAtomic m => (Effect -> m UseResult) -> m () -> Bool -> ActorId -> ActorId -> Point -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectAscend :: MonadServerAtomic m => (Effect -> m UseResult) -> m () -> Bool -> ActorId -> ActorId -> Container -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectBurn :: MonadServerAtomic m => Dice -> ActorId -> ActorId -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectBurn :: MonadServerAtomic m => Dice -> ActorId -> ActorId -> ItemId -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectCreateItem :: MonadServerAtomic m => Maybe FactionId -> Maybe Int -> ActorId -> ActorId -> CStore -> GroupName ItemKind -> TimerDice -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectCreateItem :: MonadServerAtomic m => Maybe FactionId -> Maybe Int -> ActorId -> ActorId -> Maybe ItemId -> CStore -> GroupName ItemKind -> TimerDice -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectDetect :: MonadServerAtomic m => m () -> DetectKind -> Int -> ActorId -> Point -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectDetect :: MonadServerAtomic m => m () -> DetectKind -> Int -> ActorId -> Container -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectDominate :: MonadServerAtomic m => ActorId -> ActorId -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectDominate :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectExplode :: MonadServerAtomic m => m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectExplode :: MonadServerAtomic m => m () -> GroupName ItemKind -> ActorId -> ActorId -> Container -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectRefillHP :: MonadServerAtomic m => Int -> ActorId -> ActorId -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectRefillHP :: MonadServerAtomic m => Int -> ActorId -> ActorId -> ItemId -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectSem :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> Effect -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectSem :: MonadServerAtomic m => EffApplyFlags -> ActorId -> ActorId -> ItemId -> Container -> Effect -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: effectSummon :: MonadServerAtomic m => GroupName ItemKind -> Dice -> ItemId -> ActorId -> ActorId -> Bool -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: effectSummon :: MonadServerAtomic m => GroupName ItemKind -> Dice -> ItemId -> ActorId -> ActorId -> ActivationFlag -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: imperishableKit :: Bool -> ItemFull -> Bool

+ Game.LambdaHack.Server.HandleEffectM: imperishableKit :: ActivationFlag -> ItemFull -> Bool

- Game.LambdaHack.Server.HandleEffectM: itemEffectDisco :: MonadServerAtomic m => Bool -> Bool -> ActorId -> ActorId -> ItemId -> ContentId ItemKind -> ItemKind -> Container -> Bool -> [Effect] -> m UseResult

+ Game.LambdaHack.Server.HandleEffectM: itemEffectDisco :: MonadServerAtomic m => EffApplyFlags -> ActorId -> ActorId -> ItemId -> ContentId ItemKind -> ItemKind -> Container -> [Effect] -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: itemEffectEmbedded :: MonadServerAtomic m => Bool -> ActorId -> LevelId -> Point -> ItemId -> m ()

+ Game.LambdaHack.Server.HandleEffectM: itemEffectEmbedded :: MonadServerAtomic m => EffToUse -> Bool -> ActorId -> LevelId -> Point -> ItemId -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: kineticEffectAndDestroy :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> ActorId -> ItemId -> Container -> Bool -> m ()

+ Game.LambdaHack.Server.HandleEffectM: kineticEffectAndDestroy :: MonadServerAtomic m => EffApplyFlags -> ActorId -> ActorId -> ActorId -> ItemId -> Container -> m UseResult

- Game.LambdaHack.Server.HandleEffectM: sendFlyingVector :: MonadServerAtomic m => ActorId -> ActorId -> Maybe Bool -> m Vector

+ Game.LambdaHack.Server.HandleEffectM: sendFlyingVector :: MonadServerAtomic m => ActorId -> ActorId -> Container -> Maybe Bool -> m Vector

- Game.LambdaHack.Server.HandleRequestM: reqAlterFail :: MonadServerAtomic m => Bool -> ActorId -> Point -> m (Maybe ReqFailure)

+ Game.LambdaHack.Server.HandleRequestM: reqAlterFail :: forall m. MonadServerAtomic m => Bool -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)

- Game.LambdaHack.Server.HandleRequestM: reqMoveItem :: MonadServerAtomic m => ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()

+ Game.LambdaHack.Server.HandleRequestM: reqMoveItem :: MonadServerAtomic m => Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()

- Game.LambdaHack.Server.ItemM: computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe Time)

+ Game.LambdaHack.Server.ItemM: computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer)

- Game.LambdaHack.Server.ItemM: mapActorCStore_ :: MonadServer m => CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()

+ Game.LambdaHack.Server.ItemM: mapActorCStore_ :: MonadServer m => CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()

- Game.LambdaHack.Server.ItemM: placeItemsInDungeon :: forall m. MonadServerAtomic m => EnumMap LevelId [Point] -> m ()

+ Game.LambdaHack.Server.ItemM: placeItemsInDungeon :: forall m. MonadServerAtomic m => EnumMap LevelId (EnumMap FactionId Point) -> m ()

- Game.LambdaHack.Server.ItemM: randomResetTimeout :: MonadServerAtomic m => Int -> ItemId -> ItemFull -> [Time] -> Container -> m ()

+ Game.LambdaHack.Server.ItemM: randomResetTimeout :: MonadServerAtomic m => Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()

- Game.LambdaHack.Server.ItemM: registerItem :: MonadServerAtomic m => ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId

+ Game.LambdaHack.Server.ItemM: registerItem :: MonadServerAtomic m => Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId

- Game.LambdaHack.Server.ItemM: rollAndRegisterItem :: MonadServerAtomic m => LevelId -> Freqs ItemKind -> Container -> Bool -> Maybe Int -> m (Maybe (ItemId, ItemFullKit))

+ Game.LambdaHack.Server.ItemM: rollAndRegisterItem :: MonadServerAtomic m => Bool -> LevelId -> Frequency (ContentId ItemKind, ItemKind) -> Container -> Maybe Int -> m (Maybe (ItemId, ItemFullKit))

- Game.LambdaHack.Server.ItemM: rollItemAspect :: MonadServerAtomic m => Frequency (ContentId ItemKind, ItemKind) -> LevelId -> m (Maybe (ItemKnown, ItemFullKit))

+ Game.LambdaHack.Server.ItemM: rollItemAspect :: MonadServerAtomic m => Frequency (ContentId ItemKind, ItemKind) -> LevelId -> m NewItem

- Game.LambdaHack.Server.ItemRev: dungeonFlavourMap :: COps -> Rnd FlavourMap

+ Game.LambdaHack.Server.ItemRev: dungeonFlavourMap :: COps -> FlavourMap -> Rnd FlavourMap

- Game.LambdaHack.Server.ItemRev: newItem :: COps -> Frequency (ContentId ItemKind, ItemKind) -> FlavourMap -> DiscoveryKindRev -> AbsDepth -> AbsDepth -> Rnd (Maybe (ItemKnown, ItemFullKit))

+ Game.LambdaHack.Server.ItemRev: newItem :: COps -> Frequency (ContentId ItemKind, ItemKind) -> FlavourMap -> DiscoveryKindRev -> AbsDepth -> AbsDepth -> Rnd NewItem

- Game.LambdaHack.Server.ItemRev: serverDiscos :: COps -> Rnd (DiscoveryKind, DiscoveryKindRev)

+ Game.LambdaHack.Server.ItemRev: serverDiscos :: COps -> DiscoveryKindRev -> Rnd (DiscoveryKind, DiscoveryKindRev)

- Game.LambdaHack.Server.LoopM: arenasForLoop :: MonadStateRead m => m [LevelId]

+ Game.LambdaHack.Server.LoopM: arenasForLoop :: MonadStateRead m => m (EnumSet LevelId)

- Game.LambdaHack.Server.MonadServer: getSetGen :: MonadServer m => Maybe StdGen -> m StdGen

+ Game.LambdaHack.Server.MonadServer: getSetGen :: MonadServer m => Maybe SMGen -> m SMGen

- Game.LambdaHack.Server.ServerOptions: RNGs :: Maybe StdGen -> Maybe StdGen -> RNGs

+ Game.LambdaHack.Server.ServerOptions: RNGs :: Maybe SMGen -> Maybe SMGen -> RNGs

- Game.LambdaHack.Server.ServerOptions: ServerOptions :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe (GroupName ModeKind) -> Bool -> Bool -> Maybe StdGen -> Maybe StdGen -> Bool -> Challenge -> Bool -> String -> Bool -> Bool -> ClientOptions -> ServerOptions

+ Game.LambdaHack.Server.ServerOptions: ServerOptions :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe (GroupName ModeKind) -> Bool -> Bool -> Maybe SMGen -> Maybe SMGen -> Bool -> Challenge -> Bool -> String -> Bool -> Maybe Int -> Bool -> Bool -> ClientOptions -> ServerOptions

- Game.LambdaHack.Server.ServerOptions: [dungeonRandomGenerator] :: RNGs -> Maybe StdGen

+ Game.LambdaHack.Server.ServerOptions: [dungeonRandomGenerator] :: RNGs -> Maybe SMGen

- Game.LambdaHack.Server.ServerOptions: [sdungeonRng] :: ServerOptions -> Maybe StdGen

+ Game.LambdaHack.Server.ServerOptions: [sdungeonRng] :: ServerOptions -> Maybe SMGen

- Game.LambdaHack.Server.ServerOptions: [smainRng] :: ServerOptions -> Maybe StdGen

+ Game.LambdaHack.Server.ServerOptions: [smainRng] :: ServerOptions -> Maybe SMGen

- Game.LambdaHack.Server.ServerOptions: [startingRandomGenerator] :: RNGs -> Maybe StdGen

+ Game.LambdaHack.Server.ServerOptions: [startingRandomGenerator] :: RNGs -> Maybe SMGen

- Game.LambdaHack.Server.StartM: findEntryPoss :: COps -> LevelId -> Level -> Int -> Rnd [Point]

+ Game.LambdaHack.Server.StartM: findEntryPoss :: COps -> Level -> Int -> Rnd [Point]

- Game.LambdaHack.Server.StartM: gameReset :: MonadServer m => ServerOptions -> Maybe (GroupName ModeKind) -> Maybe StdGen -> m State

+ Game.LambdaHack.Server.StartM: gameReset :: MonadServer m => ServerOptions -> Maybe (GroupName ModeKind) -> Maybe SMGen -> m State

- Game.LambdaHack.Server.StartM: populateDungeon :: MonadServerAtomic m => m ()

+ Game.LambdaHack.Server.StartM: populateDungeon :: forall m. MonadServerAtomic m => m ()

- Game.LambdaHack.Server.State: StateServer :: ActorTime -> ActorTime -> ActorPushedBy -> FactionAnalytics -> ActorAnalytics -> GenerationAnalytics -> EnumSet ActorId -> DiscoveryKindRev -> UniqueSet -> ItemRev -> FlavourMap -> ActorId -> ItemId -> EnumMap LevelId Int -> () -> EnumMap FactionId State -> PerFid -> PerValidFid -> PerCacheFid -> FovLucidLid -> FovClearLid -> FovLitLid -> [LevelId] -> Bool -> StdGen -> RNGs -> Bool -> Bool -> Bool -> ServerOptions -> ServerOptions -> StateServer

+ Game.LambdaHack.Server.State: StateServer :: ActorTime -> ActorTime -> ActorPushedBy -> GearOfTeams -> GearOfTeams -> EnumMap TeamContinuity Int -> FactionAnalytics -> ActorAnalytics -> GenerationAnalytics -> EnumSet ActorId -> DiscoveryKindRev -> UniqueSet -> ItemRev -> FlavourMap -> ActorId -> ItemId -> EnumMap LevelId Int -> () -> EnumMap FactionId State -> PerFid -> PerValidFid -> PerCacheFid -> FovLucidLid -> FovClearLid -> FovLitLid -> EnumSet LevelId -> Bool -> SMGen -> RNGs -> Bool -> Bool -> Bool -> ServerOptions -> ServerOptions -> StateServer

- Game.LambdaHack.Server.State: [sarenas] :: StateServer -> [LevelId]

+ Game.LambdaHack.Server.State: [sarenas] :: StateServer -> EnumSet LevelId

- Game.LambdaHack.Server.State: [srandom] :: StateServer -> StdGen

+ Game.LambdaHack.Server.State: [srandom] :: StateServer -> SMGen

Files

CHANGELOG.md +1621/−55
COPYLEFT +96/−6
CREDITS +0/−52
GameDefinition/Content/CaveKind.hs +254/−193
GameDefinition/Content/ItemKind.hs +1828/−1773
GameDefinition/Content/ItemKindActor.hs +207/−142
GameDefinition/Content/ItemKindBlast.hs +259/−126
GameDefinition/Content/ItemKindEmbed.hs +127/−70
GameDefinition/Content/ItemKindOrgan.hs +301/−209
GameDefinition/Content/ItemKindTemporary.hs +158/−78
GameDefinition/Content/ModeKind.hs +422/−193
GameDefinition/Content/ModeKindPlayer.hs +20/−20
GameDefinition/Content/PlaceKind.hs +234/−166
GameDefinition/Content/RuleKind.hs +17/−9
GameDefinition/Content/TileKind.hs +359/−163
GameDefinition/InGameHelp.txt +0/−184
GameDefinition/MainMenu.ascii +0/−24
GameDefinition/MoveKeys.txt +0/−19
GameDefinition/PLAYING.md +445/−241
GameDefinition/config.ui.default +96/−19
GameDefinition/fonts/BinaryCodeProLH-Bold.ttf.woff binary
GameDefinition/fonts/BinarySansProLH-Regular.ttf.woff binary
GameDefinition/fonts/BinarySansProLH-Semibold.ttf.woff binary
GameDefinition/fonts/DejaVuLGCSans-Bold.ttf.woff binary
GameDefinition/fonts/DejaVuLGCSans.ttf.woff binary
GameDefinition/fonts/Fix15Mono-Bold.woff binary
GameDefinition/fonts/Hack-Bold.ttf.woff binary
GameDefinition/fonts/LICENSE.16x16x +0/−339
GameDefinition/fonts/LICENSE.Fix15Mono-Bold +0/−94
GameDefinition/fonts/ubuntu-mono-v9-latin-ext_latin-700.ttf.woff binary
GameDefinition/fonts/ubuntu-v14-latin-ext_latin-500.ttf.woff binary
GameDefinition/fonts/ubuntu-v14-latin-ext_latin-regular.ttf.woff binary
GameDefinition/game-src/Client/UI/Content/Input.hs +123/−144
GameDefinition/game-src/Client/UI/Content/Screen.hs +23/−31
GameDefinition/game-src/Implementation/MonadClientImplementation.hs +4/−19
GameDefinition/game-src/Implementation/MonadServerImplementation.hs +8/−20
GameDefinition/game-src/TieKnot.hs +28/−15
LICENSE +0/−26
LambdaHack.cabal +86/−77
Makefile +151/−109
README.md +113/−79
definition-src/Game/LambdaHack/Content/CaveKind.hs +37/−61
definition-src/Game/LambdaHack/Content/ItemKind.hs +380/−124
definition-src/Game/LambdaHack/Content/ModeKind.hs +116/−72
definition-src/Game/LambdaHack/Content/PlaceKind.hs +12/−19
definition-src/Game/LambdaHack/Content/RuleKind.hs +7/−6
definition-src/Game/LambdaHack/Content/TileKind.hs +82/−69
definition-src/Game/LambdaHack/Core/Dice.hs +22/−27
definition-src/Game/LambdaHack/Core/Frequency.hs +10/−32
definition-src/Game/LambdaHack/Core/Prelude.hs +55/−7
definition-src/Game/LambdaHack/Core/Random.hs +64/−15
definition-src/Game/LambdaHack/Definition/Ability.hs +101/−60
definition-src/Game/LambdaHack/Definition/Color.hs +73/−43
definition-src/Game/LambdaHack/Definition/ContentData.hs +58/−12
definition-src/Game/LambdaHack/Definition/Defs.hs +70/−44
definition-src/Game/LambdaHack/Definition/Flavour.hs +28/−9
engine-src/Game/LambdaHack/Atomic.hs +2/−2
engine-src/Game/LambdaHack/Atomic/CmdAtomic.hs +81/−55
engine-src/Game/LambdaHack/Atomic/HandleAtomicWrite.hs +154/−90
engine-src/Game/LambdaHack/Atomic/MonadStateWrite.hs +59/−66
engine-src/Game/LambdaHack/Atomic/PosAtomicRead.hs +280/−86
engine-src/Game/LambdaHack/Client.hs +0/−3
engine-src/Game/LambdaHack/Client/AI.hs +27/−20
engine-src/Game/LambdaHack/Client/AI/ConditionM.hs +120/−120
engine-src/Game/LambdaHack/Client/AI/PickActionM.hs +1226/−1012
engine-src/Game/LambdaHack/Client/AI/PickActorM.hs +172/−109
engine-src/Game/LambdaHack/Client/AI/PickTargetM.hs +263/−174
engine-src/Game/LambdaHack/Client/AI/Strategy.hs +4/−11
engine-src/Game/LambdaHack/Client/Bfs.hs +40/−31
engine-src/Game/LambdaHack/Client/BfsM.hs +187/−61
engine-src/Game/LambdaHack/Client/ClientOptions.hs +0/−94
engine-src/Game/LambdaHack/Client/CommonM.hs +25/−15
engine-src/Game/LambdaHack/Client/HandleAtomicM.hs +87/−57
engine-src/Game/LambdaHack/Client/LoopM.hs +22/−12
engine-src/Game/LambdaHack/Client/MonadClient.hs +29/−19
engine-src/Game/LambdaHack/Client/Preferences.hs +170/−89
engine-src/Game/LambdaHack/Client/Request.hs +3/−3
engine-src/Game/LambdaHack/Client/State.hs +28/−17
engine-src/Game/LambdaHack/Client/UI.hs +35/−37
engine-src/Game/LambdaHack/Client/UI/ActorUI.hs +1/−20
engine-src/Game/LambdaHack/Client/UI/Animation.hs +106/−72
engine-src/Game/LambdaHack/Client/UI/Content/Input.hs +98/−61
engine-src/Game/LambdaHack/Client/UI/Content/Screen.hs +26/−16
engine-src/Game/LambdaHack/Client/UI/ContentClientUI.hs +4/−3
engine-src/Game/LambdaHack/Client/UI/DisplayAtomicM.hs +2412/−1727
engine-src/Game/LambdaHack/Client/UI/DrawM.hs +205/−118
engine-src/Game/LambdaHack/Client/UI/EffectDescription.hs +210/−42
engine-src/Game/LambdaHack/Client/UI/Frame.hs +134/−55
engine-src/Game/LambdaHack/Client/UI/FrameM.hs +167/−63
engine-src/Game/LambdaHack/Client/UI/Frontend.hs +28/−14
engine-src/Game/LambdaHack/Client/UI/Frontend/Common.hs +5/−4
engine-src/Game/LambdaHack/Client/UI/Frontend/Curses.hs +7/−5
engine-src/Game/LambdaHack/Client/UI/Frontend/Dom.hs +62/−42
engine-src/Game/LambdaHack/Client/UI/Frontend/Gtk.hs +32/−23
engine-src/Game/LambdaHack/Client/UI/Frontend/Sdl.hs +357/−125
engine-src/Game/LambdaHack/Client/UI/Frontend/Teletype.hs +8/−6
engine-src/Game/LambdaHack/Client/UI/Frontend/Vty.hs +16/−8
engine-src/Game/LambdaHack/Client/UI/HandleHelperM.hs +630/−260
engine-src/Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs +2039/−1634
engine-src/Game/LambdaHack/Client/UI/HandleHumanLocalM.hs +540/−340
engine-src/Game/LambdaHack/Client/UI/HandleHumanM.hs +78/−52
engine-src/Game/LambdaHack/Client/UI/HumanCmd.hs +29/−35
engine-src/Game/LambdaHack/Client/UI/InventoryM.hs +319/−247
engine-src/Game/LambdaHack/Client/UI/ItemDescription.hs +254/−130
engine-src/Game/LambdaHack/Client/UI/ItemSlot.hs +10/−29
engine-src/Game/LambdaHack/Client/UI/Key.hs +35/−36
engine-src/Game/LambdaHack/Client/UI/KeyBindings.hs +246/−178
engine-src/Game/LambdaHack/Client/UI/MonadClientUI.hs +177/−98
engine-src/Game/LambdaHack/Client/UI/Msg.hs +508/−276
engine-src/Game/LambdaHack/Client/UI/MsgM.hs +75/−50
engine-src/Game/LambdaHack/Client/UI/Overlay.hs +183/−89
engine-src/Game/LambdaHack/Client/UI/PointUI.hs +48/−0
engine-src/Game/LambdaHack/Client/UI/RunM.hs +14/−13
engine-src/Game/LambdaHack/Client/UI/SessionUI.hs +111/−43
engine-src/Game/LambdaHack/Client/UI/Slideshow.hs +297/−79
engine-src/Game/LambdaHack/Client/UI/SlideshowM.hs +75/−37
engine-src/Game/LambdaHack/Client/UI/UIOptions.hs +23/−18
engine-src/Game/LambdaHack/Client/UI/UIOptionsParse.hs +83/−48
engine-src/Game/LambdaHack/Common/Actor.hs +87/−20
engine-src/Game/LambdaHack/Common/ActorState.hs +92/−99
engine-src/Game/LambdaHack/Common/ClientOptions.hs +105/−0
engine-src/Game/LambdaHack/Common/Faction.hs +47/−11
engine-src/Game/LambdaHack/Common/HighScore.hs +25/−22
engine-src/Game/LambdaHack/Common/Item.hs +171/−47
engine-src/Game/LambdaHack/Common/ItemAspect.hs +22/−27
engine-src/Game/LambdaHack/Common/JSFile.hs +20/−10
engine-src/Game/LambdaHack/Common/Kind.hs +25/−19
engine-src/Game/LambdaHack/Common/Level.hs +31/−17
engine-src/Game/LambdaHack/Common/Misc.hs +42/−4
engine-src/Game/LambdaHack/Common/MonadStateRead.hs +12/−11
engine-src/Game/LambdaHack/Common/Point.hs +5/−5
engine-src/Game/LambdaHack/Common/PointArray.hs +98/−104
engine-src/Game/LambdaHack/Common/ReqFailure.hs +57/−43
engine-src/Game/LambdaHack/Common/RingBuffer.hs +1/−9
engine-src/Game/LambdaHack/Common/Save.hs +51/−26
engine-src/Game/LambdaHack/Common/State.hs +11/−7
engine-src/Game/LambdaHack/Common/Tile.hs +101/−27
engine-src/Game/LambdaHack/Common/Time.hs +22/−18
engine-src/Game/LambdaHack/Common/Types.hs +1/−7
engine-src/Game/LambdaHack/Common/Vector.hs +9/−17
engine-src/Game/LambdaHack/Server/BroadcastAtomic.hs +181/−122
engine-src/Game/LambdaHack/Server/Commandline.hs +73/−59
engine-src/Game/LambdaHack/Server/CommonM.hs +251/−123
engine-src/Game/LambdaHack/Server/DebugM.hs +2/−2
engine-src/Game/LambdaHack/Server/DungeonGen.hs +114/−64
engine-src/Game/LambdaHack/Server/DungeonGen/AreaRnd.hs +12/−12
engine-src/Game/LambdaHack/Server/DungeonGen/Cave.hs +22/−16
engine-src/Game/LambdaHack/Server/DungeonGen/Place.hs +11/−6
engine-src/Game/LambdaHack/Server/EndM.hs +0/−154
engine-src/Game/LambdaHack/Server/Fov.hs +44/−18
engine-src/Game/LambdaHack/Server/HandleAtomicM.hs +150/−78
engine-src/Game/LambdaHack/Server/HandleEffectM.hs +2296/−1894
engine-src/Game/LambdaHack/Server/HandleRequestM.hs +447/−208
engine-src/Game/LambdaHack/Server/ItemM.hs +123/−56
engine-src/Game/LambdaHack/Server/ItemRev.hs +83/−46
engine-src/Game/LambdaHack/Server/LoopM.hs +158/−69
engine-src/Game/LambdaHack/Server/MonadServer.hs +24/−15
engine-src/Game/LambdaHack/Server/PeriodicM.hs +113/−22
engine-src/Game/LambdaHack/Server/ProtocolM.hs +16/−13
engine-src/Game/LambdaHack/Server/ServerOptions.hs +30/−23
engine-src/Game/LambdaHack/Server/StartM.hs +125/−103
engine-src/Game/LambdaHack/Server/State.hs +38/−7
test/SessionUIMock.hs +148/−0
test/Spec.hs +324/−0
test/test.hs +0/−21

CHANGELOG.md view

@@ -1,58 +1,1624 @@-## [v0.9.5.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.4.0...v0.9.5.0)--- Fix NumLock disabled in the browser-- In screen reader frontend, highlight active menu line with the cursor-- Clone the main main menu commands as map mode commands-- Add C-RMB and C-S-LMB as alternatives of MMB-- Announce prominently MMB binding for describing map positions-- Clean up the default config file, keeping compatibility-- Make scenario names longer and slighlty more informative-- Make Vi movement keys the default in addition to keypad and mouse-- Fix a bug where death prompt when autoplaying was capturing a keypress-- Let ESC from main menu return to insert coin mode, if applicable-- Make various small UI tweaks, especially to main menu and its submenu-- Let main menu lines have 35, not 30, characters-- Make the main menu ASCII art less intrusive (and easier for screen readers)-- Don't invalidate the score file due to game minor (only) version bump--## [v0.9.4.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.3.0...v0.9.4.0)--- In vty frontend highlight actors more-- Clean up actor highlighting-- Add yell/yawn to minimal command set, remove swerving the aiming line-- Invoke yell/yawn exclusively with '%', due tor Windows and terminal woes-- Move C-c command to C, not to mask C-c on console frontends-- Tweak and fix vty console frontends, for screen-readers-- React specially at gameover under certain special circumstances-- Simpliy assignSlot now that slots are auto-sorted-- Get rid of explicit item sorting; let lore and menu slots agree-- Make DetectExit non-modal-- Mark in a game end confirmation message that more treasure can be found-- Add a description to the escape embedded item-- Reword gameover text for raid scenario-- Be more verbose when confirming escape from the game-- Don't claim to summon, when not possible on this level-- Fix missing 'no longer poisoned' when applying antidote-- Don't ask confirmation for neutral (e.g., not IDed) items-- Fix 'you fall down; you stand on a sword'-- Prevent selecting regions via mouse down in web frontend-- Deselect item if player declines to apply or fling-- Hand-hold the player, warning if flung item is beneficial-- Hand-hold the player, warning if applied item is harmful-- Rewrite the condition in UI applyItem check-- Improve the lobable item skill failure message-- Let mouse buttons describe tiles, etc.-- Unblock S-MouseButton in SDL2 frontend-- Always describe things under mouse button-- Make the message when hitting dead foe more varied--## [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+## [v0.10.2.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.5.0...v0.10.2.0)++- Let '?' scroll help+- Handle Alt and Shift modifiers together+- Advertise the C- Tab command instead of A-+- Ignore empty lines in history, just in case+- Don't keep trailing endlines in history+- Don't include placeholders in history.txt+- Retry explosions 10 instead of 100 times+- Point crosshair to a modified tile to easily get lore info+- Point crosshair to a bumped tile to easily get lore info+- Don't spam when reporting that crafting is forbidden+- Prevent AI from attempting to fling when challenge forbids it+- Hint about absolute paths to fonts+- Disable testing ubuntu fonts, because they can't be distributed in Debian+- If any savefile corrupted, move aside all+- Be more consistent about moving corrupted files aside+- Stop running when passing a door, etc.+- Make the game over lore headers sound more natual+- Do not mention embeds in minimal detail+- Tweak detail in one step to minimal+- Don't let distant taunts interrupt running+- Add a comment about fleeing from stash+- Help AI not to leave a scout guarding the stash+- Ensure some gems in escape scenario+- Don't show embed descriptions by default now that ~ does that easily+- Add one more typical organ symbol+- Avoid cut off descriptions of conditional effects+- Prefer weapons with burn or wound+- Pick up bad weapons if decent projectiles+- Slightly prefer weapons that have any effects+- Permit cycling through pointed-at lore with tilde+- Split chooseItemDialogMode into several functions+- Permit pointed-at lore display also outside aiming mode+- Reset the pointed at lore display sequence+- Maintain current state of lore display+- Save current state of being-aimed-at lore display+- Don't use timeout weapon if non-timeout as strong+- Add delay to pushed frames, to notice things shorter than a turn+- Pretty-print activationFlag to make it more understandable+- Replace the special periodic activation handling with effect conditions+- Replace the special effect handling under ranged with effect condition+- Set ActivationOnCombine in one case for now+- Replace EffOnSmash by ActivationOnSmash+- Add effect condition based on activation method+- Add Unless effect+- Introduce ActivationFlag in place of EffActivation type+- Make server check that melee is done with a legal weapon+- Add a failure about meleeing with not a weapon+- Get rid of a lot of spurious instances+- Don't say a hit was amusing if non-piercing damage was high+- Vary also the block messages when high armor+- Use 'a' and 'the' in dangerous item use confirmations+- Prevent safe spots near centres of big explosions+- Permit explosions to sometimes go off inside unwalkable terrain+- Don't sleep if the only friend on level is guarding the stash+- Shorten mreason text for crawl to fit in main menu with square fonts+- Don't hint to press '?' when it does nothing yet+- Avoid empty manual page at the end with square font+- Make sure spot crosshair description fits on the status line+- Don't display the aim mode prefix when inside a menu+- Experiment with item menu not insisting on selecting an item+- Talk about the relevant lore command in manual+- Hint about the relevant lore command+- Make lore display context sensitive in aiming mode+- Signal that lore command is sometimes context-sensitive+- Don't add the interruption message unless useful+- Don't wipe key status that opens main menu after automation+- Permit random flavour assignment with brightCol, etc.+- Don't make detection modal if not performed by player's faction+- Don't describe the goal tile when performing mouse goto+- Simplify turn display code, removing most of the newest additions+- Remove another spurious source of frames+- Remove spurious sources of frames+- Re-add refined *interrupted* via messages+- Ensure all frames when inside macro have one-line report only+- Display *interrupted* also when messages interrupt macros+- Factor out oneLineBasicFrame+- Declare the codebase lens-free+- Avoid distributing test.exe in Windows packages+- Use squareToUI for mouse handling in the browser+- Introduce game map coordinates: PointSquare+- Update wrt PointUI transition in other frontends+- Define UI screen coords in a separate file+- Silence messages about dead actors activating most embeds+- Make it possible to prevent the sleep effect+- Remove savefiles if config file too old+- Force savegame load result to catch errors ASAP+- Wait until browser finalizes Local Storage in the background+- Throw a Haskel exception when JS decompression fails on an old savefile+- Now that browser compresses savefiles, permit full history size+- Limit DOM keyboard focus highjacking, etc.+- Tell player when browser can be closed+- Use lz-string.js externs for minification+- Compress savefiles in GHCJS+- Bump base-compat bound to include Data.Semigroup compat+- Simplify containers for explosions+- Start embedded explosions inside the tile, not inside projectile+- Exclude meta game items from combat messages+- Move snxtScenario to session+- Avoid 'you are less more tidy'+- Don't count valuables inside organs to dungeon total+- Clarify that normal damage is piercing, as opposed to blunt wounding+- Change the misleading 'guards a hoard'+- When dropped, destroy any organs, not only conditions+- Don't hint to press ? when it would skip some messages+- Explain why the fadeout report is rendered in square font+- Show each tutorial hint at most once per game+- Require keypress when another faction killed off+- Don't show question marks in HUD for MinorAspects items+- Add MinorAspects flag+- Get rid of the mechanism for referring expressions across messages+- Commute freely messages about conditions lasting longer+- Add NopEffect+- Add AtMostOneOf effect constructor+- Assign stable faction IDs to teams with continuity+- Display also actor initial items, not only organs+- Use Condition flag, not group, for speed and simplicity+- Keep paragraphs of the same width, unless the first really short+- Add the 'stomachs' irregular plural+- Don't identify item if PutToSleep applied to sleeping actor+- Permit question marks in verb effects+- Do not announce item trigger if explicit and so already told+- Do not report conditions triggered when they vanish+- Inform differently when sleep induced by own organ, etc.+- Reflect that item triggering message appears after the fact+- Do not spam when backstory can't trigger yet+- Give more details in logs when item triggering does not work+- Do not spam about water being activated+- Prevent server failure when triggering a gold piece+- Log item application even from, e.g., periodic activation+- Don't announce that a dying actors stopped being hungry+- Add a temporary hack that prevents AI from stealing backstories in Allure+- Hardwire the player team continuity token+- Don't identify meta game items at game end+- Implement conditional effects+- At death, destroy all organs, not just the trunk+- Permit non-unique non-singleton flavours+- Render story flavours specially+- Announce identification even during melee+- Inform about discovering meta game organs+- Make sure heroes spawned in safari mode are properly numbered+- Add a few more hero names+- Improve the descritpion of MetaGame flag+- Record meta game gear for future games+- Consume current, not persistent team gear+- Create gear according to character preferences, if any+- Use server-assigned actor numbers in the client+- Assign index numbers to actors from continued teams+- Add continued team character counter+- Generalize hero gear to each team with continuity+- Store team continuity in a faction+- Add team continuity across scenarios to content+- Add persistent sheroGear to server state+- Add a comment about why aspects of meta game items are not preserved+- Keep flavour of MetaGame items between games+- Keep identity of MetaGame items between games+- Simplify and speed up serverDiscos+- Add a flag to keep item identified between games+- Make sure pushed actors never hit before flying away+- Use lookupActorTime instead of manually inlining+- Only activate the first effect with UnderRanged and UnderMelee+- Simplify deflection descriptions given they don't stack in practice, after all+- Describe the new challenges in the manual+- Implement disabled flinging challenge+- Implement disabled crafting challenge+- Add two more challenges+- Display tutorial hint only for bad temporary conditions+- Let AI use items with -1 speed, e.g., shields+- Improve valuing of SkDeflectRanged and SkDeflectMelee+- Try not to recompile dependencies between cabal-plan and LambdaHack+- Try to work around packages not updated for GHC 9.0.1+- Add deflection temporary conditions+- Add GHC 9.0.1 to travis and .cabal+- Implement skills for ranged and melee invulnerability+- Add skills for ranged and melee invulnerability+- Implement flags for applying when under attack+- Add flags for auto-activation when under attack+- Let AI with low skill target suspect terrain+- Prevent AI from trying to trigger blocked tiles+- Explain why we crop surface, not texture, even for prop font+- Explain the pointman/leader discrepancy+- Gut out the last remain of 'cabal list-bin'+- Add some list-bin debug to travis script+- Explain away a text rendering artifact+- Make sure speaking unique messages are not ignored+- Don't interrupt for taunt messages+- Move the tutorial hint about hearing taunts to the correct place+- Add tutorial hints about taking damage+- Only save to log any interruptible messages while in melee+- Add some more tutorial hint messages+- Write key names as on the keyboard, button names as in the button+- When leader stands over an item, say so, not 'notices item'+- Unify pluralization of skills and challenges+- Add some tutorial hint messages+- Add the first tutorial hint+- Start with tutorial hints, but not in screensaver mode+- Ignore tutorial hints, as needed+- Give a more informative message when detecting that AI stuck+- Move tutorial hint options from state to session because they are UI-only+- Keep the tutorial override option from game to game+- Implement the convenience option to override tutorial hint display+- Add a convenience option to override tutorial hint display+- Set tutorial messages according to game mode+- Toggle tutorial messages when starting a game+- Mark some game modes as tutorials+- Display manual at the end of help+- Keep the rest of the manual in content+- Split manual into paragraphs aware of some markdown formatting+- Simplify an address in manual not to spill over 80 columns+- Make duplicate errors more informative (fixes #204)+- Factor out movementDefinitions+- Hint in config file to disable the special movement keys+- Hint that stealth if possible and AI vs player symmetric+- Save after game over, to preserve history+- Limit mentions of 'playing' not to break immersion+- Delimit with colour the known endings section of F1 screen+- Change 'scenario' to 'adventure' to be more immersive+- Dedupe special item and lore menu overlay handling+- Strenghten the types in item and lore menu code+- Display scenario lore (fixes #157)+- Factor our scenario description code+- Mention that scale needs to be configured for high dpi displays, see #164+- Shorten some travis tests+- Make full map position info mode the default+- Refer to the inspected map position as 'here', not 'there'+- Use the actor pronoun when describing items at the same position (fixes #215)+- Don't switch the subject from enemy actor to self for the same map position+- Don't chain dependent sentences when examining map position+- Improve the wording of actor blurbs when inspecting map postions+- When inspecting map locations, make items subjects (see #215)+- Make it more obvious the game outcomes are fixed terms+- Compute BFS with Word16, not Word8; slower, but some paths are longs+- Be more careful avoiding 32bit overflows in frequencies (for JS)+- Don't interpret the common desktop-switching key combinations+- Clear the margins also when redrawing after viewpane changed+- Specify fullscreen in config file and override on commandline+- Implement both kinds of fullscreen+- Name variable same as record field+- Remove help comment regarding SDL-only+- Add fullscreen CLI option for SDL renderer+- Indent by 4, not 2, proportional spaces+- Disable brew-sdl2-osx in travis that now takes too long+- Don't configure the unused data directories when invoking cabal+- When installing don't create the now empty GameDefinition/fonts/+- Don't limit jobs to 1 now that cabal shows errors fine+- Don't embed the fonts in the web frontend version+- Get rid of datafiles from .cabal+- Kill the font license files that are duplicated in COPYLEFT file+- Get rid of the now unused fontDir option+- Use embedded fonts, unless absolute path is given+- Embed game-supplied font files+- Try to be more verbose where running cabal test in appveyor+- Don't create ~/.test directory when testing+- Version config file; fixes #220+- Don't error out if the effect-causing item is not seen by strangers+- Add assertionz that, normally, items are known by actors affected by them+- Hardwire a few less colours+- Mention the item responsible for an effect, unless spammy+- Get rid of a left over no-repetition message helper+- Pass on the item responsible for an effect+- Start main menus at the first normal item+- Open game homepage when clicked in Main Menu+- Write the homepage address in full in Main Menu+- Depend on open-browser package+- Make the game over messages more colourful; fixes #213+- Tweak the display of game over messages+- Make one kind of ending message more precise and colourful+- Display camped and restarted endings in F1 scenario screen+- Save which games are camped or restarted+- Add default messages for Restart and Camping; fixes #212+- Sort outcome constructors for best display in F1 scenario screen+- Colour only outcome name in game over header+- Refactor renderSection in preparation of multi-color lines+- Avoid 'restart in foggy mode'+- Unify rendering of game outcomes; fixes #210+- Remove a leftover mention of rmainMenuArt+- Improve the colours of the F1 scenario description screen+- Expose the meaning of colours for the use in other modules+- Specify also defeat endings+- Make headers in F1 scenario screen monospace+- Factor out attrLinesToFontMap+- Render F1 scenario screen better; fixes #208+- Add tests for many game modes in one session; fixes #228+- Add slowCrawl make target to observe AI in detail+- Mention in item description it's unique, because name may not underscore it+- Ignore the placeholder messages when displaying one message+- Don't overwrite prop with mono overlay even if the latter empty+- Add placeholders to history display, fixing #236+- Add a comment about historyMax divisible by screenful+- Improve message class of HP-affecting effects display+- Mark with dots if the show distinct messages different than the longer+- Implement distinct messages for becoming more affected by a condition+- Implement distinct messages for SfxTimerExtended+- Move messages that are hard to scrap to Distinct class, to fix it+- Prepare ppSfxMsg for Distinct messages+- Don't let ESC clear messages in aiming mode; was confusing+- Add Discord and Matrix addresses to the manual+- Add links to discord and matrix chat+- Let MsgRunStopReason suffice for running interruption+- Save spam, but don't show+- Clean up scraping messages+- Don't run if ordered to run into solid tile+- Reword the short post-action messages+- Don't show both terrain description and a warning about it in yellow+- Typeset one line of history view the same as whole history+- Make some messages longer to look better on a separate line+- Reverse history to match the order of messages shown on screen normally+- No longer specify initial repetition of a message+- Eliminate not saving and not repeating messages using counts+- Use allB in a couple more asserts+- Assert message constructors have proper length+- Get rid of message class GADT as designed by Alex Byaly, simplifying code+- Wrap first line of overlay at half the screen, not earlier+- Make indentSplitAttrString more accurate+- Tweak unique entities in content, adding 'the' as needed; fixes #214+- Don't capitalize and add 'the' to unique entities+- Be more verbose when displacing over laying items+- Align single high score lines+- Copy-paste-hacked enlarging line-wrap treshold if too long headers then fit+- Fine-tune display of too long reports+- Display message classes aligned+- Rename message class constructors for better display+- Display message class in grey+- Indent wrapped messages+- In messages, replace some magenta risks by bright red harms+- Be careful measuring length of multi-line texts for wrapping+- Use the config option for one message per line on screen+- Hide the implementation of Msg, again+- Display message class in history if one per line+- Don't report HP changes of projectiles+- Use the config option for one message per line in history+- Pass along the config option for one message per line in history+- Add config options for one message per line+- Rename the item spotting message+- Bring back filtering empty messages, to fix checking if report empty+- Add Show instance to history and its components for debugging+- Improve removing EOLs when deduplicating messages+- Remove MsgItemMoveLog now that one message class suffices for two components+- Get rid of isSavedToHistory and isDisplayed encoded now in the GADT+- Customize messages more comfortably+- Simplify restarting client+- Remove the code enabling multiple UI clients+- Don't spawn many UI clients, but re-assign a single one+- Make MsgClass a GADT+- Eliminate Binary instance of MsgClass in preparation of GADT+- In config file, specify prefixes of message class names+- Change colour of game start message to a nicer one+- Issue special messages when actor fall to sleep or wake up+- Tweak message class use and colour assignment again+- Remove abuse of MsgTileDisco+- Recolour enemy spotted animation according to colour meaning table+- Redo colour assignment to messages+- Update frontends to highlight changes+- Change the colour of names of sleeping actors to blue+- Reflect changes in highlighting in the manual+- Swap blue and green highlights+- Highlight dominated actors more distinctly, as proposed by @bulbousBullfrog+- Rename confusing message classes+- Make sure indented texts are wrapped at earlier position+- Make most texts wrap before full screen width+- Extend UI.Content.Screen validation+- Tweak texts to fit on screen easily with square font+- Permit wrapping messages after N columns+- Prefer stairs in bottom right corners to leave space for messages+- Prefer levels in bottom right corners to leave space for messages+- Update documentation to the config changes+- Prevent friendly AI from wasting time nosing around our stash+- Rename an identifier to a consistent form+- Limit the size of monospace prompts when keypress requested+- Redo message colours given that some colours get a very thin font, possibly+- Use a mixture of fonts in the challenges menu+- Comment the config file some more+- Render all titles in mono font+- Typeset mouse command table in varied font+- Gut out Ubuntu Family Fonts from Debian package, because non-free+- Beautify CREDITS+- Rand the fontsets differently+- Make the fontset tests more random+- Don't run noopt travis tests on normal length crawl+- Test all fontsets+- Extend client logging+- Make the game reentrant+- Prevent mangled newlines in concurrent screen writes+- Permit text usage in tests+- Refactor mkUIOptions to require less content+- Settile on 'auxiliary fonts' instead of 'long text'+- Hardwire GTK font size to fix breakage from config format change+- Simplify FontSetup+- Implement scaling all fonts easily and safely+- Add font scaling option to config and commandline+- Prevent overspill when prop font is, in fact, mono+- Remove the now unused portions of config and commandline+- Make getFontSetup more accurate (not used yet)+- Eliminate really the last dependency on old config file fields+- Add a comment about lack of optimization for duplicated fonts+- Eliminate one last dependency on old config file fields+- Hardwire the font families to use for GTK frontend+- Use the two weights of prop font+- Recover old SDL frontend functionality using new config+- Move font types to make importing them in ClientOptions legal+- Let fontset be chosen on commandline as well+- Extend config file with font and fontset definitions+- Molify Debian's lintian+- Legalize all the long text fonts even more+- Legalize all the long text fonts+- Add the ubuntu font family set of long text fonts+- Add another set of long text fonts+- Add new long text fonts based Adobe Source+- Remove old long text fonts+- Add commented out TTF.setHinting directive+- Crop too high fonts more at the top than bottom+- Get rid of the last traces of 'exploiting' terrain+- Simplify and speed up linearInterpolation (not benchmarked)+- Change which test is run in -O0 travis+- Make final version of integer casts hardening, using the type-level int-cast+- Explain the communication overhead concept+- Use toIntegralSized to crash when int wrap would occur during conversion+- Parse config at compile time+- Let foes occupiy exit in escape scenario, etc.+- Add missing cskip specifications+- If more info in history, end message with three dots+- Bump GHC versions for testing+- Bring back SPACE as clearning messages+- Update the default config wrt changes to RET keybinding+- Let ESC cancel the aiming line as well+- Keep the order, modulo abs, of factions as in the roster+- Don't switch level away from melee when positions not taken yet+- Improve valuing AI displace action a bit+- Increase expressiveness of initial actor generation+- Permit tiny rooms if no stairs variety+- Pick the sole actor for cwolf games ignoring empty specs+- Remove length that forces the whole psFree, even though most unused+- Don't drop initial actors if not enough initial faction positions+- Remove a code check that is already in mode content check+- Generate initial actors in the order given in content+- Prepare types for more faithful initial actor generation+- Rename ES.toList+- Simplify populateDungeon and catch similar overcomplications+- Generate initial actors in per-faction positions, not in alliances+- Make the use of integral conversion easier to verify+- Reword ESC description again+- Settle on apostrophes to denote one-letter keyboard keys+- Update command docs to command help changes+- Let only ESC clear messages+- Show newcomer aim mode help also when pressing ? in non-default detail level+- Simplify how the hint prompt works+- Align newcomer aiming help with ? help when aiming+- Try harder to display errors in appveyor runs+- Simplify and slightly fix linearInterpolation+- Extend debug information when summoning fails for lack of space+- Except for DetailLow, always show any description when examining+- Give feedback of detail level also when item selected+- Show item symbol in item lore view in square font+- Tweak and fix item examination messages one last time+- Change display of terrain more gradually as detail level rises+- Simplify two cases of sortBy emulating sortOn performance-wise+- Improve describing of items with words limit 1+- Use partItemWsDetail for item description when examining+- Make the second detail level the default+- Fine-tune shortest item examination message once more+- Move SPACE to CmdAim category+- Document that MMB and RMB cycle detail level+- Let RMB and MMB cycle detail level+- Add aiming help line for newcomers with SPACE hint+- Don't warn about our own actors+- Reformat lookAtActors+- Implement detail level for actor descriptions at position+- Show position description components according to detail level+- Show detail level in HUD+- Redraw after detail level changed+- Implement detail level for item descriptions at position+- Match the new order of descriptions in a couple more places+- Bind SPACE to cycle detail level in aiming mode+- Add DetailCycle human command+- Record detail level in the aiming mode state+- Add and improve headers for scenario endings messages+- Change sortBy to sortOn in a couple of places+- Optimize truncateOverlay with the best of the sortOn and sortBy worlds+- Replace some performance-wise wrong uses of sortOn with sortBy+- Mark the last major outcome in F1 scenario screen+- Change unique actor names to match the upcoming new convention+- Don't show even deafeat messages in F1 if not experienced+- Update the '?' hints to the new Tab semantics+- Add dumping history to a text file+- Advise to replay initial scenarios+- Adjust the order of spotting to match the order when exploring+- Swap the order of intrusion warning and enemy spotted message+- Announce specially foes that have non-trivial items equipped+- Clean up Content.Input.makeData+- Destroy the trunk when actor dies, for death effects+- Make sure embedded item desc stands out from the following activation info+- Make unique speech heard regardless of distance+- Let uniques taunt in a big way+- Add type signatures to AI action picking functions+- Reorder consistenly mode kind component definitions in the file+- Extend rarity specs to above 10 logical levels+- Improve comments and messages about Rarity datatype+- Avoid spoiling victory game over messges, until seen+- Factor out victoryOutcomes+- Display game over messages in F1 scenario screen+- Shorten a field name to avoid >80 length lines+- Colour header in the F1 scenario screen+- Disable a travis test that still panics+- Revert the scenario choice font frop prop to mono, for typographic consistency+- Shorten a flavour blurb to make it fit when font is square+- Extend wrong line break avoidance to colourful texts+- Display also flavour in scenario choice screen+- Don't attempt to display F1 scenario blurb in square fonts with two columns+- Don't display the extra TAB commands in item menu headers+- Mention the new TAB commands in manual and keys sheet+- Represent a key not appearing in help by empty categories, not CmdNoHelp+- Enable pointman cycling key bindings with Control+- Factor out the pointman cycling key bindings+- Make sure item spotting messages are of proper length+- When spotting new items, write short message to screen and long to history+- Don't merge messages with different classes+- Enable messages that are not displayed unless from history+- When spotting items, sort them only once+- Don't report each item located in stash in a separate sentence+- Add verbosity flag to UpdSpotItemBag and UpdLoseItemBag+- Make new Direction type more general so that it can be used in other cases+- Add direction type to make cycle function less verbose+- Add functionality of back-tabbing both across floors and within single levels+- Add bool flag to cyclying so that direction will be possible+- Change naming of member cycling in-code to be keypress agnostic+- Swap S-Tab for A-Tab as new binding for cycling members on the same level+- Swap descriptions in help file so that tab functionality matches description+- Swap funcionality of Tab and S-Tab without renaming in-code+- Reverse order of S-Tab so that it doesn't first cycle to another level+- Add up to two EOLs in tile examination message+- Order tile examination message elements by decreasing importance+- Make terrain names harder to confuse with items+- Improve messages and order of stores when moving items+- Make ItemNotCalm message applicable to flinging and triggering, too+- Tighten the result type of moveItems+- Add a comment to the default config with an example for rebinding a key+- Clarify that nominal values of burning and wounding are used+- Don't call robots living+- Don't display TMI about total condition time if come from explosions+- Let AI prefer a buckler over a fist+- Nag about the F1 screen when starting or resuming+- Display info about scenario in F1 screen+- Split mode note into motivation and hints to choose where text is displayed+- Restructure text displayed on challenge menu to make it more clear+- Add scenario rule notes to be displayed instead of full notes+- Don't let crosshair obscure terrain, items and actors+- Work around SDL treating tilde as paragraph on some Mac keyboards+- Speed up DOM rendering by ignoring highlights if possible+- Permit specifying seeds in the config file+- Make attacking animation more subtle to distinguish from harm animation+- Even in the subtle hit animation indicate who is the victim+- Add a missing space between 'modify terrain stat' and '5' with square font+- Make Burn as valuable as other damage for consistent UI display+- Show very good no-timeouts weapons at the correct position+- Partially hash-cons ItemQuant, with very modest effect+- Change some occurences of trivial Quant to quantSingle+- Simplify skill and place menu code+- Don't multiply initialPlaces when preparing place display+- Consume places for places menu more eagerly+- Eliminate space leak when creating items+- Avoid memory leak due to caves used for levels on a list+- Fit the short help blurb in 4 lines+- Start the game with a confirmation prompt+- Sort weapons wrt timeout and item kinds ID as well+- Simplify querying skills of the leader+- Avoid long animations before the extra burn or wound animations+- Change combat animations to easily distinguish attacker from attacked+- Let AI displace teammates when no risk of displacing back+- Restrict AI use of stash guards less harshly+- Add a comment about allies stealing each other's stashes+- Let AI keep fleeing if no support gained+- Remove a few redundant TypeFamilies pragmas+- Explain in a comment why on a level with stash many sleeping may accumulate+- Make safari scenario harder now that aliens are buffed up+- Let AI displace friends less often+- Unify the test for item being damaging+- Improve module haddocs for content+- Hide unneeded content group name patterns+- Add short-caves debug game mode+- Display melee damage even if there's no ranged damage+- Reduce the number of calls to foeRegularAssocs+- Make sure AI actions are not recursive, even shallowly+- Reduce the number of calls to currentSkillsClient+- Speed up skill arithmetic+- Math order of cases in processWatchfulness with the order in type definition+- Remove inlines that stopped helping in GHC 8.8 and that obstruct profiling+- Compute friendAssocs only once for each actor AI processing+- Limit and speed up invalidating BFS+- Speed up a few significantly expensive functions+- Use the JS splitmix optimization+- Tweak random numbers code a bit+- Improve haddocks of the dice mechanism+- Improve help display a bit+- Move ClientOptions.hs to adhere to the convention about module hierarchies+- Meld LH and Allure content, continued+- Port over oil explosions that harm the targeted actor from Allure+- Meld LH and Allure cave and item content+- State the number of item in equipment even when removing from it+- Explain the goofy handling of recharging in stash+- Regenerate tile even if kind not changed, but all embeds gone+- Permit altering tiles with items on them+- Don't leave stash unguarded if friends may spawn+- Add stash detection effect+- Cap stat bonuses when assigning AI value to items+- Value skill bonuses differently for each skill+- Be even more specific when describing what an actor does on a tile+- Adjust the SDL test to run without installing fonts, as Debian requires+- Don't let projectiles ever cause normal tile transitions+- Tweak pushing via an embed+- Add Q&A about hearing+- Tweak item valuations to make awkward armours wearable by AI+- When describing an actor, say if it's pushed+- Push towards embed, not in direction of previous movement+- Simplify key bindings display code+- Clean up naming of column offset in UI+- Ensure no missing space between columns of help text+- Prevent a trailing space+- Don't activate barrels via mist+- Don't treat blasts that damage through effects as mists+- Don't let on noise distance if nobody can hear it directly+- Differentiate the sound of projectile and actor hitting a tile+- Emit sound also when an actor hits a tile+- Display close and out-of-level noises with special colours+- Display noise distance information+- Send noise distance information+- Refactor hearing+- Mock up extended hearing+- Give better message when not enough skill to melee+- Disturb resting when calm enough again+- Don't summon by hitting a projectile+- Make actor aggresive if only one is not guarding stash on the level+- Ban teleporting immobile foes; they come back and their loot is lost+- Validate that item group names are short enough+- Cath too long group names+- Catch empty group names+- Let more actors start sleeping+- Consistently create on the ground all items looted from terrain+- Mark game modes already won in this difficulty+- Clear screen after start ASAP+- Use the AttrLine smart constructor or assertions as appropriate+- Rename firstParagraph+- Tweak types to work with the stricter smart constructor+- Move assertion about trailing whitespace to a smart constructor+- Eliminate trailing spaces in help and item menus+- Replace a momentarily trailing space with nbsp+- Don't define special messages with space, they are added automatically+- When splitting lines, remove the trailing spaces+- Simplify a condition in splitAttrPhrase+- Don't add a space when appending a report that starts with newline+- Don't produce backdrop on black background+- Optimize truncateAttrLine and truncateOverlay+- Mark assertions expensive in menus+- Make avoiding SDL frame drawing more fine-grained+- Simplify SDL frame drawing based on previous frame+- Optimize menu scrolling via an extra texture+- Don't waste healing items when HP low ceiling+- Don't display that foes don't know their weapon when only you don't+- Reflect keybindings change in the start scenario menu+- Permit hero AI to consume elixirs+- Don't flee if can kill a blocking enemy instead+- Make fast or hasted actors willing to close in for melee+- Compensate for overhead of animals when creating conditions+- Mark organs that are ready to expire once applyPeriodicLevel runs+- Avoid stating that an organ will last for 0s+- Tweak slightly AI item preferences+- Get rid of DropBestWeapon+- Don't rechare nor discharge projecile payloads+- Start dicharging with strongest weapons+- Let Discharge add to cooldown, not reset+- Discharge only items with a timeout+- Consider as support only actors that can harm in melee+- Make organs (minimally) accessible from triggering+- Let AI trigger items among organs+- Relax trigger stat 1 restrictions+- Tweak AI item use preferences valuation+- Improve the gameover item menu message+- Record duplication of items to avoid absurd gameover messages+- Discharge not only equipment, but also organs+- Don't paralyse the last AI stash guard+- Give AI stash guard more freedom if friends adjacent+- Make AI keep guarding even if teammates on the level may leave it+- Don't let AI leave stash unless foes harm it+- Don't abandon stash when teammates temporarily immobile+- Prevent displacing a stash guard+- Don't abandon stash if temporarily nonmoving+- Abandon stash if under heavy fire+- Don't abandon stash unless foes seen+- Don't use aidTgtToPos unless necessary+- If enemy in light, pelt him instead of leaving dark+- Don't stop fleeing into hideout after 5 turns even if foes appear+- Target dark if fleeing and no foes targetted+- Efficiently find closest hideout for AI+- Tabulate hideout tiles predicate+- Factor out distanceBfs+- Don't hog leadership just because weak and enemies close+- When fleeing and soon after target only actors that can't melee+- Stop fleeing if not hit and possibly friends managed to join+- Take into account recent fleeing when taking off light+- Simplify hinders+- In AI action choice use recent fleeing instead of this and last turn distress+- Don't overwrite fleeing record if fled recently+- Don't chase foes if fled recently+- GC fleeing record when actor lost+- Extend fleeing state from 1 to 5 turns+- Store not only fleeing position but also fleeing start time+- Reorder organs+- Make two organs not LH-specific+- Don't undervalue weapons with drop condition+- Make it possible for animals to mark levels as explored+- Make slack tactics AI less erratic when focused or distressed+- Add a comment about animals bad at changing levels+- Let AI displace any sleeping blockers+- Don't let AI actors fall asleep if not relaxed+- Don't force animals to change target just before reaching it+- Improve condAimCrucialM for vector targets+- Flesh out the crawl survival test scenario+- Make crafting act as if on bottom level+- Move skill checks from pathfinding to targetting and restrict immovable actors+- Forbid making missiles hungry, asleep, etc.+- Optimize processTileActions+- Make sure projectiles can modify terrain even if safe from effects+- Don't reset TVector target, because it's set manually+- Create a central staircase+- Display ranged damage even when limited space in menu line+- Shorten the display of weapons if not enough space+- Don't consider enemy projectiles for determining if AI is in melee+- Make poison less deadly in corridors+- Eliminate the stash domination exploit+- Make guessing if AI was hit by projectiles more accurate+- Prevent wounded animals from closing in agains mutliple enemies+- In messages tell discharge from recharge effects+- Make smell more important that stairs, again+- Clean up vector target code+- Melee non-targets if target not worth killing+- Don't perform all monadic actions that compute strategies before choosing one+- Don't retarget actor if blocked by the very actor and so can melee it+- Simplify target shoice for slack doctrine factions+- Sort items in lists in normal texts+- Help AI unlock the dungeon if stash guard helds the key+- Prevent animals from eating their own meat+- Prevent creating new items via throwing others, with ikit+- Signal specially when an item is located in a stash, as well+- Say when an item appears in a stash, etc.+- Don't warn if selected missile from stash can't be picked up+- Don't flee if back next turn+- When fleeing don't remember the last targetted enemy+- Move keybinding content definitions to match display order+- Prevent, in UI, removing from equipment if not calm+- Warn when illegal item movement attempted+- Display stash blurb also when switching the leader+- Don't let stash guards leave levels+- Don't prevent displacing a friend if only half of a loop is present+- Don't neglect guarding stash unless no buddies to help+- Tweak AI conditions+- Don't flee if own stash close unless completely overwhelmed+- Easily displace teammates that guard the stash+- Mention stash when walking over a tile+- Do not flee and be reluctant to chase when guarding stash+- Introduce guarding own stash+- Make isDoor more accurate+- Don't make a rumble when door closes+- Tabulate isOpenable and isClosable+- Make tall staircases more likely now that they are often broken+- Make types a bit more strict in stairs calculation+- Simplify stair number computation+- Rename cextraStairs+- Change the semantics of cextraStairs+- Separate stair number computation and level generation+- Compute abandoned stairs earlier+- Correct the documentation of cextraStairs+- Roll extra stairs earlier+- Roll cave kinds earlier+- Simplify shuffling caves+- When transforming walkable tiles, don't insist on embed activations+- Ban crafting and terrain transformation in the same action+- Try to make the terrain transformation specs more readable+- Prevent the exploit of using cover against non-moving shooters+- Make makeLine non-monadic+- Keep the data invariant of @arenas@ for longer+- Make the *interrupted* running display look less corrupted+- Add and tweak comments about item maps+- Update the manual and keybindings printout+- Tweak the wording of keybidings descriptions+- Prevent marking inert items as (charging)+- Add ANY_FLASK group+- Make sure impression is dropped before other conditions+- Handle failed bump-modification without embed activation+- Change the key for new game, not to mix up with 'n'o+- Remove misleading comment about tiles being explorable+- In message fits in one long line, don't wrap it into small lines+- Don't make consumables with Ascend effect worthless+- Change division by zero into an assertion failure+- Comment why 'seen' sometimes gets from 100% to 99%+- Validate HideAs in content instead of asserting its property later on+- Tweak (speedup the tiniest bit) updAlterTile+- Stop leader before leaving dark in a more useful way+- Don't equip light even if enemy only remembered+- Simplify the interesting target conditions for AI+- Flee through dark not only when starting in light+- Chase and flee through dark even if not starting from light+- Simplify the chasing ambient light condition+- Prefer leaders that don't step into light+- Detour when chasing, to avoid lit spots+- Prefer fleeing into dark spots+- Don't flee from projectiles if can't flee into the dark+- Prevent AI from vainly chasing fast shooters+- Tweak and simplify AI fleeing condition+- Help AI sidestep a blocking meleeing friend+- Let AI go towards enemy stash even if in melee+- Join melee from twice longer distance+- Rename CURIOUS_ITEM+- Don't display 0 ranged damages+- Add missing content group definitions+- Simplify content validation+- Check that content group names are all listed+- Let the draft detector emit noise and sound+- Tweak the engine to accomodate a detection device that pings+- Prevent non-humans from hogging key items and so blocking progress+- Reorder item definition to match those of Allure for diffing+- Don't emit server leader change messages if known to client+- Comment about the trade-offs of weapon benefit calculation+- Mark the lore screen with crafting recipes+- Don't confusingly refuse to display the pushing effect for shields+- Increase minimal damage taken, regardless of armor, to 5%+- Be pendantic when emitting messages about creating items+- Don't say that a projectile is wounded+- Show enemy HP under the selected item+- Simplify strongestMelee+- Add an alias for picking up all items, etc.+- Sort out naming of item and embed activations+- Simplify revCmdMap+- Warn when embeds activated, but transformation failed+- Check dangerous tools use even when nested in transformations+- Don't transform terrain when bumping+- Let pathfinding avoid vicinity of enemies+- Make it easy to discern an attack on teammate among many messages+- Don't display misleading condition drop messages+- Visually distinguish embed names and descriptions+- Permit fractional FPS, for debugging+- Colour-code map position descriptions+- Move the run macro to where all other engine macros are defined+- Permit unknown command, for testing+- Simplify and clarify the mock+- Unify repeatHumanTransition 1 and macroHumanTransition+- Reflect in types that macro frame stack is never empty+- Make more space for explicit import lists+- Rename components of the macro data structure+- Drive the point home that repeatHumanTransition 1 /= macroHumanTransition+- Add tests that illustrate not creating new buffers for in-game macros+- Touch up the macro code a bit+- Add tests showing lack of referential transparency of named macros+- Don't prompt about recording a macro it's part of macro replay+- Warn when pick up not to equipment due to low calm+- Display how many items in equipment when equipping+- Refuse to equip if equipment full+- Separate testing harness import from game content import+- Add a helper function to shorten tests+- Rename the semantics functions+- Implement the desired semantics of RepeatLast+- Sketch the desired semantics of RepeatLast via tests+- Use the same updateLastAction function in test mock+- Collect a more precise last action key+- Simplify slightly the mock+- Grey out more (all?) illegal commands+- Add special messages when illegally flinging or applying+- Go even through stores that all factions have empty+- Revert banning stores for all actors based on the first checked+- Add special messages when illegally moving items from or to eqp or ground+- Forbid unequipping items when not calm, again+- Don't ignore illegal stores if once shown+- Display the number of items in equipment even when not calm+- Write client RNG seed to UI RNG seed numbers at game restart+- Save UI random seed to avoid boring messages if many save/loads+- Add a comment about stealth viable for tactics, but not strategy+- Reset C-f when x-hair automatically changed+- Pick as leaders also the actors that could melee but should not+- Make animals unable to catch projectiles+- Don't cycle xhair through own stash+- Display slideshows normall unless really too long, not just excessively long+- Give more time to view a frame when frame level changes+- Be more verbose when kicking terrain+- Prevent the inability of taking off max calm draining items+- Re-assign action repeating keys+- Clean up macro command's texts+- Place ikit item in a semi-random way+- Tweak content group names for display+- Avoid 'of gain of gain' in item descriptions+- Don't talk about blocking when no kinetic damage dealt+- Match the order of game over lore screens with in-game lore menu+- Prevent AI from imbibing a potion of panic+- Don't call a tile alterable if embeds have no effects+- Prefer leaders that target enemy stashes+- Don't chase stashes of friends and neutrals+- When creating items on the floor during dungeon generation, create ikit items+- When embedding items in tiles, optionally generate more items+- Redesign so that charging items can be determined even if timeout unknown+- Clean up some instance deriving+- Factor out two more pure functions about macros to use in unit tests+- Permit creation of input content without parsing a config file+- Factor out pure function about macros to use in unit tests+- Record nested macros on stack+- Snatch enemy stash ASAP if adjacent+- Port tests to tasty+- Undo the attempt to end game when player kills window+- Remove a spurious recordHistory+- Make sure verifyCaches error doesn't obscure RNG seed of the crashing run+- Don't let big actors auto-craft at death+- In menus show how long conditions will last+- Tell how for long an actor is going to be slowed when first affected+- Tell how for long an actor is slowed in total after extra slowness, etc.+- Tell how much poisoned actor is in total after extra poison, etc.+- Don't display the mandatory turn frame if a frame already displayed this turn+- Don't draw (and printscreen) identical frames, even if small fonts used+- Don't trigger terrain if projectile has lost its payload+- Enable cooking of food thrown into fire+- Don't spam when blasts transform terrain+- Simplify dieSer+- Ensure the last step of projectile flight is shown+- Remove a repeated check+- Be more verbose when transforming items with scrolls+- Display level where the stash is, as a reminder+- Don't displace sleeping immobile actors+- Simplify checking if an item is identified+- Prevent AI from putting most weapons in reserve+- Let AI be eager to equip unidentified and good unique items+- Don't be too verbose with tile altering when leader stands on it+- Don't craft from equipment due to possible involuntary harm+- Remove altering via dropping items; too disaster-prone+- Refactor handleDir+- Permit indicating the zero vector with mouse+- Colour and reword the message about consuming items+- Be a bit more verbose about tile changes+- Don't inform about a projectile's equipment+- Avoid hitting 'feebly' with a heavy hammer+- Show, e.g., harpoon as an obvious choice for throwing despite usable for melee+- Don't summon by hitting a friend+- Don't hit delicately just because the weapon was not identified+- Prevent AI from wasting time throwing very weak projectiles+- Avoid 'chip of scientific explanation turns out to be', when identifying+- Improve item destruction messages+- Add OnUser effect constructor+- Avoid 'the pair turns out to be' when identifying+- When short name requested, don't append numbers and parens+- Prevent VerbMsgFail being repeated 99 times+- Describe how colours correspond to tile properties+- Let even unskilled actors take over stash+- Take over stash also when actor dominated or created+- Target enemy stash in preference even to enemy actors+- Add comments about salter and pathfinding+- Avoid 'controlled by Controlled foo'+- Avoid 'hits delicately' with a 14 HP wounding hammer+- Ensure in content that Burn is positive+- Mark weapon burning and wounding on HUD, to avoid hammers all look benign+- Clarify that chosen weapon needs not be optimal for a foe+- Improve display of places lore+- Pick up enemy summoning periodic items to deny them to foes+- Don't send the SfxTrigger messages to the client+- Mention that stats menu summarizes the organ menu+- Add sample cabal.project.local files+- Introduce VerbMsgFail effect+- Let crafting use up terrain, if successful+- Don't split tile properties description by description of things on the tile+- Avoid crafting via walking into a worshop tile+- Introduce SeqEffect to use for crafting creation in place of AndEffect+- Let components 'disappear', not 'be removed' during crafting+- Improve crafting recipe description+- Automatically identify crafted items+- When cratfing, use tools but destroy components+- Don't create items in equipment if not enough free slots+- When crafting, apply as many copies of durable items as required, not just one+- Don't crash if crafting fails due to unique already generated+- Improve debugging of item creation+- Don't display thrown damage for organs+- Flesh out projectiles opening terrain and flying through+- Require embed activation even for item-fueled terrain transformations+- Don't spam if recording is a part of a macro+- Make the summary of killed enemies less confusing+- Let some explosions destroy terrain+- Add black backdrop beneath prop font overlays, for readability+- Be even less verbose in descriptions of items with crafting+- Validate that item definitions have slots whenever expected+- Rename the Macro type+- Record also in-game menu navigation keys+- Recover macro's recording order invariant+- Document Macro, swap types in smacroBuffer's Either type+- Wrap the macro buffer into a newtype+- Encode recording state in type of macro buffer+- Be more precise when reporting OnCombine effects+- Format crafting recipes in a more readable way+- Gather effects application flags into one record, for redability+- Add an assertion that catches ItemQuant data invariant violation+- Ignore timeouts when using tools or transforming terrain+- Don't apply kinetic damage when using tools or transforming terrain+- Generalize printing crafting recipes to many products+- Rename the dagger item definition to match Allure+- Help parsing recipes with bullets+- Avoid spike 2d1 (cooldown 8) of cooldowns at 4+- Typeset crafting recipes slightly+- Rename the whetstone item definition to match Allure+- Don't repeat crafting recipes in OnCombine descriptions+- Show full crafting recipes only in lore menu, not when targeting+- Speed up and simplify the use of countIidConsumed+- Alter ConsumeItems and unify with ChangeWith+- Add optional count parameter to effect CreateItem+- Validate that item definition parameters in content are positive+- Display details of item crafting effects+- Add ConsumeItems effect+- Let AI ignore potentially unopenable entrances, to avoid AI loops+- Improve messages related to Discharge effect+- Simplify checking actor presence on a level+- Add the Discharge effect+- Be more verbose when loot created+- Don't complain about failed transformation if embedded item triggered+- Revert "Break thrown non-unique items, even if durable"+- Let projectiles trigger only easiest embeds and alterings+- In tile content specify if projectiles may trigger actions+- Display when ending a flight, to make harpoon a sensible weapon+- When actor lacks tools to transform a tile, inform him+- Break thrown non-unique items, even if durable+- Squash repeated terrain transformation tools in descriptions+- Confirm that a weapon is to be used for transformation+- List tools needed for transformation in terrain description+- Factor out client altering conditions+- Unify altering by bumping and altering by pointing and server conditions+- Don't waste turn when altering fails, but waste when embed triggering fails+- Factor out listToolsForAltering and subtractGrpfromBag+- Permit the use of tile altering tools with different durabilities+- Factor out parseTileAction+- Don't count repetitions in OneOf effect description+- Prefer non-durable altering tools, even in equipment+- Avoid message about triggering a 'way' without any more details+- Rename terrain patterns that denote possibly depleted resource+- Consider durable tools last for terrain alteration+- Process tile features in order to prefer trap disarming to triggering+- Prevent embeds triggering each other in a loop+- Simplify applying embeds+- Display untruncated (and mangled) messages in teletype mode+- Make frontendName to avoid losing message in teletype frontend+- Clean up the presentation of group name patterns again+- Verify that singleton group names are so+- Separate singleton kind group names+- Validate that some more kind groups are singletons+- Rename HideAs to PresentAs for item kinds+- Simplify individual content validation due to stronger global validation+- Check that group names unique and not void+- Supply group names to the content creation and validation function+- Improve special gameover messages+- Clean up the lists of hardwired patterns+- Get rid of OVER in pattern names+- Clean up the DEFENSELESS vs VULNERABLE mixup+- Remove foldl from prelude to prevent space leaks+- Group the patterns yet slightly differently+- Catch empty OneOf during item content validation+- Group the patterns slightly differently+- Be consistent in taking only first word as game mode name+- Rename PHD_DEFENSE_QUESTION to VULNERABILITY_BALM for diffing with Allure+- Group TileKind patterns+- Remove IsString instance of GroupName to catch typos+- Reorder code in content files+- Make embed content patterns different from tile patterns+- Use PatternSynonyms for all content+- Permit and use PatternSynonyms in some ItemKind-related code+- Don't crash when some items consumed during dropping+- Don't warn about untriggered embeds; altering may be the focus+- Don't report exploiting if not triggered+- Let terrain be changed with items even when embeds not untriggered+- Be less verbose when losing items+- Be more verbose when losing items due to tile altering+- Report which embedded item was exploited so that 'Nothing happens' makes sense+- Don't report items appearing under projectiles that are already spent+- Reword command category headings+- Don't move away staircase inhabitants if projectile is changing levels+- Let only visible projectiles discover hidden tiles, etc.+- Don't display vacuus menu mode switch symbols+- Waste items for altering only if voluntary or released as projectile+- Get rid of spam about inability to modify terrain+- Identify item lost in order to modify terrain+- Let projectiles alter terrain, but not when just flying over it+- Don't check alter skill when projectiles do the altering+- Improve comments about the 6 tile modifying constructors+- Don't modify terrain by just walking over it+- Permit the use of equipment for modifying terrain+- Warn when no items to modify terrain+- Prefer durable items for altering tiles+- Don't destroy but apply durable items used to alter tiles+- Add tile alteration that demands and consumes items+- Improve description of cooking effects+- Add OrEffect binary constructor+- Replace Composite by a binary constructor+- Display failure message when embed not under feet triggered vacuusly+- Don't light adjacent tiles for free+- Avoid 'you look less hungry' about the pointman+- When smashed item exhibits no effect, don't warn+- Report tile changes under a big actor+- Generally never alter tile if under feet and embed not triggered+- Detect when dropping or destroying items is vacuus+- Only alter tiles via walking on them if any embed triggered+- Don't spam when embed doesn't trigger when walked over+- Implement DestroyItem effect+- Let embedded items react to items dropped over them+- Explain away only pointman moving+- Inform about automatic melee in the in-game help+- Mention that all factions and actors are equal+- Reverse stars and underscores in HP bar in HUD+- Stress suvival in the game manual+- Make skill check for embedded items on the client consistent with server+- Give hints when terrain can't be entered nor modified+- Describe hunger removing items, etc., with more detail+- Mention leap frog in game manual+- When scrapping message repetitions, ignore trailing EOLs+- Don't spam about items underfoot at game start, when they are also 'located'+- Report moving player's stash on a new line, mostly for starting screen+- Bring back scenario notes at game start and resume+- Bring back notes in challenges menu+- Handle the meta note about scenario separately+- Mention challenges in the high score entries+- Remove the Show instance of ScoreRecord+- Invalidate inMelee when weapons dropped or picked up+- Use --assertExplored in makefile tests+- Verify the commandline assertion about explored level+- Don't assert exploration if another game started in a debug run+- Add a debug commandline option to verify explorers are not stuck+- Make projectile-less actors randomly more aggressive+- Add a bit of histeresis when fleeing+- Destroy proportional font textures to avoid freezes when they pile up+- Prevent AI from running away from helpless foe+- Stop targetting foes once they lose all weapons+- Let AI do more vs foe with HP <= 0 to avoid stalemate if foe regenerates fast+- Don't spuriously check if TEnemy is a foe+- Improve documentation of targeting+- Don't attack hapless nonmoving foes at range also+- Don't normally target nonmoving actors that can only melee+- Use actorWorthMelee in inMelee+- Melee a targeted foe even if not worth meleeing otherwise+- Don't target hapless uninteresting foes+- Don't melee a foe with only benign weapons+- Don't consider foes with benign weapons a threat+- Only consider actor in melee if adjacent foes worth meleeing+- Don't interrupt running if benign melee actor adjacent+- Introduce the count of benign weapons of an actor+- Make sure tutorial scenarios have enough melee weapons+- Avoid checking isModifiable once more, in verifyAlters+- Consistently check isModifiable together with embeds+- Mark the new request failures as impossible on the server+- Add some internal operations, for future easier profiling+- Removed TileOpenClosed error message+- Further enhancements in tile closing+- Removed TriggerTile+- Remove commandline default that forced Just that is interpreted as game reset+- Bring back the way dungeon generation perturbed random rolls+- Make 64bit native and 32bit browser games play the same with the same RNG seed+- Keep a separate random seed for UI+- Use bitmaskWithRejection form randomR+- Add some BENCHOPTS+- Use splitmix+- Suggest switching to another teammate if movement skill drained+- Turned off showing of default --maxFps value+- Additional logPriority value and defaultMaxFps+- Couple command line options are now clamped or checked before they're set+- Only run with selected actors that are not yet at goal+- Hint about menus in movement stst too low message+- Hint to wake up if movement skill drained by sleep+- Display also own asleep actors green on HUD+- Make the heading of item menu when inspecting an organ less confusing+- Tell that second 'f' projects+- Add a comment about the 'exploit' verb+- Do not mention 'trunk' in weapon strike messages+- Do not mention 'trunk' in armor blocking messages+- Suggest in history menu to press RET+- Get rid of Server.EndM+- Make sure closing window in rage at defeat/win saves game+- Mention in the manual that HP starts at half max+- Reformat game peculiarities list in the manual+- Don't announce pushing that has no effect+- Try to make the under AI control prefix less confusing+- Let animations be toggled in main menu+- Don't display buttons on a separate line unless message is very long+- Add a newline after scenario description+- Avoid blank lines in history+- Overhaul the order and blurbs of game modes+- Make raid scenario squad-based+- Display scenario descriptions in their submenu+- Don't show backstory in submenus of the main menu+- Rework new game start menus+- Add a visual separator between new games in history+- Reverse the order history messages are displayed in+- Copy the list of distinguishing features from Allure homepage+- Restructure chronologically the game manual with verbs as section titles+- Avoid empty paragraphs+- Ignore linebreaks when showing the condensed history line+- Underline that mouse is optional+- Make 'crosshair' on the status line uniform with other headers+- Bring back the help prompt that doesn't confusingly mention advancing+- Mark overful HP and Calm specially on HUD+- Add some blank lines when stacking command lists+- Stress that mouse is optional+- Move mouse help screens earlier+- Don't indent help parts by proportional space width+- Clarify the structure of help information+- Don't show 'crosshair' when not aiming+- Get rid of 'x-hair'+- Make collective running less prominent in help; tweak help+- Mark some text files as out of date+- Add a paragraph break before nearby item summary+- Accept longer menu messages+- Add a paragraph break before cave description+- Warn that over-max HP gain is transient+- Mark deaths with paragraphs and display 'Alas' already at incapacitation+- Add a line break after gameover identification of items+- Add a couple of line-breaks to reports+- Rename emptyAttrString, which was misleading+- Introduce a newtype of attribute lines with no linebreaks+- Prevent backstory overflow in main menu with proportional font+- Move O command just after I command in help+- When toggling autoplay, as with y/n, not SPACE/ESC+- Let left and right arrow keys move between sides of help screen+- Fine-tune helps screens for display side-by-side+- Naively cram help screens side by side+- Merge the two item command help pages+- Use proportional font for help, dashboard and item menu+- Use square font for movement scheme help paragraph+- Make it possible to use many fonts in help+- Get rid of MoveKeys.txt+- Set up main menu for both proportional and square fonts+- Remove backstory from help screens+- Add backstory to main menu, set up for square font, for now+- With square font, add extra space before item symbol+- Represent button width as a datatype+- Parameterize all typesetting by the font setup (multi or single)+- Pass along information about supported fonts+- Let sdl frontend really handle the setup with no prop nor mono font+- Gut out ascii art+- Add blank space around some lines of overlays+- Take all items with *, not !+- Update the item removal verb+- Switch a single place lore display to mono font+- Render skill menu and item lore menu with proper fonts+- Display item symbol in item menu in square font+- Display label and symbol in items overlay using square fonts+- Display at most 3 lines of buttons when too little space for menu+- Make a mouse misclick error easier to understand+- Don't wrap Mono keys after a prompt+- Overlay in square font when basic frame is under animations+- Introduce a separate UI coordinate system+- Make boxSize even+- Don't highlight wrong overlays when buttons highlighted+- Avoid proportional font in button-like UI areas+- Permit overlays with gaps+- Name font kinds consistently+- Display some overlays in monospace font+- Display history labels in mono font+- Specify fonts also in slideshows+- Move the definitions of DisplayFont and FontOverlayMap+- Propagate the choice of fonts for overlays+- Generalize drawOverlay to specify desired font for each overlay+- Generalize overlays to let them start at arbitrary X offsets+- Eliminate overlayFrameWithLines+- Document better the overlay types+- Move ColorMode to another module+- Specify when to use which kind of main font+- Add monospace rectangular font to game configuration+- Remove the old woff font+- Add new fonts, proportional and monospace+- Specify size of the message font separately+- Don't cursor highlight break up proportional font message chunks+- Don't let space break up prorpotional font message chunks+- Render the extra overlays in proportional font+- If message font supported, pass overlay over instead of rendering+- Initialize also the message font in SDL frontend+- Add message overlay font to game configuration+- Comment about why animals rarely eat food+- Rename tactics to doctrine+- Get rid of the henchman notion+- Rename leader to pointman+- Handle UpdTimeItem when container not visible (CStash), but item visible+- Improve command descriptions+- Redefine key bindings not to collide with new movement keys+- Detect collisions of keybindings with movement keys+- Use the keys freed by removing the right hand movement setup+- Replace right hand with left hand movement keys+- Main inventory the main store in game help and UI+- Move total value display to all posessions menu+- Identify items at any item move, in case they are thrown at stash+- Avoid spam about actors getting braced+- Mention in failure messages that hoard accessed when stading over it+- Mention in failure messages that too low Calm for Eqp+- Attempt to display handling of multiple items more succintly+- Bring back UpdMoveItem to have better messages+- Properly describe item move actions+- Lose access to stash when enemy steps on it+- Say who's stash is an item moved to, unless it's ours+- Announce that enemy stash found+- Make sure to let clients know even the human trinket items at gameover+- Let new stash correctly overwrite old, even if old not seen+- Introduce PosSightLevels and use for CStash containers+- Get rid of seenAtomicGeneralCli+- Simplify handleAndBroadcast+- Make updTimeItem more loose when enemy CStash is considered+- Don't carry item definitions in commands that don't create items+- Register on the client the items necessary for commands+- Analyze what items client needs to know to process a command+- Clean up creation vs spotting of actors and items+- Add UpdRegisterItems to be used instead of many ad-hoc calls currently+- Be permissive when performing atomic action wrt CStash+- Simplify SfxStrike, etc., and don't require access to store's bag+- Simplify PosFidAndSight+- Remove UpdMoveItem atomic command that is not too common without CInv any more+- Simplify handling of CStash action visiblity+- Display also enemy stashes in position description+- Let actors learn stash positions when they come into view+- Mark on the map enemy stashes as well+- Refactor UpdStashFaction to let enemies see it sometimes+- Add shared stash position to team's perception+- Say in position description that stash is there+- Mark own shared stash position with white box+- Remove gstash handling in atomic commands+- Move CStash in server code, not atomic commands+- Avoid catch-all in cmdAtomicSemSer+- Introduce UpdStashFaction+- Do not produce a now unused ItemFull for inventory+- When moving items, don't cycle to Ground, when over stash+- In UI don't try to use CGround when over CStash+- Don't let AI consider floor items at it shared stash location+- When scanning a map, don't consider own stash an ordinary pile of items+- Update atomic position information for shared stash+- Make eqp, not stash, unavailable when low Calm+- Make CStash the new implicit default when picking up items+- Gut out CInv and CSha and replace it with CStash represented on the map+- Remove the unused effect ActivateInv+- Bump version, anticipating major inventory logic overhaul+- Reword the MOwned item dialog mode blurbs+- Simplify the header of the lore menus+- Change meny keys / and ? to > and <+- Update scenario names in the manual+- Mention the ! key whenever KP_* is mentioned+- Simplify and fix placement of --more- prompts+- Change the AttrString word gluing operation and fix drawFrameStatus+- Slightly fix speed calculation to agree with what's on the wiki+- Fix a memory leak from tutorial hints repetition avoidance+- Fix no frames displayed while resting+- Fix missing dot at the end of taunt message+- Fix heroes starting on exit in escape scenario+- Fix the healing necklace better used from the backpack+- Fix which are considered minor effects+- Fix spurious double space suffix when rendring on blank+- Fix mouse in area help, wrongly typeset with square font+- Fix interruption message not appearing on screen, only in history+- Fix wrong order of words in the detection effect message+- Fix and simplify armor conditions message choice+- Fix good conditions displayed in red+- Fix broken combat description condition about armor+- Fix not updated tutorial switch when game won+- Fix a hint wrongly guessing the damage was piercing+- Fix failures not stopping macro playback+- Fix the lack of 'a' when hearing distant summoning+- Fix using the reserved number 0 for faction ID+- Fix backing up broken savegames+- Fix a spurious space before a sentence ending dot+- Fix lack of capitalization in verb messages+- Fix genetic flaw activated at death+- Fix a typo in identifier names+- Fix first lines of message wrapped too late+- Fix botched conditions for SfxFizzles, etc.+- Fix includeMetaGame computed twice+- Fix meta game identification not carrying through to the next game+- Fix accumulating meta game item kinds+- Fix scenarios with numbered actors but without continued team+- Fix an optimization two lines too low in shuffleExcept+- Fix a triple copy-pasto with Ability.MetaGame+- Fix discoMetaGame for clients with state held by server+- Fix displaying deflection when the perpetrator is not seen+- Fix tutorial hints disabling+- Fix a link to roguebasin+- Fix short wrapping of adventure lore+- Fix overflowing messages with more than 2 spaces+- Fix 4 spaces message indentation with square font+- Fix trash on fullscreen borders+- Fix not showing aiming line when changing epsilon+- Fix trying to describe an item that is not seen by the actor hit with it+- Fix whitespace in displayRespSfxAtomicUI+- Fix display of message log aligned to newest message+- Fix extra SPACE needed to see history after game save command+- Fix running broken due to vacuus MsgAtFeetMajor messages+- Fix MsgStopPlayback not stopping running+- Fix usage of two different widths in splitAttrString+- Fix history lines starting with EOL+- Fix monospace overlay whitespace spilling onto proportional+- Fix wrongly enabled display of MsgRunStop message class+- Fix deduplicating shown and saved messages separately+- Fix, again, leftover UI clients killing frontend after already killed+- Fix the numeric display of HP gain/loss+- Fix wrong SDL wrapping markers when using mono fonts only+- Fix a missing mouse command description+- Fix Tasty tests broken by frontend fixes+- Fix screensavers broken by UI faction not being the first+- Fix a bug with two UI clients interspersing frames+- Fix 'open main menu' command of Dashboard+- Fix the GTK frontend again+- Fix a syntax error in travis script+- Fix license name+- Fix linearInterpolation for inflated dungeon depths once more+- Fix running disturbed by many boring tiles at open levels+- Fix MsgItemMove messages not saved to history+- Fix unintentional cap on actor generation level+- Fix calling gameover and 'endgame'+- Fix lack of EOL before initial separation line of history+- Fix mouse coordinates in the browser+- Fix assigning number symbols to hero faction projectiles+- Fix and improve how deflections are displayed+- Fix a 32bit system bug that intCast detected+- Fix damage not displayed when other attributes are+- Fix flinging from item menu cancelling item selection+- Fix the comment about users able to overwrite keys+- Fix a crash when impossible command chosen+- Fix bitrot that corrupted curses frontend+- Fix 'the fallen falling' projectiles+- Fix wrong alignment of level percent seen+- Fix autoexplore with changing crosshair+- Fix goto not interrupted change of crosshair+- Fix the valuation of OnUser effect+- Fix the lack of the last backdrop line in the game greeting blurb+- Fix memory leak in placesFromState+- Fix double braced due the hack for skill-less yelling+- Fix order of using weapons inconsistent with HUD+- Fix actor that can't wait not ignored as a pointman even when inactive+- Fix stash guard preferred as pointman+- Fix AI leader choice to really prefer old leader and to avoid light more+- Fix raid scenario starting with two faction close to escape+- Fix random number out of range on 32bit JS+- Fix teleport effect from stash item not identifying it+- Fix warnings in gtk frontend+- Fix the extra blank menu line starting too late+- Fix section links in the game manual+- Fix and simplify rules for disabling tile transformation+- Fix missed blank prefixes of empty lines inside text+- Fix and simplify projectiles activating and transforming terrain, again+- Fix projectiles not able to lit up oil+- Fix padded empty string overwriting UI elements+- Fix the position of second column with square font+- Fix trailing spaces in dashboard+- Fix a trailing space in a message+- Fix disable extra empty shadow line at the bottom of menus+- Fix determining if item identified in permittedPrecious+- Fix an actor pulling himself+- Fix desynchronized copy-pasted actorVulnerable code+- Fix history message display header+- Fix Calm measurement code to match code documentation+- Fix sleeping stash guard not considered a guard+- Fix reaching escape from below when all levels explored+- Fix hero AI sometimes not exploring levels fully+- Fix weapon order of Smithhammer+- Fix messages about melee-only armor deflecting missiles+- Fix wrong condition, wrongly reducing fleeing behaviour+- Fix comments about slack doctrine targets+- Fix assertion failure when targetting a tile under oneself+- Fix code documentation about inventory stores+- Fix the unequipping failure message condition+- Fix wrong cave reversal when generating dungeon+- Fix non-pointman heroes meleeing healing geysers+- Fix poisons never activating and never running out+- Fix registering if altering failed due to bumping+- Fix a bushy patch that can block starting actors+- Fix diverging definitions of foes worth killing+- Fix barrels not destroyed by bumping+- Fix inability to open doors due to no embeds+- Fix projectiles not to bump off, but to transform terrain+- Fix the display of level in stash menu header+- Fix alliance placing to put heroes over stairs+- Fix a wrong message when displacing a waking foe+- Fix AI not eating and not removing other bad conditions+- Fix nested macros+- Fix wrong game mode started due to only the first word inspected+- Fix the result of AndEffect+- Fix the warning when flinging benign items+- Fix a loop when actor pushed to another level via stairs+- Fix melee disrupting pushed flight+- Fix unidentified weapons marked in HUD as without timeout+- Fix modelling wear and tear with DestroyItem+- Fix mixed up resistance conditions+- Fix item dropping crashes when OnSmash effects remove them while dropped+- Fix an AI loop when applying a recharging item+- Fix some no-fence places not appearing in statistics+- Fix display of empty lists of tools for terrain transformations+- Fix referring in the server code to definitions from the client internals+- Fix embedded items activated twice+- Fix an attempt to consume more items than there exist+- Fix broken running macro+- Fix activating embeds+- Fix repeating predefined macros+- Fix unsafe recording+- Fix in-game macro system+- Fix discharging an item that is not recharged+- Fix consumeItems missing in an export list+- Fix missing spaces in describeToolsAlternative+- Fix display of tool alternatives+- Fix random results of sortEmbeds+- Fix checks if actors in combat+- Fix the semantics of Discharge effect+- Fix a crash when updating invisible item timer+- Fix altering skill check in the client+- Fix omission of OpenWith when OpenTo is considered+- Fix unidentified embedded items impossible to trigger+- Fix usage of outdated state component when altering tiles+- Fix an attempt to apply a used up embedded item+- Fix the direction of < and > scrolling in ending screens+- Fix rubble tile definition wrt order of activated features+- Fix old actor body used after altering caused by collision with terrain+- Fix wrong condition for alien captured at victory message+- Fix moving only all or none items between containers+- Fix crash when actor not visible after triggering an item+- Fix crash when dopping previous may destroy next items+- Fix projectile altering a tile too many times at once+- Fix DropItem reporting no activation due to item vanishing earlier+- Fix off-by-one when picking projectiles with enough range+- Fix trying to destroy an empty item bag when modifying terrain with it+- Fix assumption that if last actor is alien, game is won+- Fix no identification message sometimes in the first turn+- Fix compilation without EXPOSE_INTERNAL+- Fix the trap of drain Calm item in equipment that can't be removed+- Fix tiles never altered via walking on them+- Fix articles incorrectly recognized in words that end similarly+- Fix wrong calculation of number of non-durable weapons+- Fix incorrect conjugation+- Fix a corruption of backstory text+- Fix first character of buttons sometimes overwritten by space+- Fix wrongly displaying a special ending for small scenarios+- Fix other frontends wrt engine and sdl2 frontend changes+- Fix proportional overlay overwriting first character of mono one+- Fix help setup for large screens+- Fix broken item menu with square font+- Fix wrong button initial position with square font+- Fix distant overlays wrongly getting a highlighted line+- Fix SDL frontend truncating proportional font lines+- Fix and tweak measuring texts in various fonts+- Fix empty menus in single font mode+- Fix spurious ending prompt in single-font setup+- Fix padding of line chunks overwriting subsequent chunks+- Fix display of history+- Fix buttons holding other locations of an item+- Fix not shown highlight of prop font lines+- Fix spurious empty line between header and menu+- Fix use of fromAscList where fromDistinctAscList would do+- Fix spacing in history display+- Fix off-by-one crash in history+- Fix mouse clicks on buttons in small font areas+- Fix updateLine for the case of multiple overlays+- Fix overrun in mouse help table+- Fix history highlight restricted to 80 columns+- Fix menu highlight splitting proportional text chunks+- Fix proportional texts never wiped out+- Fix horizontal starting points of message chunks+- Fix a syntax error stemming from wrong CPP+- Fix illegal containers creeping into item choice+- Fix cmdAtomicSemSer for UpdMoveItem+- Fix AI not sidestepping explosive tiles, even if it could+- Fix AI not sidestepping nearby actors+- Fix cmdAtomicSemSer in the presense of CStash that acts like CFloor+- Fix broken atomic commands assigned wrong LevelId+- Fix visible enemy stash position not updated, because foes not seen+- Fix countless typos+- Start using cabal-plan+- Fix and improve Makefile, cabal file and CI scripts+- Improve and update game manual and help texts wrt game changes+- Tweak travis scripts and building docs in README++## [v0.9.5.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.4.0...v0.9.5.0)++- Fix NumLock disabled in the browser+- In screen reader frontend, highlight active menu line with the cursor+- Clone the main main menu commands as map mode commands+- Add C-RMB and C-S-LMB as alternatives of MMB+- Announce prominently MMB binding for describing map positions+- Clean up the default config file, keeping compatibility+- Make scenario names longer and slighlty more informative+- Make Vi movement keys the default in addition to keypad and mouse+- Fix a bug where death prompt when autoplaying was capturing a keypress+- Let ESC from main menu return to insert coin mode, if applicable+- Make various small UI tweaks, especially to main menu and its submenu+- Let main menu lines have 35, not 30, characters+- Make the main menu ASCII art less intrusive (and easier for screen readers)+- Don't invalidate the score file due to game minor (only) version bump++## [v0.9.4.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.3.0...v0.9.4.0)++- In vty frontend highlight actors more+- Clean up actor highlighting+- Add yell/yawn to minimal command set, remove swerving the aiming line+- Invoke yell/yawn exclusively with '%', due tor Windows and terminal woes+- Move C-c command to C, not to mask C-c on console frontends+- Tweak and fix vty console frontends, for screen-readers+- React specially at gameover under certain special circumstances+- Simpliy assignSlot now that slots are auto-sorted+- Get rid of explicit item sorting; let lore and menu slots agree+- Make DetectExit non-modal+- Mark in a game end confirmation message that more treasure can be found+- Add a description to the escape embedded item+- Reword gameover text for raid scenario+- Be more verbose when confirming escape from the game+- Don't claim to summon, when not possible on this level+- Fix missing 'no longer poisoned' when applying antidote+- Don't ask confirmation for neutral (e.g., not IDed) items+- Fix 'you fall down; you stand on a sword'+- Prevent selecting regions via mouse down in web frontend+- Deselect item if player declines to apply or fling+- Hand-hold the player, warning if flung item is beneficial+- Hand-hold the player, warning if applied item is harmful+- Rewrite the condition in UI applyItem check+- Improve the lobable item skill failure message+- Let mouse buttons describe tiles, etc.+- Unblock S-MouseButton in SDL2 frontend+- Always describe things under mouse button+- Make the message when hitting dead foe more varied++## [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 gameover 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

COPYLEFT view

@@ -5,21 +5,53 @@  Files: * Copyright: 2008-2011 Andres Loeh-           2010-2019 Mikolaj Konarski and others (see git history)+           2010-2021 Mikolaj Konarski and others (see git history) License: BSD-3-Clause -Files: GameDefinition/fonts/{*.fnt,*.bdf,16x16xw.woff}+Files: GameDefinition/fonts/*.fnt GameDefinition/fonts/*.bdf GameDefinition/fonts/16x16xw.woff Copyright: 1997-2016 Leon Marrick            1997-2016 Sheldon Simms III            1997-2016 Nick McConnell-           2016-2019 Mikolaj Konarski+           2016-2021 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-2019 Mikolaj Konarski+Files: GameDefinition/fonts/Binary*.woff+Copyright 2010-2019 Adobe (http://www.adobe.com/), with Reserved Font Name 'Source'+Copyright 2021 Mikolaj Konarski License: OFL-1.1 +Files: GameDefinition/fonts/DejaVu*.woff+Copyright: Copyright (c) 2003 by Bitstream, Inc. All Rights Reserved.+ Bitstream Vera is a trademark of Bitstream, Inc.+ DejaVu changes are in public domain.+License: bitstream-vera+Comment:+ Bitstream Vera Sans Mono is Copyright Bitstream Inc. and licensed under the+ Bitstream Vera License with Reserved Font Names "Bitstream" and "Vera".+ .+ DejaVu modifications of the original Bitstream Vera Sans Mono typeface have+ been committed to the public domain.+ .+ The work in the Hack project is licensed under the MIT (Expat) License.+ .+ Copied from https://metadata.ftp-master.debian.org/changelogs//main/f/fonts-dejavu/fonts-dejavu_2.37-2_copyright++Files: GameDefinition/fonts/Hack*.woff+Copyright:+ 2003 Bitstream Inc.+ 2018 Christopher Simpkins <chris@sourcefoundry.org>+License: Expat and bitstream-vera+Comment:+ Bitstream Vera Sans Mono is Copyright Bitstream Inc. and licensed under the+ Bitstream Vera License with Reserved Font Names "Bitstream" and "Vera".+ .+ DejaVu modifications of the original Bitstream Vera Sans Mono typeface have+ been committed to the public domain.+ .+ The work in the Hack project is licensed under the MIT (Expat) License.+ .+ Copied from https://metadata.ftp-master.debian.org/changelogs//main/f/fonts-hack/fonts-hack_3.003-3_copyright+ Files: debian/* Copyright: held by the contributors mentioned in debian/changelog License: BSD-3-Clause@@ -155,3 +187,61 @@  CONSEQUENTIAL DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR  OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO USE THE FONT  SOFTWARE OR FROM OTHER DEALINGS IN THE FONT SOFTWARE.++License: bitstream-vera+ Permission is hereby granted, free of charge, to any person obtaining a copy+ of the fonts accompanying this license ("Fonts") and associated documentation+ files (the "Font Software"), to reproduce and distribute the Font Software,+ including without limitation the rights to use, copy, merge, publish,+ distribute, and/or sell copies of the Font Software, and to permit persons to+ whom the Font Software is furnished to do so, subject to the following+ conditions:+ .+ The above copyright and trademark notices and this permission notice shall be+ included in all copies of one or more of the Font Software typefaces.+ .+ The Font Software may be modified, altered, or added to, and in particular the+ designs of glyphs or characters in the Fonts may be modified and additional+ glyphs or characters may be added to the Fonts, only if the fonts are renamed+ to names not containing either the words "Bitstream" or the word "Vera".+ .+ This License becomes null and void to the extent applicable to Fonts or Font+ Software that has been modified and is distributed under the "Bitstream Vera"+ names.+ .+ The Font Software may be sold as part of a larger software package but no copy+ of one or more of the Font Software typefaces may be sold by itself.+ .+ THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+ OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF MERCHANTABILITY,+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF COPYRIGHT, PATENT,+ TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL BITSTREAM OR THE GNOME FOUNDATION+ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, INCLUDING ANY GENERAL,+ SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, WHETHER IN AN ACTION+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO+ USE THE FONT SOFTWARE OR FROM OTHER DEALINGS IN THE FONT SOFTWARE.+ .+ Except as contained in this notice, the names of Gnome, the Gnome Foundation,+ and Bitstream Inc., shall not be used in advertising or otherwise to promote+ the sale, use or other dealings in this Font Software without prior written+ authorization from the Gnome Foundation or Bitstream Inc., respectively. For+ further information, contact: fonts at gnome dot org.++License: Expat+ Permission is hereby granted, free of charge, to any person obtaining a+ copy of this software and associated documentation files (the "Software"),+ to deal in the Software without restriction, including without limitation+ the rights to use, copy, modify, merge, publish, distribute, sublicense,+ and/or sell copies of the Software, and to permit persons to whom the+ Software is furnished to do so, subject to the following conditions:+ .+ The above copyright notice and this permission notice shall be included+ in all copies or substantial portions of the Software.+ .+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+ THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR+ OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+ OTHER DEALINGS IN THE SOFTWARE.

− CREDITS

@@ -1,52 +0,0 @@-All kinds of contributions to the LambdaHack engine are gratefully welcome!-Some of the contributors are listed below, in chronological order.--Andres Loeh-Mikolaj Konarski-Tuukka Turto-Veronika Romashkina-Daniel Keefe-Pablo Reszczynski---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 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.-The modified font is released under the SIL Open Font License, as seen in-GameDefinition/fonts/LICENSE.Fix15Mono-Bold in the source code tree.-Modifications were performed with font editor FontForge and are as follows:-* straighten and enlarge #, enlarge %, &, ', +, \,, -, :, ;, O, _, `-* centre a few other glyphs-* create a small 0x22c5-* shrink 0xb7 a bit-* extend all fonts by 150% and 150%-    (the extension resulted in an artifact in letter 'n',-     which was gleefully kept, and many other artifacts and distortions-     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

GameDefinition/Content/CaveKind.hs view

@@ -1,6 +1,11 @@--- | Cave properties.+-- | Definitions of of cave kinds. Every level in the game is an instantiated+-- cave kind. module Content.CaveKind-  ( content+  ( -- * Group name patterns+    pattern CAVE_ROGUE, pattern CAVE_ARENA, pattern CAVE_SMOKING, pattern CAVE_LABORATORY, pattern CAVE_NOISE, pattern CAVE_MINE, pattern CAVE_EMPTY, pattern CAVE_SHALLOW_ROGUE, pattern CAVE_OUTERMOST, pattern CAVE_RAID, pattern CAVE_BRAWL, pattern CAVE_SHOOTOUT, pattern CAVE_HUNT, pattern CAVE_ESCAPE, pattern CAVE_ZOO, pattern CAVE_AMBUSH, pattern CAVE_BATTLE, pattern CAVE_SAFARI_1, pattern CAVE_SAFARI_2, pattern CAVE_SAFARI_3+  , groupNamesSingleton, groupNames+  , -- * Content+    content   ) where  import Prelude ()@@ -9,21 +14,65 @@  import Data.Ratio -import Game.LambdaHack.Content.CaveKind-import Game.LambdaHack.Core.Dice+import           Content.ItemKind hiding+  (content, groupNames, groupNamesSingleton)+import           Content.ItemKindActor+import           Content.PlaceKind hiding+  (content, groupNames, groupNamesSingleton)+import           Content.TileKind hiding+  (content, groupNames, groupNamesSingleton)+import           Game.LambdaHack.Content.CaveKind+import qualified Game.LambdaHack.Content.ItemKind as IK+import           Game.LambdaHack.Content.TileKind+import           Game.LambdaHack.Core.Dice+import           Game.LambdaHack.Definition.Defs +-- * Group name patterns++groupNamesSingleton :: [GroupName CaveKind]+groupNamesSingleton = []++groupNames :: [GroupName CaveKind]+groupNames =+       [CAVE_ROGUE, CAVE_ARENA, CAVE_SMOKING, CAVE_LABORATORY, CAVE_NOISE, CAVE_MINE, CAVE_EMPTY, CAVE_SHALLOW_ROGUE, CAVE_OUTERMOST, CAVE_RAID, CAVE_BRAWL, CAVE_SHOOTOUT, CAVE_HUNT, CAVE_ESCAPE, CAVE_ZOO, CAVE_AMBUSH, CAVE_BATTLE, CAVE_SAFARI_1, CAVE_SAFARI_2, CAVE_SAFARI_3]++pattern CAVE_ROGUE, CAVE_ARENA, CAVE_SMOKING, CAVE_LABORATORY, CAVE_NOISE, CAVE_MINE, CAVE_EMPTY, CAVE_SHALLOW_ROGUE, CAVE_OUTERMOST, CAVE_RAID, CAVE_BRAWL, CAVE_SHOOTOUT, CAVE_HUNT, CAVE_ESCAPE, CAVE_ZOO, CAVE_AMBUSH, CAVE_BATTLE, CAVE_SAFARI_1, CAVE_SAFARI_2, CAVE_SAFARI_3 :: GroupName CaveKind++pattern CAVE_ROGUE = GroupName "caveRogue"+pattern CAVE_ARENA = GroupName "caveArena"+pattern CAVE_SMOKING = GroupName "caveSmoking"+pattern CAVE_LABORATORY = GroupName "caveLaboratory"+pattern CAVE_NOISE = GroupName "caveNoise"+pattern CAVE_MINE = GroupName "caveMine"+pattern CAVE_EMPTY = GroupName "caveEmpty"+pattern CAVE_SHALLOW_ROGUE = GroupName "caveShallowRogue"+pattern CAVE_OUTERMOST = GroupName "caveOutermost"+pattern CAVE_RAID = GroupName "caveRaid"+pattern CAVE_BRAWL = GroupName "caveBrawl"+pattern CAVE_SHOOTOUT = GroupName "caveShootout"+pattern CAVE_HUNT = GroupName "caveHunt"+pattern CAVE_ESCAPE = GroupName "caveEscape"+pattern CAVE_ZOO = GroupName "caveZoo"+pattern CAVE_AMBUSH = GroupName "caveAmbush"+pattern CAVE_BATTLE = GroupName "caveBattle"+pattern CAVE_SAFARI_1 = GroupName "caveSafari1"+pattern CAVE_SAFARI_2 = GroupName "caveSafari2"+pattern CAVE_SAFARI_3 = GroupName "caveSafari3"++-- * Content+ content :: [CaveKind] content =-  [rogue, arena, smoking, laboratory, noise, mine, empty, shallowRogue, outermost, raid, brawl, shootout, hunt, escape, zoo, ambush, battle, safari1, safari2, safari3]+  [rogue, arena, smoking, laboratory, noise, mine, empty, outermost, shallowRogue, raid, brawl, shootout, hunt, escape, zoo, ambush, battle, safari1, safari2, safari3] -rogue,    arena, smoking, laboratory, noise, mine, empty, shallowRogue, outermost, raid, brawl, shootout, hunt, escape, zoo, ambush, battle, safari1, safari2, safari3 :: CaveKind+rogue,    arena, smoking, laboratory, noise, mine, empty, outermost, shallowRogue, raid, brawl, shootout, hunt, escape, zoo, ambush, battle, safari1, safari2, safari3 :: CaveKind  -- * Underground caves; most of mediocre height and size  rogue = CaveKind   { csymbol       = 'R'   , cname         = "A maze of twisty passages"-  , cfreq         = [("default random", 100), ("caveRogue", 1)]+  , cfreq         = [(DEFAULT_RANDOM, 100), (CAVE_ROGUE, 1)]   , cXminSize     = 80   , cYminSize     = 21   , ccellSize     = DiceXY (2 `d` 4 + 10) 6@@ -34,40 +83,43 @@   , cnightOdds    = 51  -- always night   , cauxConnects  = 1%2   , cmaxVoid      = 1%6-  , cminStairDist = 20-  , cextraStairs  = 1 + 1 `d` 2   , cdoorChance   = 3%4   , copenChance   = 1%5   , chidden       = 7   , cactorCoeff   = 65  -- the maze requires time to explore-  , cactorFreq    = [("monster", 60), ("animal", 40)]+  , cactorFreq    = [(MONSTER, 60), (ANIMAL, 40)]   , citemNum      = 6 `d` 5 + 10 - 10 `dL` 1  -- deep down quality over quantity-  , citemFreq     = [("common item", 40), ("treasure", 60)]-  , cplaceFreq    = [("rogue", 1)]+  , citemFreq     = [(IK.COMMON_ITEM, 40), (IK.TREASURE, 60)]+    -- note that the groups are flattened; e.g., if an item is moved to another+    -- group included here with the same weight, the outcome wouldn't change+  , cplaceFreq    = [(ROGUE, 1)]   , cpassable     = False   , labyrinth     = False-  , cdefTile      = "fillerWall"-  , cdarkCorTile  = "floorCorridorDark"-  , clitCorTile   = "floorCorridorLit"-  , cwallTile     = "fillerWall"-  , ccornerTile   = "fillerWall"-  , cfenceTileN   = "basic outer fence"-  , cfenceTileE   = "basic outer fence"-  , cfenceTileS   = "basic outer fence"-  , cfenceTileW   = "basic outer fence"+  , cdefTile      = FILLER_WALL+  , cdarkCorTile  = FLOOR_CORRIDOR_DARK+  , clitCorTile   = FLOOR_CORRIDOR_LIT+  , cwallTile     = FILLER_WALL+  , ccornerTile   = FILLER_WALL+  , cfenceTileN   = S_BASIC_OUTER_FENCE+  , cfenceTileE   = S_BASIC_OUTER_FENCE+  , cfenceTileS   = S_BASIC_OUTER_FENCE+  , cfenceTileW   = S_BASIC_OUTER_FENCE   , cfenceApart   = False-  , clegendDarkTile = "legendDark"-  , clegendLitTile  = "legendLit"+  , clegendDarkTile = LEGEND_DARK+  , clegendLitTile  = LEGEND_LIT+  , cminStairDist = 20+  , cmaxStairsNum = 1 + 1 `d` 2   , cescapeFreq   = []-  , cstairFreq    = [ ("walled staircase", 50), ("open staircase", 50)-                    , ("tiny staircase", 1) ]+  , cstairFreq    = [ (WALLED_STAIRCASE, 50), (OPEN_STAIRCASE, 50)+                    , (TINY_STAIRCASE, 1) ]   , cstairAllowed = []+  , cskip         = []   , cdesc         = "Winding tunnels stretch into the dark."   }  -- no lit corridors cave alternative, since both lit # and . look bad here arena = rogue   { csymbol       = 'A'   , cname         = "Dusty underground library"-  , cfreq         = [("default random", 60), ("caveArena", 1)]+  , cfreq         = [(DEFAULT_RANDOM, 60), (CAVE_ARENA, 1)]   , cXminSize     = 50   , cYminSize     = 21   , ccellSize     = DiceXY (3 `d` 3 + 17) (1 `d` 3 + 4)@@ -80,37 +132,38 @@   , cnightOdds    = 0  -- always day   , cauxConnects  = 1   , cmaxVoid      = 1%8-  , cminStairDist = 15-  , cextraStairs  = 1 `d` 2   , chidden       = 0   , cactorCoeff   = 75  -- small open level, don't rush the player-  , cactorFreq    = [("monster", 30), ("animal", 70)]+  , cactorFreq    = [(MONSTER, 30), (ANIMAL, 70)]   , citemNum      = 4 `d` 5  -- few rooms-  , citemFreq     = [("common item", 20), ("treasure", 40), ("any scroll", 40)]-  , cplaceFreq    = [("arena", 1)]+  , citemFreq     = [ (IK.COMMON_ITEM, 20), (IK.TREASURE, 40)+                    , (IK.ANY_SCROLL, 40) ]+  , cplaceFreq    = [(ARENA, 1)]   , cpassable     = True-  , cdefTile      = "arenaSetLit"-  , cdarkCorTile  = "trailLit"  -- let trails give off light-  , clitCorTile   = "trailLit"  -- may be rolled different than the above-  , cstairFreq    = [ ("walled staircase", 20), ("closed staircase", 80)-                    , ("tiny staircase", 1) ]+  , cdefTile      = ARENA_SET_LIT+  , cdarkCorTile  = TRAIL_LIT  -- let trails give off light+  , clitCorTile   = TRAIL_LIT  -- may be rolled different than the above+  , cminStairDist = 15+  , cmaxStairsNum = 1 `d` 2+  , cstairFreq    = [ (WALLED_STAIRCASE, 20), (CLOSED_STAIRCASE, 80)+                    , (TINY_STAIRCASE, 1) ]   , cdesc         = "The shelves groan with dusty books and tattered scrolls."   } smoking = arena   { cname         = "Smoking rooms"-  , cfreq         = [("caveSmoking", 1)]+  , cfreq         = [(CAVE_SMOKING, 1)]   , cdarkOdds     = 41 + 1 `d` 10  -- almost all rooms lit (1 in 10 dark)   -- Trails provide enough light for fun stealth.   , cnightOdds    = 51  -- always night   , citemNum      = 6 `d` 5  -- rare, so make it exciting-  , citemFreq     = [("common item", 20), ("treasure", 40), ("any vial", 40)]-  , cdefTile      = "arenaSetDark"+  , citemFreq     = [(IK.COMMON_ITEM, 20), (IK.TREASURE, 40), (IK.ANY_GLASS, 40)]+  , cdefTile      = ARENA_SET_DARK   , cdesc         = "Velvet couches exude the strong smell of tobacco."   } laboratory = rogue   { csymbol       = 'L'   , cname         = "Burnt laboratory"-  , cfreq         = [("caveLaboratory", 1)]+  , cfreq         = [(CAVE_LABORATORY, 1)]   , cXminSize     = 60   , cYminSize     = 21   , ccellSize     = DiceXY (1 `d` 2 + 5) 6@@ -119,23 +172,24 @@   , cnightOdds    = 0  -- always day so that the corridor smoke is lit   , cauxConnects  = 1%5   , cmaxVoid      = 1%10-  , cextraStairs  = 2   , cdoorChance   = 1   , copenChance   = 1%2-  , cactorFreq    = [("monster", 30), ("animal", 70)]+  , cactorFreq    = [(MONSTER, 30), (ANIMAL, 70)]   , citemNum      = 6 `d` 5  -- reward difficulty-  , citemFreq     = [("common item", 20), ("treasure", 40), ("explosive", 40)]-  , cplaceFreq    = [("laboratory", 1)]-  , cdarkCorTile  = "labTrailLit"  -- let lab smoke give off light always-  , clitCorTile   = "labTrailLit"-  , cstairFreq    = [ ("walled staircase", 50), ("open staircase", 50)-                    , ("tiny staircase", 1) ]+  , citemFreq     = [ (IK.COMMON_ITEM, 20), (IK.TREASURE, 40)+                    , (IK.EXPLOSIVE, 40) ]+  , cplaceFreq    = [(LABORATORY, 1)]+  , cdarkCorTile  = LAB_TRAIL_LIT  -- let lab smoke give off light always+  , clitCorTile   = LAB_TRAIL_LIT+  , cmaxStairsNum = 2+  , cstairFreq    = [ (WALLED_STAIRCASE, 50), (OPEN_STAIRCASE, 50)+                    , (TINY_STAIRCASE, 1) ]   , cdesc         = "Shattered glassware and the sharp scent of spilt chemicals show that something terrible happened here."   } noise = rogue   { csymbol       = 'N'   , cname         = "Leaky burrowed sediment"-  , cfreq         = [("default random", 30), ("caveNoise", 1)]+  , cfreq         = [(DEFAULT_RANDOM, 30), (CAVE_NOISE, 1)]   , cXminSize     = 50   , cYminSize     = 21   , ccellSize     = DiceXY (3 `d` 5 + 12) 6@@ -147,41 +201,41 @@   , cnightOdds    = 0  -- harder variant, but looks cheerful   , cauxConnects  = 1%10   , cmaxVoid      = 1%100-  , cminStairDist = 15   , cdoorChance   = 1  -- to avoid lit quasi-door tiles   , chidden       = 0   , cactorCoeff   = 80  -- the maze requires time to explore; also, small-  , cactorFreq    = [("monster", 80), ("animal", 20)]+  , cactorFreq    = [(MONSTER, 80), (ANIMAL, 20)]   , citemNum      = 6 `d` 5  -- an incentive to explore the labyrinth   , cpassable     = True   , labyrinth     = True-  , cplaceFreq    = [("noise", 1)]-  , cdefTile      = "noiseSetLit"+  , cplaceFreq    = [(NOISE, 1)]+  , cdefTile      = NOISE_SET_LIT   , cfenceApart   = True  -- ensures no cut-off parts from collapsed-  , cdarkCorTile  = "damp floor Dark"-  , clitCorTile   = "damp floor Lit"-  , cstairFreq    = [ ("closed staircase", 50), ("open staircase", 50)-                    , ("tiny staircase", 1) ]+  , cdarkCorTile  = DAMP_FLOOR_DARK+  , clitCorTile   = DAMP_FLOOR_LIT+  , cminStairDist = 15+  , cstairFreq    = [ (CLOSED_STAIRCASE, 50), (OPEN_STAIRCASE, 50)+                    , (TINY_STAIRCASE, 1) ]   , cdesc         = "Soon, these passages will be swallowed up by the mud."   } mine = noise   { cname         = "Frozen derelict mine"-  , cfreq         = [("caveMine", 1)]+  , cfreq         = [(CAVE_MINE, 1)]   , cnightOdds    = 51  -- easier variant, but looks sinister   , citemNum      = 10 `d` 4  -- an incentive to explore the final labyrinth-  , citemFreq     = [("common item", 20), ("gem", 20)]+  , citemFreq     = [(IK.COMMON_ITEM, 20), (GEM, 20)]                       -- can't be "valuable" or template items generated-  , cplaceFreq    = [("noise", 1), ("mine", 99)]-  , cdefTile      = "powerSetDark"-  , cstairFreq    = [ ("gated closed staircase", 50)-                    , ("gated open staircase", 50)-                    , ("gated tiny staircase", 1) ]+  , cplaceFreq    = [(NOISE, 1), (MINE, 99)]+  , cdefTile      = POWER_SET_DARK+  , cstairFreq    = [ (GATED_CLOSED_STAIRCASE, 50)+                    , (GATED_OPEN_STAIRCASE, 50)+                    , (GATED_TINY_STAIRCASE, 1) ]   , cdesc         = "Pillars of shining ice create a frozen labyrinth."   } empty = rogue   { csymbol       = 'E'   , cname         = "Tall cavern"-  , cfreq         = [("caveEmpty", 1)]+  , cfreq         = [(CAVE_EMPTY, 1)]   , ccellSize     = DiceXY (2 `d` 2 + 11) (1 `d` 2 + 8)   , cminPlaceSize = DiceXY 13 11   , cmaxPlaceSize = DiceXY 37 31  -- favour large rooms@@ -189,13 +243,11 @@   , cnightOdds    = 0  -- always day   , cauxConnects  = 3%2   , cmaxVoid      = 0  -- too few rooms to have void and fog common anyway-  , cminStairDist = 30-  , cextraStairs  = 1   , cdoorChance   = 0   , copenChance   = 0   , chidden       = 0   , cactorCoeff   = 7-  , cactorFreq    = [("animal", 10), ("immobile animal", 90)]+  , cactorFreq    = [(ANIMAL, 10), (IMMOBILE_ANIMAL, 90)]       -- The healing geysers on lvl 3 act like HP resets. Needed to avoid       -- cascading failure, if the particular starting conditions were       -- very hard. Items are not reset, even if they are bad, which provides@@ -203,45 +255,48 @@       -- abused, because they spawn less and less often and also HP doesn't       -- effectively accumulate over max.   , citemNum      = 4 `d` 5  -- few rooms and geysers are the boon-  , cplaceFreq    = [("empty", 1)]+  , cplaceFreq    = [(EMPTY, 1)]   , cpassable     = True-  , cdefTile      = "emptySetLit"-  , cdarkCorTile  = "floorArenaDark"-  , clitCorTile   = "floorArenaLit"-  , cstairFreq    = [ ("walled staircase", 20), ("closed staircase", 80)-                    , ("tiny staircase", 1) ]+  , cdefTile      = EMPTY_SET_LIT+  , cdarkCorTile  = FLOOR_ARENA_DARK+  , clitCorTile   = FLOOR_ARENA_LIT+  , cminStairDist = 30+  , cmaxStairsNum = 1+  , cstairFreq    = [ (WALLED_STAIRCASE, 20), (CLOSED_STAIRCASE, 80)+                    , (TINY_STAIRCASE, 1) ]   , cdesc         = "Swirls of warm fog fill the air, the hiss of geysers sounding all around."   }-shallowRogue = rogue-  { cfreq         = [("caveShallowRogue", 100)]-  , cXminSize     = 60-  , cYminSize     = 21-  , cextraStairs  = 1  -- ensure heroes meet initial monsters and their loot-  , cdesc         = "The snorts and grunts of savage beasts can be clearly heard."-  } outermost = shallowRogue   { csymbol       = 'B'   , cname         = "Cave entrance"-  , cfreq         = [("caveOutermost", 100)]+  , cfreq         = [(CAVE_OUTERMOST, 100)]   , cXminSize     = 40   , cYminSize     = 21   , cdarkOdds     = 0  -- all rooms lit, for a gentle start-  , cminStairDist = 10-  , cextraStairs  = 1   , cactorCoeff   = 80  -- already animals start there; also, pity on the noob-  , cactorFreq    = filter ((/= "monster") . fst) $ cactorFreq rogue+  , cactorFreq    = filter ((/= MONSTER) . fst) $ cactorFreq rogue   , citemNum      = 6 `d` 5  -- lure them in with loot-  , citemFreq     = filter ((/= "treasure") . fst) $ citemFreq rogue-  , cescapeFreq   = [("escape up", 1)]+  , citemFreq     = filter ((/= IK.TREASURE) . fst) $ citemFreq rogue+  , cminStairDist = 10+  , cmaxStairsNum = 1+  , cescapeFreq   = [(INDOOR_ESCAPE_UP, 1)]+  , cskip         = [0]   , cdesc         = "This close to the surface, the sunlight still illuminates the dungeon."   }+shallowRogue = rogue+  { cfreq         = [(CAVE_SHALLOW_ROGUE, 100)]+  , cXminSize     = 60+  , cYminSize     = 21+  , cmaxStairsNum = 1  -- ensure heroes meet initial monsters and their loot+  , cdesc         = "The snorts and grunts of savage beasts can be clearly heard."+  }  -- * Overground "caves"; no story-wise limits wrt height and size  raid = rogue   { csymbol       = 'T'   , cname         = "Typing den"-  , cfreq         = [("caveRaid", 1)]+  , cfreq         = [(CAVE_RAID, 1)]   , cXminSize     = 50   , cYminSize     = 21   , ccellSize     = DiceXY (2 `d` 4 + 6) 6@@ -249,13 +304,15 @@   , cmaxPlaceSize = DiceXY 16 20   , cdarkOdds     = 0  -- all rooms lit, for a gentle start   , cmaxVoid      = 1%10-  , cextraStairs  = 0   , cactorCoeff   = 250  -- deep level with no kit, so slow spawning-  , cactorFreq    = [("animal", 100)]+  , cactorFreq    = [(ANIMAL, 100)]   , citemNum      = 6 `d` 6  -- just one level, hard enemies, treasure-  , citemFreq     = [("common item", 100), ("currency", 500)]-  , cescapeFreq   = [("escape up", 1)]+  , citemFreq     = [ (IK.COMMON_ITEM, 100), (IK.S_CURRENCY, 500)+                    , (STARTING_WEAPON, 100) ]+  , cmaxStairsNum = 0+  , cescapeFreq   = [(INDOOR_ESCAPE_UP, 1)]   , cstairFreq    = []+  , cskip         = [0]   , cdesc         = ""   } brawl = rogue  -- many random solid tiles, to break LOS, since it's a day@@ -263,7 +320,7 @@                -- also, sanctuaries against missiles in shadow under trees   { csymbol       = 'b'   , cname         = "Sunny woodland"-  , cfreq         = [("caveBrawl", 1)]+  , cfreq         = [(CAVE_BRAWL, 1)]   , cXminSize     = 60   , cYminSize     = 21   , ccellSize     = DiceXY (2 `d` 5 + 5) 6@@ -273,21 +330,22 @@   , cnightOdds    = 0   , cdoorChance   = 1   , copenChance   = 0-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []-  , citemNum      = 5 `d` 6-  , citemFreq     = [("common item", 100)]-  , cplaceFreq    = [("brawl", 1)]+  , citemNum      = 4 `d` 6+  , citemFreq     = [ (IK.COMMON_ITEM, 50), (STARTING_WEAPON, 100)+                    , (STARTING_ARMOR, 100) ]+  , cplaceFreq    = [(BRAWL, 1)]   , cpassable     = True-  , cdefTile      = "brawlSetLit"-  , cdarkCorTile  = "dirt Lit"-  , clitCorTile   = "dirt Lit"+  , cdefTile      = BRAWL_SET_LIT+  , cdarkCorTile  = DIRT_LIT+  , clitCorTile   = DIRT_LIT   , cstairFreq    = []-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE+  , cmaxStairsNum = 0   , cdesc         = "Sunlight falls through the trees and dapples on the ground."   } shootout = rogue  -- a scenario with strong missiles;@@ -297,7 +355,7 @@                   -- scenario is about ranged combat at long range   { csymbol       = 'S'   , cname         = "Misty meadow"-  , cfreq         = [("caveShootout", 1)]+  , cfreq         = [(CAVE_SHOOTOUT, 1)]   , ccellSize     = DiceXY (1 `d` 2 + 6) 6   , cminPlaceSize = DiceXY 3 3   , cmaxPlaceSize = DiceXY 4 4@@ -306,33 +364,33 @@   , cauxConnects  = 1%10   , cdoorChance   = 1   , copenChance   = 0-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []   , citemNum      = 5 `d` 16                       -- less items in inventory, more to be picked up,                       -- to reward explorer and aggressor and punish camper-  , citemFreq     = [ ("common item", 30)-                    , ("any arrow", 400), ("harpoon", 300), ("explosive", 50) ]+  , citemFreq     = [ (IK.COMMON_ITEM, 30)+                    , (ANY_ARROW, 400), (HARPOON, 300), (IK.EXPLOSIVE, 50) ]                       -- Many consumable buffs are needed in symmetric maps                       -- so that aggressor prepares them in advance and camper                       -- needs to waste initial turns to buff for the defence.-  , cplaceFreq    = [("shootout", 1)]+  , cplaceFreq    = [(SHOOTOUT, 1)]   , cpassable     = True-  , cdefTile      = "shootoutSetLit"-  , cdarkCorTile  = "dirt Lit"-  , clitCorTile   = "dirt Lit"+  , cdefTile      = SHOOTOUT_SET_LIT+  , cdarkCorTile  = DIRT_LIT+  , clitCorTile   = DIRT_LIT   , cstairFreq    = []-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE+  , cmaxStairsNum = 0   , cdesc         = ""   } hunt = rogue  -- a scenario with strong missiles for ranged and shade for melee   { csymbol       = 'H'   , cname         = "Noon swamp"-  , cfreq         = [("caveHunt", 1)]+  , cfreq         = [(CAVE_HUNT, 1)]   , ccellSize     = DiceXY (1 `d` 2 + 6) 6   , cminPlaceSize = DiceXY 3 3   , cmaxPlaceSize = DiceXY 4 4@@ -341,22 +399,22 @@   , cauxConnects  = 1%10   , cdoorChance   = 1   , copenChance   = 0-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []   , citemNum      = 5 `d` 10-  , citemFreq     = [ ("common item", 30)-                    , ("any arrow", 400), ("harpoon", 300), ("explosive", 50) ]-  , cplaceFreq    = [("brawl", 50), ("shootout", 100)]+  , citemFreq     = [ (IK.COMMON_ITEM, 30)+                    , (ANY_ARROW, 400), (HARPOON, 300), (IK.EXPLOSIVE, 50) ]+  , cplaceFreq    = [(BRAWL, 50), (SHOOTOUT, 100)]   , cpassable     = True-  , cdefTile      = "shootoutSetLit"-  , cdarkCorTile  = "dirt Lit"-  , clitCorTile   = "dirt Lit"+  , cdefTile      = SHOOTOUT_SET_LIT+  , cdarkCorTile  = DIRT_LIT+  , clitCorTile   = DIRT_LIT   , cstairFreq    = []-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE+  , cmaxStairsNum = 0   , cdesc         = ""   } escape = rogue  -- a scenario with weak missiles, because heroes don't depend@@ -365,7 +423,7 @@                 -- lots of small lights to cross, to have some risks   { csymbol       = 'E'   , cname         = "Metropolitan park at dusk"  -- "night" didn't fit-  , cfreq         = [("caveEscape", 1)]+  , cfreq         = [(CAVE_ESCAPE, 1)]   , ccellSize     = DiceXY (1 `d` 3 + 7) 6   , cminPlaceSize = DiceXY 5 3   , cmaxPlaceSize = DiceXY 9 9  -- bias towards larger lamp areas@@ -373,30 +431,31 @@   , cnightOdds    = 51  -- always night   , cauxConnects  = 2  -- many lit trails, so easy to aim   , cmaxVoid      = 1%100-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []   , citemNum      = 6 `d` 8-  , citemFreq     = [ ("common item", 30), ("gem", 150)-                    , ("weak arrow", 500), ("harpoon", 400)-                    , ("explosive", 100) ]-  , cplaceFreq    = [("escape", 1)]+  , citemFreq     = [ (IK.COMMON_ITEM, 30), (GEM, 250)+                    , (WEAK_ARROW, 500), (HARPOON, 400)+                    , (IK.EXPLOSIVE, 100) ]+  , cplaceFreq    = [(ESCAPE, 1)]   , cpassable     = True-  , cdefTile      = "escapeSetDark"  -- unlike in ambush, tiles not burning yet-  , cdarkCorTile  = "safeTrailLit"  -- let trails give off light-  , clitCorTile   = "safeTrailLit"-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"-  , cescapeFreq   = [("escape outdoor down", 1)]+  , cdefTile      = ESCAPE_SET_DARK  -- unlike in ambush, tiles not burning yet+  , cdarkCorTile  = SAFE_TRAIL_LIT  -- let trails give off light+  , clitCorTile   = SAFE_TRAIL_LIT+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE+  , cmaxStairsNum = 0+  , cescapeFreq   = [(OUTDOOR_ESCAPE_DOWN, 1)]   , cstairFreq    = []+  , cskip         = [0]  -- don't start heroes on exit   , cdesc         = ""   } zoo = rogue  -- few lights and many solids, to help the less numerous heroes   { csymbol       = 'Z'   , cname         = "Menagerie in flames"-  , cfreq         = [("caveZoo", 1)]+  , cfreq         = [(CAVE_ZOO, 1)]   , ccellSize     = DiceXY (1 `d` 3 + 7) 6   , cminPlaceSize = DiceXY 4 4   , cmaxPlaceSize = DiceXY 12 5@@ -406,22 +465,22 @@   , cmaxVoid      = 1%20   , cdoorChance   = 7%10   , copenChance   = 9%10-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []   , citemNum      = 7 `d` 8-  , citemFreq     = [ ("common item", 100), ("light source", 1000)-                    , ("starting weapon", 1000) ]-  , cplaceFreq    = [("zoo", 1)]+  , citemFreq     = [ (IK.COMMON_ITEM, 100), (LIGHT_ATTENUATOR, 1000)+                    , (STARTING_WEAPON, 1000) ]+  , cplaceFreq    = [(ZOO, 1)]   , cpassable     = True-  , cdefTile      = "zooSetDark"-  , cdarkCorTile  = "safeTrailLit"  -- let trails give off light-  , clitCorTile   = "safeTrailLit"+  , cdefTile      = ZOO_SET_DARK+  , cdarkCorTile  = SAFE_TRAIL_LIT  -- let trails give off light+  , clitCorTile   = SAFE_TRAIL_LIT   , cstairFreq    = []-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE+  , cmaxStairsNum = 0   , cdesc         = ""   } ambush = rogue  -- a scenario with strong missiles;@@ -435,29 +494,29 @@                 -- active scouting, throwing flares and shooting discovers them   { csymbol       = 'M'   , cname         = "Burning metropolitan park"-  , cfreq         = [("caveAmbush", 1)]+  , cfreq         = [(CAVE_AMBUSH, 1)]   , ccellSize     = DiceXY (1 `d` 4 + 7) 6   , cminPlaceSize = DiceXY 5 3   , cmaxPlaceSize = DiceXY 9 9  -- bias towards larger lamp areas   , cdarkOdds     = 51  -- rooms always dark so that fence not visible from afar   , cnightOdds    = 51  -- always night   , cauxConnects  = 1%10  -- few lit trails, so hard to aim-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []   , citemNum      = 5 `d` 8-  , citemFreq     = [ ("common item", 30)-                    , ("any arrow", 400), ("harpoon", 300), ("explosive", 50) ]-  , cplaceFreq    = [("ambush", 1)]+  , citemFreq     = [ (IK.COMMON_ITEM, 30)+                    , (ANY_ARROW, 400), (HARPOON, 300), (IK.EXPLOSIVE, 50) ]+  , cplaceFreq    = [(AMBUSH, 1)]   , cpassable     = True-  , cdefTile      = "ambushSetDark"-  , cdarkCorTile  = "trailLit"  -- let trails give off light-  , clitCorTile   = "trailLit"+  , cdefTile      = AMBUSH_SET_DARK+  , cdarkCorTile  = TRAIL_LIT  -- let trails give off light+  , clitCorTile   = TRAIL_LIT   , cstairFreq    = []-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE+  , cmaxStairsNum = 0   , cdesc         = ""   } @@ -466,7 +525,7 @@ battle = rogue  -- few lights and many solids, to help the less numerous heroes   { csymbol       = 'B'   , cname         = "Old battle ground"-  , cfreq         = [("caveBattle", 1)]+  , cfreq         = [(CAVE_BATTLE, 1)]   , ccellSize     = DiceXY (5 `d` 3 + 11) 5  -- cfenceApart results in 2 rows   , cminPlaceSize = DiceXY 4 4   , cmaxPlaceSize = DiceXY 9 7@@ -476,52 +535,54 @@   , cmaxVoid      = 1%20   , cdoorChance   = 2%10   , copenChance   = 9%10-  , cextraStairs  = 0   , chidden       = 0   , cactorFreq    = []   , citemNum      = 5 `d` 8-  , citemFreq     = [("common item", 100), ("light source", 200)]-  , cplaceFreq    = [("battle", 50), ("rogue", 50)]+  , citemFreq     = [(IK.COMMON_ITEM, 100), (LIGHT_ATTENUATOR, 200)]+  , cplaceFreq    = [(BATTLE, 50), (ROGUE, 50)]   , cpassable     = True-  , cdefTile      = "battleSetDark"-  , cdarkCorTile  = "safeTrailLit"  -- let trails give off light-  , clitCorTile   = "safeTrailLit"-  , cfenceTileN   = "outdoor outer fence"-  , cfenceTileE   = "outdoor outer fence"-  , cfenceTileS   = "outdoor outer fence"-  , cfenceTileW   = "outdoor outer fence"+  , cdefTile      = BATTLE_SET_DARK+  , cdarkCorTile  = SAFE_TRAIL_LIT  -- let trails give off light+  , clitCorTile   = SAFE_TRAIL_LIT+  , cfenceTileN   = OUTDOOR_OUTER_FENCE+  , cfenceTileE   = OUTDOOR_OUTER_FENCE+  , cfenceTileS   = OUTDOOR_OUTER_FENCE+  , cfenceTileW   = OUTDOOR_OUTER_FENCE   , cfenceApart   = True  -- ensures no cut-off parts from collapsed+  , cmaxStairsNum = 0   , cstairFreq    = []   , cdesc         = ""   } safari1 = brawl   { cname         = "Hunam habitat"-  , cfreq         = [("caveSafari1", 1)]+  , cfreq         = [(CAVE_SAFARI_1, 1)]   , cminPlaceSize = DiceXY 5 3-  , cextraStairs  = 1-  , cstairFreq    = [ ("outdoor walled staircase", 20)-                    , ("outdoor closed staircase", 80)-                    , ("outdoor tiny staircase", 1) ]+  , cmaxStairsNum = 1+  , cstairFreq    = [ (OUTDOOR_WALLED_STAIRCASE, 20)+                    , (OUTDOOR_CLOSED_STAIRCASE, 80)+                    , (OUTDOOR_TINY_STAIRCASE, 1) ]+  , cskip         = [0]   , cdesc         = "\"Act 1. Hunams scavenge in a forest in their usual disgusting way.\""   } safari2 = escape  -- lamps instead of trees, but ok, it's only a simulation   { cname         = "Deep into the jungle"-  , cfreq         = [("caveSafari2", 1)]-  , cextraStairs  = 1+  , cfreq         = [(CAVE_SAFARI_2, 1)]+  , cmaxStairsNum = 1   , cescapeFreq   = []-  , cstairFreq    = [ ("outdoor walled staircase", 20)-                    , ("outdoor closed staircase", 80)-                    , ("outdoor tiny staircase", 1) ]+  , cstairFreq    = [ (OUTDOOR_WALLED_STAIRCASE, 20)+                    , (OUTDOOR_CLOSED_STAIRCASE, 80)+                    , (OUTDOOR_TINY_STAIRCASE, 1) ]+  , cskip         = [0]   , cdesc         = "\"Act 2. In the dark pure heart of the jungle noble animals roam freely.\""   } safari3 = zoo  -- glass rooms, but ok, it's only a simulation   { cname         = "Jungle in flames"-  , cfreq         = [("caveSafari3", 1)]+  , cfreq         = [(CAVE_SAFARI_3, 1)]   , cminPlaceSize = DiceXY 5 4-  , cescapeFreq   = [("escape outdoor down", 1)]-  , cextraStairs  = 1-  , cstairFreq    = [ ("outdoor walled staircase", 20)-                    , ("outdoor closed staircase", 80)-                    , ("outdoor tiny staircase", 1) ]+  , cescapeFreq   = [(OUTDOOR_ESCAPE_DOWN, 1)]+  , cmaxStairsNum = 1+  , cstairFreq    = [ (OUTDOOR_WALLED_STAIRCASE, 20)+                    , (OUTDOOR_CLOSED_STAIRCASE, 80)+                    , (OUTDOOR_TINY_STAIRCASE, 1) ]   , cdesc         = "\"Act 3. Jealous hunams set jungle on fire and flee.\""   }

GameDefinition/Content/ItemKind.hs view

@@ -1,1777 +1,1832 @@ -- | Item definitions. module Content.ItemKind-  ( content, items, otherItemContent-  ) where--import Prelude ()--import Game.LambdaHack.Core.Prelude--import Content.ItemKindActor-import Content.ItemKindBlast-import Content.ItemKindEmbed-import Content.ItemKindOrgan-import Content.ItemKindTemporary-import Content.RuleKind-import Game.LambdaHack.Content.ItemKind-import Game.LambdaHack.Content.RuleKind-import Game.LambdaHack.Core.Dice-import Game.LambdaHack.Definition.Ability-import Game.LambdaHack.Definition.Color-import Game.LambdaHack.Definition.Defs-import Game.LambdaHack.Definition.Flavour--content :: [ItemKind]-content = items ++ otherItemContent--otherItemContent :: [ItemKind]-otherItemContent = embeds ++ actors ++ organs ++ blasts ++ temporaries--items :: [ItemKind]-items =-  [sandstoneRock, dart, spike, spike2, slingStone, slingBullet, paralizingProj, harpoon, harpoon2, net, light1, light2, light3, blanket, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, flask15, flask16, flask17, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, jumpingPole, sharpeningTool, seeingItem, motionScanner, gorget, necklaceTemplate, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, armorLeather, armorMail, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, buckler, shield, shield2, shield3, dagger, daggerDropBestWeapon, hammerTemplate, hammer1, hammer2, hammer3, hammerParalyze, hammerSpark, sword, swordImpress, swordNullify, halberd, halberd2, halberd3, halberdPushActor, wandTemplate, wand1, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, smokingJacket]--sandstoneRock,    dart, spike, spike2, slingStone, slingBullet, paralizingProj, harpoon, harpoon2, net, light1, light2, light3, blanket, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, flask15, flask16, flask17, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, jumpingPole, sharpeningTool, seeingItem, motionScanner, gorget, necklaceTemplate, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, armorLeather, armorMail, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, buckler, shield, shield2, shield3, dagger, daggerDropBestWeapon, hammerTemplate, hammer1, hammer2, hammer3, hammerParalyze, hammerSpark, sword, swordImpress, swordNullify, halberd, halberd2, halberd3, halberdPushActor, wandTemplate, wand1, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, smokingJacket :: ItemKind---- Keep the dice rolls and sides in aspects small so that not too many--- distinct items are generated (for display in item lore and for narrative--- impact ("oh, I found the more powerful of the two variants of the item!",--- instead of "hmm, I found one of the countless variants, a decent one").--- In particular, for unique items, unless they inherit aspects from--- a standard item, permit only a couple possible variants.--- This is especially important if an item kind has multiple random aspects.--- Instead multiply dice results, e.g., (1 `d` 3) * 5 instead of 1 `d` 15.------ Beware of non-periodic non-weapon durable items with beneficial effects--- and low timeout -- AI will starve applying such an item incessantly.---- * Item group symbols, partially from Nethack--symbolProjectile, _symbolLauncher, symbolLight, symbolTool, symbolSpecial, symbolGold, symbolNecklace, symbolRing, symbolPotion, symbolFlask, symbolScroll, symbolTorsoArmor, symbolMiscArmor, symbolClothes, symbolShield, symbolPolearm, symbolEdged, symbolHafted, symbolWand, _symbolStaff, symbolFood :: Char--symbolProjectile = rsymbolProjectile standardRules  -- '|'-_symbolLauncher  = '}'-symbolLight      = '('-symbolTool       = '('-symbolSpecial    = '*'  -- don't overuse, because it clashes with projectiles-symbolGold       = '$'  -- also gems-symbolNecklace   = '"'-symbolRing       = '='-symbolPotion     = '!'  -- concoction, bottle, jar, vial, canister-symbolFlask      = '!'-symbolScroll     = '?'  -- book, note, tablet, remote, chip, card-symbolTorsoArmor = '['-symbolMiscArmor  = '['-symbolClothes    = '['-symbolShield     = ']'-symbolPolearm    = ')'-symbolEdged      = ')'-symbolHafted     = ')'-symbolWand       = '/'  -- magical rod, transmitter, pistol, rifle, instrument-_symbolStaff     = '_'  -- scanner-symbolFood       = ','  -- also body part; distinct from floor: not middle dot---- * Generic items, for any epoch---- ** Thrown weapons--sandstoneRock = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "sandstone rock"-  , ifreq    = [ ("sandstone rock", 1)-               , ("unreported inventory", 1) ]  -- too weak to spam-  , iflavour = zipPlain [Green]-  , icount   = 1 + 1 `d` 2  -- > 1, to let AI ignore sole pieces-  , irarity  = [(1, 50), (10, 1)]-  , iverbHit = "hit"-  , iweight  = 300-  , idamage  = 1 `d` 1-  , iaspects = [ AddSkill SkHurtMelee $ -16 * 5-               , SetFlag Fragile-               , toVelocity 70 ] -- not dense, irregular-  , ieffects = []-  , idesc    = "A lump of brittle sandstone rock."-  , ikit     = []-  }-dart = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "dart"-  , ifreq    = [("common item", 100), ("any arrow", 50), ("weak arrow", 50)]-  , iflavour = zipPlain [BrRed]-  , icount   = 1 + 4 `dL` 5-  , irarity  = [(1, 15), (10, 5)]-  , iverbHit = "prick"-  , iweight  = 40-  , idamage  = 1 `d` 1-  , iaspects = [AddSkill SkHurtMelee $ (-15 + 1 `d` 2 + 1 `dL` 3) * 5]-                 -- only good against leather-  , ieffects = []-  , idesc    = "A sharp delicate dart with fins."-  , ikit     = []-  }-spike = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "spike"-  , ifreq    = [("common item", 100), ("any arrow", 50), ("weak arrow", 50)]-  , iflavour = zipPlain [Cyan]-  , icount   = 1 + 4 `dL` 5-  , irarity  = [(1, 10), (10, 8)]-  , iverbHit = "nick"-  , iweight  = 150-  , idamage  = 2 `d` 1-  , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5-                   -- heavy vs armor-               , SetFlag MinorEffects-               , toVelocity 70 ]  -- hitting with tip costs speed-  , ieffects = [ Explode "single spark"  -- when hitting enemy-               , OnSmash (Explode "single spark") ]  -- at wall hit-      -- this results in a wordy item synopsis, but it's OK, the spark really-      -- is useful in some situations, not just a flavour-  , idesc    = "A cruel long nail with small head."  -- "Much inferior to arrows though, especially given the contravariance problems."  -- funny, but destroy the suspension of disbelief; this is supposed to be a Lovecraftian horror and any hilarity must ensue from the failures in making it so and not from actively trying to be funny; also, mundane objects are not supposed to be scary or transcendental; the scare is in horrors from the abstract dimension visiting our ordinary reality; without the contrast there's no horror and no wonder, so also the magical items must be contrasted with ordinary XIX century and antique items-  , ikit     = []-  }-spike2 = spike-  { ifreq    = [("common item", 2), ("any arrow", 1), ("weak arrow", 1)]-  , icount   = 6 `dL` 5-  , iverbHit = "penetrate"-  , iweight  = 200-  , idamage = 4 `d` 1-  , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5-               , SetFlag MinorEffects-               , Odds (10 * 1 `dL` 10) [] [toVelocity 70] ]-                   -- at deep levels sometimes even don't limit velocity-  , idesc    = "A jagged skewer of rusty metal."-  }-slingStone = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "sling stone"-  , ifreq    = [("common item", 5), ("any arrow", 100)]-  , iflavour = zipPlain [Blue]-  , icount   = 1 + 3 `dL` 4-  , irarity  = [(1, 1), (10, 20)]-  , iverbHit = "batter"-  , iweight  = 200-  , idamage  = 1 `d` 1-  , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5-                   -- heavy, to bludgeon through armor-               , SetFlag MinorEffects-               , toVelocity 150 ]-  , ieffects = [ Explode "single spark"  -- when hitting enemy-               , OnSmash (Explode "single spark") ]  -- at wall hit-  , idesc    = "A round stone, carefully sized and smoothed to fit the pouch of a standard string and cloth sling."-  , ikit     = []-  }-slingBullet = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "sling bullet"-  , ifreq    = [("common item", 5), ("any arrow", 100)]-  , iflavour = zipPlain [BrBlack]-  , icount   = 1 + 6 `dL` 4-  , irarity  = [(1, 1), (10, 15)]-  , iverbHit = "slug"-  , iweight  = 28-  , idamage  = 1 `d` 1-  , iaspects = [ AddSkill SkHurtMelee $ (-17 + 1 `d` 2 + 1 `dL` 3) * 5-                   -- not too good against armor-               , ToThrow $ ThrowMod 200 100 2 ]  -- piercing-  , ieffects = []-  , idesc    = "Small almond-shaped leaden projectile that weighs more than the sling used to tie the bag. It doesn't drop out of the sling's pouch when swung and doesn't snag when released. Known to pierce through flesh, at least at maximum speed."  -- we lie, it doesn't slow down in our model; but it stops piercing alright-  , ikit     = []-  }---- ** Exotic thrown weapons---- Identified, because shape (and name) says it all. Detailed aspects id by use.--- This is an extremely large value for @Paralyze@. Normally for such values--- we should instead use condition that disables (almost) all stats,--- except @SkWait@, so that the player can switch leader and not be--- helpless nor experience instadeath (unless his party is 1-person--- or the actor is isolated, but that's usually player's fault).-paralizingProj = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "bolas set"-  , ifreq    = [("common item", 100)]-  , iflavour = zipPlain [BrGreen]-  , icount   = 1 `dL` 4-  , irarity  = [(5, 5), (10, 5)]-  , iverbHit = "entangle"-  , iweight  = 500-  , idamage  = 1 `d` 1-  , iaspects = [AddSkill SkHurtMelee $ -14 * 5]-  , ieffects = [Paralyze 15, DropBestWeapon]-  , idesc    = "Wood balls tied with hemp rope. The target enemy is tripped and bound to drop the main weapon, while fighting for balance."-  , ikit     = []-  }-harpoon = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "harpoon"-  , ifreq    = [("common item", 100), ("harpoon", 100)]-  , iflavour = zipPlain [Brown]-  , icount   = 1 `dL` 5-  , irarity  = [(10, 10)]-  , iverbHit = "hook"-  , iweight  = 750-  , idamage  = 5 `d` 1-  , iaspects = [AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5]-  , ieffects = [ PullActor (ThrowMod 200 50 1)  -- 1 step, fast-               , Yell ]  -- yell, because brutal-  , idesc    = "The cruel, barbed head lodges in its victim so painfully that the weakest tug of the thin line sends the victim flying."-  , ikit     = []-  }-harpoon2 = harpoon-  { iname    = "whaling harpoon"-  , ifreq    = [("common item", 5), ("harpoon", 2)]-  , icount   = 2 `dL` 5-  , iweight  = 1000-  , idamage  = 10 `d` 1-  , idesc    = "With a brittle, barbed head and thick cord, this ancient weapon is designed for formidable prey."-  }-net = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "net"-  , ifreq    = [("common item", 100)]-  , iflavour = zipPlain [BrGreen]-  , icount   = 1 `dL` 3-  , irarity  = [(5, 5), (10, 7)]-  , iverbHit = "entangle"-  , iweight  = 1000-  , idamage  = 2 `d` 1-  , iaspects = [AddSkill SkHurtMelee $ -14 * 5]-  , ieffects = [ toOrganBad "slowed" (3 + 1 `d` 3)-               , DropItem maxBound 1 CEqp "torso armor"-                   -- only one of each kind is dropped, because no rubbish-                   -- in this group and so no risk of exploit-               , SendFlying (ThrowMod 100 50 1) ]  -- 1 step; painful-  , idesc    = "A wide net with weights along the edges. Entangles armor and restricts movement."-  , ikit     = []-  }---- ** Lights--light1 = ItemKind-  { isymbol  = symbolLight-  , iname    = "wooden torch"-  , ifreq    = [ ("common item", 100), ("light source", 100)-               , ("wooden torch", 1) ]-  , iflavour = zipPlain [Brown]-  , icount   = 1 `dL` 4-  , irarity  = [(1, 40), (4, 1)]-  , iverbHit = "scorch"-  , iweight  = 1000-  , idamage  = 0-  , iaspects = [ AddSkill SkShine 3, AddSkill SkSight (-2)-                   -- not only flashes, but also sparks,-                   -- so unused by AI due to the mixed blessing-               , SetFlag Lobable, SetFlag Equipable-               , EqpSlot EqpSlotShine ]-                   -- not Fragile; reusable flare-  , ieffects = [Burn 1]-  , idesc    = "A heavy smoking wooden torch, improvised using a cloth soaked in tar, burning in an unsteady glow."-  , ikit     = []-  }-light2 = ItemKind-  { isymbol  = symbolLight-  , iname    = "oil lamp"-  , ifreq    = [("common item", 100), ("light source", 100)]-  , iflavour = zipPlain [BrYellow]-  , icount   = 1 `dL` 2-  , irarity  = [(4, 10)]-  , iverbHit = "burn"-  , iweight  = 1500-  , idamage  = 1 `d` 1-  , iaspects = [ AddSkill SkShine 3, AddSkill SkSight (-1)-               , SetFlag Lobable, SetFlag Fragile, SetFlag Equipable-               , EqpSlot EqpSlotShine ]-  , ieffects = [ Burn 1-               , toOrganBad "pacified" (2 + 1 `d` 2)-               , OnSmash (Explode "burning oil 2") ]-  , idesc    = "A clay lamp filled with plant oil feeding a tiny wick."-  , ikit     = []-  }-light3 = ItemKind-  { isymbol  = symbolLight-  , iname    = "brass lantern"-  , ifreq    = [("common item", 100), ("light source", 100)]-  , iflavour = zipPlain [Red]-  , icount   = 1-  , irarity  = [(10, 6)]-  , iverbHit = "burn"-  , iweight  = 3000-  , idamage  = 2 `d` 1-  , iaspects = [ AddSkill SkShine 4, AddSkill SkSight (-1)-               , SetFlag Lobable, SetFlag Fragile, SetFlag Equipable-               , EqpSlot EqpSlotShine ]-  , ieffects = [ Burn 1-               , toOrganBad "pacified" (4 + 1 `d` 2)-               , OnSmash (Explode "burning oil 4") ]-  , idesc    = "Very bright and very heavy brass lantern."-  , ikit     = []-  }-blanket = ItemKind-  { isymbol  = symbolLight-  , iname    = "wool blanket"-  , ifreq    = [("common item", 100), ("light source", 100), ("blanket", 1)]-  , iflavour = zipPlain [BrBlack]-  , icount   = 1-  , irarity  = [(1, 1)]  -- not every playthrough needs one-  , iverbHit = "swoosh"-  , iweight  = 1000-  , idamage  = 0-  , iaspects = [ AddSkill SkShine (-10)-               , AddSkill SkArmorMelee 2, AddSkill SkMaxCalm 5-               , SetFlag Lobable, SetFlag Equipable ]-                   -- not Fragile; reusable douse implement;-                   -- douses torch, lamp and lantern in one action,-                   -- both in equipment and when thrown at the floor-  , ieffects = []-  , idesc    = "Warm, comforting, and concealing, woven from soft wool."-  , ikit     = []-  }---- ** Exploding consumables, often intended to be thrown.---- Not identified, because they are perfect for the id-by-use fun,--- due to effects. They are fragile and upon hitting the ground explode--- for effects roughly corresponding to their normal effects.--- Whether to hit with them or explode them close to the target--- is intended to be an interesting tactical decision.------ Flasks are often not natural; maths, magic, distillery.--- In fact, they just cover all conditions, except those for stats.------ There is no flask nor condition of Calm depletion,--- because Calm reduced often via combat, etc.--flaskTemplate = ItemKind-  { isymbol  = symbolFlask-  , iname    = "flask"-  , ifreq    = [("flask unknown", 1)]-  , iflavour = zipGlassPlain darkCol ++ zipGlassFancy darkCol-               ++ zipLiquid darkCol-                 -- ++ zipPlain darkCol ++ zipFancy darkCol-  , icount   = 1 `dL` 3-  , irarity  = [(1, 7), (10, 3)]-  , iverbHit = "splash"-  , iweight  = 500-  , idamage  = 0-  , iaspects = [ HideAs "flask unknown", SetFlag Lobable, SetFlag Fragile-               , toVelocity 50 ]  -- oily, bad grip-  , ieffects = []-  , idesc    = "A flask of oily liquid of a suspect color. Something seems to be moving inside. Double dose causes twice longer effect."-  , ikit     = []-  }-flask1 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , icount   = 1 `dL` 5-  , irarity  = [(10, 10)]-  , iaspects = ELabel "of strength renewal brew"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "strengthened" (20 + 1 `d` 5)-               , toOrganNoTimer "regenerating"-               , OnSmash (Explode "dense shower") ]-  }-flask2 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of weakness brew"-               : iaspects flaskTemplate-  , ieffects = [ toOrganBad "weakened" (20 + 1 `d` 5)-               , OnSmash (Explode "sparse shower") ]-  }-flask3 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of melee protective balm"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "protected from melee" (20 + 1 `d` 5)-               , OnSmash (Explode "melee protective balm") ]-  }-flask4 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of ranged protective balm"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "protected from ranged" (20 + 1 `d` 5)-               , OnSmash (Explode "ranged protective balm") ]-  }-flask5 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of PhD defense questions"-               : iaspects flaskTemplate-  , ieffects = [ toOrganBad "defenseless" (20 + 1 `d` 5)-               , Impress-               , Detect DetectExit 20-               , OnSmash (Explode "PhD defense question") ]-  }-flask6 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , irarity  = [(1, 1)]  -- not every playthrough needs one-  , iaspects = ELabel "of resolution"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "resolute" (500 + 1 `d` 200)  -- long, for scouting-               , RefillCalm 60  -- not to make it a drawback, via @calmEnough@-               , OnSmash (Explode "resolution dust") ]-  }-flask7 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , icount   = 1  -- too powerful en masse-  , iaspects = ELabel "of haste brew"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "hasted" (20 + 1 `d` 5)-               , OnSmash (Explode "haste spray") ]-  }-flask8 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of eye drops"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "far-sighted" (40 + 1 `d` 10)-               , OnSmash (Explode "eye drop") ]-  }-flask9 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , irarity  = [(10, 2)]  -- not very useful right now-  , iaspects = ELabel "of smelly concoction"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "keen-smelling" (40 + 1 `d` 10)-               , Detect DetectActor 10  -- make it at least slightly useful-               , OnSmash (Explode "smelly droplet") ]-  }-flask10 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , irarity  = [(10, 2)]  -- not very useful right now-  , iaspects = ELabel "of cat tears"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "shiny-eyed" (40 + 1 `d` 10)-               , OnSmash (Explode "eye shine") ]-  }-flask11 = flaskTemplate-  { iname    = "bottle"-  , ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , icount   = 1 `d` 3  -- the only one sometimes giving away its identity-  , iaspects = ELabel "of whiskey"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "drunk" (20 + 1 `d` 5)-               , Burn 1, RefillHP 3, Yell-               , OnSmash (Explode "whiskey spray") ]-  }-flask12 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , icount   = 1-  , iaspects = ELabel "of bait cocktail"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "drunk" (20 + 1 `d` 5)-               , Burn 1, RefillHP 3  -- risky exploit possible, good-               , Summon "mobile animal" 1-               , OnSmash (Summon "mobile animal" 1)-               , OnSmash Impress  -- mildly useful when thrown-               , OnSmash (Explode "waste") ]-  }--- The player has full control over throwing the flask at his party,--- so he can milk the explosion, so it has to be much weaker, so a weak--- healing effect is enough. OTOH, throwing a harmful flask at many enemies--- at once is not easy to arrange, so these explosions can stay powerful.-flask13 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , irarity  = [(1, 2), (10, 12)]-  , iaspects = ELabel "of regeneration brew"-               : iaspects flaskTemplate-  , ieffects = [ toOrganGood "rose-smelling" (80 + 1 `d` 20)-               , toOrganNoTimer "regenerating"-               , toOrganNoTimer "regenerating"  -- x2-               , OnSmash (Explode "youth sprinkle") ]-  }-flask14 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of poison"-               : iaspects flaskTemplate-  , ieffects = [ toOrganNoTimer "poisoned", toOrganNoTimer "poisoned"  -- x2-               , OnSmash (Explode "poison cloud") ]-  }-flask15 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , irarity  = [(10, 4)]-  , iaspects = ELabel "of slow resistance"-               : iaspects flaskTemplate-  , ieffects = [ toOrganNoTimer "slow resistant"-               , OnSmash (Explode "anti-slow mist") ]-  }-flask16 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , irarity  = [(10, 4)]-  , iaspects = ELabel "of poison resistance"-               : iaspects flaskTemplate-  , ieffects = [ toOrganNoTimer "poison resistant"-               , OnSmash (Explode "antidote mist") ]-  }-flask17 = flaskTemplate-  { ifreq    = [("common item", 100), ("explosive", 100), ("any vial", 100)]-  , iaspects = ELabel "of calamity"-               : iaspects flaskTemplate-  , ieffects = [ toOrganNoTimer "poisoned"-               , toOrganBad "weakened" (20 + 1 `d` 5)-               , toOrganBad "defenseless" (20 + 1 `d` 5)-               , OnSmash (Explode "glass hail") ]  -- enough glass to cause that-  }---- Potions are often natural, including natural stats.--- They appear deeper than most flasks. Various configurations of effects.--- A different class of effects is on scrolls and mechanical items.--- Some are shared.--potionTemplate = ItemKind-  { isymbol  = symbolPotion-  , iname    = "potion"-  , ifreq    = [("potion unknown", 1)]-  , iflavour = zipLiquid brightCol ++ zipPlain brightCol ++ zipFancy brightCol-  , icount   = 1 `dL` 3-  , irarity  = [(1, 10), (10, 6)]-  , iverbHit = "splash"-  , iweight  = 200-  , idamage  = 0-  , iaspects = [ HideAs "potion unknown", SetFlag Lobable, SetFlag Fragile-               , toVelocity 50 ]  -- oily, bad grip-  , ieffects = []-  , idesc    = "A vial of bright, frothing concoction. The best that nature has to offer."-  , ikit     = []-  }-potion1 = potionTemplate-  { iname    = "vial"-  , ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , icount   = 3 `dL` 1  -- very useful, despite appearances-  , iaspects = ELabel "of rose water"-               : iaspects potionTemplate-  , ieffects = [ Impress, toOrganGood "rose-smelling" (80 + 1 `d` 20)-               , OnSmash ApplyPerfume, OnSmash (Explode "fragrance") ]-  }-potion2 = potionTemplate-  { ifreq    = [("treasure", 100), ("any vial", 100)]-  , icount   = 1-  , irarity  = [(5, 8), (10, 8)]-  , iaspects = [ SetFlag Unique, ELabel "of Attraction"-               , SetFlag Precious, SetFlag Lobable, SetFlag Fragile-               , toVelocity 50 ]  -- identified-  , ieffects = [ Dominate-               , toOrganGood "hasted" (20 + 1 `d` 5)-               , OnSmash (Explode "pheromone")-               , OnSmash (Explode "haste spray") ]-  , idesc    = "The liquid fizzes with energy."-  }-potion3 = potionTemplate-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , ieffects = [ RefillHP 5, DropItem 1 maxBound COrgan "poisoned"-               , OnSmash (Explode "healing mist") ]-  }-potion4 = potionTemplate-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , irarity  = [(1, 6), (10, 10)]-  , ieffects = [ RefillHP 10, DropItem maxBound maxBound COrgan "condition"-               , OnSmash (Explode "healing mist 2") ]-  }-potion5 = potionTemplate-  -- needs to be common to show at least a portion of effects-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , icount   = 3 `dL` 1  -- always as many as possible on this level-                         -- without giving away potion identity-  , irarity  = [(1, 12)]-  , ieffects = [ OneOf [ RefillHP 10, RefillHP 5, Burn 5-                       , DropItem 1 maxBound COrgan "poisoned"-                       , toOrganGood "strengthened" (20 + 1 `d` 5) ]-               , OnSmash (OneOf [ Explode "dense shower"-                                , Explode "sparse shower"-                                , Explode "melee protective balm"-                                , Explode "ranged protective balm"-                                , Explode "PhD defense question" ]) ]-  }-potion6 = potionTemplate-  -- needs to be common to show at least a portion of effects-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , icount   = 3 `dL` 1-  , irarity  = [(10, 10)]-  , ieffects = [ Impress-               , OneOf [ RefillHP 20, RefillHP 10, Burn 10-                       , DropItem 1 maxBound COrgan "poisoned"-                       , toOrganGood "hasted" (20 + 1 `d` 5)-                       , toOrganBad "impatient" (2 + 1 `d` 2) ]-               , OnSmash (OneOf [ Explode "healing mist 2"-                                , Explode "wounding mist"-                                , Explode "distressing odor"-                                , Explode "impatient mist"-                                , Explode "haste spray"-                                , Explode "slowness mist"-                                , Explode "fragrance"-                                , Explode "violent flash" ]) ]-  }-potion7 = potionTemplate-  { iname    = "ampoule"  -- probably filled with nitroglycerine, but let's-                          -- not mix fantasy with too much technical jargon-  , ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , icount   = 3 `dL` 1-  , ieffects = [ DropItem 1 maxBound COrgan "condition"-               , OnSmash (Explode "violent concussion") ]-      -- not fragmentation nor glass hail, because not enough glass-  }-potion8 = potionTemplate-  { ifreq    = [("treasure", 100), ("any vial", 100)]-  , icount   = 1-  , irarity  = [(10, 5)]-  , iaspects = [ SetFlag Unique, ELabel "of Love"-               , SetFlag Precious, SetFlag Lobable, SetFlag Fragile-               , toVelocity 50 ]  -- identified-  , ieffects = [ RefillHP 60, RefillCalm (-60)-               , toOrganGood "rose-smelling" (80 + 1 `d` 20)-               , OnSmash (Explode "healing mist 2")-               , OnSmash (Explode "distressing odor") ]-  , idesc    = "Perplexing swirls of intense, compelling colour."-  }-potion9 = potionTemplate-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , irarity  = [(10, 5)]-  , iaspects = ELabel "of grenadier focus"-               : iaspects potionTemplate-  , ieffects = [ toOrganGood "more projecting" (40 + 1 `d` 10)-               , toOrganBad "pacified" (5 + 1 `d` 3)-                   -- the malus has to be weak, or would be too good-                   -- when thrown at foes-               , OnSmash (Explode "more projecting dew")-               , OnSmash (Explode "pacified mist") ]-  , idesc    = "Thick, sluggish fluid with violently-bursting bubbles."-  }-potion10 = potionTemplate-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , irarity  = [(10, 8)]-  , iaspects = ELabel "of frenzy"-               : iaspects potionTemplate-  , ieffects = [ Yell-               , toOrganGood "strengthened" (20 + 1 `d` 5)-               , toOrganBad "retaining" (5 + 1 `d` 3)-               , toOrganBad "frenzied" (40 + 1 `d` 10)-               , OnSmash (Explode "dense shower")-               , OnSmash (Explode "retaining mist")-               , OnSmash (Explode "retaining mist") ]-  }-potion11 = potionTemplate-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , irarity  = [(10, 8)]-  , iaspects = ELabel "of panic"-               : iaspects potionTemplate-  , ieffects = [ RefillCalm (-30)-               , toOrganGood "hasted" (20 + 1 `d` 5)-               , toOrganBad "weakened" (20 + 1 `d` 5)-               , toOrganBad "withholding" (10 + 1 `d` 5)-               , OnSmash (Explode "haste spray")-               , OnSmash (Explode "sparse shower")-               , OnSmash (Explode "withholding mist") ]-  }-potion12 = potionTemplate-  { ifreq    = [("common item", 100), ("potion", 100), ("any vial", 100)]-  , irarity  = [(10, 8)]-  , iaspects = ELabel "of quicksilver"-               : iaspects potionTemplate-  , ieffects = [ toOrganGood "hasted" (20 + 1 `d` 5)-               , toOrganBad "blind" (10 + 1 `d` 5)-               , toOrganBad "immobile" (5 + 1 `d` 5)-               , OnSmash (Explode "haste spray")-               , OnSmash (Explode "iron filing")-               , OnSmash (Explode "immobile mist") ]-  }---- ** Explosives, with the only effect being @Explode@--fragmentationBomb = ItemKind-  { isymbol  = symbolProjectile-  , iname    = "clay pot"-      -- clay pot filled with black powder; fragmentation comes from the clay-      -- shards, so it's not obvious if it's a weapon or just storage method;-      -- deflagration, not detonation, so large mass and hard container-      -- required not to burn harmlessly; improvised short fuze-  , ifreq    = [("common item", 100), ("explosive", 200)]-  , iflavour = zipPlain [Red]-  , icount   = 1 `dL` 5  -- many, because not very intricate-  , irarity  = [(5, 8), (10, 5)]-  , iverbHit = "thud"-  , iweight  = 3000  -- low velocity due to weight-  , idamage  = 1 `d` 1  -- heavy and hard-  , iaspects = [ ELabel "of black powder"-               , SetFlag Lobable, SetFlag Fragile ]-  , ieffects = [ Explode "focused fragmentation"-               , OnSmash (Explode "violent fragmentation") ]-  , idesc    = "The practical application of science."-  , ikit     = []-  }-concussionBomb = fragmentationBomb-  { iname    = "satchel"-      -- slightly stabilized nitroglycerine in a soft satchel, hence-      -- no fragmentation, but huge shock wave despite small size and lack of-      -- strong container to build up pressure (hence only mild hearing loss);-      -- indoors helps the shock wave; unstable enough that no fuze required-  , iflavour = zipPlain [Magenta]-  , iverbHit = "flap"-  , iweight  = 400-  , idamage  = 0-  , iaspects = [ ELabel "of mining charges"-               , SetFlag Lobable, SetFlag Fragile-               , toVelocity 70 ]  -- flappy and so slow-  , ieffects = [ Explode "focused concussion"-               , OnSmash (Explode "violent concussion") ]-  , idesc    = "Avoid sudden movements."-  }--- Not flashbang, because powerful bang without fragmentation is harder--- to manufacture (requires an oxidizer and steel canister with holes).--- The bang would also paralyze and/or lower the movement skill--- (out of balance due to ear trauma).-flashBomb = fragmentationBomb-  { iname    = "magnesium ribbon"  -- filled with magnesium flash powder-  , iflavour = zipPlain [BrYellow]  -- avoid @BrWhite@; looks wrong in dark-  , iverbHit = "flash"-  , iweight  = 400-  , idamage  = 0-  , iaspects = [ SetFlag Lobable, SetFlag Fragile-               , toVelocity 70 ]  -- bad shape for throwing-  , ieffects = [Explode "focused flash", OnSmash (Explode "violent flash")]-  , idesc    = "For dramatic entrances and urgent exits."-  }-firecrackerBomb = fragmentationBomb-  { iname = "roll"  -- not fireworks, as they require outdoors-  , iflavour = zipPlain [BrMagenta]-  , irarity  = [(1, 5), (5, 6)]  -- a toy, if deadly-  , iverbHit = "crack"  -- a pun, matches the verb from "ItemKindBlast"-  , iweight  = 1000-  , idamage  = 0-  , iaspects = [SetFlag Lobable, SetFlag Fragile]-  , ieffects = [Explode "firecracker", OnSmash (Explode "firecracker")]-  , idesc    = "String and paper, concealing a deadly surprise."-  }---- ** Non-exploding consumables, not specifically designed for throwing---- Foods require only minimal apply skill to consume. Many animals can eat them.--ediblePlantTemplate = ItemKind-  { isymbol  = symbolFood-  , iname    = "edible plant"-  , ifreq    = [("edible plant unknown", 1)]-  , iflavour = zipPlain stdCol-  , icount   = 1 `dL` 5-  , irarity  = [(1, 12), (10, 6)]  -- let's feed the animals-  , iverbHit = "thump"-  , iweight  = 50-  , idamage  = 0-  , iaspects = [ HideAs "edible plant unknown"-               , toVelocity 30 ]  -- low density, often falling apart-  , ieffects = []-  , idesc    = "Withered but fragrant bits of a colorful plant. Taste tolerably and break down easily, but only eating may reveal the full effects."-  , ikit     = []-  }-ediblePlant1 = ediblePlantTemplate-  { iname    = "overripe berry"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , ieffects = [RefillHP 1, toOrganBad "immobile" (5 + 1 `d` 5)]-  }-ediblePlant2 = ediblePlantTemplate-  { iname    = "frayed fungus"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , ieffects = [toOrganNoTimer "poisoned"]-  }-ediblePlant3 = ediblePlantTemplate-  { iname    = "thick leaf"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , ieffects = [DropItem 1 maxBound COrgan "poisoned"]-  }-ediblePlant4 = ediblePlantTemplate-  { iname    = "shrunk fruit"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , ieffects = [toOrganBad "blind" (10 + 1 `d` 10)]-  }-ediblePlant5 = ediblePlantTemplate-  { iname    = "fragrant herb"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , icount   = 1 `dL` 9-  , irarity  = [(1, 12), (10, 5)]-  , iaspects = ELabel "of lethargy"-               : iaspects ediblePlantTemplate-  , ieffects = [ toOrganBad "slowed" (20 + 1 `d` 5)-               , toOrganNoTimer "regenerating"-               , toOrganNoTimer "regenerating"  -- x2-               , RefillCalm 5 ]-  }-ediblePlant6 = ediblePlantTemplate-  { iname    = "dull flower"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , ieffects = [PutToSleep]-  }-ediblePlant7 = ediblePlantTemplate-  { iname    = "spicy bark"-  , ifreq    = [("common item", 100), ("edible plant", 100)]-  , ieffects = [InsertMove 20, toOrganBad "frenzied" (40 + 1 `d` 10)]-  }---- These require high apply skill to consume.--scrollTemplate = ItemKind-  { isymbol  = symbolScroll-  , iname    = "scroll"-  , ifreq    = [("scroll unknown", 1)]-  , iflavour = zipFancy stdCol ++ zipPlain stdCol-  , icount   = 1 `dL` 3-  , irarity  = [(1, 14), (10, 7)]-  , iverbHit = "thump"-  , iweight  = 50-  , idamage  = 0-  , iaspects = [ HideAs "scroll unknown"-               , toVelocity 30 ]  -- bad shape, even rolled up-  , ieffects = []-  , idesc    = "Scraps of haphazardly scribbled mysteries from beyond. Is this equation an alchemical recipe? Is this diagram an extradimensional map? Is this formula a secret call sign?"-  , ikit     = []-  }-scroll1 = scrollTemplate-  { ifreq    = [("treasure", 100), ("any scroll", 100)]-  , icount   = 1-  , irarity  = [(5, 9), (10, 9)]  -- mixed blessing, so found early for a unique-  , iaspects = [SetFlag Unique, ELabel "of Reckless Beacon"]-               ++ iaspects scrollTemplate-  , ieffects = [Summon "hero" 1, Summon "mobile animal" (2 + 1 `d` 2)]-  , idesc    = "The bright flame and sweet-smelling smoke of this heavily infused scroll should attract natural creatures inhabiting the area, including human survivors, if any."-  }-scroll2 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(1, 6), (10, 2)]-  , ieffects = [Ascend False]-  }-scroll3 = scrollTemplate-  -- needs to be common to show at least a portion of effects-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , icount   = 3 `dL` 1-  , irarity  = [(1, 14)]-  , ieffects = [OneOf [ Teleport 5, Paralyze 10, InsertMove 30-                      , Detect DetectEmbed 12, Detect DetectHidden 20 ]]-  }-scroll4 = scrollTemplate-  -- needs to be common to show at least a portion of effects-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , icount   = 3 `dL` 1-  , irarity  = [(10, 14)]-  , ieffects = [ Impress-               , OneOf [ Teleport 20, Ascend False, Ascend True-                       , Summon "hero" 1, Summon "mobile animal" $ 1 `d` 2-                       , Detect DetectLoot 20  -- the most useful of detections-                       , CreateItem CGround "common item" timerNone ] ]-  }-scroll5 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(1, 6)]  -- powerful, but low counts at the depths it appears on-  , ieffects = [InsertMove $ 20 + 1 `dL` 20]-  }-scroll6 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , icount   = 3 `dL` 1-  , irarity  = [(1, 20)]  -- uncommon deep down, where all is known-  , iaspects = ELabel "of scientific explanation"-               : iaspects scrollTemplate-  , ieffects = [Composite [Identify, RefillCalm 10]]-  , idesc    = "The most pressing existential concerns are met with a deeply satisfying scientific answer."-  }-scroll7 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(10, 20)]  -- at endgame a crucial item may be missing-  , iaspects = ELabel "of transmutation"-               : iaspects scrollTemplate-  , ieffects = [Composite [PolyItem, Explode "firecracker"]]-  }-scroll8 = scrollTemplate-  { ifreq    = [("treasure", 100), ("any scroll", 100)]-  , icount   = 1-  , irarity  = [(10, 12)]-  , iaspects = [SetFlag Unique, ELabel "of Rescue Proclamation"]-               ++ iaspects scrollTemplate-  , ieffects = [Summon "hero" 1]-  , idesc    = "A survivor of past exploration missions is found that enjoys, apparently, complete physiological integrity. We can pronounce him a comrade in arms and let him join our party."-  }-scroll9 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(10, 4)]  -- powerful, even if not ideal; scares newbies-  , ieffects = [Detect DetectAll 20]-  }-scroll10 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , iaspects = ELabel "of cue interpretation"-               : iaspects scrollTemplate-  , ieffects = [Detect DetectActor 20]-  }-scroll11 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(10, 11)]-  , ieffects = [PushActor (ThrowMod 400 200 1)]  -- 8 steps, 4 turns-  }-scroll12 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(10, 15)]-  , iaspects = ELabel "of similarity"-               : iaspects scrollTemplate-  , ieffects = [DupItem]-  }-scroll13 = scrollTemplate-  { ifreq    = [("common item", 100), ("any scroll", 100)]-  , irarity  = [(10, 15)]-  , iaspects = ELabel "of transfiguration"-               : iaspects scrollTemplate-  , ieffects = [RerollItem]-  }---- ** Assorted tools--jumpingPole = ItemKind-  { isymbol  = symbolWand-  , iname    = "jumping pole"-  , ifreq    = [("common item", 100)]-  , iflavour = zipPlain [White]-  , icount   = 1-  , irarity  = [(1, 3)]-  , iverbHit = "prod"-  , iweight  = 10000-  , idamage  = 0-  , iaspects = [ Timeout $ (2 + 1 `d` 2 - 1 `dL` 2) * 5-               , SetFlag Durable ]-  , ieffects = [toOrganGood "hasted" 1]-                 -- safe for AI, because it speeds up, so when AI applies it-                 -- again and again, it gets its time back and is not stuck;-                 -- in total, the explorations speed is unchanged,-                 -- but it's useful when fleeing in the dark to make distance-                 -- and when initiating combat, so it's OK that AI uses it-  , idesc    = "Makes you vulnerable at take-off, but then you are free like a bird."-  , ikit     = []-  }-sharpeningTool = ItemKind-  { isymbol  = symbolTool-  , iname    = "whetstone"-  , ifreq    = [("common item", 100)]-  , iflavour = zipPlain [Blue]-  , icount   = 1-  , irarity  = [(10, 10)]-  , iverbHit = "smack"-  , iweight  = 400-  , idamage  = 0-  , iaspects = [ AddSkill SkHurtMelee $ (1 `dL` 7) * 5-               , SetFlag Equipable, EqpSlot EqpSlotHurtMelee ]-  , ieffects = []-  , idesc    = "A portable sharpening stone for keeping your weapons keen and true, without the need to set up camp, fish out tools and assemble a proper sharpening workshop."-  , ikit     = []-  }-seeingItem = ItemKind-  { isymbol  = symbolFood-  , iname    = "giant pupil"-  , ifreq    = [("common item", 100)]-  , iflavour = zipPlain [Red]-  , icount   = 1-  , irarity  = [(1, 2)]-  , iverbHit = "gaze at"-  , iweight  = 100-  , idamage  = 0-  , iaspects = [ Timeout 3-               , AddSkill SkSight 10  -- a spyglass for quick wields-               , AddSkill SkMaxCalm 30  -- to diminish clipping sight by Calm-               , AddSkill SkShine 2  -- to lit corridors when flying-               , SetFlag Periodic ]-  , ieffects = [ Detect DetectActor 20  -- rare enough-               , toOrganNoTimer "poisoned"  -- really can't be worn-               , Summon "mobile monster" 1 ]-  , idesc    = "A slimy, dilated green pupil torn out from some giant eye. Clear and focused, as if still alive."-  , ikit     = []-  }-motionScanner = ItemKind-  { isymbol  = symbolTool-  , iname    = "draft detector"-  , ifreq    = [("common item", 100), ("add nocto 1", 20)]-  , iflavour = zipPlain [BrRed]-  , icount   = 1-  , irarity  = [(5, 2)]-  , iverbHit = "jingle"-  , iweight  = 300-  , idamage  = 0-  , iaspects = [ AddSkill SkNocto 1-               , AddSkill SkArmorMelee (-15 + (1 `dL` 3) * 5)-               , AddSkill SkArmorRanged (-15 + (1 `dL` 3) * 5)-               , SetFlag Equipable, EqpSlot EqpSlotMiscBonus ]-  , ieffects = []-  , idesc    = "A silk flag with a bell for detecting sudden draft changes. May indicate a nearby corridor crossing or a fast enemy approaching in the dark. Is also very noisy."-  , ikit     = []-  }---- ** Periodic jewelry---- Morally these are the aspects, but we also need to add a fake @Timeout@,--- to let clients know that the not identified item is periodic jewelry.-iaspects_necklaceTemplate :: [Aspect]-iaspects_necklaceTemplate =-  [ HideAs "necklace unknown"-  , SetFlag Periodic, SetFlag Precious, SetFlag Equipable-  , toVelocity 50 ]  -- not dense enough-gorget = necklaceTemplate-  { iname    = "Old Gorget"-  , ifreq    = [("common item", 25), ("treasure", 25)]-  , iflavour = zipFancy [BrCyan]  -- looks exactly the same as one of necklaces,-                                  -- but it's OK, it's an artifact-  , iaspects = [ SetFlag Unique-               , Timeout $ 5 - 1 `dL` 4-               , AddSkill SkArmorMelee 3, AddSkill SkArmorRanged 2-               , SetFlag Durable ]-               ++ iaspects_necklaceTemplate-  , ieffects = [RefillCalm 1]-  , idesc    = "Highly ornamental, cold, large, steel medallion on a chain. Unlikely to offer much protection as an armor piece, but the old, worn engraving reassures you."-  }--- Not identified, because id by use, e.g., via periodic activations. Fun.-necklaceTemplate = ItemKind-  { isymbol  = symbolNecklace-  , iname    = "necklace"-  , ifreq    = [("necklace unknown", 1)]-  , iflavour = zipFancy stdCol ++ zipPlain brightCol-  , icount   = 1-  , irarity  = [(4, 3), (10, 6)]-  , iverbHit = "whip"-  , iweight  = 30-  , idamage  = 0-  , iaspects = Timeout 1000000-                 -- fake, needed to display "charging"; the timeout itself-                 -- won't be displayed thanks to periodic; as a side-effect,-                 -- it can't be activated until identified, which is better-                 -- than letting the player try to activate before the real-                 -- cooldown is over and waste turn-               : iaspects_necklaceTemplate-  , ieffects = []-  , idesc    = "Menacing Greek symbols shimmer with increasing speeds along a chain of fine encrusted links. After a tense build-up, a prismatic arc shoots towards the ground and the iridescence subdues, becomes ordered and resembles a harmless ornament again, for a time."-  , ikit     = []-  }-necklace1 = necklaceTemplate-  { ifreq    = [("treasure", 100), ("any jewelry", 100)]-  , irarity  = [(10, 3)]-  , iaspects = [ SetFlag Unique, ELabel "of Aromata"-               , Timeout $ (4 - 1 `dL` 3) * 10-                   -- priceless, so worth the long wait-               , SetFlag Durable ]-               ++ iaspects_necklaceTemplate-  , ieffects = [RefillHP 1]-  , idesc    = "A cord of freshly dried herbs and healing berries."-  }-necklace2 = necklaceTemplate-  { ifreq    = [("treasure", 100), ("any jewelry", 100)]-      -- too nasty to call it just a "common item"-  , irarity  = [(10, 3)]-  , iaspects = [ SetFlag Unique, ELabel "of Live Bait"-               , Timeout 30-               , AddSkill SkOdor 2-               , SetFlag Durable ]-               ++ iaspects_necklaceTemplate-  , ieffects = [ DropItem 1 1 COrgan "condition"  -- mildly useful when applied-               , Impress-               , Summon "mobile animal" $ 1 `dL` 2-               , Explode "waste" ]-  , idesc    = "A cord hung with lumps of decaying meat. It's better not to think about the source."-  }-necklace3 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , iaspects = [ ELabel "of fearful listening"-               , Timeout ((1 + 1 `d` 2) * 10)-               , AddSkill SkHearing 2 ]-               ++ iaspects_necklaceTemplate-  , ieffects = [ Detect DetectActor 10  -- can be applied; destroys the item-               , RefillCalm (-40) ]-  }-necklace4 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , iaspects = Timeout ((3 + 1 `d` 3 - 1 `dL` 3) * 2)-               : iaspects_necklaceTemplate-  , ieffects = [Teleport $ 3 `d` 2]-  }-necklace5 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , iaspects = [ ELabel "of escape"-               , Timeout $ (7 - 1 `dL` 5) * 10 ]-               ++ iaspects_necklaceTemplate-  , ieffects = [ Teleport $ 14 + 3 `d` 3  -- can be applied; destroys the item-               , Detect DetectExit 20-               , Yell ]  -- drawback when used for quick exploring-  , idesc    = "A supple chain that slips through your fingers."-  }-necklace6 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , iaspects = Timeout (1 + (1 `d` 3) * 2)-               : iaspects_necklaceTemplate-  , ieffects = [PushActor (ThrowMod 100 50 1)]  -- 1 step, slow-                  -- the @50@ is only for the case of very light actor, etc.-  }-necklace7 = necklaceTemplate-  { ifreq    = [("treasure", 100), ("any jewelry", 100)]-  , irarity  = [(10, 1)]  -- different gameplay for the actor that wears it-  , iaspects = [ SetFlag Unique, ELabel "of Overdrive"-               , Timeout 4-               , AddSkill SkMaxHP 25  -- give incentive to cope with impatience-               , SetFlag Durable ]-               ++ iaspects_necklaceTemplate-  , ieffects = [ InsertMove $ 9 + 1 `d` 11  -- unpredictable-               , toOrganBad "impatient" 4]-                 -- The same duration as timeout, to avoid spurious messages-                 -- as well as unlimited accumulation of the duration.-  , idesc    = "A string of beads in various colours, with no discernable pattern."-  }-necklace8 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , irarity  = [(4, 3)]  -- entirely optional-  , iaspects = Timeout ((1 + 1 `d` 3) * 5)-               : iaspects_necklaceTemplate-  , ieffects = [Explode "spark"]-  }-necklace9 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , iaspects = Timeout ((1 + 1 `d` 3) * 5)-               : iaspects_necklaceTemplate-  , ieffects = [Explode "fragrance"]-  }-necklace10 = necklaceTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , iaspects = [ ELabel "of greed"-               , Timeout ((2 + 1 `d` 3) * 10) ]-               ++ iaspects_necklaceTemplate-  , ieffects = [ Detect DetectLoot 20-               , Teleport 40  -- risky-               , toOrganBad "parsimonious" (5 + 1 `d` 3) ]  -- hard to flee-  }---- ** Non-periodic jewelry--imageItensifier = ItemKind-  { isymbol  = symbolRing-  , iname    = "light cone"-  , ifreq    = [("treasure", 100), ("add nocto 1", 80)]-  , iflavour = zipFancy [BrYellow]-  , icount   = 1-  , irarity  = [(5, 2)]-  , iverbHit = "bang"-  , iweight  = 500-  , idamage  = 0-  , iaspects = [ AddSkill SkNocto 1, AddSkill SkSight (-1)-               , AddSkill SkArmorMelee $ (-1 + 1 `dL` 6) * 3-               , SetFlag Precious, SetFlag Equipable-               , EqpSlot EqpSlotMiscBonus ]-  , ieffects = []-  , idesc    = "Contraption of lenses and mirrors on a polished brass headband for capturing and strengthening light in dark environment. Hampers vision in daylight. Stackable."-  , ikit     = []-  }-sightSharpening = ringTemplate  -- small and round, so mistaken for a ring-  { iname    = "sharp monocle"-  , ifreq    = [("treasure", 20), ("add sight", 1)]-      -- it's has to be very rare, because it's powerful and not unique,-      -- and also because it looks exactly as one of necklaces, so it would-      -- be misleading when seen on the map-  , irarity  = [(7, 1), (10, 12)]  -- low @ifreq@-  , iweight  = 50  -- heavier that it looks, due to glass-  , iaspects = [ AddSkill SkSight $ 1 + 1 `dL` 2-               , AddSkill SkHurtMelee $ (-1 + 1 `d` 3) * 3-               , EqpSlot EqpSlotSight ]-               ++ iaspects ringTemplate-  , idesc    = "Lets you better focus your weaker eye."-  }--- Don't add standard effects to rings, because they go in and out--- of eqp and so activating them would require UI tedium: looking for--- them in eqp and inv or even activating a wrong item by mistake.------ By general mechanisms, due to not having effects that could identify--- them by observing the effect, rings are identified on pickup.--- That's unlike necklaces, which provide the fun of id-by-use, because they--- have effects and when the effects are triggered, they get identified.-ringTemplate = ItemKind-  { isymbol  = symbolRing-  , iname    = "ring"-  , ifreq    = [("ring unknown", 1)]-  , iflavour = zipPlain stdCol ++ zipFancy darkCol-  , icount   = 1-  , irarity  = [(10, 2)]  -- the default very low-  , iverbHit = "knock"-  , iweight  = 15-  , idamage  = 0-  , iaspects = [HideAs "ring unknown", SetFlag Precious, SetFlag Equipable]-  , ieffects = []-  , idesc    = "It looks like an ordinary object, but it's in fact a generator of exceptional effects: adding to some of your natural qualities and subtracting from others."-  , ikit     = []-  }-ring1 = ringTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , irarity  = [(8, 4)]-  , iaspects = [ AddSkill SkSpeed $ 1 `dL` 3, AddSkill SkMaxHP (-10)-               , EqpSlot EqpSlotSpeed ]-               ++ iaspects ringTemplate-  }-ring2 = ringTemplate-  { ifreq    = [("treasure", 100), ("any jewelry", 100)]-  , iaspects = [ SetFlag Unique, ELabel "of Rush"-               , AddSkill SkSpeed $ (1 + 1 `dL` 2) * 2-               , AddSkill SkMaxCalm (-40), AddSkill SkMaxHP (-20)-               , SetFlag Durable, EqpSlot EqpSlotSpeed ]-               ++ iaspects ringTemplate-  , idesc    = "Roughly-shaped metal with shallow scratches marking it."-  }-ring3 = ringTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , irarity  = [(10, 8)]-  , iaspects = [ AddSkill SkMaxHP $ 5 + (1 `d` 2 + 1 `dL` 2) * 5-               , AddSkill SkMaxCalm $ -30 + (1 `dL` 3) * 5-               , EqpSlot EqpSlotMaxHP ]-               ++ iaspects ringTemplate-  }-ring4 = ringTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , irarity  = [(5, 1), (10, 9)]  -- needed after other rings drop Calm-  , iaspects = [ AddSkill SkMaxCalm $ 20 + (1 `dL` 4) * 5-               , EqpSlot EqpSlotMiscBonus ]-               ++ iaspects ringTemplate-  , idesc    = "Cold, solid to the touch, perfectly round, engraved with solemn, strangely comforting, worn out words."-  }-ring5 = ringTemplate-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , irarity  = [(3, 4), (10, 8)]-  , iaspects = [ AddSkill SkHurtMelee $ (2 + 1 `d` 2 + (1 `dL` 2) * 2 ) * 3-               , AddSkill SkMaxHP $ (-3 + 1 `dL` 3) * 10-               , EqpSlot EqpSlotHurtMelee ]-               ++ iaspects ringTemplate-  }-ring6 = ringTemplate  -- weak skill per eqp slot, so can be without drawbacks-  { ifreq    = [("common item", 100), ("any jewelry", 100)]-  , irarity  = [(10, 3)]-  , iaspects = [ AddSkill SkShine 1-               , EqpSlot EqpSlotShine ]-               ++ iaspects ringTemplate-  , idesc    = "A sturdy ring with a large, shining stone."-  }-ring7 = ringTemplate-  { ifreq    = [("ring of opportunity sniper", 1) ]  -- only for scenarios-  , irarity  = [(1, 1)]-  , iaspects = [ ELabel "of opportunity sniper"-               , AddSkill SkProject 8-               , EqpSlot EqpSlotProject ]-               ++ iaspects ringTemplate-  }-ring8 = ringTemplate-  { ifreq    = [("ring of opportunity grenadier", 1) ]  -- only for scenarios-  , irarity  = [(1, 1)]-  , iaspects = [ ELabel "of opportunity grenadier"-               , AddSkill SkProject 11-               , EqpSlot EqpSlotProject ]-               ++ iaspects ringTemplate-  }---- ** Armor--armorLeather = ItemKind-  { isymbol  = symbolTorsoArmor-  , iname    = "leather armor"-  , ifreq    = [("common item", 100), ("torso armor", 1)]-  , iflavour = zipPlain [Brown]-  , icount   = 1-  , irarity  = [(1, 9), (10, 3)]-  , iverbHit = "thud"-  , iweight  = 7000-  , idamage  = 0-  , iaspects = [ AddSkill SkHurtMelee (-2)-               , AddSkill SkArmorMelee $ (2 + 1 `dL` 4) * 5-               , AddSkill SkArmorRanged $ (1 + 1 `dL` 2) * 3-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotArmorMelee ]-  , ieffects = []-  , idesc    = "A stiff jacket formed from leather boiled in bee wax, padded linen and horse hair. Protects from anything that is not too sharp. Smells much better than the rest of your garment."-  , ikit     = []-  }-armorMail = armorLeather-  { iname    = "ring armor"-  , ifreq    = [("common item", 100), ("torso armor", 1), ("armor ranged", 50)]-  , iflavour = zipPlain [Cyan]-  , irarity  = [(6, 9), (10, 3)]-  , iweight  = 12000-  , idamage  = 0-  , iaspects = [ AddSkill SkHurtMelee (-3)-               , AddSkill SkArmorMelee $ (2 + 1 `dL` 4) * 5-               , AddSkill SkArmorRanged $ (4 + 1 `dL` 2) * 3-               , AddSkill SkOdor 2-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotArmorRanged ]-  , ieffects = []-  , idesc    = "A long shirt with tiny iron rings sewn into it. Discourages foes from attacking your torso, especially with ranged weapons, which can't pierce the rings nor aim between them. The stiff fabric is hard to wash, though."-  }-gloveFencing = ItemKind-  { isymbol  = symbolMiscArmor-  , iname    = "leather glove"-  , ifreq    = [("common item", 100), ("misc armor", 1), ("armor ranged", 50)]-  , iflavour = zipPlain [White]-  , icount   = 1-  , irarity  = [(5, 9), (10, 9)]-  , iverbHit = "flap"-  , iweight  = 100-  , idamage  = 1 `d` 1-  , iaspects = [ AddSkill SkHurtMelee $ (2 + 1 `d` 2 + 1 `dL` 2) * 3-               , AddSkill SkArmorRanged $ (1 `dL` 2) * 3-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotHurtMelee-               , toVelocity 50 ]  -- flaps and flutters-  , ieffects = []-  , idesc    = "A fencing glove from rough leather ensuring a good grip. Also quite effective in deflecting or even catching slow projectiles."-  , ikit     = []-  }-gloveGauntlet = gloveFencing-  { iname    = "steel gauntlet"-  , ifreq    = [("common item", 100), ("misc armor", 1)]-  , iflavour = zipPlain [BrCyan]-  , irarity  = [(1, 9), (10, 3)]-  , iweight  = 300-  , idamage  = 2 `d` 1-  , iaspects = [ AddSkill SkArmorMelee $ (1 + 1 `dL` 4) * 5-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotArmorMelee-               , toVelocity 50 ]  -- flaps and flutters-  , idesc    = "Long leather gauntlet covered in overlapping steel plates."-  }-gloveJousting = gloveFencing-  { iname    = "Tournament Gauntlet"-  , ifreq    = [("common item", 100), ("misc armor", 1)]-  , iflavour = zipFancy [BrRed]-  , irarity  = [(1, 3), (10, 3)]-  , iverbHit = "rasp"-  , iweight  = 3000-  , idamage  = 3 `d` 1-  , iaspects = [ SetFlag Unique-               , AddSkill SkHurtMelee $ (-7 + 1 `dL` 5) * 3-               , AddSkill SkArmorMelee $ (2 + 1 `d` 2 + 1 `dL` 2) * 5-               , AddSkill SkArmorRanged $ (1 + 1 `dL` 2) * 3-                 -- very random on purpose and can even be good on occasion-                 -- or when ItemRerolled enough times-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotArmorMelee-               , toVelocity 50 ]  -- flaps and flutters-  , idesc    = "Rigid, steel jousting handgear. If only you had a lance. And a horse to carry it all."-  }-hatUshanka = ItemKind-  { isymbol  = symbolMiscArmor-  , iname    = "ushanka hat"-  , ifreq    = [("common item", 100), ("misc armor", 1)]-  , iflavour = zipPlain [Brown]-  , icount   = 1-  , irarity  = [(1, 6), (10, 1)]-  , iverbHit = "tickle"-  , iweight  = 500-  , idamage  = 0-  , iaspects = [ Timeout $ (2 + 1 `d` 2) * 3-               , AddSkill SkArmorMelee 5, AddSkill SkHearing (-10)-               , SetFlag Periodic, SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotArmorMelee-               , toVelocity 50 ]  -- flaps and flutters-  , ieffects = [RefillCalm 1]-  , idesc    = "Soft and warm fur. It keeps your ears warm."-  , ikit     = []-  }-capReinforced = ItemKind-  { isymbol  = symbolMiscArmor-  , iname    = "leather cap"-  , ifreq    = [("common item", 100), ("misc armor", 1)]-  , iflavour = zipPlain [BrYellow]-  , icount   = 1-  , irarity  = [(6, 9), (10, 3)]-  , iverbHit = "cut"-  , iweight  = 1000-  , idamage  = 0-  , iaspects = [ AddSkill SkArmorMelee $ (1 `d` 2) * 5-               , AddSkill SkProject 1-                   -- the brim shields against blinding by light sources, etc.-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotProject ]-  , ieffects = []-  , idesc    = "Boiled leather with a wide brim. It might soften a blow."-  , ikit     = []-  }-helmArmored = ItemKind-  { isymbol  = symbolMiscArmor-  , iname    = "bucket helm"-  , ifreq    = [("common item", 100), ("misc armor", 1)]-  , iflavour = zipPlain [BrCyan]-  , icount   = 1-  , irarity  = [(6, 9), (10, 3)]-  , iverbHit = "bounce"-  , iweight  = 2000-  , idamage  = 0-  , iaspects = [ AddSkill SkArmorMelee $ (1 + 1 `dL` 4) * 5-               , AddSkill SkArmorRanged $ (2 + 1 `dL` 2) * 3  -- headshot-               , AddSkill SkHearing (-7), AddSkill SkSight (-1)-               , AddSkill SkSmell (-5)-               , SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotArmorRanged ]-  , ieffects = []-  , idesc    = "Blocks out everything, including your senses."-  , ikit     = []-  }---- ** Shields---- Shield doesn't protect against ranged attacks to prevent--- micromanagement: walking with shield, melee without.--- Note that AI will pick them up but never wear and will use them at most--- as a way to push itself (but they won't recharge, not being in eqp).--- Being @Meleeable@ they will not be use as weapons either.--- This is OK, using shields smartly is totally beyond AI.-buckler = ItemKind-  { isymbol  = symbolShield-  , iname    = "buckler"-  , ifreq    = [("common item", 100)]-  , iflavour = zipPlain [Blue]-  , icount   = 1-  , irarity  = [(4, 5)]-  , iverbHit = "bash"-  , iweight  = 2000-  , idamage  = 0  -- safe to be used on self-  , iaspects = [ Timeout $ (3 + 1 `d` 3 - 1 `dL` 3) * 2-               , AddSkill SkArmorMelee 40-                   -- not enough to compensate; won't be in eqp-               , AddSkill SkHurtMelee (-30)-                   -- too harmful; won't be wielded as weapon-               , SetFlag MinorEffects, SetFlag Durable, SetFlag Meleeable-               , EqpSlot EqpSlotArmorMelee-               , toVelocity 50 ]  -- unwieldy to throw-  , ieffects = [PushActor (ThrowMod 200 50 1)]  -- 1 step, fast-  , idesc    = "Heavy and unwieldy. Absorbs a percentage of melee damage, both dealt and sustained. Too small to intercept projectiles with. May serve as a counterweight to suddenly push forth."-  , ikit     = []-  }-shield = buckler-  { iname    = "shield"-  , irarity  = [(8, 4)]  -- the stronger variants add to total probability-  , iflavour = zipPlain [Green]-  , iweight  = 4000-  , idamage  = 4 `d` 1-  , iaspects = [ Timeout $ (3 + 1 `d` 3 - 1 `dL` 3) * 4-               , AddSkill SkArmorMelee 80-                   -- not enough to compensate; won't be in eqp-               , AddSkill SkHurtMelee (-70)-                   -- too harmful; won't be wielded as weapon-               , SetFlag MinorEffects, SetFlag Durable, SetFlag Meleeable-               , EqpSlot EqpSlotArmorMelee-               , toVelocity 50 ]  -- unwieldy to throw-  , ieffects = [PushActor (ThrowMod 400 50 1)]  -- 2 steps, fast-  , idesc    = "Large and unwieldy. Absorbs a percentage of melee damage, both dealt and sustained. Too heavy to intercept projectiles with. Useful to push foes out of the way."-  }-shield2 = shield-  { ifreq    = [("common item", 3 * 3)]  -- very low base rarity-  , iweight  = 5000-  , idamage  = 8 `d` 1-  , idesc    = "A relic of long-past wars, heavy and with a central spike."-  }-shield3 = shield2-  { ifreq    = [("common item", 1 * 3)]  -- very low base rarity-  , iweight  = 6000-  , idamage  = 12 `d` 1-  }---- ** Weapons--dagger = ItemKind-  { isymbol  = symbolEdged-  , iname    = "dagger"-  , ifreq    = [("common item", 100), ("starting weapon", 200)]-  , iflavour = zipPlain [BrCyan]-  , icount   = 1-  , irarity  = [(1, 40), (4, 1)]-  , iverbHit = "cut"-  , iweight  = 800-  , idamage  = 6 `d` 1-  , iaspects = [ Timeout 2-               , AddSkill SkHurtMelee $ (-1 + 1 `d` 2 + 1 `dL` 2) * 3-               , AddSkill SkArmorMelee $ (1 `d` 2) * 5-                   -- very common, so don't make too random-               , SetFlag Durable, SetFlag Meleeable-               , EqpSlot EqpSlotWeaponFast-               , toVelocity 40 ]  -- ensuring it hits with the tip costs speed-  , ieffects = []-  , idesc    = "A short dagger for thrusting and parrying blows. Does not penetrate deeply, but is quick to move and hard to block. Especially useful in conjunction with a larger weapon."-  , ikit     = []-  }-daggerDropBestWeapon = dagger-  { iname    = "Double Dagger"-  , ifreq    = [("treasure", 20)]-  , irarity  = [(1, 3), (10, 3)]-  , iaspects = [SetFlag Unique]-               ++ iaspects dagger-  , ieffects = [DropBestWeapon, Yell]  -- powerful and low timeout, but makes-                                       -- noise and useless against stupid foes-  , idesc    = "A double dagger that a focused fencer can use to catch and twist away an opponent's blade."-  }-hammerTemplate = ItemKind-  { isymbol  = symbolHafted-  , iname    = "war hammer"-  , ifreq    = [("hammer unknown", 1)]-  , iflavour = zipFancy [BrMagenta]  -- avoid "pink"-  , icount   = 1-  , irarity  = [(5, 20), (8, 1)]-  , iverbHit = "club"-  , iweight  = 1600-  , idamage  = 8 `d` 1  -- we are lying about the dice here, but the dungeon-                        -- is too small and the extra-dice hammers too rare-                        -- to subdivide this identification class by dice-  , iaspects = [ HideAs "hammer unknown"-               , SetFlag Durable, SetFlag Meleeable-               , toVelocity 40 ]  -- ensuring it hits with the tip costs speed-  , ieffects = []-  , idesc    = "It may not cause extensive wounds, but neither does it harmlessly glance off heavy armour as blades and polearms tend to. There are so many shapes and types, some looking more like tools than weapons, that at a glance you can't tell what a particular specimen does. It's obvious, though, that any of them requires some time to recover after a swing."  -- if it's really the average kind, the weak kind, the description stays; if not, it's replaced with one of the descriptions below at identification time-  , ikit     = []-  }-hammer1 = hammerTemplate-  { ifreq    = [("common item", 100), ("starting weapon", 70)]-  , iaspects = [Timeout 5, EqpSlot EqpSlotWeaponBig]-               ++ iaspects hammerTemplate-  }-hammer2 = hammerTemplate-  { ifreq    = [("common item", 20), ("starting weapon", 7)]-  , iverbHit = "gouge"-  , iaspects = [Timeout 3, EqpSlot EqpSlotWeaponFast]-               ++ iaspects hammerTemplate-  , idesc    = "Upon closer inspection, this hammer turns out particularly handy and well balanced, with one thick and sturdy and two long and sharp points compensating the modest size."-  }-hammer3 = hammerTemplate-  { ifreq    = [("common item", 3), ("starting weapon", 1)]-  , iverbHit = "puncture"-  , iweight  = 2400  -- weight gives it away-  , idamage  = 12 `d` 1-  , iaspects = [ Timeout 12  -- balance, or @DupItem@ would break the game-               , EqpSlot EqpSlotWeaponBig]-               ++ delete (HideAs "hammer unknown") (iaspects hammerTemplate)-  , idesc    = "This hammer sports a long metal handle that increases the momentum of the sharpened head's swing, at the cost of long recovery."-  }-hammerParalyze = hammerTemplate-  { iname    = "Brute Hammer"-  , ifreq    = [("treasure", 20)]-  , irarity  = [(5, 1), (8, 6)]-  , iaspects = [ SetFlag Unique-               , Timeout 5-               , EqpSlot EqpSlotWeaponBig ]-               ++ iaspects hammerTemplate-  , ieffects = [Paralyze 10]-  , idesc    = "A huge shapeless lump of meteorite iron alloy on a sturdy pole. Nobody remains standing when this head connects."-  }-hammerSpark = hammerTemplate-  { iname    = "Grand Smithhammer"-  , ifreq    = [("treasure", 20)]-  , irarity  = [(5, 1), (8, 6)]-  , iweight  = 2400  -- weight gives it away-  , idamage  = 12 `d` 1-  , iaspects = [ SetFlag Unique-               , Timeout 10-               , EqpSlot EqpSlotWeaponBig-               , AddSkill SkShine 3]-               ++ delete (HideAs "hammer unknown") (iaspects hammerTemplate)-  , ieffects = [Explode "spark"]-      -- we can't use a focused explosion, because it would harm the hammer-      -- wielder as well, unlike this one-  , idesc    = "Smiths of old wielded this heavy hammer and its sparks christened many a potent blade."-  }-sword = ItemKind-  { isymbol  = symbolEdged-  , iname    = "sword"-  , ifreq    = [("common item", 100), ("starting weapon", 30)]-  , iflavour = zipPlain [BrBlue]-  , icount   = 1-  , irarity  = [(4, 1), (6, 20)]-  , iverbHit = "slash"-  , iweight  = 2000-  , idamage  = 10 `d` 1-  , iaspects = [ Timeout 7-               , SetFlag Durable, SetFlag Meleeable-               , EqpSlot EqpSlotWeaponBig-               , toVelocity 40 ]  -- ensuring it hits with the tip costs speed-  , ieffects = []-  , idesc    = "Difficult to master; deadly when used effectively. The steel is particularly hard and keen, but rusts quickly without regular maintenance."-  , ikit     = []-  }-swordImpress = sword-  { iname    = "Master's Sword"-  , ifreq    = [("treasure", 20)]-  , irarity  = [(5, 1), (8, 6)]-  , iaspects = [SetFlag Unique]-               ++ iaspects sword-  , ieffects = [Impress]-  , idesc    = "A particularly well-balance blade, lending itself to impressive shows of fencing skill."-  }-swordNullify = sword-  { iname    = "Gutting Sword"-  , ifreq    = [("treasure", 20)]-  , iverbHit = "pierce"-  , irarity  = [(5, 1), (8, 6)]-  , iaspects = [SetFlag Unique, Timeout 3, EqpSlot EqpSlotWeaponFast]-               ++ (iaspects sword \\ [Timeout 7, EqpSlot EqpSlotWeaponBig])-  , ieffects = [ DropItem 1 maxBound COrgan "condition"-               , RefillCalm (-10)-               , Yell ]-  , idesc    = "Cold, thin blade that pierces deeply and sends its victim into abrupt, sobering shock."-  }-halberd = ItemKind-  { isymbol  = symbolPolearm-  , iname    = "war scythe"-  , ifreq    = [("common item", 100), ("starting weapon", 20)]-  , iflavour = zipPlain [BrYellow]-  , icount   = 1-  , irarity  = [(5, 0), (8, 15)]-  , iverbHit = "impale"-  , iweight  = 3000-  , idamage  = 12 `d` 1-  , iaspects = [ Timeout 10-               , AddSkill SkHurtMelee $ (-5 + 1 `dL` 3) * 5-                   -- useless against armor at game start-               , AddSkill SkArmorMelee 20-               , SetFlag Durable, SetFlag Meleeable-               , EqpSlot EqpSlotWeaponBig-               , toVelocity 20 ]  -- not balanced-  , ieffects = []-  , idesc    = "An improvised weapon made of scythe's blade attached to a long pole. Not often one succeeds in making enough space to swing it freely, but even when stuck between terrain obstacles it blocks approaches effectively and makes using other weapons difficult, both by friends and foes."-  , ikit     = []-  }-halberd2 = halberd-  { iname    = "halberd"-  , ifreq    = [("common item", 3 * 2), ("starting weapon", 1)]-  , iweight  = 4000-  , iaspects = [AddSkill SkHurtMelee $ (-6 + 1 `dL` 4) * 10]-                 -- balance, or @DupItem@ would break the game;-                 -- together with @RerollItem@, it's allowed to, though-               ++ (iaspects halberd-                   \\ [AddSkill SkHurtMelee $ (-6 + 1 `dL` 4) * 5])-  , idamage  = 18 `d` 1-  , idesc    = "A long haft with a sharp blade. Designed and refined for war."-  }-halberd3 = halberd2-  { iname    = "bardiche"-  , ifreq    = [("common item", 1 * 2)]  -- compensating for low base rarity-  , iverbHit = "carve"-  , iweight  = 5000-  , idamage  = 24 `d` 1-  , idesc    = "The reach of a spear but the edge of an axe."-  }-halberdPushActor = halberd-  { iname    = "Swiss Halberd"-  , ifreq    = [("treasure", 20)]-  , irarity  = [(7, 0), (9, 15)]-  , iaspects = [SetFlag Unique]-               ++ iaspects halberd-  , ieffects = [PushActor (ThrowMod 200 100 1)]  -- 2 steps, slow-  , idesc    = "A versatile polearm, with great reach and leverage. Foes are held at a distance."-  }---- ** Wands--wandTemplate = ItemKind-  { isymbol  = symbolWand-  , iname    = "wand"-  , ifreq    = [("wand unknown", 1)]-  , iflavour = zipFancy brightCol-  , icount   = 1-  , irarity  = []-  , iverbHit = "club"-  , iweight  = 300-  , idamage  = 0-  , iaspects = [ HideAs "wand unknown"-               , AddSkill SkShine 1, AddSkill SkSpeed (-1)-                   -- pulsing with power, distracts-               , SetFlag Durable-               , toVelocity 125 ]  -- magic-  , ieffects = []-  , idesc    = "Buzzing with dazzling light that shines even through appendages that handle it."  -- will have math flavour-  , ikit     = []-  }-wand1 = wandTemplate-  { ifreq    = []-  , ieffects = []  -- will be: emit a cone of sound shrapnel that makes enemy cover his ears and so drop '|' and '{'-  }---- ** Treasure--gemTemplate = ItemKind-  { isymbol  = symbolGold-  , iname    = "gem"-  , ifreq    = [("gem unknown", 1), ("valuable", 100)]-  , iflavour = zipPlain $ delete BrYellow brightCol  -- natural, so not fancy-  , icount   = 1-  , irarity  = [(3, 0), (10, 24)]-  , iverbHit = "tap"-  , iweight  = 50-  , idamage  = 0-  , iaspects = [HideAs "gem unknown", SetFlag Precious]-  , ieffects = []-  , idesc    = "Useless, and still worth around 100 gold each. Would gems of thought and pearls of artful design be valued that much in our age of Science and Progress!"-  , ikit     = []-  }-gem1 = gemTemplate-  { ifreq    = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100)-               , ("valuable", 100) ]-  , irarity  = [(3, 0), (6, 12), (10, 8)]-  , iaspects = [AddSkill SkShine 1, AddSkill SkSpeed (-1)]-                 -- reflects strongly, distracts; so it glows in the dark,-                 -- is visible on dark floor, but not too tempting to wear-               ++ iaspects gemTemplate-  }-gem2 = gem1-  { ifreq    = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100)-               , ("valuable", 100) ]-  , irarity  = [(5, 0), (7, 25), (10, 8)]-  }-gem3 = gem1-  { ifreq    = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100)-               , ("valuable", 100) ]-  , irarity  = [(7, 0), (8, 20), (10, 8)]-  }-gem4 = gem1-  { ifreq    = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100)-               , ("valuable", 100) ]-  , irarity  = [(9, 0), (10, 70)]-  }-gem5 = gem1-  { isymbol  = symbolSpecial-  , iname    = "elixir"-  , ifreq    = [ ("treasure", 100), ("gem", 25), ("any jewelry", 10)-               , ("valuable", 100) ]-  , iflavour = zipPlain [BrYellow]-  , irarity  = [(1, 40), (10, 10)]-  , iaspects = [ ELabel "of youth", SetFlag Precious  -- not hidden-               , AddSkill SkOdor (-1) ]-  , ieffects = [RefillCalm 10, RefillHP 40]-  , idesc    = "A crystal vial of amber liquid, supposedly granting eternal youth and fetching 100 gold per piece. The main effect seems to be mild euphoria, but it admittedly smells good and heals minor ailments rather well."-  }-currencyTemplate = ItemKind-  { isymbol  = symbolGold-  , iname    = "gold piece"-  , ifreq    = [("currency unknown", 1), ("valuable", 1)]-  , iflavour = zipPlain [BrYellow]-  , icount   = 10 + 1 `d` 20 + 1 `dL` 20-  , irarity  = [(1, 25), (10, 10)]-  , iverbHit = "tap"-  , iweight  = 31-  , idamage  = 0-  , iaspects = [HideAs "currency unknown", SetFlag Precious]-  , ieffects = []-  , idesc    = "Reliably valuable in every civilized plane of existence."-  , ikit     = []-  }-currency = currencyTemplate-  { ifreq    = [("treasure", 100), ("currency", 100), ("valuable", 1)]-  , iaspects = [AddSkill SkShine 1, AddSkill SkSpeed (-1)]-               ++ iaspects currencyTemplate--  }---- * LambdaHack-specific items---- ** Clothing--smokingJacket = ItemKind-  { isymbol  = symbolClothes-  , iname    = "smoking jacket"-  , ifreq    = [("common item", 100), ("misc clothing", 1), ("chic gear", 100)]-  , iflavour = zipFancy [BrGreen]-  , icount   = 1-  , irarity  = [(1, 9), (10, 3)]-  , iverbHit = "stroke"-  , iweight  = 5000-  , idamage  = 0-  , iaspects = [ Timeout $ (1 `d` 2) * 3-               , AddSkill SkSpeed 2-               , AddSkill SkOdor 2-               , SetFlag Periodic, SetFlag Durable, SetFlag Equipable-               , EqpSlot EqpSlotSpeed ]-  , ieffects = [RefillCalm 1]-  , idesc    = "Wearing this velvet jacket, anyone would look dashing."+  ( -- * Group name patterns+    pattern HARPOON, pattern EDIBLE_PLANT, pattern RING_OF_OPPORTUNITY_GRENADIER, pattern ARMOR_LOOSE, pattern CLOTHING_MISC, pattern CHIC_GEAR+  , groupNamesSingleton, groupNames+  , -- * Content+    content, items, otherItemContent+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import Content.ItemKindActor+import Content.ItemKindBlast+import Content.ItemKindEmbed+import Content.ItemKindOrgan+import Content.ItemKindTemporary+import Content.RuleKind+import Game.LambdaHack.Content.ItemKind+import Game.LambdaHack.Content.RuleKind+import Game.LambdaHack.Core.Dice+import Game.LambdaHack.Definition.Ability+import Game.LambdaHack.Definition.Color+import Game.LambdaHack.Definition.Defs+import Game.LambdaHack.Definition.Flavour++-- * Group name patterns++groupNamesSingleton :: [GroupName ItemKind]+groupNamesSingleton =+       [S_FRAGRANCE, S_SINGLE_SPARK, S_SPARK]+    ++ [FLASK_UNKNOWN, POTION_UNKNOWN, EDIBLE_PLANT_UNKNOWN, SCROLL_UNKNOWN, NECKLACE_UNKNOWN, RING_UNKNOWN, HAMMER_UNKNOWN, GEM_UNKNOWN, CURRENCY_UNKNOWN]+    ++ embedsGNSingleton ++ actorsGNSingleton ++ organsGNSingleton+    ++ blastsGNSingleton ++ temporariesGNSingleton++pattern FLASK_UNKNOWN, POTION_UNKNOWN, EDIBLE_PLANT_UNKNOWN, SCROLL_UNKNOWN, NECKLACE_UNKNOWN, RING_UNKNOWN, HAMMER_UNKNOWN, GEM_UNKNOWN, CURRENCY_UNKNOWN :: GroupName ItemKind++groupNames :: [GroupName ItemKind]+groupNames =+       [TREASURE, ANY_SCROLL, ANY_GLASS, ANY_POTION, ANY_FLASK, EXPLOSIVE, ANY_JEWELRY, VALUABLE, UNREPORTED_INVENTORY]+    ++ [HARPOON, EDIBLE_PLANT, RING_OF_OPPORTUNITY_GRENADIER, ARMOR_LOOSE, CLOTHING_MISC, CHIC_GEAR]+    ++ embedsGN ++ actorsGN ++ organsGN ++ blastsGN++pattern HARPOON, EDIBLE_PLANT, RING_OF_OPPORTUNITY_GRENADIER, ARMOR_LOOSE, CLOTHING_MISC, CHIC_GEAR :: GroupName ItemKind++-- The @UNKNOWN@ patterns don't need to be exported. Used internally.+-- They also represent singleton groups.+pattern FLASK_UNKNOWN = GroupName "flask unknown"+pattern POTION_UNKNOWN = GroupName "potion unknown"+pattern EDIBLE_PLANT_UNKNOWN = GroupName "edible plant unknown"+pattern SCROLL_UNKNOWN = GroupName "scroll unknown"+pattern NECKLACE_UNKNOWN = GroupName "necklace unknown"+pattern RING_UNKNOWN = GroupName "ring unknown"+pattern HAMMER_UNKNOWN = GroupName "hammer unknown"+pattern GEM_UNKNOWN = GroupName "gem unknown"+pattern CURRENCY_UNKNOWN = GroupName "currency unknown"++pattern HARPOON = GroupName "harpoon"+pattern EDIBLE_PLANT = GroupName "edible plant"+pattern RING_OF_OPPORTUNITY_GRENADIER = GroupName "ring of grenadier"+pattern ARMOR_LOOSE = GroupName "loose armor"+pattern CLOTHING_MISC = GroupName "miscellaneous clothing"+pattern CHIC_GEAR = GroupName "chic gear"++-- * Content++content :: [ItemKind]+content = items ++ otherItemContent++otherItemContent :: [ItemKind]+otherItemContent = embeds ++ actors ++ organs ++ blasts ++ temporaries++items :: [ItemKind]+items =+  [sandstoneRock, dart, spike, spike2, slingStone, slingBullet, paralizingProj, harpoon, harpoon2, net, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, potion13, potion14, potion15, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, light1, light2, light3, blanket, gorget, necklaceTemplate, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, motionScanner, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, armorLeather, armorMail, meleeEnhancement, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, smokingJacket, buckler, shield, shield2, shield3, hammerTemplate, hammer1, hammer2, hammer3, hammerParalyze, hammerSpark, knife, daggerDropBestWeapon, sword, swordImpress, swordNullify, halberd, halberd2, halberd3, halberdPushActor, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, jumpingPole, seeingItem]++sandstoneRock,    dart, spike, spike2, slingStone, slingBullet, paralizingProj, harpoon, harpoon2, net, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, potion13, potion14, potion15, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, light1, light2, light3, blanket, gorget, necklaceTemplate, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, motionScanner, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, armorLeather, armorMail, meleeEnhancement, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, smokingJacket, buckler, shield, shield2, shield3, hammerTemplate, hammer1, hammer2, hammer3, hammerParalyze, hammerSpark, knife, daggerDropBestWeapon, sword, swordImpress, swordNullify, halberd, halberd2, halberd3, halberdPushActor, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, jumpingPole, seeingItem :: ItemKind++-- Keep the dice rolls and sides in aspects small so that not too many+-- distinct items are generated (for display in item lore and for narrative+-- impact ("oh, I found the more powerful of the two variants of the item!",+-- instead of "hmm, I found one of the countless variants, a decent one").+-- In particular, for unique items, unless they inherit aspects from+-- a standard item, permit only a couple possible variants.+-- This is especially important if an item kind has multiple random aspects.+-- Instead multiply dice results, e.g., (1 `d` 3) * 5 instead of 1 `d` 15.+--+-- Beware of non-periodic non-weapon durable items with beneficial effects+-- and low timeout -- AI will starve applying such an item incessantly.++-- * Item group symbols, partially from Nethack++symbolProjectile, _symbolLauncher, symbolLight, symbolTool, symbolSpecial, symbolGold, symbolNecklace, symbolRing, symbolPotion, symbolFlask, symbolScroll, symbolTorsoArmor, symbolMiscArmor, symbolClothes, symbolShield, symbolPolearm, symbolEdged, symbolHafted, symbolWand, _symbolStaff, symbolFood :: Char++symbolProjectile = rsymbolProjectile standardRules  -- '|'+_symbolLauncher  = '}'+symbolLight      = '('+symbolTool       = '('+symbolSpecial    = '*'  -- don't overuse, because it clashes with projectiles+symbolGold       = '$'  -- also gems+symbolNecklace   = '"'+symbolRing       = '='+symbolPotion     = '!'  -- concoction, bottle, jar, vial, canister+symbolFlask      = '!'+symbolScroll     = '?'  -- book, note, tablet, remote, chip, card+symbolTorsoArmor = '['+symbolMiscArmor  = '['+symbolClothes    = '['+symbolShield     = ']'+symbolPolearm    = ')'+symbolEdged      = ')'+symbolHafted     = ')'+symbolWand       = '/'  -- magical rod, transmitter, pistol, rifle, instrument+_symbolStaff     = '_'  -- scanner+symbolFood       = ','  -- also body part; distinct from floor: not middle dot++-- ** Thrown weapons++sandstoneRock = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "sandstone rock"+  , ifreq    = [ (S_SANDSTONE_ROCK, 1)+               , (UNREPORTED_INVENTORY, 1) ]  -- too weak to spam+  , iflavour = zipPlain [Green]+  , icount   = 1 + 1 `d` 2  -- > 1, to let AI ignore sole pieces+  , irarity  = [(1, 50), (10, 1)]+  , iverbHit = "hit"+  , iweight  = 300+  , idamage  = 1 `d` 1+  , iaspects = [ AddSkill SkHurtMelee $ -16 * 5+               , SetFlag Fragile+               , toVelocity 70 ] -- not dense, irregular+  , ieffects = []+  , idesc    = "A lump of brittle sandstone rock."+  , ikit     = []+  }+dart = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "dart"+  , ifreq    = [(COMMON_ITEM, 100), (ANY_ARROW, 50), (WEAK_ARROW, 50)]+  , iflavour = zipPlain [BrRed]+  , icount   = 1 + 4 `dL` 5+  , irarity  = [(1, 15), (10, 5)]+  , iverbHit = "prick"+  , iweight  = 40+  , idamage  = 1 `d` 1+  , iaspects = [AddSkill SkHurtMelee $ (-15 + 1 `d` 2 + 1 `dL` 3) * 5]+                 -- only good against leather+  , ieffects = []+  , idesc    = "A sharp delicate dart with fins."+  , ikit     = []+  }+spike = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "spike"+  , ifreq    = [(COMMON_ITEM, 100), (ANY_ARROW, 50), (WEAK_ARROW, 50)]+  , iflavour = zipPlain [Cyan]+  , icount   = 1 + 4 `dL` 5+  , irarity  = [(1, 10), (10, 8)]+  , iverbHit = "nick"+  , iweight  = 150+  , idamage  = 2 `d` 1+  , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5+                   -- heavy vs armor+               , SetFlag MinorEffects+               , toVelocity 70 ]  -- hitting with tip costs speed+  , ieffects = [ Explode S_SINGLE_SPARK  -- when hitting enemy+               , OnSmash (Explode S_SINGLE_SPARK) ]  -- at wall hit+      -- this results in a wordy item synopsis, but it's OK, the spark really+      -- is useful in some situations, not just a flavour+  , idesc    = "A cruel long nail with small head."  -- "Much inferior to arrows though, especially given the contravariance problems."  -- funny, but destroy the suspension of disbelief; this is supposed to be a Lovecraftian horror and any hilarity must ensue from the failures in making it so and not from actively trying to be funny; also, mundane objects are not supposed to be scary or transcendental; the scare is in horrors from the abstract dimension visiting our ordinary reality; without the contrast there's no horror and no wonder, so also the magical items must be contrasted with ordinary XIX century and antique items+  , ikit     = []+  }+spike2 = spike+  { ifreq    = [(COMMON_ITEM, 2), (ANY_ARROW, 1), (WEAK_ARROW, 1)]+  , icount   = 6 `dL` 5+  , iverbHit = "penetrate"+  , iweight  = 200+  , idamage = 4 `d` 1+  , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5+               , SetFlag MinorEffects+               , Odds (10 * 1 `dL` 10) [] [toVelocity 70] ]+                   -- at deep levels sometimes even don't limit velocity+  , idesc    = "A jagged skewer of rusty metal."+  }+slingStone = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "sling stone"+  , ifreq    = [(COMMON_ITEM, 5), (ANY_ARROW, 100)]+  , iflavour = zipPlain [Blue]+  , icount   = 1 + 3 `dL` 4+  , irarity  = [(1, 1), (10, 20)]+  , iverbHit = "batter"+  , iweight  = 200+  , idamage  = 1 `d` 1+  , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5+                   -- heavy, to bludgeon through armor+               , SetFlag MinorEffects+               , toVelocity 150 ]+  , ieffects = [ Explode S_SINGLE_SPARK  -- when hitting enemy+               , OnSmash (Explode S_SINGLE_SPARK) ]  -- at wall hit+  , idesc    = "A round stone, carefully sized and smoothed to fit the pouch of a standard string and cloth sling."+  , ikit     = []+  }+slingBullet = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "sling bullet"+  , ifreq    = [(COMMON_ITEM, 5), (ANY_ARROW, 100)]+  , iflavour = zipPlain [BrBlack]+  , icount   = 1 + 6 `dL` 4+  , irarity  = [(1, 1), (10, 15)]+  , iverbHit = "slug"+  , iweight  = 28+  , idamage  = 1 `d` 1+  , iaspects = [ AddSkill SkHurtMelee $ (-17 + 1 `d` 2 + 1 `dL` 3) * 5+                   -- not too good against armor+               , ToThrow $ ThrowMod 200 100 2 ]  -- piercing+  , ieffects = []+  , idesc    = "Small almond-shaped leaden projectile that weighs more than the sling used to tie the bag. It doesn't drop out of the sling's pouch when swung and doesn't snag when released. Known to pierce through flesh, at least at maximum speed."  -- we lie, it doesn't slow down in our model; but it stops piercing alright+  , ikit     = []+  }++-- ** Exotic thrown weapons++-- Identified, because shape (and name) says it all. Detailed aspects id by use.+-- This is an extremely large value for @Paralyze@. Normally for such values+-- we should instead use condition that disables (almost) all stats,+-- except @SkWait@, so that the player can switch leader and not be+-- helpless nor experience instadeath (unless his party is 1-person+-- or the actor is isolated, but that's usually player's fault).+paralizingProj = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "bolas set"+  , ifreq    = [(COMMON_ITEM, 100)]+  , iflavour = zipPlain [BrGreen]+  , icount   = 1 `dL` 4+  , irarity  = [(5, 5), (10, 5)]+  , iverbHit = "entangle"+  , iweight  = 500+  , idamage  = 1 `d` 1+  , iaspects = [AddSkill SkHurtMelee $ -14 * 5]+  , ieffects = [Paralyze 15, Discharge 1 100]+  , idesc    = "Wood balls tied with hemp rope. The foe is unlikely to use its main weapon while fighting for balance."+  , ikit     = []+  }+harpoon = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "harpoon"+  , ifreq    = [(COMMON_ITEM, 100), (HARPOON, 100)]+  , iflavour = zipPlain [Brown]+  , icount   = 1 `dL` 5+  , irarity  = [(10, 10)]+  , iverbHit = "hook"+  , iweight  = 750+  , idamage  = 5 `d` 1+  , iaspects = [AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5]+  , ieffects = [ PullActor (ThrowMod 200 50 1)  -- 1 step, fast+               , Yell ]  -- yell, because brutal+  , idesc    = "The cruel, barbed head lodges in its victim so painfully that the weakest tug of the thin line sends the victim flying."+  , ikit     = []+  }+harpoon2 = harpoon+  { iname    = "whaling harpoon"+  , ifreq    = [(COMMON_ITEM, 5), (HARPOON, 2)]+  , icount   = 2 `dL` 5+  , iweight  = 1000+  , idamage  = 10 `d` 1+  , idesc    = "With a brittle, barbed head and thick cord, this ancient weapon is designed for formidable prey."+  }+net = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "net"+  , ifreq    = [(COMMON_ITEM, 100)]+  , iflavour = zipPlain [BrGreen]+  , icount   = 1 `dL` 3+  , irarity  = [(5, 5), (10, 7)]+  , iverbHit = "entangle"+  , iweight  = 1000+  , idamage  = 2 `d` 1+  , iaspects = [AddSkill SkHurtMelee $ -14 * 5]+  , ieffects = [ toOrganBad S_SLOWED (3 + 1 `d` 3)+               , DropItem maxBound 1 CEqp ARMOR_LOOSE+                   -- only one of each kind is dropped, because no rubbish+                   -- in this group and so no risk of exploit+               , SendFlying (ThrowMod 100 50 1) ]  -- 1 step; painful+  , idesc    = "A wide net with weights along the edges. Entangles armor and restricts movement."+  , ikit     = []+  }++-- ** Explosives, with the only effect being @Explode@++fragmentationBomb = ItemKind+  { isymbol  = symbolProjectile+  , iname    = "clay pot"+      -- clay pot filled with black powder; fragmentation comes from the clay+      -- shards, so it's not obvious if it's a weapon or just storage method;+      -- deflagration, not detonation, so large mass and hard container+      -- required not to burn harmlessly; improvised short fuze+  , ifreq    = [(COMMON_ITEM, 100), (EXPLOSIVE, 200)]+  , iflavour = zipPlain [Red]+  , icount   = 1 `dL` 5  -- many, because not very intricate+  , irarity  = [(5, 8), (10, 5)]+  , iverbHit = "thud"+  , iweight  = 3000  -- low velocity due to weight+  , idamage  = 0  -- heavy and hard, but let's not confuse with blast damage+  , iaspects = [ ELabel "of black powder"+               , SetFlag Lobable, SetFlag Fragile ]+  , ieffects = [ Explode S_FOCUSED_FRAGMENTATION+               , OnSmash (Explode S_VIOLENT_FRAGMENTATION) ]+  , idesc    = "The practical application of science."+  , ikit     = []+  }+concussionBomb = fragmentationBomb+  { iname    = "satchel"+      -- slightly stabilized nitroglycerine in a soft satchel, hence+      -- no fragmentation, but huge shock wave despite small size and lack of+      -- strong container to build up pressure (hence only mild hearing loss);+      -- indoors helps the shock wave; unstable enough that no fuze required+  , iflavour = zipPlain [Magenta]+  , iverbHit = "flap"+  , iweight  = 400+  , iaspects = [ ELabel "of mining charges"+               , SetFlag Lobable, SetFlag Fragile+               , toVelocity 70 ]  -- flappy and so slow+  , ieffects = [ Explode S_FOCUSED_CONCUSSION+               , OnSmash (Explode S_VIOLENT_CONCUSSION) ]+  , idesc    = "Avoid sudden movements."+  }+-- Not flashbang, because powerful bang without fragmentation is harder+-- to manufacture (requires an oxidizer and steel canister with holes).+-- The bang would also paralyze and/or lower the movement skill+-- (out of balance due to ear trauma).+flashBomb = fragmentationBomb+  { iname    = "magnesium ribbon"  -- filled with magnesium flash powder+  , iflavour = zipPlain [BrYellow]  -- avoid @BrWhite@; looks wrong in dark+  , iverbHit = "flash"+  , iweight  = 400+  , iaspects = [ SetFlag Lobable, SetFlag Fragile+               , toVelocity 70 ]  -- bad shape for throwing+  , ieffects = [Explode S_FOCUSED_FLASH, OnSmash (Explode S_VIOLENT_FLASH)]+  , idesc    = "For dramatic entrances and urgent exits."+  }+firecrackerBomb = fragmentationBomb+  { iname = "roll"  -- not fireworks, as they require outdoors+  , iflavour = zipPlain [BrMagenta]+  , irarity  = [(1, 5), (5, 6)]  -- a toy, if deadly+  , iverbHit = "crack"  -- a pun, matches the verb from "ItemKindBlast"+  , iweight  = 1000+  , iaspects = [SetFlag Lobable, SetFlag Fragile]+  , ieffects = [Explode S_FIRECRACKER, OnSmash (Explode S_FIRECRACKER)]+  , idesc    = "String and paper, concealing a deadly surprise."+  }++-- ** Exploding consumables.++-- Not identified, because they are perfect for the id-by-use fun,+-- due to effects. They are fragile and upon hitting the ground explode+-- for effects roughly corresponding to their normal effects.+-- Whether to hit with them or explode them close to the target+-- is intended to be an interesting tactical decision.++-- Flasks are intended to be thrown. They are often not natural: maths, magic,+-- distillery. In fact, they cover all temporary conditions, except those+-- for stats resistance and regeneration. They never heal, directly+-- nor indirectly (regen), so may be thrown without the risk of wasting+-- precious HP.+--+-- There is no flask nor condition that only does Calm or max Calm depletion,+-- because Calm reduced often via combat, etc.++flaskTemplate = ItemKind+  { isymbol  = symbolFlask+  , iname    = "flask"+  , ifreq    = [(FLASK_UNKNOWN, 1)]+  , iflavour = zipGlassPlain darkCol ++ zipGlassFancy darkCol+               ++ zipLiquid darkCol+  , icount   = 1 `dL` 3+  , irarity  = [(1, 7), (10, 3)]+  , iverbHit = "splash"+  , iweight  = 500+  , idamage  = 0+  , iaspects = [ PresentAs FLASK_UNKNOWN, SetFlag Lobable, SetFlag Fragile+               , toVelocity 60 ]  -- oily, rather bad grip+  , ieffects = []+  , idesc    = "A flask of oily liquid of a suspect color. Something seems to be moving inside. Double dose causes twice longer effect. Triple dose is not advisable, since the active substance is never without unhealty side-efects and often dissolved in large volumes of alcohol."+  , ikit     = []+  }+flask1 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , icount   = 1 `dL` 5+  , irarity  = [(10, 10)]+  , iaspects = ELabel "of strength renewal brew"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_STRENGTHENED (20 + 1 `d` 5)+               , OnSmash (Explode S_DENSE_SHOWER) ]+  }+flask2 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of weakness brew"+               : iaspects flaskTemplate+  , ieffects = [ toOrganBad S_WEAKENED (20 + 1 `d` 5)+               , OnSmash (Explode S_SPARSE_SHOWER) ]+  }+flask3 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of melee protective balm"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_PROTECTED_FROM_MELEE (20 + 1 `d` 5)+               , OnSmash (Explode S_MELEE_PROTECTIVE_BALM) ]+  }+flask4 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of ranged protective balm"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_PROTECTED_FROM_RANGED (20 + 1 `d` 5)+               , OnSmash (Explode S_RANGE_PROTECTIVE_BALM) ]+  }+flask5 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of PhD defense questions"+               : iaspects flaskTemplate+  , ieffects = [ toOrganBad S_DEFENSELESS (20 + 1 `d` 5)+               , Impress+               , Detect DetectExit 20+               , OnSmash (Explode S_DEFENSELESSNESS_RUNOUT) ]+  }+flask6 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , irarity  = [(1, 1)]  -- not every playthrough needs one+  , iaspects = ELabel "of resolution"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_RESOLUTE (500 + 1 `d` 200)  -- long, for scouting+               , RefillCalm 60  -- not to make it a drawback, via @calmEnough@+               , OnSmash (Explode S_RESOLUTION_DUST) ]+  }+flask7 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , icount   = 1 `d` 2  -- too powerful en masse+  , iaspects = ELabel "of haste brew"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_HASTED (20 + 1 `d` 5)+               , OnSmash (Explode S_HASTE_SPRAY) ]+  }+flask8 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of eye drops"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_FAR_SIGHTED (40 + 1 `d` 10)+               , OnSmash (Explode S_EYE_DROP) ]+  }+flask9 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , irarity  = [(10, 2)]  -- not very useful right now+  , iaspects = ELabel "of smelly concoction"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_KEEN_SMELLING (40 + 1 `d` 10)+               , Detect DetectActor 10  -- make it at least slightly useful+               , OnSmash (Explode S_SMELLY_DROPLET) ]+  }+flask10 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , irarity  = [(10, 2)]  -- not very useful right now+  , iaspects = ELabel "of cat tears"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_SHINY_EYED (40 + 1 `d` 10)+               , OnSmash (Explode S_EYE_SHINE) ]+  }+flask11 = flaskTemplate+  { iname    = "bottle"+  , ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , icount   = 1 `d` 3  -- the only one sometimes giving away its identity+  , iaspects = ELabel "of whiskey"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_DRUNK (20 + 1 `d` 5)+               , Burn 10, RefillHP 10, Yell+               , OnSmash (Explode S_WHISKEY_SPRAY) ]+  }+flask12 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of bait cocktail"+               : iaspects flaskTemplate+  , ieffects = [ toOrganGood S_DRUNK (20 + 1 `d` 5)+               , Burn 1, RefillHP 3  -- risky exploit possible, good+               , Summon MOBILE_ANIMAL 1+               , OnSmash (Summon MOBILE_ANIMAL 1)+               , OnSmash Impress  -- mildly useful when thrown+               , OnSmash (Explode S_WASTE) ]+  }+flask13 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of poison"+               : iaspects flaskTemplate+  , ieffects = [ toOrganNoTimer S_POISONED, toOrganNoTimer S_POISONED  -- x2+               , OnSmash (Explode S_POISON_CLOUD) ]+  }+flask14 = flaskTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , iaspects = ELabel "of calamity"+               : iaspects flaskTemplate+  , ieffects = [ toOrganNoTimer S_POISONED+               , toOrganBad S_WEAKENED (20 + 1 `d` 5)+               , toOrganBad S_DEFENSELESS (20 + 1 `d` 5)+               , OnSmash (Explode S_GLASS_HAIL) ]  -- enough glass to cause that+  }++-- Vials are often not intended to be thrown. They usually natural,+-- including natural stat boosts. They also include the only healing+-- consumables in the game, apart of elixirs and, to a limited extent, fruits.+-- They appear deeper than most flasks. Various configurations of effects.+-- A different class of effects is on scrolls and mechanical items.+-- Some are shared.++potionTemplate = ItemKind+  { isymbol  = symbolPotion+  , iname    = "potion"+  , ifreq    = [(POTION_UNKNOWN, 1)]+  , iflavour = zipLiquid brightCol ++ zipPlain brightCol ++ zipFancy brightCol+  , icount   = 1 `dL` 3+  , irarity  = [(1, 10), (10, 6)]+  , iverbHit = "splash"+  , iweight  = 200+  , idamage  = 0+  , iaspects = [ PresentAs POTION_UNKNOWN, SetFlag Lobable, SetFlag Fragile+               , toVelocity 50 ]  -- oily, small momentum due to small size+  , ieffects = []+  , idesc    = "A vial of bright, frothing concoction. The best medicine that nature has to offer for wounds, ailments and mood swings."+  , ikit     = []+  }+potion1 = potionTemplate+  { iname    = "vial"+  , ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , icount   = 3 `dL` 1  -- very useful, despite appearances+  , iaspects = ELabel "of rose water"+               : iaspects potionTemplate+  , ieffects = [ Impress, toOrganGood S_ROSE_SMELLING (80 + 1 `d` 20)+               , OnSmash ApplyPerfume, OnSmash (Explode S_FRAGRANCE) ]+  }+potion2 = potionTemplate+  { iname    = "the Potion"+  , ifreq    = [(TREASURE, 100), (ANY_GLASS, 100)]+  , icount   = 1+  , irarity  = [(5, 8), (10, 8)]+  , iaspects = [ SetFlag Unique, ELabel "of Attraction"+               , SetFlag Precious, SetFlag Lobable, SetFlag Fragile+               , toVelocity 50 ]  -- identified+  , ieffects = [ Dominate+               , toOrganGood S_HASTED (20 + 1 `d` 5)+               , OnSmash (Explode S_PHEROMONE)+               , OnSmash (Explode S_HASTE_SPRAY) ]+  , idesc    = "The liquid fizzes with energy."+  }+potion3 = potionTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , ieffects = [ RefillHP 5, DropItem 1 maxBound COrgan S_POISONED+               , OnSmash (Explode S_HEALING_MIST) ]+  }+potion4 = potionTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , irarity  = [(1, 6), (10, 10)]+  , ieffects = [ RefillHP 10+               , DropItem maxBound maxBound COrgan CONDITION+               , OnSmash (Explode S_HEALING_MIST_2) ]+  }+potion5 = potionTemplate+  { iname    = "ampoule"  -- probably filled with nitroglycerine, but let's+                          -- not mix fantasy with too much technical jargon+  , ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , icount   = 3 `dL` 1+  , ieffects = [ DropItem 1 maxBound COrgan CONDITION+               , OnSmash (Explode S_VIOLENT_CONCUSSION) ]+      -- not fragmentation nor glass hail, because not enough glass+  }+potion6 = potionTemplate+  -- needs to be common to show at least a portion of effects+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , icount   = 3 `dL` 1  -- always as many as possible on this level+                         -- without giving away potion identity+  , irarity  = [(1, 12)]+  , ieffects = [ OneOf [ RefillHP 10, RefillHP 5, Burn 5+                       , DropItem 1 maxBound COrgan S_POISONED+                       , toOrganGood S_STRENGTHENED (20 + 1 `d` 5) ]+               , OnSmash (OneOf [ Explode S_DENSE_SHOWER+                                , Explode S_SPARSE_SHOWER+                                , Explode S_MELEE_PROTECTIVE_BALM+                                , Explode S_RANGE_PROTECTIVE_BALM+                                , Explode S_DEFENSELESSNESS_RUNOUT ]) ]+  }+potion7 = potionTemplate+  -- needs to be common to show at least a portion of effects+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , icount   = 3 `dL` 1+  , irarity  = [(10, 10)]+  , ieffects = [ Impress+               , OneOf [ RefillHP 20, RefillHP 10, Burn 10+                       , DropItem 1 maxBound COrgan S_POISONED+                       , toOrganGood S_HASTED (20 + 1 `d` 5)+                       , toOrganBad S_IMPATIENT (2 + 1 `d` 2) ]+               , OnSmash (OneOf [ Explode S_HEALING_MIST_2+                                , Explode S_WOUNDING_MIST+                                , Explode S_DISTRESSING_ODOR+                                , Explode $ blastNoStatOf S_IMPATIENT+                                , Explode S_HASTE_SPRAY+                                , Explode S_SLOWNESS_MIST+                                , Explode S_FRAGRANCE+                                , Explode S_VIOLENT_FLASH ]) ]+  }+potion8 = potionTemplate+  { iname    = "the Potion"+  , ifreq    = [(TREASURE, 100), (ANY_GLASS, 100)]+  , icount   = 1+  , irarity  = [(10, 5)]+  , iaspects = [ SetFlag Unique, ELabel "of Love"+               , SetFlag Precious, SetFlag Lobable, SetFlag Fragile+               , toVelocity 50 ]  -- identified+  , ieffects = [ RefillHP 60, RefillCalm (-60)+               , toOrganGood S_ROSE_SMELLING (80 + 1 `d` 20)+               , OnSmash (Explode S_HEALING_MIST_2)+               , OnSmash (Explode S_DISTRESSING_ODOR) ]+  , idesc    = "Perplexing swirls of intense, compelling colour."+  }+potion9 = potionTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , irarity  = [(10, 5)]+  , iaspects = ELabel "of grenadier focus"+               : iaspects potionTemplate+  , ieffects = [ toOrganGood S_MORE_PROJECTING (40 + 1 `d` 10)+               , toOrganBad S_PACIFIED (5 + 1 `d` 3)+                   -- the malus has to be weak, or would be too good+                   -- when thrown at foes+               , OnSmash (Explode $ blastBonusStatOf S_MORE_PROJECTING)+               , OnSmash (Explode $ blastNoStatOf S_PACIFIED) ]+  , idesc    = "Thick, sluggish fluid with violently-bursting bubbles."+  }+potion10 = potionTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , irarity  = [(10, 8)]+  , iaspects = ELabel "of frenzy"+               : iaspects potionTemplate+  , ieffects = [ Yell+               , toOrganGood S_STRENGTHENED (20 + 1 `d` 5)+               , toOrganBad S_RETAINING (5 + 1 `d` 3)+               , toOrganBad S_FRENZIED (40 + 1 `d` 10)+               , OnSmash (Explode S_DENSE_SHOWER)+               , OnSmash (Explode $ blastNoStatOf S_RETAINING)    -- more+               , OnSmash (Explode $ blastNoStatOf S_RETAINING) ]  -- explosion+  }+potion11 = potionTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , irarity  = [(10, 8)]+  , iaspects = ELabel "of panic"+               : iaspects potionTemplate+  , ieffects = [ RefillCalm (-30)+               , toOrganGood S_HASTED (20 + 1 `d` 5)+               , toOrganBad S_WEAKENED (20 + 1 `d` 5)+               , toOrganBad S_WITHHOLDING (10 + 1 `d` 5)+               , OnSmash (Explode S_HASTE_SPRAY)+               , OnSmash (Explode S_SPARSE_SHOWER)+               , OnSmash (Explode $ blastNoStatOf S_WITHHOLDING) ]+  }+potion12 = potionTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_POTION, 100), (ANY_GLASS, 100)]+  , irarity  = [(10, 8)]+  , iaspects = ELabel "of quicksilver"+               : iaspects potionTemplate+  , ieffects = [ toOrganGood S_HASTED (20 + 1 `d` 5)+               , toOrganBad S_BLIND (10 + 1 `d` 5)+               , toOrganBad S_IMMOBILE (5 + 1 `d` 5)+               , OnSmash (Explode S_HASTE_SPRAY)+               , OnSmash (Explode S_IRON_FILING)+               , OnSmash (Explode $ blastNoStatOf S_IMMOBILE) ]+  }+potion13 = potionTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , irarity  = [(10, 4)]+  , iaspects = ELabel "of slow resistance"+               : iaspects potionTemplate+  , ieffects = [ toOrganNoTimer S_SLOW_RESISTANT+               , OnSmash (Explode S_ANTI_SLOW_MIST) ]+  }+potion14 = potionTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , irarity  = [(10, 4)]+  , iaspects = ELabel "of poison resistance"+               : iaspects potionTemplate+  , ieffects = [ toOrganNoTimer S_POISON_RESISTANT+               , OnSmash (Explode S_ANTIDOTE_MIST) ]+  }+-- The player has full control over throwing the flask at his party,+-- so he can milk the explosion, so it has to be much weaker, so a weak+-- healing effect is enough. OTOH, throwing a harmful flask at many enemies+-- at once is not easy to arrange, so these explosions can stay powerful.+potion15 = potionTemplate+  { ifreq    = [ (COMMON_ITEM, 100), (ANY_FLASK, 100), (EXPLOSIVE, 100)+               , (ANY_GLASS, 100) ]+  , irarity  = [(1, 2), (10, 12)]+  , iaspects = ELabel "of regeneration brew"+               : iaspects potionTemplate+  , ieffects = [ toOrganGood S_ROSE_SMELLING (80 + 1 `d` 20)+               , toOrganNoTimer S_REGENERATING+               , toOrganNoTimer S_REGENERATING  -- x2+               , OnSmash (Explode S_YOUTH_SPRINKLE) ]+  }++-- ** Non-exploding consumables, not specifically designed for throwing++-- Readable or otherwise communicating consumables require high apply skill+-- to be consumed.++scrollTemplate = ItemKind+  { isymbol  = symbolScroll+  , iname    = "scroll"+  , ifreq    = [(SCROLL_UNKNOWN, 1)]+  , iflavour = zipFancy stdCol ++ zipPlain stdCol+  , icount   = 1 `dL` 3+  , irarity  = [(1, 14), (10, 7)]+  , iverbHit = "thump"+  , iweight  = 50+  , idamage  = 0+  , iaspects = [ PresentAs SCROLL_UNKNOWN+               , toVelocity 30 ]  -- bad shape, even rolled up+  , ieffects = []+  , idesc    = "Scraps of haphazardly scribbled mysteries from beyond. Is this equation an alchemical recipe? Is this diagram an extradimensional map? Is this formula a secret call sign?"+  , ikit     = []+  }+scroll1 = scrollTemplate+  { iname    = "the Scroll"+  , ifreq    = [(TREASURE, 100), (ANY_SCROLL, 100)]+  , icount   = 1+  , irarity  = [(5, 9), (10, 9)]  -- mixed blessing, so found early for a unique+  , iaspects = [SetFlag Unique, ELabel "of Reckless Beacon"]+               ++ iaspects scrollTemplate+  , ieffects = [Summon HERO 1, Summon MOBILE_ANIMAL (2 + 1 `d` 2)]+  , idesc    = "The bright flame and sweet-smelling smoke of this heavily infused scroll should attract natural creatures inhabiting the area, including human survivors, if any."+  }+scroll2 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(1, 6), (10, 2)]+  , ieffects = [Ascend False]+  }+scroll3 = scrollTemplate+  -- needs to be common to show at least a portion of effects+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , icount   = 3 `dL` 1+  , irarity  = [(1, 14)]+  , ieffects = [OneOf [ Teleport 5, Paralyze 10, InsertMove 30+                      , Detect DetectEmbed 12, Detect DetectHidden 20 ]]+  }+scroll4 = scrollTemplate+  -- needs to be common to show at least a portion of effects+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , icount   = 3 `dL` 1+  , irarity  = [(10, 14)]+  , ieffects = [ Impress+               , OneOf [ Teleport 20, Ascend False, Ascend True+                       , Summon HERO 1, Summon MOBILE_ANIMAL $ 1 `d` 2+                       , Detect DetectLoot 20  -- the most useful of detections+                       , CreateItem Nothing CGround COMMON_ITEM timerNone ] ]+  }+scroll5 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(1, 6)]  -- powerful, but low counts at the depths it appears on+  , ieffects = [InsertMove $ 20 + 1 `dL` 20]+  }+scroll6 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(10, 11)]+  , ieffects = [PullActor (ThrowMod 800 75 1)]  -- 6 steps, 1.5 turns+  }+scroll7 = scrollTemplate+  { iname    = "the Scroll"+  , ifreq    = [(TREASURE, 100), (ANY_SCROLL, 100)]+  , icount   = 1+  , irarity  = [(10, 12)]+  , iaspects = [SetFlag Unique, ELabel "of Rescue Proclamation"]+               ++ iaspects scrollTemplate+  , ieffects = [Summon HERO 1]+  , idesc    = "A survivor of past exploration missions is found that enjoys, apparently, complete physiological integrity. We can pronounce him a comrade in arms and let him join our party."+  }+scroll8 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(10, 4)]  -- powerful, even if not ideal; scares newbies+  , ieffects = [Detect DetectAll 20]+  }+scroll9 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , iaspects = ELabel "of cue interpretation"+               : iaspects scrollTemplate+  , ieffects = [Detect DetectActor 20]+  }+scroll10 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , icount   = 3 `dL` 1+  , irarity  = [(1, 20)]  -- uncommon deep down, where all is known+  , iaspects = ELabel "of scientific explanation"+               : iaspects scrollTemplate+  , ieffects = [Identify `AndEffect` RefillCalm 10]+  , idesc    = "The most pressing existential concerns are met with a deeply satisfying scientific answer."+  }+scroll11 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(10, 20)]  -- at gameover a crucial item may be missing+  , iaspects = ELabel "of transmutation"+               : iaspects scrollTemplate+  , ieffects = [PolyItem `AndEffect` Explode S_FIRECRACKER]+  }+scroll12 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(10, 15)]+  , iaspects = ELabel "of transfiguration"+               : iaspects scrollTemplate+  , ieffects = [RerollItem]+  }+scroll13 = scrollTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_SCROLL, 100)]+  , irarity  = [(10, 15)]+  , iaspects = ELabel "of similarity"+               : iaspects scrollTemplate+  , ieffects = [DupItem]+  }++-- Foods require only minimal apply skill to consume. Many animals can eat them.++ediblePlantTemplate = ItemKind+  { isymbol  = symbolFood+  , iname    = "edible plant"+  , ifreq    = [(EDIBLE_PLANT_UNKNOWN, 1)]+  , iflavour = zipFancy stdCol+  , icount   = 1 `dL` 5+  , irarity  = [(1, 12), (10, 6)]  -- let's feed the animals+  , iverbHit = "thump"+  , iweight  = 50+  , idamage  = 0+  , iaspects = [ PresentAs EDIBLE_PLANT_UNKNOWN+               , toVelocity 30 ]  -- low density, often falling apart+  , ieffects = []+  , idesc    = "Withered but fragrant bits of a colorful plant. Taste tolerably and break down easily, but only eating may reveal the full effects."+  , ikit     = []+  }+ediblePlant1 = ediblePlantTemplate+  { iname    = "overripe berry"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , ieffects = [RefillHP 1, toOrganBad S_IMMOBILE (5 + 1 `d` 5)]+  }+ediblePlant2 = ediblePlantTemplate+  { iname    = "frayed fungus"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , ieffects = [toOrganNoTimer S_POISONED]+  }+ediblePlant3 = ediblePlantTemplate+  { iname    = "thick leaf"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , ieffects = [DropItem 1 maxBound COrgan S_POISONED]+  }+ediblePlant4 = ediblePlantTemplate+  { iname    = "shrunk fruit"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , ieffects = [toOrganBad S_BLIND (10 + 1 `d` 10)]+  }+ediblePlant5 = ediblePlantTemplate+  { iname    = "fragrant herb"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , icount   = 1 `dL` 9+  , irarity  = [(1, 12), (10, 5)]+  , iaspects = ELabel "of lethargy"+               : iaspects ediblePlantTemplate+  , ieffects = [ toOrganBad S_SLOWED (20 + 1 `d` 5)+               , toOrganNoTimer S_REGENERATING+               , toOrganNoTimer S_REGENERATING  -- x2+               , RefillCalm 5 ]+  }+ediblePlant6 = ediblePlantTemplate+  { iname    = "dull flower"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , ieffects = [PutToSleep]+  }+ediblePlant7 = ediblePlantTemplate+  { iname    = "spicy bark"+  , ifreq    = [(COMMON_ITEM, 100), (EDIBLE_PLANT, 100)]+  , ieffects = [InsertMove 20, toOrganBad S_FRENZIED (40 + 1 `d` 10)]+  }++-- ** Lights++light1 = ItemKind+  { isymbol  = symbolLight+  , iname    = "wooden torch"+  , ifreq    = [ (COMMON_ITEM, 100), (LIGHT_ATTENUATOR, 100)+               , (S_WOODEN_TORCH, 1) ]+  , iflavour = zipPlain [Brown]+  , icount   = 1 `dL` 4+  , irarity  = [(1, 40), (4, 1)]+  , iverbHit = "scorch"+  , iweight  = 1000+  , idamage  = 0+  , iaspects = [ AddSkill SkShine 3, AddSkill SkSight (-2)+                   -- not only flashes, but also sparks,+                   -- so unused by AI due to the mixed blessing+               , SetFlag Lobable, SetFlag Equipable+               , EqpSlot EqpSlotShine ]+                   -- not Fragile; reusable flare+  , ieffects = [Burn 1]+  , idesc    = "A heavy smoking wooden torch, improvised using a cloth soaked in tar, burning in an unsteady glow."+  , ikit     = []+  }+light2 = ItemKind+  { isymbol  = symbolLight+  , iname    = "oil lamp"+  , ifreq    = [(COMMON_ITEM, 100), (LIGHT_ATTENUATOR, 100)]+  , iflavour = zipPlain [BrYellow]+  , icount   = 1 `dL` 2+  , irarity  = [(4, 10)]+  , iverbHit = "burn"+  , iweight  = 1500+  , idamage  = 1 `d` 1+  , iaspects = [ AddSkill SkShine 3, AddSkill SkSight (-1)+               , SetFlag Lobable, SetFlag Fragile, SetFlag Equipable+               , EqpSlot EqpSlotShine ]+  , ieffects = [ Burn 1+               , toOrganBad S_PACIFIED (2 + 1 `d` 2)+               , OnSmash (Explode S_BURNING_OIL_2) ]+  , idesc    = "A clay lamp filled with plant oil feeding a tiny wick."+  , ikit     = []+  }+light3 = ItemKind+  { isymbol  = symbolLight+  , iname    = "brass lantern"+  , ifreq    = [(COMMON_ITEM, 100), (LIGHT_ATTENUATOR, 100)]+  , iflavour = zipPlain [Red]+  , icount   = 1+  , irarity  = [(10, 6)]+  , iverbHit = "burn"+  , iweight  = 3000+  , idamage  = 2 `d` 1+  , iaspects = [ AddSkill SkShine 4, AddSkill SkSight (-1)+               , SetFlag Lobable, SetFlag Fragile, SetFlag Equipable+               , EqpSlot EqpSlotShine ]+  , ieffects = [ Burn 1+               , toOrganBad S_PACIFIED (4 + 1 `d` 2)+               , OnSmash (Explode S_BURNING_OIL_4) ]+  , idesc    = "Very bright and very heavy brass lantern."+  , ikit     = []+  }+blanket = ItemKind+  { isymbol  = symbolLight+  , iname    = "wool blanket"+  , ifreq    = [ (COMMON_ITEM, 100), (LIGHT_ATTENUATOR, 100)+               , (FIREPROOF_CLOTH, 1) ]+  , iflavour = zipPlain [BrBlack]+  , icount   = 1+  , irarity  = [(1, 1)]  -- not every playthrough needs one+  , iverbHit = "swoosh"+  , iweight  = 1000+  , idamage  = 0+  , iaspects = [ AddSkill SkShine (-10)+               , AddSkill SkArmorMelee 2, AddSkill SkMaxCalm 5+               , SetFlag Lobable, SetFlag Equipable+               , EqpSlot EqpSlotArmorMelee ]+                  -- not Fragile; reusable douse implement;+                   -- douses torch, lamp and lantern in one action,+                   -- both in equipment and when thrown at the floor+  , ieffects = []+  , idesc    = "Warm, comforting, and concealing, woven from soft wool."+  , ikit     = []+  }++-- ** Periodic jewelry++-- Morally these are the aspects, but we also need to add a fake @Timeout@,+-- to let clients know that the not identified item is periodic jewelry.+iaspects_necklaceTemplate :: [Aspect]+iaspects_necklaceTemplate =+  [ PresentAs NECKLACE_UNKNOWN+  , SetFlag Periodic, SetFlag Precious, SetFlag Equipable+  , toVelocity 50 ]  -- not dense enough+gorget = necklaceTemplate+  { iname    = "Old Gorget"+  , ifreq    = [(COMMON_ITEM, 25), (TREASURE, 25)]+  , iflavour = zipFancy [BrCyan]  -- looks exactly the same as one of necklaces,+                                  -- but it's OK, it's an artifact+  , iaspects = [ SetFlag Unique+               , Timeout $ 5 - 1 `dL` 4+                   -- the dL dice need to be in negative positions+                   -- for negative stats, such as @Timeout@, so that+                   -- the @RerollItem@ effect makes the item better, not worse+               , AddSkill SkArmorMelee 3, AddSkill SkArmorRanged 2+               , AddSkill SkHearing 3+               , SetFlag Durable ]+               ++ iaspects_necklaceTemplate+  , ieffects = [RefillCalm 1]+  , idesc    = "Highly ornamental, cold, large steel medallion on a chain. Unlikely to offer much protection as an armor piece, but the old worn engraving reassures the wearer."+  }+-- Not identified, because id by use, e.g., via periodic activations. Fun.+necklaceTemplate = ItemKind+  { isymbol  = symbolNecklace+  , iname    = "necklace"+  , ifreq    = [(NECKLACE_UNKNOWN, 1)]+  , iflavour = zipFancy stdCol ++ zipPlain brightCol+  , icount   = 1+  , irarity  = [(4, 3), (10, 6)]+  , iverbHit = "whip"+  , iweight  = 30+  , idamage  = 0+  , iaspects = Timeout 1000000+                 -- fake, needed to display "charging"; the timeout itself+                 -- won't be displayed thanks to periodic; as a side-effect,+                 -- it can't be activated until identified, which is better+                 -- than letting the player try to activate before the real+                 -- cooldown is over and waste turn+               : iaspects_necklaceTemplate+  , ieffects = []+  , idesc    = "Menacing Greek symbols shimmer with increasing speed along a chain of fine encrusted links. After a tense build-up, a prismatic arc shoots towards the ground and the iridescence subdues, becomes ordered and resembles a harmless ornament again, for a time."+  , ikit     = []+  }+necklace1 = necklaceTemplate+  { iname    = "the Necklace"+  , ifreq    = [(TREASURE, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(10, 3)]+  , iaspects = [ SetFlag Unique, ELabel "of Aromata"+               , Timeout $ (4 - 1 `dL` 3) * 10+                   -- priceless, so worth the long wait and Calm drain+               , SetFlag Durable ]+               ++ iaspects_necklaceTemplate+  , ieffects = [ RefillCalm (-5)+               , When (TriggeredBy ActivationPeriodic) $ RefillHP 1 ]+  , idesc    = "A cord of freshly dried herbs and healing berries."+  }+necklace2 = necklaceTemplate+  { iname    = "the Necklace"+  , ifreq    = [(TREASURE, 100), (ANY_JEWELRY, 100)]+      -- too nasty to call it just a COMMON_ITEM+  , irarity  = [(10, 3)]+  , iaspects = [ SetFlag Unique, ELabel "of Live Bait"+               , Timeout 30+               , AddSkill SkOdor 2+               , SetFlag Durable ]+               ++ iaspects_necklaceTemplate+  , ieffects = [ DropItem 1 1 COrgan CONDITION  -- mildly useful when applied+               , When (TriggeredBy ActivationPeriodic) $ SeqEffect+                   [ Impress+                   , Summon MOBILE_ANIMAL $ 1 `dL` 2+                   , Explode S_WASTE ] ]+  , idesc    = "A cord hung with lumps of decaying meat. It's better not to think about the source."+  }+necklace3 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , iaspects = [ ELabel "of fearful listening"+               , Timeout 40+                   -- has to be larger than Calm drain or item not removable;+                   -- equal is not enough if enemies drained Calm already+               , AddSkill SkHearing 6 ]+               ++ iaspects_necklaceTemplate+  , ieffects = [ Detect DetectActor 20  -- can be applied; destroys the item+               , When (TriggeredBy ActivationPeriodic) $ RefillCalm (-30) ]+  }+necklace4 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , iaspects = [ ELabel "of escape"+               , Timeout $ (7 - 1 `dL` 5) * 10 ]+               ++ iaspects_necklaceTemplate+  , ieffects = [ Teleport $ 14 + 3 `d` 3  -- can be applied; destroys the item+               , Detect DetectExit 20+               , Yell ]  -- drawback when used for quick exploring+  , idesc    = "A supple chain that slips through your fingers."+  }+necklace5 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , iaspects = [ ELabel "of greed"+               , Timeout ((2 + 1 `d` 3) * 10) ]+               ++ iaspects_necklaceTemplate+  , ieffects = [ Detect DetectLoot 20+               , toOrganBad S_PARSIMONIOUS (5 + 1 `d` 3)  -- hard to flee+               , When (TriggeredBy ActivationPeriodic) $ Teleport 40 ]  -- risky+  }+necklace6 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , iaspects = Timeout ((3 + 1 `d` 3 - 1 `dL` 3) * 2)+               : iaspects_necklaceTemplate+  , ieffects = [Teleport $ 3 `d` 2]+  }+necklace7 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , iaspects = Timeout (1 + (1 `d` 3) * 2)+               : iaspects_necklaceTemplate+  , ieffects = [PushActor (ThrowMod 100 50 1)]  -- 1 step, slow+                  -- the @50@ is only for the case of very light actor, etc.+  }+necklace8 = necklaceTemplate+  { iname    = "the Necklace"+  , ifreq    = [(TREASURE, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(10, 1)]  -- different gameplay for the actor that wears it+  , iaspects = [ SetFlag Unique, ELabel "of Overdrive"+               , Timeout 4+               , AddSkill SkMaxHP 25  -- give incentive to cope with impatience+               , SetFlag Durable ]+               ++ iaspects_necklaceTemplate+  , ieffects = [ InsertMove $ 9 + 1 `d` 11  -- unpredictable+               , toOrganBad S_IMPATIENT 4]+                 -- The same duration as timeout, to avoid spurious messages+                 -- as well as unlimited accumulation of the duration.+  , idesc    = "A string of beads in various colours, with no discernable pattern."+  }+necklace9 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(4, 3)]  -- entirely optional+  , iaspects = Timeout ((1 + 1 `d` 3) * 5)+               : iaspects_necklaceTemplate+  , ieffects = [Explode S_SPARK]+  }+necklace10 = necklaceTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , iaspects = Timeout ((1 + 1 `d` 3) * 5)+               : iaspects_necklaceTemplate+  , ieffects = [Explode S_FRAGRANCE]+  }+motionScanner = necklaceTemplate+  { iname    = "draft detector"+  , ifreq    = [(COMMON_ITEM, 100), (ADD_NOCTO_1, 20)]+  , irarity  = [(5, 2)]+  , iverbHit = "jingle"+  , iweight  = 300  -- almost gives it away+  , iaspects = [ Timeout $ 4 + 1 `dL` 6+               , AddSkill SkNocto 1+               , AddSkill SkArmorMelee (-20 + (1 `dL` 3) * 5)+               , EqpSlot EqpSlotMiscBonus ]+               ++ iaspects_necklaceTemplate+  , ieffects = [Explode S_PING_PLASH]+  , idesc    = "A silk flag with a bell for detecting sudden draft changes. May indicate a nearby corridor crossing or a fast enemy approaching in the dark. The bell is very noisy and casts light reflection flashes."+  }++-- ** Non-periodic jewelry++imageItensifier = ItemKind+  { isymbol  = symbolRing+  , iname    = "light cone"+  , ifreq    = [(TREASURE, 100), (ADD_NOCTO_1, 80)]+  , iflavour = zipFancy [BrYellow]+  , icount   = 1+  , irarity  = [(5, 2)]+  , iverbHit = "bang"+  , iweight  = 500+  , idamage  = 0+  , iaspects = [ AddSkill SkNocto 1, AddSkill SkSight (-1)+               , AddSkill SkArmorMelee $ (-1 + 1 `dL` 6) * 3+               , SetFlag Precious, SetFlag Equipable+               , EqpSlot EqpSlotMiscBonus ]+  , ieffects = []+  , idesc    = "Contraption of lenses and mirrors on a polished brass headband for capturing and strengthening light in dark environment. Hampers vision in daylight. Stackable."+  , ikit     = []+  }+sightSharpening = ringTemplate  -- small and round, so mistaken for a ring+  { iname    = "sharp monocle"+  , ifreq    = [(TREASURE, 20), (ADD_SIGHT, 1)]+      -- it's has to be very rare, because it's powerful and not unique,+      -- and also because it looks exactly as one of necklaces, so it would+      -- be misleading when seen on the map+  , irarity  = [(7, 1), (10, 12)]  -- low @ifreq@+  , iweight  = 50  -- heavier that it looks, due to glass+  , iaspects = [ AddSkill SkSight $ 1 + 1 `dL` 2+               , AddSkill SkHurtMelee $ (-1 + 1 `d` 3) * 3+               , EqpSlot EqpSlotSight ]+               ++ iaspects ringTemplate+  , idesc    = "Lets you better focus your weaker eye."+  }+-- Don't add standard effects to rings, because they go in and out+-- of eqp and so activating them would require UI tedium: looking for+-- them in eqp and stash or even activating a wrong item by mistake.+--+-- By general mechanisms, due to not having effects that could identify+-- them by observing the effect, rings are identified on pickup.+-- That's unlike necklaces, which provide the fun of id-by-use, because they+-- have effects and when the effects are triggered, they get identified.+ringTemplate = ItemKind+  { isymbol  = symbolRing+  , iname    = "ring"+  , ifreq    = [(RING_UNKNOWN, 1)]+  , iflavour = zipPlain stdCol ++ zipFancy darkCol+  , icount   = 1+  , irarity  = [(10, 2)]  -- the default very low+  , iverbHit = "knock"+  , iweight  = 15+  , idamage  = 0+  , iaspects = [PresentAs RING_UNKNOWN, SetFlag Precious, SetFlag Equipable]+  , ieffects = []+  , idesc    = "It looks like an ordinary object, but it's in fact a generator of exceptional effects: adding to some of your natural qualities and subtracting from others."+  , ikit     = []+  }+ring1 = ringTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(8, 4)]+  , iaspects = [ AddSkill SkSpeed $ 1 `dL` 3+               , AddSkill SkMaxHP (-10)+               , EqpSlot EqpSlotSpeed ]+               ++ iaspects ringTemplate+  }+ring2 = ringTemplate+  { iname    = "the Ring"+  , ifreq    = [(TREASURE, 100), (ANY_JEWELRY, 100)]+  , iaspects = [ SetFlag Unique, ELabel "of Rush"+               , AddSkill SkSpeed $ (1 + 1 `dL` 2) * 2+               , AddSkill SkMaxHP (-20)+               , AddSkill SkMaxCalm (-40)+               , SetFlag Durable, EqpSlot EqpSlotSpeed ]+               ++ iaspects ringTemplate+  , idesc    = "Roughly-shaped metal with shallow scratches marking it."+  }+ring3 = ringTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(3, 4), (10, 8)]+  , iaspects = [ AddSkill SkHurtMelee $ (2 + 1 `d` 2 + (1 `dL` 2) * 2 ) * 3+               , AddSkill SkMaxHP $ (-3 + 1 `dL` 3) * 10+               , EqpSlot EqpSlotHurtMelee ]+               ++ iaspects ringTemplate+  }+ring4 = ringTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(10, 8)]+  , iaspects = [ AddSkill SkMaxHP $ 5 + (1 `d` 2 + 1 `dL` 2) * 5+               , AddSkill SkMaxCalm $ -30 + (1 `dL` 3) * 5+               , EqpSlot EqpSlotMaxHP ]+               ++ iaspects ringTemplate+  }+ring5 = ringTemplate+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(5, 1), (10, 9)]  -- needed after other rings drop Calm+  , iaspects = [ AddSkill SkMaxCalm $ 20 + (1 `dL` 4) * 5+               , AddSkill SkHearing 6+               , EqpSlot EqpSlotMiscBonus ]+               ++ iaspects ringTemplate+  , idesc    = "Cold, solid to the touch, perfectly round, engraved with solemn, strangely comforting, worn out words."+  }+ring6 = ringTemplate  -- weak skill per eqp slot, so can be without drawbacks+  { ifreq    = [(COMMON_ITEM, 100), (ANY_JEWELRY, 100)]+  , irarity  = [(10, 3)]+  , iaspects = [ AddSkill SkShine 1+               , EqpSlot EqpSlotShine ]+               ++ iaspects ringTemplate+  , idesc    = "A sturdy ring with a large, shining stone."+  }+ring7 = ringTemplate+  { ifreq    = [(RING_OF_OPPORTUNITY_SNIPER, 1) ]  -- only for scenarios+  , irarity  = [(1, 1)]+  , iaspects = [ ELabel "of opportunity sniper"+               , AddSkill SkProject 8+               , EqpSlot EqpSlotProject ]+               ++ iaspects ringTemplate+  }+ring8 = ringTemplate+  { ifreq    = [(RING_OF_OPPORTUNITY_GRENADIER, 1) ]  -- only for scenarios+  , irarity  = [(1, 1)]+  , iaspects = [ ELabel "of opportunity grenadier"+               , AddSkill SkProject 11+               , EqpSlot EqpSlotProject ]+               ++ iaspects ringTemplate+  }++-- ** Armor++armorLeather = ItemKind+  { isymbol  = symbolTorsoArmor+  , iname    = "leather armor"+  , ifreq    = [(COMMON_ITEM, 100), (ARMOR_LOOSE, 1), (STARTING_ARMOR, 100)]+  , iflavour = zipPlain [Brown]+  , icount   = 1+  , irarity  = [(1, 9), (10, 3)]+  , iverbHit = "thud"+  , iweight  = 7000+  , idamage  = 0+  , iaspects = [ AddSkill SkHurtMelee (-2)+               , AddSkill SkArmorMelee $ (2 + 1 `dL` 4) * 5+               , AddSkill SkArmorRanged $ (1 + 1 `dL` 2) * 3+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotArmorMelee ]+  , ieffects = []+  , idesc    = "A stiff jacket formed from leather boiled in bee wax, padded linen and horse hair. Protects from anything that is not too sharp. Smells much better than the rest of your garment."+  , ikit     = []+  }+armorMail = armorLeather+  { iname    = "ring armor"+  , ifreq    = [ (COMMON_ITEM, 100), (ARMOR_LOOSE, 1), (ARMOR_RANGED, 50)+               , (STARTING_ARMOR, 50) ]+  , iflavour = zipPlain [Cyan]+  , irarity  = [(6, 9), (10, 3)]+  , iweight  = 12000+  , idamage  = 0+  , iaspects = [ AddSkill SkHurtMelee (-3)+               , AddSkill SkArmorMelee $ (2 + 1 `dL` 4) * 5+               , AddSkill SkArmorRanged $ (4 + 1 `dL` 2) * 3+               , AddSkill SkOdor 2+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotArmorRanged ]+  , ieffects = []+  , idesc    = "A long shirt with tiny iron rings sewn into it. Discourages foes from attacking your torso, especially with ranged weapons, which can't pierce the rings nor aim between them. The stiff fabric is hard to wash, though."+  }+meleeEnhancement = ItemKind+  { isymbol  = symbolTool+  , iname    = "whetstone"+  , ifreq    = [(COMMON_ITEM, 100)]+  , iflavour = zipPlain [Blue]+  , icount   = 1+  , irarity  = [(10, 10)]+  , iverbHit = "smack"+  , iweight  = 400+  , idamage  = 0+  , iaspects = [ AddSkill SkHurtMelee $ (1 `dL` 7) * 5+               , AddSkill SkArmorMelee 2+               , SetFlag Equipable, EqpSlot EqpSlotHurtMelee ]+  , ieffects = []+  , idesc    = "A portable sharpening stone for keeping your weapons keen and true, without the need to set up camp, fish out tools and assemble a proper sharpening workshop. Provides an extra polish to amor, as well."+  , ikit     = []+  }+gloveFencing = ItemKind+  { isymbol  = symbolMiscArmor+  , iname    = "leather glove"+  , ifreq    = [ (COMMON_ITEM, 100), (ARMOR_MISC, 1), (ARMOR_RANGED, 50)+               , (STARTING_ARMOR, 50) ]+  , iflavour = zipPlain [White]+  , icount   = 1+  , irarity  = [(5, 9), (10, 9)]+  , iverbHit = "flap"+  , iweight  = 100+  , idamage  = 1 `d` 1+  , iaspects = [ AddSkill SkHurtMelee $ (2 + 1 `d` 2 + 1 `dL` 2) * 3+               , AddSkill SkArmorRanged $ (1 `dL` 2) * 3+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotHurtMelee+               , toVelocity 50 ]  -- flaps and flutters+  , ieffects = []+  , idesc    = "A fencing glove from rough leather ensuring a good grip. Also quite effective in averting or even catching slow projectiles."+  , ikit     = []+  }+gloveGauntlet = gloveFencing+  { iname    = "steel gauntlet"+  , ifreq    = [(COMMON_ITEM, 100), (ARMOR_MISC, 1), (STARTING_ARMOR, 50)]+  , iflavour = zipPlain [BrCyan]+  , irarity  = [(1, 9), (10, 3)]+  , iweight  = 300+  , idamage  = 2 `d` 1+  , iaspects = [ AddSkill SkArmorMelee $ (1 + 1 `dL` 4) * 5+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotArmorMelee+               , toVelocity 50 ]  -- flaps and flutters+  , idesc    = "Long leather gauntlet covered in overlapping steel plates."+  }+gloveJousting = gloveFencing+  { iname    = "Tournament Gauntlet"+  , ifreq    = [(COMMON_ITEM, 100), (ARMOR_MISC, 1)]+  , iflavour = zipFancy [BrRed]+  , irarity  = [(1, 3), (10, 3)]+  , iverbHit = "rasp"+  , iweight  = 3000+  , idamage  = 3 `d` 1+  , iaspects = [ SetFlag Unique+               , AddSkill SkHurtMelee $ (-7 + 1 `dL` 5) * 3+               , AddSkill SkArmorMelee $ (2 + 1 `d` 2 + 1 `dL` 2) * 5+               , AddSkill SkArmorRanged $ (1 + 1 `dL` 2) * 3+                 -- very random on purpose and can even be good on occasion+                 -- or when ItemRerolled enough times+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotArmorMelee+               , toVelocity 50 ]  -- flaps and flutters+  , idesc    = "Rigid, steel jousting handgear. If only you had a lance. And a horse to carry it all."+  }+hatUshanka = ItemKind+  { isymbol  = symbolMiscArmor+  , iname    = "ushanka hat"+  , ifreq    = [ (COMMON_ITEM, 100), (ARMOR_MISC, 1), (CLOTHING_MISC, 1)+               , (STARTING_ARMOR, 50) ]+  , iflavour = zipPlain [Brown]+  , icount   = 1+  , irarity  = [(1, 6), (10, 1)]+  , iverbHit = "tickle"+  , iweight  = 500+  , idamage  = 0+  , iaspects = [ Timeout $ (2 + 1 `d` 2) * 3+               , AddSkill SkArmorMelee 5, AddSkill SkHearing (-10)+               , SetFlag Periodic, SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotArmorMelee+               , toVelocity 50 ]  -- flaps and flutters+  , ieffects = [RefillCalm 1]+  , idesc    = "Soft and warm fur. It keeps your ears warm."+  , ikit     = []+  }+capReinforced = ItemKind+  { isymbol  = symbolMiscArmor+  , iname    = "leather cap"+  , ifreq    = [(COMMON_ITEM, 100), (ARMOR_MISC, 1), (STARTING_ARMOR, 50)]+  , iflavour = zipPlain [BrYellow]+  , icount   = 1+  , irarity  = [(6, 9), (10, 3)]+  , iverbHit = "cut"+  , iweight  = 1000+  , idamage  = 0+  , iaspects = [ AddSkill SkArmorMelee $ (1 `d` 2) * 5+               , AddSkill SkProject 1+                   -- the brim shields against blinding by light sources, etc.+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotProject ]+  , ieffects = []+  , idesc    = "Boiled leather with a wide brim. It might soften a blow."+  , ikit     = []+  }+helmArmored = ItemKind+  { isymbol  = symbolMiscArmor+  , iname    = "bucket helm"+  , ifreq    = [(COMMON_ITEM, 100), (ARMOR_MISC, 1), (STARTING_ARMOR, 50)]+  , iflavour = zipPlain [BrCyan]+  , icount   = 1+  , irarity  = [(6, 9), (10, 3)]+  , iverbHit = "bounce"+  , iweight  = 2000+  , idamage  = 0+  , iaspects = [ AddSkill SkArmorMelee $ (1 + 1 `dL` 4) * 5+               , AddSkill SkArmorRanged $ (2 + 1 `dL` 2) * 3  -- headshot+               , AddSkill SkHearing (-7), AddSkill SkSight (-1)+               , AddSkill SkSmell (-5)+               , SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotArmorRanged ]+  , ieffects = []+  , idesc    = "Blocks out everything, including your senses."+  , ikit     = []+  }+smokingJacket = ItemKind+  { isymbol  = symbolClothes+  , iname    = "smoking jacket"+  , ifreq    = [(COMMON_ITEM, 100), (CLOTHING_MISC, 1), (CHIC_GEAR, 100)]+  , iflavour = zipFancy [BrGreen]+  , icount   = 1+  , irarity  = [(1, 9), (10, 3)]+  , iverbHit = "stroke"+  , iweight  = 5000+  , idamage  = 0+  , iaspects = [ Timeout $ (1 `d` 2) * 3+               , AddSkill SkSpeed 2+               , AddSkill SkOdor 2+               , SetFlag Periodic, SetFlag Durable, SetFlag Equipable+               , EqpSlot EqpSlotSpeed ]+  , ieffects = [RefillCalm 1]+  , idesc    = "Wearing this velvet jacket, anyone would look dashing."+  , ikit     = []+  }+-- Shield doesn't protect against ranged attacks to prevent+-- micromanagement: walking with shield, melee without.+-- Their biggest power is pushing enemies, which however reduces+-- to 1 extra damage point if no clear space behind enemy.+-- So they require keen tactical management.+-- Note that AI will pick them up but never wear and will use them at most+-- as a way to push itself. Despite being @Meleeable@, they will not be used+-- as weapons either. This is OK, using shields smartly is totally beyond AI.+buckler = ItemKind+  { isymbol  = symbolShield+  , iname    = "buckler"+  , ifreq    = [(COMMON_ITEM, 100), (ARMOR_LOOSE, 1)]+  , iflavour = zipPlain [Blue]+  , icount   = 1+  , irarity  = [(4, 5)]+  , iverbHit = "bash"+  , iweight  = 2000+  , idamage  = 0  -- safe to be used on self+  , iaspects = [ Timeout $ (3 + 1 `d` 3 - 1 `dL` 3) * 2+               , AddSkill SkArmorMelee 40+                   -- not enough to compensate; won't be in eqp+               , AddSkill SkHurtMelee (-30)+                   -- too harmful; won't be wielded as weapon+               , SetFlag Durable, SetFlag Meleeable+               , EqpSlot EqpSlotArmorMelee ]+  , ieffects = [PushActor (ThrowMod 200 50 1)]  -- 1 step, fast+  , idesc    = "Heavy and unwieldy. Absorbs a percentage of melee damage, both dealt and sustained. Too small to intercept projectiles with. May serve as a counterweight to suddenly push forth."+  , ikit     = []+  }+shield = buckler+  { iname    = "shield"+  , irarity  = [(8, 4)]  -- the stronger variants add to total probability+  , iflavour = zipPlain [Green]+  , iweight  = 4000+  , idamage  = 4 `d` 1+  , iaspects = [ Timeout $ (3 + 1 `d` 3 - 1 `dL` 3) * 4+               , AddSkill SkArmorMelee 80+                   -- not enough to compensate; won't be in eqp+               , AddSkill SkHurtMelee (-70)+                   -- too harmful; won't be wielded as weapon+               , SetFlag Durable, SetFlag Meleeable+               , EqpSlot EqpSlotArmorMelee+               , toVelocity 50 ]  -- unwieldy to throw+  , ieffects = [PushActor (ThrowMod 400 50 1)]  -- 2 steps, fast+  , idesc    = "Large and unwieldy. Absorbs a percentage of melee damage, both dealt and sustained. Too heavy to intercept projectiles with. Useful to push foes out of the way."+  }+shield2 = shield+  { ifreq    = [(COMMON_ITEM, 3 * 3)]  -- very low base rarity+  , iweight  = 5000+  , idamage  = 8 `d` 1+  , idesc    = "A relic of long-past wars, heavy and with a central spike."+  }+shield3 = shield2+  { ifreq    = [(COMMON_ITEM, 1 * 3)]  -- very low base rarity+  , iweight  = 6000+  , idamage  = 12 `d` 1+  }++-- ** Weapons++knife = ItemKind+  { isymbol  = symbolEdged+  , iname    = "dagger"+  , ifreq    = [(COMMON_ITEM, 100), (STARTING_WEAPON, 200)]+  , iflavour = zipPlain [BrCyan]+  , icount   = 1+  , irarity  = [(2, 45), (4, 1)]+  , iverbHit = "cut"+  , iweight  = 800+  , idamage  = 6 `d` 1+  , iaspects = [ Timeout 2+               , AddSkill SkHurtMelee $ (-1 + 1 `d` 2 + 1 `dL` 2) * 3+               , AddSkill SkArmorMelee $ (1 `d` 2) * 5+                   -- very common, so don't make too random+               , SetFlag Durable, SetFlag Meleeable+               , EqpSlot EqpSlotWeaponFast+               , toVelocity 40 ]  -- ensuring it hits with the tip costs speed+  , ieffects = []+  , idesc    = "A short dagger for thrusting and parrying blows. Does not penetrate deeply, but is quick to move and hard to block. Especially useful in conjunction with a larger weapon."+  , ikit     = []+  }+daggerDropBestWeapon = knife+  { iname    = "The Double Dagger"+  , ifreq    = [(TREASURE, 20)]+  , irarity  = [(1, 3), (10, 3)]+  , iaspects = SetFlag Unique+               : iaspects knife+  , ieffects = [Discharge 1 50, Yell]  -- powerful and low timeout, but noisy+                                       -- and no effect if no weapons charged+  , idesc    = "A double dagger that a focused fencer can use to catch and twist away an opponent's blade."+  }+hammerTemplate = ItemKind+  { isymbol  = symbolHafted+  , iname    = "war hammer"+  , ifreq    = [(HAMMER_UNKNOWN, 1)]+  , iflavour = zipFancy [BrMagenta]  -- avoid "pink"+  , icount   = 1+  , irarity  = [(5, 20), (8, 1)]+  , iverbHit = "club"+  , iweight  = 1600+  , idamage  = 8 `d` 1  -- we are lying about the dice here, but the dungeon+                        -- is too small and the extra-dice hammers too rare+                        -- to subdivide this identification class by dice+  , iaspects = [ PresentAs HAMMER_UNKNOWN+               , SetFlag Durable, SetFlag Meleeable+               , toVelocity 40 ]  -- ensuring it hits with the tip costs speed+  , ieffects = []+  , idesc    = "It may not cause extensive wounds, but neither does it harmlessly glance off heavy armour as blades and polearms tend to. There are so many shapes and types, some looking more like tools than weapons, that at a glance you can't tell what a particular specimen does. It's obvious, though, that any of them requires some time to recover after a swing."  -- if it's really the average kind, the weak kind, the description stays; if not, it's replaced with one of the descriptions below at identification time+  , ikit     = []+  }+hammer1 = hammerTemplate+  { ifreq    = [(COMMON_ITEM, 100), (STARTING_WEAPON, 70)]+  , iaspects = [Timeout 5, EqpSlot EqpSlotWeaponBig]+               ++ iaspects hammerTemplate+  }+hammer2 = hammerTemplate+  { ifreq    = [(COMMON_ITEM, 20), (STARTING_WEAPON, 7)]+  , iverbHit = "gouge"+  , iaspects = [Timeout 3, EqpSlot EqpSlotWeaponFast]+               ++ iaspects hammerTemplate+  , idesc    = "Upon closer inspection, this hammer turns out particularly handy and well balanced, with one thick and sturdy and two long and sharp points compensating the modest size."+  }+hammer3 = hammerTemplate+  { ifreq    = [(COMMON_ITEM, 3), (STARTING_WEAPON, 1)]+  , iverbHit = "puncture"+  , iweight  = 2400  -- weight gives it away+  , idamage  = 12 `d` 1+  , iaspects = [ Timeout 12  -- balance, or @DupItem@ would break the game+               , EqpSlot EqpSlotWeaponBig]+               ++ delete (PresentAs HAMMER_UNKNOWN) (iaspects hammerTemplate)+  , idesc    = "This hammer sports a long metal handle that increases the momentum of the sharpened head's swing, at the cost of long recovery."+  }+hammerParalyze = hammerTemplate+  { iname    = "The Brute Hammer"+  , ifreq    = [(TREASURE, 20)]+  , irarity  = [(5, 1), (8, 6)]+  , iaspects = [ SetFlag Unique+               , Timeout 5+               , EqpSlot EqpSlotWeaponBig ]+               ++ iaspects hammerTemplate+  , ieffects = [Paralyze 10]+  , idesc    = "A huge shapeless lump of meteorite iron alloy on a sturdy pole. Nobody remains standing when this head connects."+  }+hammerSpark = hammerTemplate+  { iname    = "The Grand Smithhammer"+  , ifreq    = [(TREASURE, 20)]+  , irarity  = [(5, 1), (8, 6)]+  , iweight  = 2400  -- weight gives it away+  , idamage  = 12 `d` 1+  , iaspects = [ SetFlag Unique+               , Timeout 10+               , EqpSlot EqpSlotWeaponBig+               , AddSkill SkShine 3]+               ++ delete (PresentAs HAMMER_UNKNOWN) (iaspects hammerTemplate)+  , ieffects = [Explode S_SPARK]+      -- we can't use a focused explosion, because it would harm the hammer+      -- wielder as well, unlike this one+  , idesc    = "Smiths of old wielded this heavy hammer and its sparks christened many a potent blade."+  }+sword = ItemKind+  { isymbol  = symbolEdged+  , iname    = "sword"+  , ifreq    = [(COMMON_ITEM, 100), (STARTING_WEAPON, 30)]+  , iflavour = zipPlain [BrBlue]+  , icount   = 1+  , irarity  = [(4, 1), (6, 20)]+  , iverbHit = "slash"+  , iweight  = 2000+  , idamage  = 10 `d` 1+  , iaspects = [ Timeout 7+               , SetFlag Durable, SetFlag Meleeable+               , EqpSlot EqpSlotWeaponBig+               , toVelocity 40 ]  -- ensuring it hits with the tip costs speed+  , ieffects = []+  , idesc    = "Difficult to master; deadly when used effectively. The steel is particularly hard and keen, but rusts quickly without regular maintenance."+  , ikit     = []+  }+swordImpress = sword+  { iname    = "The Master's Sword"+  , ifreq    = [(TREASURE, 20)]+  , irarity  = [(5, 1), (8, 6)]+  , iaspects = SetFlag Unique+               : iaspects sword+  , ieffects = [Impress]+  , idesc    = "A particularly well-balance blade, lending itself to impressive shows of fencing skill."+  }+swordNullify = sword+  { iname    = "The Gutting Sword"+  , ifreq    = [(TREASURE, 20)]+  , iverbHit = "pierce"+  , irarity  = [(5, 1), (8, 6)]+  , iaspects = [SetFlag Unique, Timeout 3, EqpSlot EqpSlotWeaponFast]+               ++ (iaspects sword \\ [Timeout 7, EqpSlot EqpSlotWeaponBig])+  , ieffects = [ DropItem 1 maxBound COrgan CONDITION+               , RefillCalm (-10)+               , Yell ]+  , idesc    = "Cold, thin blade that pierces deeply and sends its victim into abrupt, sobering shock."+  }+halberd = ItemKind+  { isymbol  = symbolPolearm+  , iname    = "war scythe"+  , ifreq    = [(COMMON_ITEM, 100), (STARTING_WEAPON, 20)]+  , iflavour = zipPlain [BrYellow]+  , icount   = 1+  , irarity  = [(5, 1), (8, 15)]+  , iverbHit = "impale"+  , iweight  = 3000+  , idamage  = 12 `d` 1+  , iaspects = [ Timeout 10+               , AddSkill SkHurtMelee $ (-5 + 1 `dL` 3) * 5+                   -- useless against armor at game start+               , AddSkill SkArmorMelee 20+               , SetFlag Durable, SetFlag Meleeable+               , EqpSlot EqpSlotWeaponBig+               , toVelocity 20 ]  -- not balanced+  , ieffects = []+  , idesc    = "An improvised weapon made of scythe's blade attached to a long pole. Not often one succeeds in making enough space to swing it freely, but even when stuck between terrain obstacles it blocks approaches effectively and makes using other weapons difficult, both by friends and foes."+  , ikit     = []+  }+halberd2 = halberd+  { iname    = "halberd"+  , ifreq    = [(COMMON_ITEM, 3 * 2), (STARTING_WEAPON, 1)]+  , iweight  = 4000+  , iaspects = AddSkill SkHurtMelee ((-6 + 1 `dL` 4) * 10)+                 -- balance, or @DupItem@ would break the game;+                 -- together with @RerollItem@, it's allowed to, though+               : (iaspects halberd+                  \\ [AddSkill SkHurtMelee $ (-6 + 1 `dL` 4) * 5])+  , idamage  = 18 `d` 1+  , idesc    = "A long haft with a sharp blade. Designed and refined for war."+  }+halberd3 = halberd2+  { iname    = "bardiche"+  , ifreq    = [(COMMON_ITEM, 1 * 2)]  -- compensating for low base rarity+  , iverbHit = "carve"+  , iweight  = 5000+  , idamage  = 24 `d` 1+  , idesc    = "The reach of a spear but the edge of an axe."+  }+halberdPushActor = halberd+  { iname    = "The Swiss Halberd"+  , ifreq    = [(TREASURE, 20)]+  , irarity  = [(7, 0), (9, 15)]+  , iaspects = SetFlag Unique+               : iaspects halberd+  , ieffects = [PushActor (ThrowMod 200 100 1)]  -- 2 steps, slow+  , idesc    = "A versatile polearm, with great reach and leverage. Foes are held at a distance."+  }++-- ** Treasure++gemTemplate = ItemKind+  { isymbol  = symbolGold+  , iname    = "gem"+  , ifreq    = [(GEM_UNKNOWN, 1), (VALUABLE, 100)]+  , iflavour = zipPlain $ delete BrYellow brightCol  -- natural, so not fancy+  , icount   = 1+  , irarity  = [(3, 0), (10, 24)]+  , iverbHit = "tap"+  , iweight  = 50+  , idamage  = 0+  , iaspects = [PresentAs GEM_UNKNOWN, SetFlag Precious]+  , ieffects = []+  , idesc    = "Useless, and still worth around 100 gold each. Would gems of thought and pearls of artful design be valued that much in our age of Science and Progress!"+  , ikit     = []+  }+gem1 = gemTemplate+  { ifreq    = [ (TREASURE, 100), (GEM, 100), (ANY_JEWELRY, 10)+               , (VALUABLE, 100) ]+  , irarity  = [(3, 0), (6, 12), (10, 8)]+  , iaspects = [AddSkill SkShine 1, AddSkill SkSpeed (-1)]+                 -- reflects strongly, distracts; so it glows in the dark,+                 -- is visible on dark floor, but not too tempting to wear+               ++ iaspects gemTemplate+  }+gem2 = gem1+  { ifreq    = [ (TREASURE, 150), (GEM, 100), (ANY_JEWELRY, 10)+               , (VALUABLE, 100) ]+  , irarity  = [(5, 0), (7, 25), (10, 8)]+  }+gem3 = gem1+  { ifreq    = [ (TREASURE, 150), (GEM, 100), (ANY_JEWELRY, 10)+               , (VALUABLE, 100) ]+  , irarity  = [(7, 0), (8, 20), (10, 8)]+  }+gem4 = gem1+  { ifreq    = [ (TREASURE, 150), (GEM, 100), (ANY_JEWELRY, 30)+               , (VALUABLE, 100) ]+  , irarity  = [(9, 0), (10, 70)]+  }+gem5 = gem1+  { isymbol  = symbolSpecial+  , iname    = "elixir"+  , ifreq    = [ (TREASURE, 100), (GEM, 25), (ANY_JEWELRY, 10)+               , (VALUABLE, 100) ]+  , iflavour = zipPlain [BrYellow]+  , irarity  = [(1, 40), (10, 10)]+  , iaspects = [ ELabel "of youth", SetFlag Precious  -- not hidden+               , AddSkill SkOdor (-1) ]+  , ieffects = [RefillCalm 10, RefillHP 40]+  , idesc    = "A crystal vial of amber liquid, supposedly granting eternal youth and fetching 100 gold per piece. The main effect seems to be mild euphoria, but it admittedly smells good and heals minor ailments rather well."+  }+currencyTemplate = ItemKind+  { isymbol  = symbolGold+  , iname    = "gold piece"+  , ifreq    = [(CURRENCY_UNKNOWN, 1), (VALUABLE, 1)]+  , iflavour = zipPlain [BrYellow]+  , icount   = 10 + 1 `d` 20 + 1 `dL` 20+  , irarity  = [(1, 25), (10, 10)]+  , iverbHit = "tap"+  , iweight  = 31+  , idamage  = 0+  , iaspects = [PresentAs CURRENCY_UNKNOWN, SetFlag Precious]+  , ieffects = []+  , idesc    = "Reliably valuable in every civilized plane of existence."+  , ikit     = []+  }+currency = currencyTemplate+  { ifreq    = [(TREASURE, 100), (S_CURRENCY, 100), (VALUABLE, 1)]+  , iaspects = [AddSkill SkShine 1, AddSkill SkSpeed (-1)]+               ++ iaspects currencyTemplate+  }++-- ** Tools to be actively used, but not worn++jumpingPole = ItemKind+  { isymbol  = symbolWand+  , iname    = "jumping pole"+  , ifreq    = [(COMMON_ITEM, 100)]+  , iflavour = zipPlain [White]+  , icount   = 1+  , irarity  = [(1, 3)]+  , iverbHit = "prod"+  , iweight  = 10000+  , idamage  = 0+  , iaspects = [ Timeout $ (2 + 1 `d` 2 - 1 `dL` 2) * 5+               , SetFlag Durable ]+  , ieffects = [toOrganGood S_HASTED 1]+                 -- This works and doesn't cause AI loops. @InsertMove@+                 -- would produce an activation that doesn't change game state.+                 -- Hasting for an absolute number of turns would cause+                 -- an explosion of time when several poles are accumulated.+                 -- Here it speeds AI up for exactly the turn spent activating,+                 -- so when AI applies it repeatedly, it gets its time back and+                 -- is not stuck. In total, the exploration speed is unchanged,+                 -- but it's useful when fleeing in the dark to make distance+                 -- and when initiating combat, so it's OK that AI uses it.+                 -- Timeout is rather high, because for factions with leaders+                 -- some time is often gained, so this could be useful+                 -- even during melee, which would be tiresome to employ.+  , idesc    = "Makes you vulnerable at take-off, but then you are free like a bird."+  , ikit     = []+  }+seeingItem = ItemKind+  { isymbol  = symbolFood+  , iname    = "giant pupil"+  , ifreq    = [(COMMON_ITEM, 100)]+  , iflavour = zipPlain [Red]+  , icount   = 1+  , irarity  = [(1, 2)]+  , iverbHit = "gaze at"+  , iweight  = 100+  , idamage  = 0+  , iaspects = [ Timeout 3+               , AddSkill SkSight 10  -- a spyglass for quick wields+               , AddSkill SkMaxCalm 30  -- to diminish clipping sight by Calm+               , AddSkill SkShine 2  -- to lit corridors when flying+               , SetFlag Periodic ]+  , ieffects = [ Detect DetectActor 20  -- rare enough+               , When (TriggeredBy ActivationPeriodic) $ SeqEffect+                   [ toOrganNoTimer S_POISONED  -- really can't be worn+                   , Summon MOBILE_MONSTER 1 ] ]+  , idesc    = "A slimy, dilated green pupil torn out from some giant eye. Clear and focused, as if still alive."   , ikit     = []   }

GameDefinition/Content/ItemKindActor.hs view

@@ -1,25 +1,80 @@ -- | Actor (or rather actor body trunk) definitions. module Content.ItemKindActor-  ( actors+  ( -- * Group name patterns+    pattern S_WOODEN_TORCH+  , pattern HERO, pattern SCOUT_HERO, pattern RANGER_HERO, pattern ESCAPIST_HERO, pattern AMBUSHER_HERO, pattern BRAWLER_HERO, pattern SOLDIER_HERO, pattern CIVILIAN, pattern MONSTER, pattern MOBILE_MONSTER, pattern SCOUT_MONSTER, pattern ANIMAL, pattern MOBILE_ANIMAL, pattern IMMOBILE_ANIMAL+  , pattern ADD_SIGHT, pattern ARMOR_RANGED, pattern ADD_NOCTO_1, pattern WEAK_ARROW, pattern LIGHT_ATTENUATOR, pattern FIREPROOF_CLOTH, pattern RING_OF_OPPORTUNITY_SNIPER, pattern ANY_ARROW, pattern STARTING_ARMOR, pattern STARTING_WEAPON, pattern GEM+  , actorsGN, actorsGNSingleton+  , -- * Content+    actors   ) where  import Prelude ()  import Game.LambdaHack.Core.Prelude +import Content.ItemKindOrgan import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour +-- * Group name patterns++actorsGNSingleton :: [GroupName ItemKind]+actorsGNSingleton =+       [S_WOODEN_TORCH]++pattern S_WOODEN_TORCH :: GroupName ItemKind++actorsGN :: [GroupName ItemKind]+actorsGN =+       [HERO, SCOUT_HERO, RANGER_HERO, ESCAPIST_HERO, AMBUSHER_HERO, BRAWLER_HERO, SOLDIER_HERO, CIVILIAN, MONSTER, MOBILE_MONSTER, SCOUT_MONSTER, ANIMAL, MOBILE_ANIMAL, IMMOBILE_ANIMAL]+    ++ [ADD_SIGHT, ARMOR_RANGED, ADD_NOCTO_1, WEAK_ARROW, LIGHT_ATTENUATOR, FIREPROOF_CLOTH, RING_OF_OPPORTUNITY_SNIPER, ANY_ARROW, STARTING_ARMOR, STARTING_WEAPON, GEM]++pattern HERO, SCOUT_HERO, RANGER_HERO, ESCAPIST_HERO, AMBUSHER_HERO, BRAWLER_HERO, SOLDIER_HERO, CIVILIAN, MONSTER, MOBILE_MONSTER, SCOUT_MONSTER, ANIMAL, MOBILE_ANIMAL, IMMOBILE_ANIMAL :: GroupName ItemKind++pattern ADD_SIGHT, ARMOR_RANGED, ADD_NOCTO_1, WEAK_ARROW, LIGHT_ATTENUATOR, FIREPROOF_CLOTH, RING_OF_OPPORTUNITY_SNIPER, ANY_ARROW, STARTING_ARMOR, STARTING_WEAPON, GEM :: GroupName ItemKind++pattern HERO = GroupName "hero"+pattern SCOUT_HERO = GroupName "scout hero"+pattern RANGER_HERO = GroupName "ranger hero"+pattern ESCAPIST_HERO = GroupName "escapist hero"+pattern AMBUSHER_HERO = GroupName "ambusher hero"+pattern BRAWLER_HERO = GroupName "brawler hero"+pattern SOLDIER_HERO = GroupName "soldier hero"+pattern CIVILIAN = GroupName "civilian"+pattern MONSTER = GroupName "monster"+pattern MOBILE_MONSTER = GroupName "mobile monster"+pattern SCOUT_MONSTER = GroupName "scout monster"+pattern ANIMAL = GroupName "animal"+pattern MOBILE_ANIMAL = GroupName "mobile animal"+pattern IMMOBILE_ANIMAL = GroupName "immobile animal"++pattern S_WOODEN_TORCH = GroupName "wooden torch"++pattern ADD_SIGHT = GroupName "sight improvement"+pattern ARMOR_RANGED = GroupName "ranged armor"+pattern ADD_NOCTO_1 = GroupName "noctovision improvement"+pattern WEAK_ARROW = GroupName "weak arrow"+pattern LIGHT_ATTENUATOR = GroupName "light attenuator"+pattern FIREPROOF_CLOTH = GroupName "fireproof cloth"+pattern RING_OF_OPPORTUNITY_SNIPER = GroupName "ring of sniper"+pattern ANY_ARROW = GroupName "arrow"+pattern STARTING_ARMOR = GroupName "starting armor"+pattern STARTING_WEAPON = GroupName "starting weapon"+pattern GEM = GroupName "gem"++-- * Content+ actors :: [ItemKind] actors =-  [warrior, warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush]+  [warrior, warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, brawler, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush]   -- LH-specific   ++ [geyserBoiling, geyserArsenic, geyserSulfur] -warrior,    warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush :: ItemKind+warrior,    warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, brawler, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush :: ItemKind -- LH-specific geyserBoiling, geyserArsenic, geyserSulfur :: ItemKind @@ -31,10 +86,14 @@  -- * Hunams +humanOrgans :: [(GroupName ItemKind, CStore)]+humanOrgans = [ (S_FIST, COrgan), (S_FOOT, COrgan)+              , (S_EYE_6, COrgan), (S_EAR_3, COrgan)+              , (S_SAPIENT_BRAIN, COrgan) ] warrior = ItemKind   { isymbol  = '@'   , iname    = "warrior"  -- modified if initial actors in hero faction-  , ifreq    = [("hero", 100), ("mobile", 1)]+  , ifreq    = [(HERO, 100), (MOBILE, 1)]   , iflavour = zipPlain [BrWhite]   , icount   = 1   , irarity  = [(1, 5)]@@ -52,9 +111,7 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = ""  -- "A hardened veteran of combat."-  , ikit     = [ ("fist", COrgan), ("foot", COrgan)-               , ("eye 6", COrgan), ("ear 3", COrgan)-               , ("sapient brain", COrgan) ]+  , ikit     = humanOrgans   } warrior2 = warrior   { iname    = "adventurer"@@ -75,57 +132,63 @@  scout = warrior   { iname    = "scout"-  , ifreq    = [("scout hero", 100), ("mobile", 1)]-  , ikit     = ikit warrior-               ++ [ ("add sight", CEqp)-                  , ("armor ranged", CEqp)-                  , ("add nocto 1", CInv) ]+  , ifreq    = [(SCOUT_HERO, 100), (MOBILE, 1)]+  , ikit     = humanOrgans+               ++ [ (ADD_SIGHT, CEqp)+                  , (ARMOR_RANGED, CEqp)+                  , (ADD_NOCTO_1, CStash) ]   -- , idesc    = ""   } ranger = warrior   { iname    = "ranger"-  , ifreq    = [("ranger hero", 100), ("mobile", 1)]-  , ikit     = ikit warrior-               ++ [ ("armor ranged", CEqp)-                  , ("weak arrow", CInv) ]+  , ifreq    = [(RANGER_HERO, 100), (MOBILE, 1)]+  , ikit     = humanOrgans+               ++ [ (ARMOR_RANGED, CEqp)+                  , (WEAK_ARROW, CStash) ]   -- , idesc    = ""   } escapist = warrior   { iname    = "escapist"-  , ifreq    = [("escapist hero", 100), ("mobile", 1)]-  , ikit     = ikit warrior-               ++ [ ("add sight", CEqp)-                  , ("armor ranged", CEqp)-                  , ("weak arrow", CInv)  -- mostly for probing-                  , ("light source", CInv)-                  , ("wooden torch", CInv)-                  , ("blanket", CInv) ]+  , ifreq    = [(ESCAPIST_HERO, 100), (MOBILE, 1)]+  , ikit     = humanOrgans+               ++ [ (ADD_SIGHT, CEqp)+                  , (STARTING_ARMOR, CEqp)+                  , (WEAK_ARROW, CStash)  -- mostly for probing+                  , (LIGHT_ATTENUATOR, CStash)+                  , (S_WOODEN_TORCH, CStash)+                  , (FIREPROOF_CLOTH, CStash) ]   -- , idesc    = ""   } ambusher = warrior   { iname    = "ambusher"-  , ifreq    = [("ambusher hero", 100), ("mobile", 1)]-  , ikit     = ikit warrior  -- dark and numerous, so more kit without exploring-               ++ [ ("ring of opportunity sniper", CEqp)-                  , ("any arrow", CSha)-                  , ("weak arrow", CInv)-                  , ("explosive", CSha)-                  , ("light source", CEqp)-                  , ("wooden torch", CInv) ]+  , ifreq    = [(AMBUSHER_HERO, 100), (MOBILE, 1)]+  , ikit     = humanOrgans  -- dark and numerous, so more kit without exploring+               ++ [ (RING_OF_OPPORTUNITY_SNIPER, CEqp)+                  , (ANY_ARROW, CStash)+                  , (WEAK_ARROW, CStash)+                  , (EXPLOSIVE, CStash)+                  , (LIGHT_ATTENUATOR, CEqp)+                  , (S_WOODEN_TORCH, CStash) ]   -- , idesc    = ""   }-soldier = warrior+brawler = warrior+  { iname    = "brawler"+  , ifreq    = [(BRAWLER_HERO, 100), (MOBILE, 1)]+  , ikit     = humanOrgans+               ++ [(STARTING_WEAPON, CEqp)]+  -- , idesc    = ""+  }+soldier = brawler   { iname    = "soldier"-  , ifreq    = [("soldier hero", 100), ("mobile", 1)]-  , ikit     = ikit warrior-               ++ [ ("starting weapon", CEqp)-                  , ("explosive", CSha) ]+  , ifreq    = [(SOLDIER_HERO, 100), (MOBILE, 1)]+  , ikit     = ikit brawler+               ++ [(EXPLOSIVE, CStash)]   -- , idesc    = ""   }  civilian = warrior   { iname    = "clerk"-  , ifreq    = [("civilian", 100), ("mobile", 1)]+  , ifreq    = [(CIVILIAN, 100), (MOBILE, 1)]   , iflavour = zipPlain [BrBlack]   -- , idesc    = ""   }@@ -153,8 +216,8 @@ eye = ItemKind   { isymbol  = 'e'   , iname    = "reducible eye"-  , ifreq    = [ ("monster", 100), ("mobile", 1)-               , ("mobile monster", 100), ("scout monster", 10) ]+  , ifreq    = [ (MONSTER, 100), (MOBILE, 1)+               , (MOBILE_MONSTER, 100), (SCOUT_MONSTER, 10) ]   , iflavour = zipFancy [BrRed]   , icount   = 1   , irarity  = [(3, 0), (4, 10), (10, 8)]@@ -169,14 +232,14 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Under your stare, it reduces to the bits that define its essence. Under introspection, the bits slow down and solidify into an arbitrary form again. It must be huge inside, for holographic principle to manifest so overtly."  -- holographic principle is an anachronism for XIX or most of XX century, but "the cosmological scale effects" is too weak-  , ikit     = [ ("lash", COrgan), ("pupil", COrgan)  -- at least one non-timed-               , ("sapient brain", COrgan) ]  -- no hearing, it's all eyes+  , ikit     = [ (S_LASH, COrgan), (S_PUPIL, COrgan)  -- at least one non-timed+               , (S_SAPIENT_BRAIN, COrgan) ]  -- no hearing, it's all eyes   } fastEye = ItemKind   { isymbol  = 'j'   , iname    = "injective jaw"-  , ifreq    = [ ("monster", 100), ("mobile", 1)-               , ("mobile monster", 100), ("scout monster", 60) ]+  , ifreq    = [ (MONSTER, 100), (MOBILE, 1)+               , (MOBILE_MONSTER, 100), (SCOUT_MONSTER, 60) ]   , iflavour = zipFancy [BrBlue]   , icount   = 1   , irarity  = [(3, 0), (4, 6), (10, 12)]@@ -189,15 +252,15 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Hungers but never eats. Bites but never swallows. Burrows its own image through, but never carries anything back."  -- rather weak: not about injective objects, but puny, concrete, injective functions  --- where's the madness in that?-  , ikit     = [ ("tooth", COrgan), ("lip", COrgan)-               , ("speed gland 10", COrgan)-               , ("vision 6", COrgan), ("ear 3", COrgan)-               , ("sapient brain", COrgan) ]+  , ikit     = [ (S_TOOTH, COrgan), (S_LIP, COrgan)+               , (S_SPEED_GLAND_10, COrgan)+               , (S_VISION_6, COrgan), (S_EAR_3, COrgan)+               , (S_SAPIENT_BRAIN, COrgan) ]   } nose = ItemKind  -- depends solely on smell   { isymbol  = 'n'   , iname    = "point-free nose"-  , ifreq    = [("monster", 100), ("mobile", 1), ("mobile monster", 100)]+  , ifreq    = [(MONSTER, 100), (MOBILE, 1), (MOBILE_MONSTER, 100)]   , iflavour = zipFancy [BrGreen]   , icount   = 1   , irarity  = [(3, 0), (4, 5), (10, 7)]@@ -211,15 +274,15 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "No mouth, yet it devours everything around, constantly sniffing itself inward; pure movement structure, no constant point to focus one's maddened gaze on."-  , ikit     = [ ("nose tip", COrgan), ("lip", COrgan)-               , ("nostril", COrgan)-               , ("sapient brain", COrgan) ]  -- no sight nor hearing+  , ikit     = [ (S_TIP, COrgan), (S_LIP, COrgan)+               , (S_NOSTRIL, COrgan)+               , (S_SAPIENT_BRAIN, COrgan) ]  -- no sight nor hearing   } elbow = ItemKind   { isymbol  = 'e'   , iname    = "commutative elbow"-  , ifreq    = [ ("monster", 100), ("mobile", 1)-               , ("mobile monster", 100), ("scout monster", 30) ]+  , ifreq    = [ (MONSTER, 100), (MOBILE, 1)+               , (MOBILE_MONSTER, 100), (SCOUT_MONSTER, 30) ]   , iflavour = zipFancy [BrMagenta]   , icount   = 1   , irarity  = [(3, 0), (4, 1), (10, 12)]@@ -234,17 +297,17 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "An arm strung like a bow. A few edges, but none keen enough. A few points, but none piercing. Deadly objects zip out of the void."-  , ikit     = [ ("speed gland 5", COrgan), ("bark", COrgan)-               , ("vision 12", COrgan), ("ear 8", COrgan)+  , ikit     = [ (S_SPEED_GLAND_5, COrgan), (S_BARK, COrgan)+               , (S_VISION_12, COrgan), (S_EAR_8, COrgan)                    -- too powerful to get stronger sight-               , ("sapient brain", COrgan)-               , ("any arrow", CSha), ("any arrow", CInv)-               , ("weak arrow", CInv), ("weak arrow", CInv) ]+               , (S_SAPIENT_BRAIN, COrgan)+               , (ANY_ARROW, CStash), (ANY_ARROW, CStash)+               , (WEAK_ARROW, CStash), (WEAK_ARROW, CStash) ]   } torsor = ItemKind   { isymbol  = 'T'-  , iname    = "Forgetful Torsor"-  , ifreq    = [("monster", 100), ("mobile", 1)]+  , iname    = "The Forgetful Torsor"+  , ifreq    = [(MONSTER, 100), (MOBILE, 1)]   , iflavour = zipFancy [BrCyan]   , icount   = 1   , irarity  = [(9, 0), (10, 1000)]  -- unique@@ -262,11 +325,12 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "A principal homogeneous manifold, that acts freely and with enormous force, but whose stabilizers are trivial, making it rather helpless without a support group."-  , ikit     = [ ("right torsion", COrgan), ("left torsion", COrgan)-               , ("pupil", COrgan), ("tentacle", COrgan)-               , ("ear 8", COrgan)-               , ("sapient brain", COrgan)-               , ("gem", CInv), ("gem", CInv), ("gem", CInv), ("gem", CInv) ]+  , ikit     = [ (S_RIGHT_TORSION, COrgan), (S_LEFT_TORSION, COrgan)+               , (S_PUPIL, COrgan), (S_TENTACLE, COrgan)+               , (S_EAR_8, COrgan)+               , (S_SAPIENT_BRAIN, COrgan)+               , (GEM, CStash), (GEM, CStash)+               , (GEM, CStash), (GEM, CStash) ]   } -- "ground x" --- for immovable monster that can only tele or prob travel -- pullback@@ -277,11 +341,11 @@ -- They need rather strong melee, because they don't use items. -- They have dull colors, except for yellow, because there is no dull variant. -goldenJackal = ItemKind  -- basically a much smaller and slower hyena+goldenJackal = ItemKind  -- basically a much smaller, slower and nosy hyena   { isymbol  = 'j'   , iname    = "golden jackal"-  , ifreq    = [ ("animal", 100), ("mobile", 1), ("mobile animal", 100)-               , ("scavenger", 50) ]+  , ifreq    = [ (ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)+               , (SCAVENGER, 50) ]   , iflavour = zipPlain [BrYellow]   , icount   = 1   , irarity  = [(1, 4), (10, 2)]@@ -293,15 +357,15 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "An opportunistic predator, feeding on carrion and the weak."-  , ikit     = [ ("small jaw", COrgan)-               , ("eye 6", COrgan), ("nostril", COrgan), ("ear 8", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_SMALL_JAW, COrgan)+               , (S_EYE_6, COrgan), (S_NOSTRIL, COrgan), (S_EAR_8, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   }-griffonVulture = ItemKind+griffonVulture = ItemKind  -- keep it boring and weak, because it summons   { isymbol  = 'v'   , iname    = "griffon vulture"-  , ifreq    = [ ("animal", 100), ("mobile", 1), ("mobile animal", 100)-               , ("scavenger", 30) ]+  , ifreq    = [ (ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)+               , (SCAVENGER, 30) ]   , iflavour = zipPlain [BrYellow]   , icount   = 1   , irarity  = [(1, 3), (10, 3)]@@ -317,20 +381,19 @@                , SetFlag Durable ]       -- Animals don't have leader, usually, so even if only one on level,       -- it pays the communication overhead, so the speed is higher to get-      -- them on par with human leaders moving solo. Common random double moves,-      -- on either side, are just too bothersome.+      -- them on par with human leaders moving solo.   , ieffects = []   , idesc    = "It soars high above, searching for vulnerable prey."-  , ikit     = [ ("screeching beak", COrgan)  -- in reality it grunts and hisses-               , ("small claw", COrgan)-               , ("eye 8", COrgan), ("ear 8", COrgan)+  , ikit     = [ (S_SCREECHING_BEAK, COrgan)  -- in reality it grunts and hisses+               , (S_SMALL_CLAW, COrgan)+               , (S_EYE_8, COrgan), (S_EAR_8, COrgan)                    -- can't shoot, so strong sight is OK-               , ("animal brain", COrgan) ]+               , (S_ANIMAL_BRAIN, COrgan) ]   } skunk = ItemKind   { isymbol  = 's'   , iname    = "hog-nosed skunk"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [White]   , icount   = 1   , irarity  = [(1, 8), (5, 1)]@@ -344,15 +407,15 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Its only defence is the terrible stench."-  , ikit     = [ ("scent gland", COrgan)-               , ("small claw", COrgan), ("snout", COrgan)-               , ("eye 3", COrgan), ("ear 6", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_SCENT_GLAND, COrgan)+               , (S_SMALL_CLAW, COrgan), (S_SNOUT, COrgan)+               , (S_EYE_3, COrgan), (S_EAR_6, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } armadillo = ItemKind   { isymbol  = 'a'   , iname    = "giant armadillo"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [Brown]   , icount   = 1   , irarity  = [(1, 7)]@@ -365,15 +428,15 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "When threatened, it rolls into a ball."-  , ikit     = [ ("hooked claw", COrgan), ("snout", COrgan)-               , ("armored skin", COrgan), ("armored skin", COrgan)-               , ("eye 3", COrgan), ("nostril", COrgan), ("ear 6", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_HOOKED_CLAW, COrgan), (S_SNOUT, COrgan)+               , (S_ARMORED_SKIN, COrgan), (S_ARMORED_SKIN, COrgan)+               , (S_EYE_3, COrgan), (S_NOSTRIL, COrgan), (S_EAR_6, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } gilaMonster = ItemKind   { isymbol  = 'g'   , iname    = "Gila monster"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [Magenta]   , icount   = 1   , irarity  = [(2, 5), (10, 2)]@@ -386,14 +449,14 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Numbing venom ensures that even the fastest prey has no escape."-  , ikit     = [ ("venom tooth", COrgan), ("small claw", COrgan)-               , ("eye 3", COrgan), ("nostril", COrgan), ("ear 6", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_VENOM_TOOTH, COrgan), (S_SMALL_CLAW, COrgan)+               , (S_EYE_3, COrgan), (S_NOSTRIL, COrgan), (S_EAR_6, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } rattlesnake = ItemKind   { isymbol  = 's'   , iname    = "rattlesnake"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [Brown]   , icount   = 1   , irarity  = [(5, 1), (10, 7)]@@ -402,20 +465,21 @@   , idamage  = 0   , iaspects = [ AddSkill SkMaxHP 28, AddSkill SkMaxCalm 60                , AddSkill SkSpeed 16, AddSkill SkNocto 2+               , AddSkill SkAggression 2  -- often discharged. so flees anyway                , AddSkill SkAlter (-2)  -- can't use normal stairs nor doors                , SetFlag Durable ]   , ieffects = []   , idesc    = "Beware its rattle - it serves as a warning of an agonising death."-  , ikit     = [ ("venom fang", COrgan)  -- when on cooldown, it's weaponless-               , ("rattle", COrgan)-               , ("eye 3", COrgan), ("nostril", COrgan), ("ear 6", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_VENOM_FANG, COrgan)  -- when discharged, it's weaponless+               , (S_RATLLE, COrgan)+               , (S_EYE_3, COrgan), (S_NOSTRIL, COrgan), (S_EAR_6, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } hyena = ItemKind   { isymbol  = 'h'   , iname    = "spotted hyena"-  , ifreq    = [ ("animal", 100), ("mobile", 1), ("mobile animal", 100)-               , ("scavenger", 20) ]+  , ifreq    = [ (ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)+               , (SCAVENGER, 20) ]   , iflavour = zipPlain [BrYellow]   , icount   = 1   , irarity  = [(4, 1), (10, 5)]  -- gets summoned often, so low base rarity@@ -427,36 +491,36 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Skulking in the shadows, waiting for easy prey."-  , ikit     = [ ("jaw", COrgan)-               , ("eye 6", COrgan), ("nostril", COrgan), ("ear 8", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_JAW, COrgan)+               , (S_EYE_6, COrgan), (S_NOSTRIL, COrgan), (S_EAR_8, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } komodoDragon = ItemKind   { isymbol  = 'k'   , iname    = "Komodo dragon"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [BrRed]  -- speedy, so bright red   , icount   = 1   , irarity  = [(9, 0), (10, 11)]   , iverbHit = "thud"   , iweight  = 80000   , idamage  = 0-  , iaspects = [ AddSkill SkMaxHP 40, AddSkill SkMaxCalm 60+  , iaspects = [ AddSkill SkMaxHP 40, AddSkill SkMaxCalm 60  -- regens                , AddSkill SkSpeed 17, AddSkill SkNocto 2                , AddSkill SkAggression 1  -- match the description                , SetFlag Durable ]   , ieffects = []   , idesc    = "Larger and more aggressive than any other lizard, but as easily recovering from wounds as its lesser cousins."-  , ikit     = [ ("large tail", COrgan), ("jaw", COrgan)-               , ("hooked claw", COrgan)-               , ("speed gland 5", COrgan), ("armored skin", COrgan)-               , ("eye 3", COrgan), ("nostril", COrgan), ("ear 3", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_LARGE_TAIL, COrgan), (S_JAW, COrgan)+               , (S_HOOKED_CLAW, COrgan)+               , (S_SPEED_GLAND_5, COrgan), (S_ARMORED_SKIN, COrgan)+               , (S_EYE_3, COrgan), (S_NOSTRIL, COrgan), (S_EAR_3, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } alligator = ItemKind   { isymbol  = 'a'   , iname    = "alligator"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [Blue]   , icount   = 1   , irarity  = [(9, 0), (10, 12)]@@ -469,16 +533,17 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "An armored predator from the dawn of time. You better not get within its reach."-  , ikit     = [ ("huge tail", COrgan), ("large jaw", COrgan)-               , ("small claw", COrgan)-               , ("armored skin", COrgan)-               , ("eye 6", COrgan), ("ear 8", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_HUGE_TAIL, COrgan)  -- the special trick, breaking frontline+               , (S_LARGE_JAW, COrgan)+               , (S_SMALL_CLAW, COrgan)+               , (S_ARMORED_SKIN, COrgan)+               , (S_EYE_6, COrgan), (S_EAR_8, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   } rhinoceros = ItemKind   { isymbol  = 'R'-  , iname    = "Maddened Rhinoceros"-  , ifreq    = [("animal", 100), ("mobile", 1)]+  , iname    = "The Maddened Rhinoceros"+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1)]   , iflavour = zipPlain [Brown]   , icount   = 1   , irarity  = [(2, 0), (3, 1000), (4, 0)]  -- unique@@ -494,10 +559,10 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "The last of its kind. Blind with rage. Charges at deadly speed."-  , ikit     = [ ("rhino horn", COrgan), ("snout", COrgan)-               , ("armored skin", COrgan)-               , ("eye 3", COrgan), ("ear 8", COrgan)-               , ("animal brain", COrgan) ]+  , ikit     = [ (S_RHINO_HORN, COrgan), (S_SNOUT, COrgan)+               , (S_ARMORED_SKIN, COrgan)+               , (S_EYE_3, COrgan), (S_EAR_8, COrgan)+               , (S_ANIMAL_BRAIN, COrgan) ]   }  -- * Non-animal animals@@ -505,14 +570,14 @@ beeSwarm = ItemKind   { isymbol  = 'b'   , iname    = "bee swarm"-  , ifreq    = [("animal", 100), ("mobile", 1)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1)]   , iflavour = zipPlain [Brown]   , icount   = 1   , irarity  = [(1, 3), (10, 4)]   , iverbHit = "buzz"   , iweight  = 1000   , idamage  = 0-  , iaspects = [ AddSkill SkMaxHP 8, AddSkill SkMaxCalm 60+  , iaspects = [ AddSkill SkMaxHP 10, AddSkill SkMaxCalm 60                , AddSkill SkSpeed 30, AddSkill SkNocto 2  -- armor in sting                , AddSkill SkAlter (-2)  -- can't use normal stairs nor doors                , AddSkill SkWait (-2)  -- can't brace, sleep and lurk@@ -520,14 +585,14 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Every bee would die for the queen."-  , ikit     = [ ("bee sting", COrgan)  -- weaponless when it's used up-               , ("vision 6", COrgan), ("ear 6", COrgan)-               , ("insect mortality", COrgan), ("animal brain", COrgan) ]+  , ikit     = [ (S_BEE_STING, COrgan)  -- weaponless when it's used up+               , (S_VISION_6, COrgan), (S_EAR_6, COrgan)+               , (S_INSECT_MORTALITY, COrgan), (S_ANIMAL_BRAIN, COrgan) ]   } hornetSwarm = ItemKind   { isymbol  = 'h'   , iname    = "hornet swarm"-  , ifreq    = [("animal", 100), ("mobile", 1), ("mobile animal", 100)]+  , ifreq    = [(ANIMAL, 100), (MOBILE, 1), (MOBILE_ANIMAL, 100)]   , iflavour = zipPlain [Magenta]   , icount   = 1   , irarity  = [(5, 1), (10, 4)]  -- should be many, because die after a time@@ -543,14 +608,14 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "A vicious cloud of stings and hate."-  , ikit     = [ ("sting", COrgan)  -- when on cooldown, it's weaponless-               , ("vision 6", COrgan), ("ear 6", COrgan)-               , ("insect mortality", COrgan), ("animal brain", COrgan) ]+  , ikit     = [ (S_STING, COrgan)  -- when on cooldown, it's weaponless+               , (S_VISION_6, COrgan), (S_EAR_6, COrgan)+               , (S_INSECT_MORTALITY, COrgan), (S_ANIMAL_BRAIN, COrgan) ]   } thornbush = ItemKind   { isymbol  = 't'   , iname    = "thornbush"-  , ifreq    = [("animal", 20), ("immobile animal", 20)]+  , ifreq    = [(ANIMAL, 20), (IMMOBILE_ANIMAL, 20)]   , iflavour = zipPlain [Brown]   , icount   = 1   , irarity  = [(1, 13)]@@ -563,13 +628,13 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "Each branch bears long, curved thorns."-  , ikit     = [ ("thorn", COrgan)  -- after all run out, it's weaponless-               , ("bark", COrgan) ]+  , ikit     = [ (S_THORN, COrgan)  -- after all run out, it's weaponless+               , (S_BARK, COrgan) ]   } geyserBoiling = ItemKind   { isymbol  = 'g'   , iname    = "geyser"-  , ifreq    = [("animal", 8), ("immobile animal", 30)]+  , ifreq    = [(ANIMAL, 8), (IMMOBILE_ANIMAL, 30)]   , iflavour = zipPlain [Blue]   , icount   = 1   , irarity  = [(1, 10), (10, 6)]@@ -582,12 +647,12 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "A jet of acidic water, hot enough to melt flesh."-  , ikit     = [("boiling vent", COrgan), ("boiling fissure", COrgan)]+  , ikit     = [(S_BOILING_VENT, COrgan), (S_BOILING_FISSURE, COrgan)]   } geyserArsenic = ItemKind   { isymbol  = 'g'   , iname    = "arsenic geyser"-  , ifreq    = [("animal", 8), ("immobile animal", 40)]+  , ifreq    = [(ANIMAL, 8), (IMMOBILE_ANIMAL, 40)]   , iflavour = zipPlain [Cyan]   , icount   = 1   , irarity  = [(1, 10), (10, 6)]@@ -600,12 +665,12 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "The sharp scent betrays the poison within the spray."-  , ikit     = [("arsenic vent", COrgan), ("arsenic fissure", COrgan)]+  , ikit     = [(S_ARSENIC_VENT, COrgan), (S_ARSENIC_FISSURE, COrgan)]   } geyserSulfur = ItemKind   { isymbol  = 'g'   , iname    = "sulfur geyser"-  , ifreq    = [("animal", 8), ("immobile animal", 120)]+  , ifreq    = [(ANIMAL, 8), (IMMOBILE_ANIMAL, 120)]   , iflavour = zipPlain [BrYellow]  -- exception, animal with bright color   , icount   = 1   , irarity  = [(1, 10), (10, 6)]@@ -618,5 +683,5 @@                , SetFlag Durable ]   , ieffects = []   , idesc    = "The pool boils and bubbles, stinking of rotten eggs. Despite the smell, these waters purify and strengthen."-  , ikit     = [("sulfur vent", COrgan), ("sulfur fissure", COrgan)]+  , ikit     = [(S_SULFUR_VENT, COrgan), (S_SULFUR_FISSURE, COrgan)]   }

GameDefinition/Content/ItemKindBlast.hs view

@@ -1,24 +1,112 @@ -- | Blast definitions. module Content.ItemKindBlast-  ( blasts+  ( -- * Group name patterns+    pattern S_FIRECRACKER, pattern S_VIOLENT_FRAGMENTATION, pattern S_FRAGMENTATION, pattern S_FOCUSED_FRAGMENTATION, pattern S_VIOLENT_CONCUSSION, pattern S_CONCUSSION, pattern S_FOCUSED_CONCUSSION, pattern S_VIOLENT_FLASH, pattern S_FOCUSED_FLASH, pattern S_GLASS_HAIL, pattern S_FOCUSED_GLASS_HAIL, pattern S_PHEROMONE, pattern S_CALMING_MIST, pattern S_DISTRESSING_ODOR, pattern S_HEALING_MIST, pattern S_HEALING_MIST_2, pattern S_WOUNDING_MIST, pattern S_DISTORTION, pattern S_SMOKE, pattern S_BOILING_WATER, pattern S_GLUE, pattern S_WASTE, pattern S_ANTI_SLOW_MIST, pattern S_ANTIDOTE_MIST, pattern S_SLEEP_MIST, pattern S_DENSE_SHOWER, pattern S_SPARSE_SHOWER, pattern S_MELEE_PROTECTIVE_BALM, pattern S_RANGE_PROTECTIVE_BALM, pattern S_DEFENSELESSNESS_RUNOUT, pattern S_RESOLUTION_DUST, pattern S_HASTE_SPRAY, pattern S_SLOWNESS_MIST, pattern S_EYE_DROP, pattern S_IRON_FILING, pattern S_SMELLY_DROPLET, pattern S_EYE_SHINE, pattern S_WHISKEY_SPRAY, pattern S_YOUTH_SPRINKLE, pattern S_POISON_CLOUD, pattern S_PING_PLASH, pattern S_VIOLENT_BURNING_OIL_2, pattern S_VIOLENT_BURNING_OIL_3, pattern S_VIOLENT_BURNING_OIL_4, pattern S_BURNING_OIL_2, pattern S_BURNING_OIL_3, pattern S_BURNING_OIL_4, pattern S_FOCUSED_BURNING_OIL_2, pattern S_FOCUSED_BURNING_OIL_3, pattern S_FOCUSED_BURNING_OIL_4+  , blastNoStatOf, blastBonusStatOf+  , pattern ARMOR_MISC+  , blastsGNSingleton, blastsGN+  , -- * Content+    blasts   ) where  import Prelude ()  import Game.LambdaHack.Core.Prelude +import Content.ItemKindTemporary+import Game.LambdaHack.Content.ItemKind+import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs-import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Flavour-import Game.LambdaHack.Content.ItemKind +-- * Group name patterns++blastsGNSingleton :: [GroupName ItemKind]+blastsGNSingleton =+       [S_FIRECRACKER, S_VIOLENT_FRAGMENTATION, S_FRAGMENTATION, S_FOCUSED_FRAGMENTATION, S_VIOLENT_CONCUSSION, S_CONCUSSION, S_FOCUSED_CONCUSSION, S_VIOLENT_FLASH, S_FOCUSED_FLASH, S_GLASS_HAIL, S_FOCUSED_GLASS_HAIL, S_PHEROMONE, S_CALMING_MIST, S_DISTRESSING_ODOR, S_HEALING_MIST, S_HEALING_MIST_2, S_WOUNDING_MIST, S_DISTORTION, S_SMOKE, S_BOILING_WATER, S_GLUE, S_WASTE, S_ANTI_SLOW_MIST, S_ANTIDOTE_MIST, S_SLEEP_MIST, S_DENSE_SHOWER, S_SPARSE_SHOWER, S_MELEE_PROTECTIVE_BALM, S_RANGE_PROTECTIVE_BALM, S_DEFENSELESSNESS_RUNOUT, S_RESOLUTION_DUST, S_HASTE_SPRAY, S_SLOWNESS_MIST, S_EYE_DROP, S_IRON_FILING, S_SMELLY_DROPLET, S_EYE_SHINE, S_WHISKEY_SPRAY, S_YOUTH_SPRINKLE, S_POISON_CLOUD, S_PING_PLASH, S_VIOLENT_BURNING_OIL_2, S_VIOLENT_BURNING_OIL_3, S_VIOLENT_BURNING_OIL_4, S_BURNING_OIL_2, S_BURNING_OIL_3, S_BURNING_OIL_4, S_FOCUSED_BURNING_OIL_2, S_FOCUSED_BURNING_OIL_3, S_FOCUSED_BURNING_OIL_4]+  ++ map firecrackerAt [1..4]+  ++ map blastNoStatOf noStatGN+  ++ map blastBonusStatOf bonusStatGN++pattern S_FIRECRACKER, S_VIOLENT_FRAGMENTATION, S_FRAGMENTATION, S_FOCUSED_FRAGMENTATION, S_VIOLENT_CONCUSSION, S_CONCUSSION, S_FOCUSED_CONCUSSION, S_VIOLENT_FLASH, S_FOCUSED_FLASH, S_GLASS_HAIL, S_FOCUSED_GLASS_HAIL, S_PHEROMONE, S_CALMING_MIST, S_DISTRESSING_ODOR, S_HEALING_MIST, S_HEALING_MIST_2, S_WOUNDING_MIST, S_DISTORTION, S_SMOKE, S_BOILING_WATER, S_GLUE, S_WASTE, S_ANTI_SLOW_MIST, S_ANTIDOTE_MIST, S_SLEEP_MIST, S_DENSE_SHOWER, S_SPARSE_SHOWER, S_MELEE_PROTECTIVE_BALM, S_RANGE_PROTECTIVE_BALM, S_DEFENSELESSNESS_RUNOUT, S_RESOLUTION_DUST, S_HASTE_SPRAY, S_SLOWNESS_MIST, S_EYE_DROP, S_IRON_FILING, S_SMELLY_DROPLET, S_EYE_SHINE, S_WHISKEY_SPRAY, S_YOUTH_SPRINKLE, S_POISON_CLOUD, S_PING_PLASH, S_VIOLENT_BURNING_OIL_2, S_VIOLENT_BURNING_OIL_3, S_VIOLENT_BURNING_OIL_4, S_BURNING_OIL_2, S_BURNING_OIL_3, S_BURNING_OIL_4, S_FOCUSED_BURNING_OIL_2, S_FOCUSED_BURNING_OIL_3, S_FOCUSED_BURNING_OIL_4 :: GroupName ItemKind++blastsGN :: [GroupName ItemKind]+blastsGN =+       [ARMOR_MISC]++pattern ARMOR_MISC :: GroupName ItemKind++pattern S_FIRECRACKER = GroupName "firecracker"+pattern S_VIOLENT_FRAGMENTATION = GroupName "violent fragmentation"+pattern S_FRAGMENTATION = GroupName "fragmentation"+pattern S_FOCUSED_FRAGMENTATION = GroupName "focused fragmentation"+pattern S_VIOLENT_CONCUSSION = GroupName "violent concussion"+pattern S_CONCUSSION = GroupName "concussion"+pattern S_FOCUSED_CONCUSSION = GroupName "focused concussion"+pattern S_VIOLENT_FLASH = GroupName "violent flash"+pattern S_FOCUSED_FLASH = GroupName "focused flash"+pattern S_GLASS_HAIL = GroupName "glass hail"+pattern S_FOCUSED_GLASS_HAIL = GroupName "focused glass hail"+pattern S_PHEROMONE = GroupName "pheromone"+pattern S_CALMING_MIST = GroupName "calming mist"+pattern S_DISTRESSING_ODOR = GroupName "distressing odor"+pattern S_HEALING_MIST = GroupName "healing mist"+pattern S_HEALING_MIST_2 = GroupName "strong healing mist"+pattern S_WOUNDING_MIST = GroupName "wounding mist"+pattern S_DISTORTION = GroupName "distortion"+pattern S_SMOKE = GroupName "smoke"+pattern S_BOILING_WATER = GroupName "boiling water"+pattern S_GLUE = GroupName "glue"+pattern S_WASTE = GroupName "waste"+pattern S_ANTI_SLOW_MIST = GroupName "anti-slow mist"+pattern S_ANTIDOTE_MIST = GroupName "antidote mist"+pattern S_SLEEP_MIST = GroupName "sleep mist"+pattern S_DENSE_SHOWER = GroupName "dense shower"+pattern S_SPARSE_SHOWER = GroupName "sparse shower"+pattern S_MELEE_PROTECTIVE_BALM = GroupName "melee protective balm"+pattern S_RANGE_PROTECTIVE_BALM = GroupName "ranged protective balm"+pattern S_DEFENSELESSNESS_RUNOUT = GroupName "PhD defense question"+pattern S_RESOLUTION_DUST = GroupName "resolution dust"+pattern S_HASTE_SPRAY = GroupName "haste spray"+pattern S_SLOWNESS_MIST = GroupName "slowness mist"+pattern S_EYE_DROP = GroupName "eye drop"+pattern S_IRON_FILING = GroupName "iron filing"+pattern S_SMELLY_DROPLET = GroupName "smelly droplet"+pattern S_EYE_SHINE = GroupName "eye shine"+pattern S_WHISKEY_SPRAY = GroupName "whiskey spray"+pattern S_YOUTH_SPRINKLE = GroupName "youth sprinkle"+pattern S_POISON_CLOUD = GroupName "poison cloud"+pattern S_PING_PLASH = GroupName "ping and flash"+pattern S_VIOLENT_BURNING_OIL_2 = GroupName "violent burning oil 2"+pattern S_VIOLENT_BURNING_OIL_3 = GroupName "violent burning oil 3"+pattern S_VIOLENT_BURNING_OIL_4 = GroupName "violent burning oil 4"+pattern S_BURNING_OIL_2 = GroupName "burning oil 2"+pattern S_BURNING_OIL_3 = GroupName "burning oil 3"+pattern S_BURNING_OIL_4 = GroupName "burning oil 4"+pattern S_FOCUSED_BURNING_OIL_2 = GroupName "focused burning oil 2"+pattern S_FOCUSED_BURNING_OIL_3 = GroupName "focused burning oil 3"+pattern S_FOCUSED_BURNING_OIL_4 = GroupName "focused burning oil 4"++firecrackerAt :: Int -> GroupName ItemKind+firecrackerAt n = GroupName $ "firecracker" <+> tshow n++blastNoStatOf :: GroupName ItemKind -> GroupName ItemKind+blastNoStatOf grp = GroupName $ fromGroupName grp <+> "mist"++blastBonusStatOf :: GroupName ItemKind -> GroupName ItemKind+blastBonusStatOf grp = GroupName $ fromGroupName grp <+> "dew"++pattern ARMOR_MISC = GroupName "miscellaneous armor"++-- * Content+ blasts :: [ItemKind] blasts =-  [burningOil2, burningOil3, burningOil4, firecracker1, firecracker2, firecracker3, firecracker4, firecracker5, spreadFragmentation, spreadFragmentation8, focusedFragmentation, spreadConcussion, spreadConcussion8, focusedConcussion, spreadFlash, spreadFlash8, focusedFlash, singleSpark, glassPiece, focusedGlass, fragrance, pheromone, mistCalming, odorDistressing, mistHealing, mistHealing2, mistWounding, distortion, smoke, boilingWater, glue, waste, mistAntiSlow, mistAntidote, mistSleep, denseShower, sparseShower, protectingBalmMelee, protectingBalmRanged, vulnerabilityBalm, resolutionDust, hasteSpray, slownessMist, eyeDrop, ironFiling, smellyDroplet, eyeShine, whiskeySpray, youthSprinkle, poisonCloud, blastNoSkMove, blastNoSkMelee, blastNoSkDisplace, blastNoSkAlter, blastNoSkWait, blastNoSkMoveItem, blastNoSkProject, blastNoSkApply, blastBonusSkMove, blastBonusSkMelee, blastBonusSkDisplace, blastBonusSkAlter, blastBonusSkWait, blastBonusSkMoveItem, blastBonusSkProject, blastBonusSkApply]+  [spreadBurningOil2, spreadBurningOil3, spreadBurningOil4, spreadBurningOil82, spreadBurningOil83, spreadBurningOil84, focusedBurningOil2, focusedBurningOil3, focusedBurningOil4, firecracker1, firecracker2, firecracker3, firecracker4, firecracker5, spreadFragmentation, spreadFragmentation8, focusedFragmentation, spreadConcussion, spreadConcussion8, focusedConcussion, spreadFlash, spreadFlash8, focusedFlash, singleSpark, glassPiece, focusedGlass, fragrance, pheromone, mistCalming, odorDistressing, mistHealing, mistHealing2, mistWounding, distortion, smoke, boilingWater, glue, waste, mistAntiSlow, mistAntidote, mistSleep, denseShower, sparseShower, protectingBalmMelee, protectingBalmRanged, defenselessnessRunout, resolutionDust, hasteSpray, slownessMist, eyeDrop, ironFiling, smellyDroplet, eyeShine, whiskeySpray, youthSprinkle, poisonCloud, pingFlash, blastNoSkMove, blastNoSkMelee, blastNoSkDisplace, blastNoSkAlter, blastNoSkWait, blastNoSkMoveItem, blastNoSkProject, blastNoSkApply, blastBonusSkMove, blastBonusSkMelee, blastBonusSkDisplace, blastBonusSkAlter, blastBonusSkWait, blastBonusSkMoveItem, blastBonusSkProject, blastBonusSkApply] -burningOil2,    burningOil3, burningOil4, firecracker1, firecracker2, firecracker3, firecracker4, firecracker5, spreadFragmentation, spreadFragmentation8, focusedFragmentation, spreadConcussion, spreadConcussion8, focusedConcussion, spreadFlash, spreadFlash8, focusedFlash, singleSpark, glassPiece, focusedGlass, fragrance, pheromone, mistCalming, odorDistressing, mistHealing, mistHealing2, mistWounding, distortion, smoke, boilingWater, glue, waste, mistAntiSlow, mistAntidote, mistSleep, denseShower, sparseShower, protectingBalmMelee, protectingBalmRanged, vulnerabilityBalm, resolutionDust, hasteSpray, slownessMist, eyeDrop, ironFiling, smellyDroplet, eyeShine, whiskeySpray, youthSprinkle, poisonCloud, blastNoSkMove, blastNoSkMelee, blastNoSkDisplace, blastNoSkAlter, blastNoSkWait, blastNoSkMoveItem, blastNoSkProject, blastNoSkApply, blastBonusSkMove, blastBonusSkMelee, blastBonusSkDisplace, blastBonusSkAlter, blastBonusSkWait, blastBonusSkMoveItem, blastBonusSkProject, blastBonusSkApply :: ItemKind+spreadBurningOil2,    spreadBurningOil3, spreadBurningOil4, spreadBurningOil82, spreadBurningOil83, spreadBurningOil84, focusedBurningOil2, focusedBurningOil3, focusedBurningOil4, firecracker1, firecracker2, firecracker3, firecracker4, firecracker5, spreadFragmentation, spreadFragmentation8, focusedFragmentation, spreadConcussion, spreadConcussion8, focusedConcussion, spreadFlash, spreadFlash8, focusedFlash, singleSpark, glassPiece, focusedGlass, fragrance, pheromone, mistCalming, odorDistressing, mistHealing, mistHealing2, mistWounding, distortion, smoke, boilingWater, glue, waste, mistAntiSlow, mistAntidote, mistSleep, denseShower, sparseShower, protectingBalmMelee, protectingBalmRanged, defenselessnessRunout, resolutionDust, hasteSpray, slownessMist, eyeDrop, ironFiling, smellyDroplet, eyeShine, whiskeySpray, youthSprinkle, poisonCloud, pingFlash, blastNoSkMove, blastNoSkMelee, blastNoSkDisplace, blastNoSkAlter, blastNoSkWait, blastNoSkMoveItem, blastNoSkProject, blastNoSkApply, blastBonusSkMove, blastBonusSkMelee, blastBonusSkDisplace, blastBonusSkAlter, blastBonusSkWait, blastBonusSkMoveItem, blastBonusSkProject, blastBonusSkApply :: ItemKind  -- We take care (e.g., in burningOil below) that blasts are not faster -- than 100% fastest natural speed, or some frames would be skipped,@@ -26,13 +114,13 @@  -- * Parameterized blasts -burningOil :: Int -> ItemKind-burningOil n = ItemKind+spreadBurningOil :: Int -> GroupName ItemKind -> ItemKind+spreadBurningOil n grp = ItemKind   { isymbol  = '*'   , iname    = "burning oil"-  , ifreq    = [(toGroupName $ "burning oil" <+> tshow n, 1)]+  , ifreq    = [(grp, 1)]   , iflavour = zipPlain [BrYellow]-  , icount   = intToDice (4 + n * 4)+  , icount   = intToDice (4 + n * 3)   , irarity  = [(1, 1)]   , iverbHit = "sear"   , iweight  = 1@@ -41,35 +129,65 @@                , SetFlag Fragile, SetFlag Blast                , AddSkill SkShine 2 ]   , ieffects = [ Burn 1-               , toOrganBad "pacified" (1 `d` 2) ]+               , toOrganBad S_PACIFIED (2 + 1 `d` 2) ]                    -- slips and frantically puts out fire   , idesc    = "Sticky oil, burning brightly."   , ikit     = []   }-burningOil2 = burningOil 2  -- 2 steps, 2 turns-burningOil3 = burningOil 3  -- 3 steps, 2 turns-burningOil4 = burningOil 4  -- 4 steps, 2 turns+spreadBurningOil2 = spreadBurningOil 2 S_VIOLENT_BURNING_OIL_2+                      -- 2 steps, 2 turns+spreadBurningOil3 = spreadBurningOil 3 S_VIOLENT_BURNING_OIL_3+                      -- 2 steps, 2 turns+spreadBurningOil4 = spreadBurningOil 4 S_VIOLENT_BURNING_OIL_4+                      -- 4 steps, 2 turns+spreadBurningOil8 :: Int -> GroupName ItemKind -> ItemKind+spreadBurningOil8 n grp = (spreadBurningOil (n `div` 2) grp)+  { icount   = 7+  }+spreadBurningOil82 = spreadBurningOil8 2 S_BURNING_OIL_2+spreadBurningOil83 = spreadBurningOil8 3 S_BURNING_OIL_3+spreadBurningOil84 = spreadBurningOil8 4 S_BURNING_OIL_4+focusedBurningOil :: Int -> GroupName ItemKind -> GroupName ItemKind -> ItemKind+focusedBurningOil n grp grpExplode = ItemKind+  { isymbol  = '`'+  , iname    = "igniting oil"+  , ifreq    = [(grp, 1)]+  , iflavour = zipPlain [Brown]+  , icount   = intToDice n+  , irarity  = [(1, 1)]+  , iverbHit = "ignite"+  , iweight  = 1+  , idamage  = 0+  , iaspects = [ toLinger 0  -- 0 steps, 1 turn+               , SetFlag Fragile, SetFlag Blast ]+      -- when the target position is occupied, the explosion starts one step+      -- away, hence we set range to 0 steps, to limit dispersal+  , ieffects = [OnSmash $ Explode grpExplode]+  , idesc    = idesc spreadBurningOil2+  , ikit     = []+  }+focusedBurningOil2 = focusedBurningOil 2 S_FOCUSED_BURNING_OIL_2 S_BURNING_OIL_2+focusedBurningOil3 = focusedBurningOil 3 S_FOCUSED_BURNING_OIL_3 S_BURNING_OIL_3+focusedBurningOil4 = focusedBurningOil 4 S_FOCUSED_BURNING_OIL_4 S_BURNING_OIL_4 firecracker :: Int -> ItemKind firecracker n = ItemKind   { isymbol  = '*'   , iname    = "firecracker"-  , ifreq    = [(toGroupName $ if n == 5-                               then "firecracker"-                               else "firecracker" <+> tshow n, 1)]+  , ifreq    = [(if n == 5+                 then S_FIRECRACKER+                 else firecrackerAt n, 1)]   , iflavour = zipPlain [brightCol !! ((n + 2) `mod` length brightCol)]   , icount   = if n <= 3 then 1 `d` min 2 n else 2 + 1 `d` 2   , irarity  = [(1, 1)]   , iverbHit = if n >= 4 then "singe" else "crack"   , iweight  = 1   , idamage  = 0-  , iaspects = [ toVelocity 5+  , iaspects = [ toVelocity 5  -- 1 step, 1 turn                , SetFlag Fragile, SetFlag Blast                , AddSkill SkShine $ intToDice $ 1 + n `div` 2 ]   , ieffects = [if n >= 4 then Burn 1 else RefillCalm (-2)]-               ++ [DropBestWeapon | n >= 4]-               ++ [ OnSmash $ Explode-                    $ toGroupName $ "firecracker" <+> tshow (n - 1)-                  | n >= 2 ]+               ++ [Discharge 1 30 | n >= 3]+               ++ [OnSmash $ Explode $ firecrackerAt (n - 1) | n >= 2]   , idesc    = "Scraps of burnt paper, covering little pockets of black powder, buffeted by colorful explosions."   , ikit     = []   }@@ -84,7 +202,7 @@ spreadFragmentation = ItemKind   { isymbol  = '*'   , iname    = "fragmentation burst"-  , ifreq    = [("violent fragmentation", 1)]+  , ifreq    = [(S_VIOLENT_FRAGMENTATION, 1)]   , iflavour = zipPlain [Red]   , icount   = 16  -- strong but few, so not always hits target   , irarity  = [(1, 1)]@@ -95,13 +213,12 @@   , iaspects = [ ToThrow $ ThrowMod 100 20 4  -- 4 steps, 1 turn                , SetFlag Lobable, SetFlag Fragile, SetFlag Blast                , AddSkill SkShine 3, AddSkill SkHurtMelee $ -12 * 5 ]-  , ieffects = [DropItem 1 1 COrgan "condition"]+  , ieffects = [DropItem 1 1 COrgan CONDITION]   , idesc    = "Flying shards, flame and smoke."   , ikit     = []   } spreadFragmentation8 = spreadFragmentation-  { iname    = "fragmentation burst"-  , ifreq    = [("fragmentation", 1)]+  { ifreq    = [(S_FRAGMENTATION, 1)]   , icount   = 8   , iaspects = [ ToThrow $ ThrowMod 100 10 2  -- 2 steps, 1 turn                , SetFlag Lobable, SetFlag Fragile, SetFlag Blast@@ -111,7 +228,7 @@ focusedFragmentation = ItemKind   { isymbol  = '`'   , iname    = "deflagration ignition"  -- black powder-  , ifreq    = [("focused fragmentation", 1)]+  , ifreq    = [(S_FOCUSED_FRAGMENTATION, 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 4  -- 32 in total vs 16; on average 4 hits   , irarity  = [(1, 1)]@@ -122,14 +239,14 @@                , SetFlag Fragile, SetFlag Blast ]       -- when the target position is occupied, the explosion starts one step       -- away, hence we set range to 0 steps, to limit dispersal-  , ieffects = [OnSmash $ Explode "fragmentation"]+  , ieffects = [OnSmash $ Explode S_FRAGMENTATION]   , idesc    = idesc spreadFragmentation   , ikit     = []   } spreadConcussion = ItemKind   { isymbol  = '*'   , iname    = "concussion blast"-  , ifreq    = [("violent concussion", 1)]+  , ifreq    = [(S_VIOLENT_CONCUSSION, 1)]   , iflavour = zipPlain [Magenta]   , icount   = 16   , irarity  = [(1, 1)]@@ -143,17 +260,16 @@       -- outdoors it has short range, but we only model indoors in the game;       -- it's much faster than black powder shock wave, but we are beyond       -- human-noticeable speed differences on short distances anyway-  , ieffects = [ DropItem maxBound 1 CEqp "misc armor"+  , ieffects = [ DropItem maxBound 1 CEqp ARMOR_MISC                , PushActor (ThrowMod 400 25 1)  -- 1 step, fast; after DropItem                    -- this produces spam for braced actors; too bad-               , toOrganBad "immobile" 3  -- no balance-               , toOrganBad "deafened" 23 ]+               , toOrganBad S_IMMOBILE 3  -- no balance+               , toOrganBad S_DEAFENED 23 ]   , idesc    = "Shock wave, hot gases, some fire and smoke."   , ikit     = []   } spreadConcussion8 = spreadConcussion-  { iname    = "concussion blast"-  , ifreq    = [("concussion", 1)]+  { ifreq    = [(S_CONCUSSION, 1)]   , icount   = 8   , iaspects = [ ToThrow $ ThrowMod 100 10 2  -- 2 steps, 1 turn                , SetFlag Lobable, SetFlag Fragile, SetFlag Blast@@ -162,7 +278,7 @@ focusedConcussion = ItemKind   { isymbol  = '`'   , iname    = "detonation ignition"  -- nitroglycerine-  , ifreq    = [("focused concussion", 1)]+  , ifreq    = [(S_FOCUSED_CONCUSSION, 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 4   , irarity  = [(1, 1)]@@ -171,14 +287,14 @@   , idamage  = 0   , iaspects = [ toLinger 0  -- 0 steps, 1 turn                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [OnSmash $ Explode "concussion"]+  , ieffects = [OnSmash $ Explode S_CONCUSSION]   , idesc    = idesc spreadConcussion   , ikit     = []   } spreadFlash = ItemKind   { isymbol  = '`'   , iname    = "magnesium flash"-  , ifreq    = [("violent flash", 1)]+  , ifreq    = [(S_VIOLENT_FLASH, 1)]   , iflavour = zipPlain [BrWhite]   , icount   = 16   , irarity  = [(1, 1)]@@ -188,7 +304,7 @@   , iaspects = [ ToThrow $ ThrowMod 100 20 4  -- 4 steps, 1 turn                , SetFlag Fragile, SetFlag Blast                , AddSkill SkShine 5 ]-  , ieffects = [toOrganBad "blind" 5, toOrganBad "weakened" 20]+  , ieffects = [toOrganBad S_BLIND 5, toOrganBad S_WEAKENED 20]                  -- Wikipedia says: blind for five seconds and afterimage                  -- for much longer, harming aim   , idesc    = "A very bright flash of fire."@@ -196,9 +312,9 @@   } spreadFlash8 = spreadFlash   { iname    = "spark"-  , ifreq    = [("spark", 1)]+  , ifreq    = [(S_SPARK, 1)]   , icount   = 8-  , iverbHit = "blind"+  , iverbHit = "singe"   , iaspects = [ ToThrow $ ThrowMod 100 10 2  -- 2 steps, 1 turn                , SetFlag Fragile, SetFlag Blast                , AddSkill SkShine 5 ]@@ -206,7 +322,7 @@ focusedFlash = ItemKind   { isymbol  = '`'   , iname    = "magnesium ignition"-  , ifreq    = [("focused flash", 1)]+  , ifreq    = [(S_FOCUSED_FLASH, 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 4   , irarity  = [(1, 1)]@@ -215,13 +331,13 @@   , idamage  = 0   , iaspects = [ toLinger 0  -- 0 steps, 1 turn                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [OnSmash $ Explode "spark"]+  , ieffects = [OnSmash $ Explode S_SPARK]   , idesc    = idesc spreadFlash   , ikit     = []   } singleSpark = spreadFlash   { iname    = "single spark"-  , ifreq    = [("single spark", 1)]+  , ifreq    = [(S_SINGLE_SPARK, 1)]   , icount   = 1   , iverbHit = "spark"   , iaspects = [ toLinger 5  -- 1 step, 1 turn@@ -234,7 +350,7 @@ glassPiece = ItemKind   { isymbol  = '*'   , iname    = "glass piece"-  , ifreq    = [("glass hail", 1)]+  , ifreq    = [(S_GLASS_HAIL, 1)]   , iflavour = zipPlain [Blue]   , icount   = 8   , irarity  = [(1, 1)]@@ -250,29 +366,29 @@   , ikit     = []   } focusedGlass = glassPiece  -- when blowing up windows-  { ifreq    = [("focused glass hail", 1)]+  { ifreq    = [(S_FOCUSED_GLASS_HAIL, 1)]   , icount   = 4   , iaspects = [ toLinger 0  -- 0 steps, 1 turn                , SetFlag Fragile, SetFlag Blast                , AddSkill SkHurtMelee $ -15 * 5 ]-  , ieffects = [OnSmash $ Explode "glass hail"]+  , ieffects = [OnSmash $ Explode S_GLASS_HAIL]   } --- * Assorted blasts don't induce conditions or not mainly so+-- * Assorted blasts that don't induce conditions or not used mainly for them  fragrance = ItemKind   { isymbol  = '`'   , iname    = "fragrance"  -- instant, fast fragrance-  , ifreq    = [("fragrance", 1)]+  , ifreq    = [(S_FRAGRANCE, 1)]   , iflavour = zipPlain [Magenta]   , icount   = 12   , irarity  = [(1, 1)]   , iverbHit = "engulf"   , iweight  = 1   , idamage  = 0-  , iaspects = [ toLinger 10  -- 2 steps, 1 turn+  , iaspects = [ ToThrow $ ThrowMod 200 5 1  -- 2 steps, .5 turn (necklaces)                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [Impress, toOrganGood "rose-smelling" 45]+  , ieffects = [Impress, toOrganGood S_ROSE_SMELLING 45]   -- Linger 10, because sometimes it takes 2 turns due to starting just   -- before actor turn's end (e.g., via a necklace).   , idesc    = "A pleasant scent."@@ -281,7 +397,7 @@ pheromone = ItemKind   { isymbol  = '`'   , iname    = "musky whiff"  -- a kind of mist rather than fragrance-  , ifreq    = [("pheromone", 1)]+  , ifreq    = [(S_PHEROMONE, 1)]   , iflavour = zipPlain [BrMagenta]   , icount   = 16   , irarity  = [(1, 1)]@@ -297,7 +413,7 @@ mistCalming = ItemKind  -- unused   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [("calming mist", 1)]+  , ifreq    = [(S_CALMING_MIST, 1)]   , iflavour = zipPlain [BrGreen]   , icount   = 8   , irarity  = [(1, 1)]@@ -313,7 +429,7 @@ odorDistressing = ItemKind   { isymbol  = '`'   , iname    = "distressing whiff"-  , ifreq    = [("distressing odor", 1)]+  , ifreq    = [(S_DISTRESSING_ODOR, 1)]   , iflavour = zipFancy [BrRed]  -- salmon   , icount   = 8   , irarity  = [(1, 1)]@@ -323,15 +439,15 @@   , iaspects = [ toLinger 10  -- 2 steps, 1 turn                , SetFlag Fragile, SetFlag Blast ]   , ieffects = [ RefillCalm (-10)-               , toOrganBad "foul-smelling" (20 + 1 `d` 5)-               , toOrganBad "impatient" (2 + 1 `d` 2) ]+               , toOrganBad S_FOUL_SMELLING (20 + 1 `d` 5)+               , toOrganBad S_IMPATIENT (2 + 1 `d` 2) ]   , idesc    = "It turns the stomach."  -- and so can't stand still   , ikit     = []   } mistHealing = ItemKind   { isymbol  = '`'   , iname    = "mist"  -- powerful, so slow and narrow-  , ifreq    = [("healing mist", 1)]+  , ifreq    = [(S_HEALING_MIST, 1)]   , iflavour = zipFancy [BrGreen]   , icount   = 8   , irarity  = [(1, 1)]@@ -348,7 +464,7 @@ mistHealing2 = ItemKind   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [("healing mist 2", 1)]+  , ifreq    = [(S_HEALING_MIST_2, 1)]   , iflavour = zipPlain [Green]   , icount   = 8   , irarity  = [(1, 1)]@@ -365,7 +481,7 @@ mistWounding = ItemKind   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [("wounding mist", 1)]+  , ifreq    = [(S_WOUNDING_MIST, 1)]   , iflavour = zipPlain [BrRed]   , icount   = 8   , irarity  = [(1, 1)]@@ -381,7 +497,7 @@ distortion = ItemKind   { isymbol  = 'v'   , iname    = "vortex"-  , ifreq    = [("distortion", 1)]+  , ifreq    = [(S_DISTORTION, 1)]   , iflavour = zipPlain [White]   , icount   = 8  -- braced are immune to Teleport; avoid failure messages   , irarity  = [(1, 1)]@@ -397,7 +513,7 @@ smoke = ItemKind  -- when stuff burns out  -- unused   { isymbol  = '`'   , iname    = "smoke fume"  -- pluralizes better than 'smokes'-  , ifreq    = [("smoke", 1)]+  , ifreq    = [(S_SMOKE, 1)]   , iflavour = zipPlain [BrBlack]   , icount   = 16   , irarity  = [(1, 1)]@@ -406,7 +522,7 @@   , idamage  = 0   , iaspects = [ toVelocity 20  -- 4 steps, 2 turns                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [toOrganBad "withholding" (5 + 1 `d` 3)]+  , ieffects = [toOrganBad S_WITHHOLDING (5 + 1 `d` 3)]                   -- choking and tears, can roughly see, but not aim   , idesc    = "Twirling clouds of grey smoke."   , ikit     = []@@ -414,7 +530,7 @@ boilingWater = ItemKind   { isymbol  = '*'   , iname    = "boiling water"-  , ifreq    = [("boiling water", 1)]+  , ifreq    = [(S_BOILING_WATER, 1)]   , iflavour = zipPlain [White]   , icount   = 18   , irarity  = [(1, 1)]@@ -430,7 +546,7 @@ glue = ItemKind   { isymbol  = '*'   , iname    = "hoof glue"-  , ifreq    = [("glue", 1)]+  , ifreq    = [(S_GLUE, 1)]   , iflavour = zipPlain [Cyan]   , icount   = 8  -- Paralyze doesn't stack; avoid failure messages   , irarity  = [(1, 1)]@@ -446,7 +562,7 @@ waste = ItemKind   { isymbol  = '*'   , iname    = "waste piece"-  , ifreq    = [("waste", 1)]+  , ifreq    = [(S_WASTE, 1)]   , iflavour = zipPlain [Brown]   , icount   = 16   , irarity  = [(1, 1)]@@ -454,15 +570,15 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [ toOrganBad "foul-smelling" (30 + 1 `d` 10)-               , toOrganBad "dispossessed" (10 + 1 `d` 5) ]+  , ieffects = [ toOrganBad S_FOUL_SMELLING (30 + 1 `d` 10)+               , toOrganBad S_DISPOSSESSED (10 + 1 `d` 5) ]   , idesc    = "Sodden and foul-smelling."   , ikit     = []   } mistAntiSlow = ItemKind   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [("anti-slow mist", 1)]+  , ifreq    = [(S_ANTI_SLOW_MIST, 1)]   , iflavour = zipFancy [BrYellow]   , icount   = 8   , irarity  = [(1, 1)]@@ -471,14 +587,14 @@   , idamage  = 0   , iaspects = [ toVelocity 5  -- 1 step, 1 turn                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [DropItem 1 1 COrgan "slowed"]+  , ieffects = [DropItem 1 1 COrgan S_SLOWED]   , idesc    = "A cleansing rain."   , ikit     = []   } mistAntidote = ItemKind   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [("antidote mist", 1)]+  , ifreq    = [(S_ANTIDOTE_MIST, 1)]   , iflavour = zipFancy [BrBlue]   , icount   = 8   , irarity  = [(1, 1)]@@ -487,14 +603,14 @@   , idamage  = 0   , iaspects = [ toVelocity 5  -- 1 step, 1 turn                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [DropItem 1 maxBound COrgan "poisoned"]+  , ieffects = [DropItem 1 maxBound COrgan S_POISONED]   , idesc    = "Washes away death's dew."   , ikit     = []   } mistSleep = ItemKind   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [("sleep mist", 1)]+  , ifreq    = [(S_SLEEP_MIST, 1)]   , iflavour = zipFancy [BrMagenta]   , icount   = 8   , irarity  = [(1, 1)]@@ -518,7 +634,7 @@ denseShower = ItemKind   { isymbol  = '`'   , iname    = "dense shower"-  , ifreq    = [("dense shower", 1)]+  , ifreq    = [(S_DENSE_SHOWER, 1)]   , iflavour = zipFancy [Green]   , icount   = 12   , irarity  = [(1, 1)]@@ -526,14 +642,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "strengthened" 5]+  , ieffects = [toOrganGood S_STRENGTHENED 5]   , idesc    = "A thick rain of droplets."   , ikit     = []   } sparseShower = ItemKind   { isymbol  = '`'   , iname    = "sparse shower"-  , ifreq    = [("sparse shower", 1)]+  , ifreq    = [(S_SPARSE_SHOWER, 1)]   , iflavour = zipFancy [Red]   , icount   = 8   , irarity  = [(1, 1)]@@ -541,14 +657,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganBad "weakened" 7]+  , ieffects = [toOrganBad S_WEAKENED 7]   , idesc    = "Light droplets that cling to clothing."   , ikit     = []   } protectingBalmMelee = ItemKind   { isymbol  = '`'   , iname    = "balm droplet"-  , ifreq    = [("melee protective balm", 1)]+  , ifreq    = [(S_MELEE_PROTECTIVE_BALM, 1)]   , iflavour = zipFancy [Brown]   , icount   = 16   , irarity  = [(1, 1)]@@ -556,14 +672,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "protected from melee" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_PROTECTED_FROM_MELEE (3 + 1 `d` 3)]   , idesc    = "A thick ointment that hardens the skin."   , ikit     = []   } protectingBalmRanged = ItemKind   { isymbol  = '`'   , iname    = "balm droplet"-  , ifreq    = [("ranged protective balm", 1)]+  , ifreq    = [(S_RANGE_PROTECTIVE_BALM, 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 16   , irarity  = [(1, 1)]@@ -571,14 +687,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "protected from ranged" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_PROTECTED_FROM_RANGED (3 + 1 `d` 3)]   , idesc    = "Grease that protects from flying death."   , ikit     = []   }-vulnerabilityBalm = ItemKind+defenselessnessRunout = ItemKind   { isymbol  = '?'   , iname    = "PhD defense question"-  , ifreq    = [("PhD defense question", 1)]+  , ifreq    = [(S_DEFENSELESSNESS_RUNOUT, 1)]   , iflavour = zipFancy [BrRed]   , icount   = 16   , irarity  = [(1, 1)]@@ -586,14 +702,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganBad "defenseless" (3 + 1 `d` 3)]+  , ieffects = [toOrganBad S_DEFENSELESS (3 + 1 `d` 3)]   , idesc    = "Only the most learned make use of this."   , ikit     = []   } resolutionDust = ItemKind   { isymbol  = '`'   , iname    = "resolution dust"-  , ifreq    = [("resolution dust", 1)]+  , ifreq    = [(S_RESOLUTION_DUST, 1)]   , iflavour = zipPlain [Brown]   , icount   = 16   , irarity  = [(1, 1)]@@ -601,7 +717,7 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "resolute" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_RESOLUTE (3 + 1 `d` 3)]                  -- short enough duration that @calmEnough@ not a big problem   , idesc    = "A handful of honest earth, to strengthen the soul."   , ikit     = []@@ -609,7 +725,7 @@ hasteSpray = ItemKind   { isymbol  = '`'   , iname    = "haste spray"-  , ifreq    = [("haste spray", 1)]+  , ifreq    = [(S_HASTE_SPRAY, 1)]   , iflavour = zipFancy [BrYellow]   , icount   = 16   , irarity  = [(1, 1)]@@ -617,14 +733,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "hasted" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_HASTED (3 + 1 `d` 3)]   , idesc    = "A quick spurt."   , ikit     = []   } slownessMist = ItemKind   { isymbol  = '`'   , iname    = "slowness mist"-  , ifreq    = [("slowness mist", 1)]+  , ifreq    = [(S_SLOWNESS_MIST, 1)]   , iflavour = zipPlain [BrBlue]   , icount   = 8   , irarity  = [(1, 1)]@@ -633,14 +749,14 @@   , idamage  = 0   , iaspects = [toVelocity 5, SetFlag Fragile, SetFlag Blast]                  -- 1 step, 1 turn, mist, slow-  , ieffects = [toOrganBad "slowed" (3 + 1 `d` 3)]+  , ieffects = [toOrganBad S_SLOWED (3 + 1 `d` 3)]   , idesc    = "Clammy fog, making each movement an effort."   , ikit     = []   } eyeDrop = ItemKind   { isymbol  = '`'   , iname    = "eye drop"-  , ifreq    = [("eye drop", 1)]+  , ifreq    = [(S_EYE_DROP, 1)]   , iflavour = zipFancy [BrCyan]   , icount   = 16   , irarity  = [(1, 1)]@@ -648,14 +764,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "far-sighted" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_FAR_SIGHTED (3 + 1 `d` 3)]   , idesc    = "Not to be taken orally."   , ikit     = []   }-ironFiling = ItemKind+ironFiling = ItemKind  -- fast, short, strongly blinding blast   { isymbol  = '`'   , iname    = "iron filing"-  , ifreq    = [("iron filing", 1)]+  , ifreq    = [(S_IRON_FILING, 1)]   , iflavour = zipPlain [Red]   , icount   = 16   , irarity  = [(1, 1)]@@ -663,14 +779,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganBad "blind" (10 + 1 `d` 10)]+  , ieffects = [toOrganBad S_BLIND (10 + 1 `d` 10)]   , idesc    = "A shaving of bright metal."   , ikit     = []   } smellyDroplet = ItemKind   { isymbol  = '`'   , iname    = "smelly droplet"-  , ifreq    = [("smelly droplet", 1)]+  , ifreq    = [(S_SMELLY_DROPLET, 1)]   , iflavour = zipFancy [Blue]   , icount   = 16   , irarity  = [(1, 1)]@@ -678,14 +794,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "keen-smelling" (5 + 1 `d` 3)]+  , ieffects = [toOrganGood S_KEEN_SMELLING (5 + 1 `d` 3)]   , idesc    = "A viscous lump that stains the skin."   , ikit     = []   } eyeShine = ItemKind   { isymbol  = '`'   , iname    = "eye shine"-  , ifreq    = [("eye shine", 1)]+  , ifreq    = [(S_EYE_SHINE, 1)]   , iflavour = zipFancy [Cyan]   , icount   = 16   , irarity  = [(1, 1)]@@ -693,14 +809,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "shiny-eyed" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_SHINY_EYED (3 + 1 `d` 3)]   , idesc    = "They almost glow in the dark."   , ikit     = []   } whiskeySpray = ItemKind   { isymbol  = '`'   , iname    = "whiskey spray"-  , ifreq    = [("whiskey spray", 1)]+  , ifreq    = [(S_WHISKEY_SPRAY, 1)]   , iflavour = zipFancy [Brown]   , icount   = 16   , irarity  = [(1, 1)]@@ -708,14 +824,14 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [toOrganGood "drunk" (3 + 1 `d` 3)]+  , ieffects = [toOrganGood S_DRUNK (3 + 1 `d` 3)]   , idesc    = "It burns in the best way."   , ikit     = []   } youthSprinkle = ItemKind   { isymbol  = '`'   , iname    = "youth sprinkle"-  , ifreq    = [("youth sprinkle", 1)]+  , ifreq    = [(S_YOUTH_SPRINKLE, 1)]   , iflavour = zipFancy [BrGreen]   , icount   = 16   , irarity  = [(1, 1)]@@ -723,32 +839,49 @@   , iweight  = 1   , idamage  = 0   , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast]-  , ieffects = [ toOrganGood "rose-smelling" (40 + 1 `d` 20)-               , toOrganNoTimer "regenerating" ]+  , ieffects = [ toOrganGood S_ROSE_SMELLING (40 + 1 `d` 20)+               , toOrganNoTimer S_REGENERATING ]   , idesc    = "Bright and smelling of the Spring."   , ikit     = []   } poisonCloud = ItemKind   { isymbol  = '`'   , iname    = "poison cloud"-  , ifreq    = [("poison cloud", 1)]+  , ifreq    = [(S_POISON_CLOUD, 1)]   , iflavour = zipFancy [BrMagenta]   , icount   = 16   , irarity  = [(1, 1)]   , iverbHit = "poison"-  , iweight  = 0+  , iweight  = 0  -- lingers, blocking path   , idamage  = 0   , iaspects = [ ToThrow $ ThrowMod 10 100 2  -- 2 steps, 2 turns                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [toOrganNoTimer "poisoned"]+  , ieffects = [toOrganNoTimer S_POISONED]   , idesc    = "Choking gas that stings the eyes."   , ikit     = []   }-blastNoStat :: Text -> ItemKind+pingFlash = ItemKind+  { isymbol  = '`'+  , iname    = "flash"+  , ifreq    = [(S_PING_PLASH, 1)]+  , iflavour = zipFancy [Green]+  , icount   = 1+  , irarity  = [(1, 1)]+  , iverbHit = "ping"+  , iweight  = 1  -- to prevent blocking the way+  , idamage  = 0+  , iaspects = [ toLinger 0+               , SetFlag Fragile, SetFlag Blast+               , AddSkill SkShine 2 ]+  , ieffects = [OnSmash Yell]+  , idesc    = "A ping and a display flash from an echolocator out of sync momentarily."+  , ikit     = []+  }+blastNoStat :: GroupName ItemKind -> ItemKind blastNoStat grp = ItemKind   { isymbol  = '`'   , iname    = "mist"-  , ifreq    = [(toGroupName $ grp <+> "mist", 1)]+  , ifreq    = [(blastNoStatOf grp, 1)]   , iflavour = zipFancy [White]   , icount   = 12   , irarity  = [(1, 1)]@@ -757,23 +890,23 @@   , idamage  = 0   , iaspects = [ toVelocity 10  -- 2 steps, 2 turns                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [toOrganBad (toGroupName grp) (3 + 1 `d` 3)]+  , ieffects = [toOrganBad grp (3 + 1 `d` 3)]   , idesc    = "Completely disables one personal faculty."   , ikit     = []   }-blastNoSkMove = blastNoStat "immobile"-blastNoSkMelee = blastNoStat "pacified"-blastNoSkDisplace = blastNoStat "irreplaceable"-blastNoSkAlter = blastNoStat "retaining"-blastNoSkWait = blastNoStat "impatient"-blastNoSkMoveItem = blastNoStat "dispossessed"-blastNoSkProject = blastNoStat "withholding"-blastNoSkApply = blastNoStat "parsimonious"-blastBonusStat :: Text -> ItemKind+blastNoSkMove = blastNoStat S_IMMOBILE+blastNoSkMelee = blastNoStat S_PACIFIED+blastNoSkDisplace = blastNoStat S_IRREPLACEABLE+blastNoSkAlter = blastNoStat S_RETAINING+blastNoSkWait = blastNoStat S_IMPATIENT+blastNoSkMoveItem = blastNoStat S_DISPOSSESSED+blastNoSkProject = blastNoStat S_WITHHOLDING+blastNoSkApply = blastNoStat S_PARSIMONIOUS+blastBonusStat :: GroupName ItemKind -> ItemKind blastBonusStat grp = ItemKind   { isymbol  = '`'   , iname    = "dew"-  , ifreq    = [(toGroupName $ grp <+> "dew", 1)]+  , ifreq    = [(blastBonusStatOf grp, 1)]   , iflavour = zipFancy [White]   , icount   = 12   , irarity  = [(1, 1)]@@ -782,15 +915,15 @@   , idamage  = 0   , iaspects = [ toVelocity 10  -- 2 steps, 2 turns                , SetFlag Fragile, SetFlag Blast ]-  , ieffects = [toOrganGood (toGroupName grp) (20 + 1 `d` 5)]+  , ieffects = [toOrganGood grp (20 + 1 `d` 5)]   , idesc    = "Temporarily enhances the given personal faculty."   , ikit     = []   }-blastBonusSkMove = blastBonusStat "more mobile"-blastBonusSkMelee = blastBonusStat "more combative"-blastBonusSkDisplace = blastBonusStat "more displacing"-blastBonusSkAlter = blastBonusStat "more altering"-blastBonusSkWait = blastBonusStat "more patient"-blastBonusSkMoveItem = blastBonusStat "more tidy"-blastBonusSkProject = blastBonusStat "more projecting"-blastBonusSkApply = blastBonusStat "more practical"+blastBonusSkMove = blastBonusStat S_MORE_MOBILE+blastBonusSkMelee = blastBonusStat S_MORE_COMBATIVE+blastBonusSkDisplace = blastBonusStat S_MORE_DISPLACING+blastBonusSkAlter = blastBonusStat S_MORE_MODIFYING+blastBonusSkWait = blastBonusStat S_MORE_PATIENT+blastBonusSkMoveItem = blastBonusStat S_MORE_TIDY+blastBonusSkProject = blastBonusStat S_MORE_PROJECTING+blastBonusSkApply = blastBonusStat S_MORE_PRACTICAL

GameDefinition/Content/ItemKindEmbed.hs view

@@ -1,12 +1,20 @@ -- | Definitions of items embedded in map tiles. module Content.ItemKindEmbed-  ( embeds+  ( -- * Group name patterns+    pattern SCRATCH_ON_WALL, pattern OBSCENE_PICTOGRAM, pattern SUBTLE_FRESCO, pattern TREASURE_CACHE, pattern TREASURE_CACHE_TRAP, pattern SIGNAGE, pattern SMALL_FIRE, pattern BIG_FIRE, pattern FROST, pattern RUBBLE, pattern DOORWAY_TRAP_UNKNOWN, pattern DOORWAY_TRAP, pattern STAIRS_UP, pattern STAIRS_DOWN, pattern ESCAPE, pattern STAIRS_TRAP_UP, pattern STAIRS_TRAP_DOWN, pattern LECTERN, pattern SHALLOW_WATER, pattern STRAIGHT_PATH, pattern FROZEN_GROUND+  , pattern S_SANDSTONE_ROCK+  , embedsGNSingleton, embedsGN+  , -- * Content+    embeds   ) where  import Prelude ()  import Game.LambdaHack.Core.Prelude +import Content.ItemKindActor+import Content.ItemKindBlast+import Content.ItemKindTemporary import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability@@ -14,12 +22,53 @@ import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour +-- * Group name patterns++embedsGNSingleton :: [GroupName ItemKind]+embedsGNSingleton = [S_SANDSTONE_ROCK]++pattern S_SANDSTONE_ROCK :: GroupName ItemKind++embedsGN :: [GroupName ItemKind]+embedsGN =+       [SCRATCH_ON_WALL, OBSCENE_PICTOGRAM, SUBTLE_FRESCO, TREASURE_CACHE, TREASURE_CACHE_TRAP, SIGNAGE, SMALL_FIRE, BIG_FIRE, FROST, RUBBLE, DOORWAY_TRAP_UNKNOWN, DOORWAY_TRAP, STAIRS_UP, STAIRS_DOWN, ESCAPE, STAIRS_TRAP_UP, STAIRS_TRAP_DOWN, LECTERN, SHALLOW_WATER, STRAIGHT_PATH, FROZEN_GROUND]++pattern SCRATCH_ON_WALL, OBSCENE_PICTOGRAM, SUBTLE_FRESCO, TREASURE_CACHE, TREASURE_CACHE_TRAP, SIGNAGE, SMALL_FIRE, BIG_FIRE, FROST, RUBBLE, DOORWAY_TRAP_UNKNOWN, DOORWAY_TRAP, STAIRS_UP, STAIRS_DOWN, ESCAPE, STAIRS_TRAP_UP, STAIRS_TRAP_DOWN, LECTERN, SHALLOW_WATER, STRAIGHT_PATH, FROZEN_GROUND :: GroupName ItemKind++pattern SCRATCH_ON_WALL = GroupName "scratch on wall"+pattern OBSCENE_PICTOGRAM = GroupName "obscene pictogram"+pattern SUBTLE_FRESCO = GroupName "subtle fresco"+pattern TREASURE_CACHE = GroupName "treasure cache"+pattern TREASURE_CACHE_TRAP = GroupName "treasure cache trap"+pattern SIGNAGE = GroupName "signage"+pattern SMALL_FIRE = GroupName "small fire"+pattern BIG_FIRE = GroupName "big fire"+pattern FROST = GroupName "frozen mass"+pattern RUBBLE = GroupName "rubble"+pattern DOORWAY_TRAP_UNKNOWN = GroupName "doorway trap unknown"+pattern DOORWAY_TRAP = GroupName "doorway trap"+pattern STAIRS_UP = GroupName "stairs up"+pattern STAIRS_DOWN = GroupName "stairs down"+pattern ESCAPE = GroupName "escape"+pattern STAIRS_TRAP_UP = GroupName "stairs trap up"+pattern STAIRS_TRAP_DOWN = GroupName "stairs trap down"+pattern LECTERN = GroupName "lectern"+pattern SHALLOW_WATER = GroupName "shallow water"+pattern STRAIGHT_PATH = GroupName "straight path"+pattern FROZEN_GROUND = GroupName "frozen ground"++pattern S_SANDSTONE_ROCK = GroupName "sandstone rock"++-- * Content+ embeds :: [ItemKind] embeds =-  [scratchOnWall, obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signboardExit, signboardEmbed, signboardMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, staircaseTrapUp, staircaseTrapDown, pulpit, shallowWater, straightPath, frozenGround]+  [scratchOnWall, obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signageExit, signageEmbed, signageMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, stairsTrapUp, stairsTrapDown, lectern, shallowWater, straightPath, frozenGround] -scratchOnWall,    obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signboardExit, signboardEmbed, signboardMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, staircaseTrapUp, staircaseTrapDown, pulpit, shallowWater, straightPath, frozenGround :: ItemKind+scratchOnWall,    obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signageExit, signageEmbed, signageMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, stairsTrapUp, stairsTrapDown, lectern, shallowWater, straightPath, frozenGround :: ItemKind +-- * Embedded items+ -- Make sure very few walls are substantially useful, e.g., caches, -- and none that are secret. Otherwise the player will spend a lot of time -- bumping walls, which is boring compared to fights or dialogues@@ -29,7 +78,7 @@ scratchOnWall = ItemKind   { isymbol  = '?'   , iname    = "claw mark"-  , ifreq    = [("scratch on wall", 1)]+  , ifreq    = [(SCRATCH_ON_WALL, 1)]   , iflavour = zipPlain [BrBlack]   , icount   = 1   , irarity  = [(1, 1)]@@ -37,7 +86,7 @@   , iweight  = 1000   , idamage  = 0   , iaspects = [SetFlag Durable]-  , ieffects = [ VerbMsg "start making sense of the scratches"+  , ieffects = [ VerbMsg "start making sense of the scratches" "."                , Detect DetectHidden 3 ]   , idesc    = "A seemingly random series of scratches, carved deep into the wall."   , ikit     = []@@ -45,7 +94,7 @@ obscenePictogram = ItemKind   { isymbol  = '*'   , iname    = "obscene pictogram"-  , ifreq    = [("obscene pictogram", 1)]+  , ifreq    = [(OBSCENE_PICTOGRAM, 1)]   , iflavour = zipPlain [BrMagenta]   , icount   = 1   , irarity  = [(1, 1)]@@ -53,17 +102,18 @@   , iweight  = 1000   , idamage  = 0   , iaspects = [Timeout 7, SetFlag Durable]-  , ieffects = [ VerbMsg "enter destructive rage at the sight of an obscene pictogram"+  , ieffects = [ VerbMsg "enter destructive rage at the sight of an obscene pictogram" "."                , RefillCalm (-20)-               , OneOf [ toOrganGood "strengthened" (3 + 1 `d` 2)-                       , CreateItem CInv "sandstone rock" timerNone ] ]+               , OneOf [ toOrganGood S_STRENGTHENED (3 + 1 `d` 2)+                       , CreateItem Nothing CGround S_SANDSTONE_ROCK timerNone ]+               ]   , idesc    = "It's not even anatomically possible."   , ikit     = []   } subtleFresco = ItemKind   { isymbol  = '*'   , iname    = "subtle fresco"-  , ifreq    = [("subtle fresco", 1)]+  , ifreq    = [(SUBTLE_FRESCO, 1)]   , iflavour = zipPlain [BrGreen]   , icount   = 1   , irarity  = [(1, 1)]@@ -71,17 +121,17 @@   , iweight  = 1000   , idamage  = 0   , iaspects = [Timeout 7, SetFlag Durable]-  , ieffects = [ VerbMsg "feel refreshed by the subtle fresco"-               , toOrganGood "far-sighted" (3 + 1 `d` 2)-               , toOrganGood "keen-smelling" (3 + 1 `d` 2) ]+  , ieffects = [ VerbMsg "feel refreshed by the subtle fresco" "."+               , toOrganGood S_FAR_SIGHTED (3 + 1 `d` 2)+               , toOrganGood S_KEEN_SMELLING (3 + 1 `d` 2) ]                  -- hearing gets a boost through bracing, so no need here   , idesc    = "Expensive yet tasteful."   , ikit     = []   } treasureCache = ItemKind-  { isymbol  = '0'+  { isymbol  = 'o'   , iname    = "treasure cache"-  , ifreq    = [("treasure cache", 1)]+  , ifreq    = [(TREASURE_CACHE, 1)]   , iflavour = zipPlain [BrBlue]   , icount   = 1   , irarity  = [(1, 1)]@@ -89,14 +139,16 @@   , iweight  = 10000   , idamage  = 0   , iaspects = [SetFlag Durable]-  , ieffects = [CreateItem CGround "common item" timerNone]+  , ieffects = [CreateItem Nothing CGround COMMON_ITEM timerNone]   , idesc    = "Glittering treasure, just waiting to be taken."   , ikit     = []   }+reliefMsg :: Effect+reliefMsg = VerbMsg "sigh with relief when nothing explodes in your face!" "" treasureCacheTrap = ItemKind   { isymbol  = '^'   , iname    = "cache trap"-  , ifreq    = [("treasure cache trap", 1)]+  , ifreq    = [(TREASURE_CACHE_TRAP, 1)]   , iflavour = zipPlain [Red]   , icount   = 1   , irarity  = [(1, 1)]@@ -104,17 +156,17 @@   , iweight  = 1000   , idamage  = 0   , iaspects = []  -- not Durable, springs at most once-  , ieffects = [OneOf [ toOrganBad "blind" (10 + 1 `d` 10)+  , ieffects = [OneOf [ toOrganBad S_BLIND (10 + 1 `d` 10)                       , RefillCalm (-99)-                      , Explode "focused concussion"-                      , RefillCalm (-1), RefillCalm (-1), RefillCalm (-1) ]]+                      , Explode S_FOCUSED_CONCUSSION+                      , reliefMsg, reliefMsg ]]   , idesc    = "It's a trap!"   , ikit     = []   }-signboardExit = ItemKind+signageExit = ItemKind   { isymbol  = '?'   , iname    = "inscription"-  , ifreq    = [("signboard", 50)]+  , ifreq    = [(SIGNAGE, 50)]   , iflavour = zipPlain [BrMagenta]   , icount   = 1   , irarity  = [(1, 1)]@@ -126,22 +178,22 @@   , idesc    = "Crude big arrows hastily carved by unknown hands."   , ikit     = []   }-signboardEmbed = signboardExit+signageEmbed = signageExit   { iname    = "notice"-  , ifreq    = [("signboard", 50)]+  , ifreq    = [(SIGNAGE, 50)]   , ieffects = [Detect DetectEmbed 12]   , idesc    = "The battered poster is untitled and unsigned."   }-signboardMerchandise = signboardExit+signageMerchandise = signageExit   { iname    = "treasure map"-  , ifreq    = [("signboard", 50)]+  , ifreq    = [(SIGNAGE, 50)]   , ieffects = [Detect DetectLoot 20]   , idesc    = "In equal parts cryptic and promising."   } fireSmall = ItemKind-  { isymbol  = '%'+  { isymbol  = 'o'   , iname    = "small fire"-  , ifreq    = [("small fire", 1)]+  , ifreq    = [(SMALL_FIRE, 1)]   , iflavour = zipPlain [BrRed]   , icount   = 1   , irarity  = [(1, 1)]@@ -149,24 +201,24 @@   , iweight  = 10000   , idamage  = 0   , iaspects = [SetFlag Durable]-  , ieffects = [Burn 1, Explode "single spark"]+  , ieffects = [Burn 1, Explode S_SINGLE_SPARK]   , idesc    = "A few small logs, burning brightly."   , ikit     = []   } fireBig = fireSmall   { isymbol  = '0'   , iname    = "big fire"-  , ifreq    = [("big fire", 1)]+  , ifreq    = [(BIG_FIRE, 1)]   , ieffects = [ Burn 2-               , CreateItem CInv "wooden torch" timerNone-               , Explode "spark" ]+               , CreateItem Nothing CGround S_WOODEN_TORCH timerNone+               , Explode S_SPARK ]   , idesc    = "Glowing with light and warmth."   , ikit     = []   } frost = ItemKind   { isymbol  = '^'   , iname    = "frost"-  , ifreq    = [("frost", 1)]+  , ifreq    = [(FROST, 1)]   , iflavour = zipPlain [BrBlue]   , icount   = 1   , irarity  = [(1, 1)]@@ -183,7 +235,7 @@ rubble = ItemKind   { isymbol  = '&'   , iname    = "rubble"-  , ifreq    = [("rubble", 1)]+  , ifreq    = [(RUBBLE, 1)]   , iflavour = zipPlain [BrYellow]   , icount   = 1   , irarity  = [(1, 1)]@@ -191,50 +243,53 @@   , iweight  = 100000   , idamage  = 0   , iaspects = [SetFlag Durable]-  , ieffects = [OneOf [ Explode "focused glass hail"-                      , Summon "mobile animal" $ 1 `dL` 2-                      , toOrganNoTimer "poisoned"-                      , CreateItem CGround "common item" timerNone-                      , RefillCalm (-1), RefillCalm (-1), RefillCalm (-1)-                      , RefillCalm (-1), RefillCalm (-1), RefillCalm (-1) ]]+  , ieffects = [OneOf [ Explode S_FOCUSED_GLASS_HAIL+                      , Summon MOBILE_ANIMAL $ 1 `dL` 2+                      , toOrganNoTimer S_POISONED+                      , CreateItem Nothing CGround ANY_ARROW timerNone+                      , CreateItem Nothing CGround STARTING_WEAPON timerNone+                      , reliefMsg, reliefMsg, reliefMsg+                      , reliefMsg, reliefMsg, reliefMsg ]]   , idesc    = "Broken chunks of rock and glass."   , ikit     = []   } doorwayTrapTemplate = ItemKind   { isymbol  = '+'   , iname    = "doorway trap"-  , ifreq    = [("doorway trap unknown", 1)]+  , ifreq    = [(DOORWAY_TRAP_UNKNOWN, 1), (DOORWAY_TRAP, 0)]+      -- the void group needed to pick the item for tile triggering+      -- even when not yet identified   , iflavour = zipPlain brightCol   , icount   = 1   , irarity  = [(1, 1)]   , iverbHit = "cripple"   , iweight  = 10000   , idamage  = 0-  , iaspects = [HideAs "doorway trap unknown"]+  , iaspects = [PresentAs DOORWAY_TRAP_UNKNOWN]       -- not Durable, springs at most once   , ieffects = []   , idesc    = "Just turn the handle..."   , ikit     = []   } doorwayTrap1 = doorwayTrapTemplate-  { ifreq    = [("doorway trap", 50)]-  , ieffects = [toOrganBad "blind" $ (1 `dL` 4) * 5]+  { ifreq    = [(DOORWAY_TRAP, 50)]+  , ieffects = [toOrganBad S_BLIND $ (1 `dL` 4) * 5]   -- , idesc    = ""   } doorwayTrap2 = doorwayTrapTemplate-  { ifreq    = [("doorway trap", 25)]-  , ieffects = [toOrganBad "slowed" $ (1 `dL` 4) * 10]+  { ifreq    = [(DOORWAY_TRAP, 25)]+  , ieffects = [toOrganBad S_SLOWED $ (1 `dL` 4) * 10]   -- , idesc    = ""   } doorwayTrap3 = doorwayTrapTemplate-  { ifreq    = [("doorway trap", 25)]-  , ieffects = [toOrganBad "weakened" $ (1 `dL` 4) * 10 ]+  { ifreq    = [(DOORWAY_TRAP, 25)]+  , ieffects = [toOrganBad S_WEAKENED $ (1 `dL` 4) * 10 ]   -- , idesc    = ""   } stairsUp = ItemKind   { isymbol  = '<'   , iname    = "flight"-  , ifreq    = [("staircase up", 1)]+  , ifreq    = [(STAIRS_UP, 1)]   , iflavour = zipPlain [BrWhite]   , icount   = 1   , irarity  = [(1, 1)]@@ -249,23 +304,25 @@   } stairsDown = stairsUp   { isymbol  = '>'-  , ifreq    = [("staircase down", 1)]+  , ifreq    = [(STAIRS_DOWN, 1)]   , ieffects = [Ascend False]   , idesc    = ""   } escape = stairsUp   { isymbol  = 'E'   , iname    = "way"-  , ifreq    = [("escape", 1)]+  , ifreq    = [(ESCAPE, 1)]   , iflavour = zipPlain [BrYellow]   , iaspects = [SetFlag Durable]   , ieffects = [Escape]   , idesc    = "May this nightmare have an end?"+                 -- generic escape, so the text should be too;+                 -- for moon outdoors, spaceship, everywhere   }-staircaseTrapUp = ItemKind+stairsTrapUp = ItemKind   { isymbol  = '^'   , iname    = "staircase trap"-  , ifreq    = [("staircase trap up", 1)]+  , ifreq    = [(STAIRS_TRAP_UP, 1)]   , iflavour = zipPlain [Red]   , icount   = 1   , irarity  = [(1, 1)]@@ -273,25 +330,25 @@   , iweight  = 10000   , idamage  = 0   , iaspects = []  -- not Durable, springs at most once-  , ieffects = [ VerbMsg "be caught in an updraft"+  , ieffects = [ VerbMsgFail "be caught in an updraft" "."                , Teleport $ 3 + 1 `dL` 10 ]   , idesc    = "A hidden spring, to help the unwary soar."   , ikit     = []   }--- Needs to be separate from staircaseTrapUp, to make sure the item is--- registered after up staircase (not only after down staircase)+-- Needs to be separate from stairsTrapUp, to make sure the item is+-- registered after up stairs (not only after down stairs) -- so that effects are invoked in the proper order and, e.g., teleport works.-staircaseTrapDown = staircaseTrapUp-  { ifreq    = [("staircase trap down", 1)]+stairsTrapDown = stairsTrapUp+  { ifreq    = [(STAIRS_TRAP_DOWN, 1)]   , iverbHit = "open up under"-  , ieffects = [ VerbMsg "tumble down the stairwell"-               , toOrganGood "drunk" (20 + 1 `d` 5) ]+  , ieffects = [ VerbMsgFail "tumble down the stairwell" "."+               , toOrganGood S_DRUNK (20 + 1 `d` 5) ]   , idesc    = "A treacherous slab, to teach those who are too proud."   }-pulpit = ItemKind+lectern = ItemKind   { isymbol  = '?'   , iname    = "lectern"-  , ifreq    = [("pulpit", 1)]+  , ifreq    = [(LECTERN, 1)]   , iflavour = zipFancy [BrYellow]   , icount   = 1   , irarity  = [(1, 1)]@@ -299,18 +356,18 @@   , iweight  = 10000   , idamage  = 0   , iaspects = []  -- not Durable, springs at most once-  , ieffects = [ OneOf [ CreateItem CGround "any scroll" timerNone+  , ieffects = [ OneOf [ CreateItem Nothing CGround ANY_SCROLL timerNone                        , Detect DetectAll 20-                       , toOrganBad "defenseless" $ (1 `dL` 6) * 10-                       , toOrganGood "drunk" (20 + 1 `d` 5) ]-               , Explode "PhD defense question" ]+                       , toOrganBad S_DEFENSELESS $ (1 `dL` 6) * 10+                       , toOrganGood S_DRUNK (20 + 1 `d` 5) ]+               , Explode S_DEFENSELESSNESS_RUNOUT ]   , idesc    = "A dark wood stand, where strange priests once preached."   , ikit     = []   } shallowWater = ItemKind   { isymbol  = '~'   , iname    = "shallow water"-  , ifreq    = [("shallow water", 1)]+  , ifreq    = [(SHALLOW_WATER, 1)]   , iflavour = zipFancy [BrCyan]   , icount   = 1   , irarity  = [(1, 1)]@@ -325,7 +382,7 @@ straightPath = ItemKind   { isymbol  = '.'   , iname    = "straight path"-  , ifreq    = [("straight path", 1)]+  , ifreq    = [(STRAIGHT_PATH, 1)]   , iflavour = zipFancy [BrRed]   , icount   = 1   , irarity  = [(1, 1)]@@ -340,9 +397,9 @@ frozenGround = ItemKind   { isymbol  = '.'   , iname    = "shade"-  , ifreq    = [("frozen ground", 1)]+  , ifreq    = [(FROZEN_GROUND, 1)]   , iflavour = zipFancy [BrBlue]-  , icount   = 50  -- very thick ice and refreezes+  , icount   = 10  -- very thick ice and refreezes, but not too large and boring   , irarity  = [(1, 1)]   , iverbHit = "betray"   , iweight  = 10000

GameDefinition/Content/ItemKindOrgan.hs view

@@ -1,12 +1,20 @@ -- | Actor organ definitions. module Content.ItemKindOrgan-  ( organs+  ( -- * Group name patterns+    pattern S_FIST, pattern S_FOOT, pattern S_HOOKED_CLAW, pattern S_SMALL_CLAW, pattern S_SNOUT, pattern S_SMALL_JAW, pattern S_JAW, pattern S_LARGE_JAW, pattern S_ANTLER, pattern S_HORN, pattern S_RHINO_HORN, pattern S_TENTACLE, pattern S_TIP, pattern S_LIP, pattern S_THORN, pattern S_BOILING_FISSURE, pattern S_ARSENIC_FISSURE, pattern S_SULFUR_FISSURE, pattern S_BEE_STING, pattern S_STING, pattern S_VENOM_TOOTH, pattern S_VENOM_FANG, pattern S_SCREECHING_BEAK, pattern S_LARGE_TAIL, pattern S_HUGE_TAIL, pattern S_ARMORED_SKIN, pattern S_BARK, pattern S_NOSTRIL, pattern S_RATLLE, pattern S_INSECT_MORTALITY, pattern S_SAPIENT_BRAIN, pattern S_ANIMAL_BRAIN, pattern S_SCENT_GLAND, pattern S_BOILING_VENT, pattern S_ARSENIC_VENT, pattern S_SULFUR_VENT, pattern S_EYE_3, pattern S_EYE_6, pattern S_EYE_8, pattern S_VISION_6, pattern S_VISION_12, pattern S_VISION_16, pattern S_EAR_3, pattern S_EAR_6, pattern S_EAR_8, pattern S_SPEED_GLAND_5, pattern S_SPEED_GLAND_10+  , pattern S_TOOTH, pattern S_LASH, pattern S_RIGHT_TORSION, pattern S_LEFT_TORSION, pattern S_PUPIL+  , pattern SCAVENGER+  , organsGNSingleton, organsGN+  , -- * Content+    organs   ) where  import Prelude ()  import Game.LambdaHack.Core.Prelude +import Content.ItemKindBlast+import Content.ItemKindTemporary import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability@@ -14,24 +22,117 @@ import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour +-- * Group name patterns++organsGNSingleton :: [GroupName ItemKind]+organsGNSingleton =+       [S_FIST, S_FOOT, S_HOOKED_CLAW, S_SMALL_CLAW, S_SNOUT, S_SMALL_JAW, S_JAW, S_LARGE_JAW, S_ANTLER, S_HORN, S_RHINO_HORN, S_TENTACLE, S_TIP, S_LIP, S_THORN, S_BOILING_FISSURE, S_ARSENIC_FISSURE, S_SULFUR_FISSURE, S_BEE_STING, S_STING, S_VENOM_TOOTH, S_VENOM_FANG, S_SCREECHING_BEAK, S_LARGE_TAIL, S_HUGE_TAIL, S_ARMORED_SKIN, S_BARK, S_NOSTRIL, S_RATLLE, S_INSECT_MORTALITY, S_SAPIENT_BRAIN, S_ANIMAL_BRAIN, S_SCENT_GLAND, S_BOILING_VENT, S_ARSENIC_VENT, S_SULFUR_VENT, S_EYE_3, S_EYE_6, S_EYE_8, S_VISION_6, S_VISION_12, S_VISION_16, S_EAR_3, S_EAR_6, S_EAR_8, S_SPEED_GLAND_5, S_SPEED_GLAND_10]+    ++ [S_TOOTH, S_LASH, S_RIGHT_TORSION, S_LEFT_TORSION, S_PUPIL]++pattern S_FIST, S_FOOT, S_HOOKED_CLAW, S_SMALL_CLAW, S_SNOUT, S_SMALL_JAW, S_JAW, S_LARGE_JAW, S_ANTLER, S_HORN, S_RHINO_HORN, S_TENTACLE, S_TIP, S_LIP, S_THORN, S_BOILING_FISSURE, S_ARSENIC_FISSURE, S_SULFUR_FISSURE, S_BEE_STING, S_STING, S_VENOM_TOOTH, S_VENOM_FANG, S_SCREECHING_BEAK, S_LARGE_TAIL, S_HUGE_TAIL, S_ARMORED_SKIN, S_BARK, S_NOSTRIL, S_RATLLE, S_INSECT_MORTALITY, S_SAPIENT_BRAIN, S_ANIMAL_BRAIN, S_SCENT_GLAND, S_BOILING_VENT, S_ARSENIC_VENT, S_SULFUR_VENT, S_EYE_3, S_EYE_6, S_EYE_8, S_VISION_6, S_VISION_12, S_VISION_16, S_EAR_3, S_EAR_6, S_EAR_8, S_SPEED_GLAND_5, S_SPEED_GLAND_10 :: GroupName ItemKind++pattern S_TOOTH, S_LASH, S_RIGHT_TORSION, S_LEFT_TORSION, S_PUPIL :: GroupName ItemKind++organsGN :: [GroupName ItemKind]+organsGN =+       [SCAVENGER]++pattern SCAVENGER :: GroupName ItemKind++pattern S_FIST = GroupName "fist"+pattern S_FOOT = GroupName "foot"+pattern S_HOOKED_CLAW = GroupName "hooked claw"+pattern S_SMALL_CLAW = GroupName "small claw"+pattern S_SNOUT = GroupName "snout"+pattern S_SMALL_JAW = GroupName "small jaw"+pattern S_JAW = GroupName "jaw"+pattern S_LARGE_JAW = GroupName "large jaw"+pattern S_ANTLER = GroupName "antler"+pattern S_HORN = GroupName "horn"+pattern S_RHINO_HORN = GroupName "rhino horn"+pattern S_TENTACLE = GroupName "tentacle"+pattern S_TIP = GroupName "tip"+pattern S_LIP = GroupName "lip"+pattern S_THORN = GroupName "thorn"+pattern S_BOILING_FISSURE = GroupName "boiling fissure"+pattern S_ARSENIC_FISSURE = GroupName "arsenic fissure"+pattern S_SULFUR_FISSURE = GroupName "sulfur fissure"+pattern S_BEE_STING = GroupName "bee sting"+pattern S_STING = GroupName "sting"+pattern S_VENOM_TOOTH = GroupName "venom tooth"+pattern S_VENOM_FANG = GroupName "venom fang"+pattern S_SCREECHING_BEAK = GroupName "screeching beak"+pattern S_LARGE_TAIL = GroupName "large tail"+pattern S_HUGE_TAIL = GroupName "huge tail"+pattern S_ARMORED_SKIN = GroupName "armored skin"+pattern S_BARK = GroupName "bark"+pattern S_NOSTRIL = GroupName "nostril"+pattern S_RATLLE = GroupName "rattle"+pattern S_INSECT_MORTALITY = GroupName "insect mortality"+pattern S_SAPIENT_BRAIN = GroupName "sapient brain"+pattern S_ANIMAL_BRAIN = GroupName "animal brain"+pattern S_SCENT_GLAND = GroupName "scent gland"+pattern S_BOILING_VENT = GroupName "boiling vent"+pattern S_ARSENIC_VENT = GroupName "arsenic vent"+pattern S_SULFUR_VENT = GroupName "sulfur vent"+pattern S_EYE_3 = GroupName "eye 3"+pattern S_EYE_6 = GroupName "eye 6"+pattern S_EYE_8 = GroupName "eye 8"+pattern S_VISION_6 = GroupName "vision 6"+pattern S_VISION_12 = GroupName "vision 12"+pattern S_VISION_16 = GroupName "vision 16"+pattern S_EAR_3 = GroupName "ear 3"+pattern S_EAR_6 = GroupName "ear 6"+pattern S_EAR_8 = GroupName "ear 8"+pattern S_SPEED_GLAND_5 = GroupName "speed gland 5"+pattern S_SPEED_GLAND_10 = GroupName "speed gland 10"++-- * LH-specific+pattern S_TOOTH = GroupName "tooth"+pattern S_LASH = GroupName "lash"+pattern S_RIGHT_TORSION = GroupName "right torsion"+pattern S_LEFT_TORSION = GroupName "left torsion"+pattern S_PUPIL = GroupName "pupil"++pattern SCAVENGER = GroupName "scavenger"++-- * Content+ organs :: [ItemKind] organs =-  [fist, foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed]+  [fist, foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, tip, lip, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed]   -- LH-specific-  ++ [tooth, lash, noseTip, lip, torsionRight, torsionLeft, pupil]+  ++ [tooth, lash, torsionRight, torsionLeft, pupil] -fist,    foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed :: ItemKind+fist,    foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, tip, lip, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed :: ItemKind -- LH-specific-tooth, lash, noseTip, lip, torsionRight, torsionLeft, pupil :: ItemKind+tooth, lash, torsionRight, torsionLeft, pupil :: ItemKind --- Weapons --- * Human weapon organs+-- * No-cooldown melee damage organs without effects +thorn = fist+  { iname    = "thorn"+  , ifreq    = [(S_THORN, 1)]+  , icount   = 2 + 1 `d` 2  -- unrealistic, but not boring+  , iverbHit = "puncture"+  , idamage  = 2 `d` 1+  , iaspects = [SetFlag Meleeable]  -- not Durable+  , ieffects = [VerbNoLonger "be not so thorny any more" "."]+  , idesc    = "Sharp yet brittle."+  }+tip = fist+  { iname    = "tip"+  , ifreq    = [(S_TIP, 1)]+  , icount   = 1+  , iverbHit = "poke"+  , idamage  = 2 `d` 1+  , idesc    = ""+  } fist = ItemKind   { isymbol  = ','   , iname    = "fist"-  , ifreq    = [("fist", 100)]+  , ifreq    = [(S_FIST, 1)]   , iflavour = zipPlain [Red]   , icount   = 2   , irarity  = [(1, 1)]@@ -45,36 +146,22 @@   } foot = fist   { iname    = "foot"-  , ifreq    = [("foot", 50)]+  , ifreq    = [(S_FOOT, 1)]   , iverbHit = "kick"   , idamage  = 4 `d` 1   , idesc    = "A weapon you can still use if disarmed."                  -- great example of tutorial hints inside a flavourful text   }---- * Other weapon organs--hookedClaw = fist-  { iname    = "hooked claw"-  , ifreq    = [("hooked claw", 50)]-  , icount   = 2  -- even if more, only the fore claws used for fighting-  , iverbHit = "hook"-  , idamage  = 2 `d` 1-  , iaspects = Timeout (12 - 1 `dL` 3)-               : iaspects fist-  , ieffects = [toOrganBad "slowed" 2]-  , idesc    = "A curved talon."-  } smallClaw = fist   { iname    = "small claw"-  , ifreq    = [("small claw", 50)]+  , ifreq    = [(S_SMALL_CLAW, 1)]   , iverbHit = "slash"   , idamage  = 2 `d` 1   , idesc    = "A pearly spike."   } snout = fist   { iname    = "snout"-  , ifreq    = [("snout", 10)]+  , ifreq    = [(S_SNOUT, 1)]   , icount   = 1   , iverbHit = "bite"   , idamage  = 2 `d` 1@@ -82,46 +169,37 @@   } smallJaw = fist   { iname    = "small jaw"-  , ifreq    = [("small jaw", 20)]+  , ifreq    = [(S_SMALL_JAW, 1)]   , icount   = 1   , iverbHit = "rip"   , idamage  = 3 `d` 1   , idesc    = "Filled with small, even teeth."   }++-- * Cooldown melee damage organs without effects++tentacle = fist  -- two copies only+  { iname    = "tentacle"+  , ifreq    = [(S_TENTACLE, 1)]+  , iverbHit = "slap"+  , idamage  = 4 `d` 1+  , iaspects = Timeout 3  -- minimal timeout that lets other organs show+               : iaspects fist+  , idesc    = "Damp and dextrous."+  } jaw = fist   { iname    = "jaw"-  , ifreq    = [("jaw", 20)]+  , ifreq    = [(S_JAW, 1)]   , icount   = 1   , iverbHit = "rip"   , idamage  = 5 `d` 1+  , iaspects = Timeout (2 + 1 `d` 2)  -- no effect, but limit raw damage+               : iaspects fist   , idesc    = "Delivers a powerful bite."   }-largeJaw = fist-  { iname    = "large jaw"-  , ifreq    = [("large jaw", 100)]-  , icount   = 1-  , iverbHit = "crush"-  , idamage  = 10 `d` 1-  , iaspects = [Timeout $ 2 + 1 `d` 2]  -- no effect, but limit raw damage-               ++ iaspects fist-  , idesc    = "Enough to swallow anything in a single gulp."-  }-antler = fist-  { iname    = "antler"-  , ifreq    = [("antler", 100)]-  , icount   = 2-  , iverbHit = "ram"-  , idamage  = 4 `d` 1-  , iaspects = [ Timeout $ 3 + (1 `d` 3) * 3-               , AddSkill SkArmorMelee 10 ]  -- bonus doubled-               ++ iaspects fist-  , ieffects = [PushActor (ThrowMod 100 50 1)]  -- 1 step, slow-  , idesc    = ""-  } horn = fist   { iname    = "horn"-  , ifreq    = [("horn", 100)]-  , icount   = 2+  , ifreq    = [(S_HORN, 1)]   , iverbHit = "impale"   , idamage  = 5 `d` 1   , iaspects = [ AddSkill SkHurtMelee 10@@ -129,69 +207,22 @@                ++ iaspects fist   , idesc    = "Sharp and long, for defence or attack."   }-rhinoHorn = fist-  { iname    = "ugly horn"  -- made of keratin, unlike real horns-  , ifreq    = [("rhino horn", 100)]-  , icount   = 1  -- single, unlike real horns-  , iverbHit = "gore"-  , idamage  = 5 `d` 1-  , iaspects = [Timeout 5, AddSkill SkHurtMelee 20]-               ++ iaspects fist-  , ieffects = [Impress, Yell]  -- the owner is a mid-boss, after all-  , idesc    = "Very solid, considering it has the same composition as fingernails."-  }-tentacle = fist-  { iname    = "tentacle"-  , ifreq    = [("tentacle", 50)]-  , icount   = 4-  , iverbHit = "slap"-  , idamage  = 4 `d` 1-  , idesc    = "Damp and dextrous."-  }-thorn = fist-  { iname    = "thorn"-  , ifreq    = [("thorn", 100)]-  , icount   = 2 + 1 `d` 3-  , iverbHit = "puncture"-  , idamage  = 2 `d` 1-  , iaspects = [SetFlag Meleeable]  -- not Durable-  , ieffects = [VerbNoLonger "be not so thorny any more"]-  , idesc    = "Sharp yet brittle."-  }-boilingFissure = fist-  { iname    = "fissure"-  , ifreq    = [("boiling fissure", 100)]-  , icount   = 5 + 1 `d` 5-  , iverbHit = "hiss at"-  , idamage  = 1 `d` 1-  , iaspects = [ AddSkill SkHurtMelee 20  -- decreasing as count decreases-               , SetFlag Meleeable ]  -- not Durable-  , ieffects = [ DropItem 1 1 COrgan "condition"  -- useful; limited-               , VerbNoLonger "widen the crack, releasing pressure" ]-  , idesc    = "A deep crack to the underworld."-  }-arsenicFissure = boilingFissure-  { iname    = "fissure"-  , ifreq    = [("arsenic fissure", 100)]-  , icount   = 3 + 1 `d` 3-  , idamage  = 2 `d` 1-  , ieffects = [ toOrganBad "parsimonious" (5 + 1 `d` 3)-               -- weaken/poison, impacting intellectual abilities first-               , VerbNoLonger "stop exuding stupefying vapours" ]-  , idesc    = ""-  }-sulfurFissure = boilingFissure-  { iname    = "fissure"-  , ifreq    = [("sulfur fissure", 100)]-  , icount   = 2 + 1 `d` 2-  , idamage  = 0  -- heal not via (negative) idamage, for armour would block it-  , ieffects = [ RefillHP 5-               , VerbNoLonger "run out of the healing fumes" ]-  , idesc    = ""+largeJaw = fist+  { iname    = "large jaw"+  , ifreq    = [(S_LARGE_JAW, 1)]+  , icount   = 1+  , iverbHit = "crush"+  , idamage  = 10 `d` 1+  , iaspects = Timeout (2 + 1 `d` 2)  -- no effect, but limit raw damage+               : iaspects fist+  , idesc    = "Enough to swallow anything in a single gulp."   }++-- * Direct damage organs with effects+ beeSting = fist   { iname    = "bee sting"-  , ifreq    = [("bee sting", 100)]+  , ifreq    = [(S_BEE_STING, 1)]   , icount   = 1   , iverbHit = "sting"   , idamage  = 0@@ -203,51 +234,83 @@   } sting = fist   { iname    = "sting"-  , ifreq    = [("sting", 100)]+  , ifreq    = [(S_STING, 1)]   , icount   = 1   , iverbHit = "inject"   , idamage  = 1 `d` 1   , iaspects = [Timeout $ 10 - 1 `dL` 4, AddSkill SkHurtMelee 40]                ++ iaspects fist-  , ieffects = [toOrganBad "retaining" (3 + 1 `d` 3)]+  , ieffects = [toOrganBad S_RETAINING (3 + 1 `d` 3)]   , idesc    = "Painful, debilitating and harmful."   }+lip = fist+  { iname    = "lip"+  , ifreq    = [(S_LIP, 1)]+  , icount   = 1+  , iverbHit = "lap"+  , idamage  = 1 `d` 1+  , iaspects = Timeout (3 + 1 `d` 2)+               : iaspects fist+  , ieffects = [toOrganBad S_WEAKENED (2 + 1 `dL` 3)]+  , idesc    = ""+  } venomTooth = fist   { iname    = "venom tooth"-  , ifreq    = [("venom tooth", 100)]-  , icount   = 2+  , ifreq    = [(S_VENOM_TOOTH, 1)]   , iverbHit = "bite"   , idamage  = 1 `d` 1   , iaspects = Timeout (7 - 1 `dL` 3)                : iaspects fist-  , ieffects = [toOrganBad "slowed" (3 + 1 `d` 3)]+  , ieffects = [toOrganBad S_SLOWED (3 + 1 `d` 3)]   , idesc    = "A chilling numbness spreads from its bite."   }-venomFang = fist-  { iname    = "venom fang"-  , ifreq    = [("venom fang", 100)]-  , icount   = 2-  , iverbHit = "bite"-  , idamage  = 0-  , iaspects = Timeout (10 - 1 `dL` 5)+hookedClaw = fist+  { iname    = "hooked claw"+  , ifreq    = [(S_HOOKED_CLAW, 1)]+  , icount   = 2  -- even if more, only the fore claws used for fighting+  , iverbHit = "hook"+  , idamage  = 2 `d` 1+  , iaspects = Timeout (12 - 1 `dL` 3)                : iaspects fist-  , ieffects = [toOrganNoTimer "poisoned"]-  , idesc    = "Dripping with deadly venom."+  , ieffects = [toOrganBad S_SLOWED 2]+  , idesc    = "A curved talon."   } screechingBeak = fist   { iname    = "screeching beak"-  , ifreq    = [("screeching beak", 100)]+  , ifreq    = [(S_SCREECHING_BEAK, 1)]   , icount   = 1   , iverbHit = "peck"   , idamage  = 3 `d` 1   , iaspects = Timeout (7 - 1 `dL` 3)                : iaspects fist-  , ieffects = [Summon "scavenger" $ 1 `dL` 3]+  , ieffects = [Summon SCAVENGER $ 1 `dL` 3]   , idesc    = "Both a weapon and a beacon, calling more scavengers to the meal."   }+antler = fist+  { iname    = "antler"+  , ifreq    = [(S_ANTLER, 1)]+  , iverbHit = "ram"+  , idamage  = 4 `d` 1+  , iaspects = [ Timeout $ 3 + (1 `d` 3) * 3+               , AddSkill SkArmorMelee 10 ]  -- bonus doubled+               ++ iaspects fist+  , ieffects = [PushActor (ThrowMod 100 50 1)]  -- 1 step, slow+  , idesc    = ""+  }+rhinoHorn = fist+  { iname    = "ugly horn"  -- made of keratin, unlike real horns+  , ifreq    = [(S_RHINO_HORN, 1)]+  , icount   = 1  -- single, unlike real horns+  , iverbHit = "gore"+  , idamage  = 5 `d` 1+  , iaspects = [Timeout 5, AddSkill SkHurtMelee 20]+               ++ iaspects fist+  , ieffects = [Impress, Yell]  -- the owner is a mid-boss, after all+  , idesc    = "Very solid, considering it has the same composition as fingernails."+  } largeTail = fist   { iname    = "large tail"-  , ifreq    = [("large tail", 50)]+  , ifreq    = [(S_LARGE_TAIL, 1)]   , icount   = 1   , iverbHit = "knock"   , idamage  = 7 `d` 1@@ -259,7 +322,7 @@   } hugeTail = largeTail   { iname    = "huge tail"-  , ifreq    = [("huge tail", 50)]+  , ifreq    = [(S_HUGE_TAIL, 1)]   , iverbHit = "upend"   , iaspects = [Timeout $ 3 + 1 `d` 2, AddSkill SkHurtMelee 20]                ++ iaspects fist@@ -268,14 +331,60 @@   , idesc    = "Slow but immensely heavy."   } --- Non-weapons+-- * Melee weapons without direct damage +venomFang = fist+  { iname    = "venom fang"+  , ifreq    = [(S_VENOM_FANG, 1)]+  , iverbHit = "bite"+  , idamage  = 0+  , iaspects = Timeout (10 - 1 `dL` 5)+               : iaspects fist+  , ieffects = [toOrganNoTimer S_POISONED]+  , idesc    = "Dripping with deadly venom."+  }++-- * Special melee weapons++sulfurFissure = boilingFissure+  { iname    = "fissure"+  , ifreq    = [(S_SULFUR_FISSURE, 1)]+  , icount   = 2 + 1 `d` 2+  , idamage  = 0  -- heal not via (negative) idamage, for armour would block it+  , iaspects = SetFlag Benign : iaspects boilingFissure+  , ieffects = [ RefillHP 5+               , VerbNoLonger "run out of the healing fumes" "."]+  , idesc    = ""+  }+boilingFissure = fist+  { iname    = "fissure"+  , ifreq    = [(S_BOILING_FISSURE, 1)]+  , icount   = 5 + 1 `d` 5+  , iverbHit = "hiss at"+  , idamage  = 1 `d` 1+  , iaspects = [ AddSkill SkHurtMelee 20  -- decreasing as count decreases+               , SetFlag Meleeable ]  -- not Durable+  , ieffects = [ DropItem 1 1 COrgan CONDITION  -- useful; limited+               , VerbNoLonger "widen the crack, releasing pressure" "."]+  , idesc    = "A deep crack to the underworld."+  }+arsenicFissure = boilingFissure+  { iname    = "fissure"+  , ifreq    = [(S_ARSENIC_FISSURE, 1)]+  , icount   = 3 + 1 `d` 3+  , idamage  = 2 `d` 1+  , ieffects = [ toOrganBad S_PARSIMONIOUS (5 + 1 `d` 3)+               -- weaken/poison, impacting intellectual abilities first+               , VerbNoLonger "stop exuding stupefying vapours" "."]+  , idesc    = ""+  }+ -- * Armor organs  armoredSkin = ItemKind   { isymbol  = ','   , iname    = "armored skin"-  , ifreq    = [("armored skin", 100)]+  , ifreq    = [(S_ARMORED_SKIN, 1)]   , iflavour = zipPlain [Red]   , icount   = 1   , irarity  = [(1, 1)]@@ -290,65 +399,65 @@   } bark = armoredSkin   { iname    = "bark"-  , ifreq    = [("bark", 100)]+  , ifreq    = [(S_BARK, 1)]   , idesc    = ""   }  -- * Sense organs -eye :: Int -> ItemKind-eye n = armoredSkin+eye :: Int -> GroupName ItemKind -> ItemKind+eye n grp = armoredSkin   { iname    = "eye"-  , ifreq    = [(toGroupName $ "eye" <+> tshow n, 100)]+  , ifreq    = [(grp, 1)]   , icount   = 2   , iverbHit = "glare at"   , iaspects = [ AddSkill SkSight (intToDice n)                , SetFlag Durable ]   , idesc    = "A piercing stare."   }-eye3 = eye 3-eye6 = eye 6-eye8 = eye 8-vision :: Int -> ItemKind-vision n = armoredSkin+eye3 = eye 3 S_EYE_3+eye6 = eye 6 S_EYE_6+eye8 = eye 8 S_EYE_8+vision :: Int -> GroupName ItemKind -> ItemKind+vision n grp = armoredSkin   { iname    = "vision"-  , ifreq    = [(toGroupName $ "vision" <+> tshow n, 100)]+  , ifreq    = [(grp, 1)]   , iverbHit = "visualize"   , iaspects = [ AddSkill SkSight (intToDice n)                , SetFlag Durable ]   , idesc    = ""   }-vision6 = vision 6-vision12 = vision 12-vision16 = vision 16+vision6 = vision 6 S_VISION_6+vision12 = vision 12 S_VISION_12+vision16 = vision 16 S_VISION_16 nostril = armoredSkin   { iname    = "nostril"-  , ifreq    = [("nostril", 100)]+  , ifreq    = [(S_NOSTRIL, 1)]   , icount   = 2   , iverbHit = "snuff"   , iaspects = [ AddSkill SkSmell 1  -- times 2, from icount                , SetFlag Durable ]   , idesc    = ""   }-ear   :: Int -> ItemKind-ear n = armoredSkin+ear :: Int -> GroupName ItemKind -> ItemKind+ear n grp = armoredSkin   { iname    = "ear"-  , ifreq    = [(toGroupName $ "ear" <+> tshow n, 100)]+  , ifreq    = [(grp, 1)]   , icount   = 2   , iverbHit = "overhear"   , iaspects = [ AddSkill SkHearing (intToDice n)                , SetFlag Durable ]   , idesc    = ""   }-ear3 = ear 3-ear6 = ear 6-ear8 = ear 8+ear3 = ear 3 S_EAR_3+ear6 = ear 6 S_EAR_6+ear8 = ear 8 S_EAR_8  -- * Assorted  rattleOrgan = armoredSkin   { iname    = "rattle"-  , ifreq    = [("rattle", 100)]+  , ifreq    = [(S_RATLLE, 1)]   , iverbHit = "announce"   , iaspects = [ Timeout $ 10 + (1 `d` 3) * 10  -- long, to limit spam                , SetFlag Periodic, SetFlag Durable ]@@ -357,7 +466,7 @@   } insectMortality = armoredSkin   { iname    = "insect mortality"-  , ifreq    = [("insect mortality", 100)]+  , ifreq    = [(S_INSECT_MORTALITY, 1)]   , iverbHit = "age"   , iaspects = [ AddSkill SkAggression 2  -- try to attack before you die                , Timeout $ 30 + (1 `d` 3) * 10  -- die very slowly@@ -367,7 +476,7 @@   } sapientBrain = armoredSkin   { iname    = "sapient brain"-  , ifreq    = [("sapient brain", 100)]+  , ifreq    = [(S_SAPIENT_BRAIN, 1)]   , iverbHit = "outbrain"   , iaspects = [AddSkill sk 1 | sk <- [SkMove .. SkApply]]                ++ [AddSkill SkMove 4]  -- can move at once when waking up@@ -379,23 +488,25 @@   } animalBrain = armoredSkin   { iname    = "animal brain"-  , ifreq    = [("animal brain", 100)]+  , ifreq    = [(S_ANIMAL_BRAIN, 1)]   , iverbHit = "blank"   , iaspects = [AddSkill sk 1 | sk <- [SkMove .. SkApply]]                ++ [AddSkill SkMove 4]  -- can move at once when waking up                ++ [AddSkill SkAlter 2]  -- can use normal stairs; can't dig                ++ [AddSkill SkWait 2]  -- can brace and sleep-               -- No @SkAppy@ bonus, so can only apply foods.+               -- No @SkApply@ bonus, so can only apply foods. Note, however,+               -- that AI doesn't risk applying unIded items, so in early+               -- game animals won't eat anything.                ++ [AddSkill SkDisplace (-1)]  -- no melee tactics                ++ [AddSkill SkMoveItem (-1)]  -- no item gathering                ++ [AddSkill SkProject (-1)]  -- nor item flinging                ++ [SetFlag Durable]   , idesc    = ""   }-speedGland :: Int -> ItemKind-speedGland n = armoredSkin+speedGland :: Int -> GroupName ItemKind -> ItemKind+speedGland n grp = armoredSkin   { iname    = "speed gland"-  , ifreq    = [(toGroupName $ "speed gland" <+> tshow n, 100)]+  , ifreq    = [(grp, 1)]   , iverbHit = "spit at"   , iaspects = [ AddSkill SkSpeed $ intToDice n                , Timeout $ intToDice (100 `div` n)@@ -403,50 +514,50 @@   , ieffects = [RefillHP 1]   , idesc    = ""   }-speedGland5 = speedGland 5-speedGland10 = speedGland 10+speedGland5 = speedGland 5 S_SPEED_GLAND_5+speedGland10 = speedGland 10 S_SPEED_GLAND_10 scentGland = armoredSkin   { iname    = "scent gland"-  , ifreq    = [("scent gland", 100)]+  , ifreq    = [(S_SCENT_GLAND, 1)]   , icount   = 10 + 1 `d` 3  -- runs out   , iverbHit = "spray at"   , iaspects = [ Timeout $ (1 `d` 3) * 10                , SetFlag Periodic, SetFlag Fragile ]  -- not Durable-  , ieffects = [ VerbNoLonger "look spent"+  , ieffects = [ VerbNoLonger "look spent" "."                , ApplyPerfume-               , Explode "distressing odor" ]+               , Explode S_DISTRESSING_ODOR ]                    -- keep explosion at the end to avoid the ambiguity of                    -- "of ([foo explosion] of [bar])"   , idesc    = ""   }-boilingVent = armoredSkin+sulfurVent = armoredSkin   { iname    = "vent"-  , ifreq    = [("boiling vent", 100)]-  , iflavour = zipPlain [Blue]+  , ifreq    = [(S_SULFUR_VENT, 1)]+  , iflavour = zipPlain [BrYellow]   , iverbHit = "menace"   , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5                , SetFlag Periodic, SetFlag Durable ]-  , ieffects = [RefillHP 2, Explode "boiling water"]+  , ieffects = [RefillHP 2, Explode S_DENSE_SHOWER]   , idesc    = ""   }-arsenicVent = armoredSkin+boilingVent = armoredSkin   { iname    = "vent"-  , ifreq    = [("arsenic vent", 100)]-  , iflavour = zipPlain [Cyan]+  , ifreq    = [(S_BOILING_VENT, 1)]+  , iflavour = zipPlain [Blue]   , iverbHit = "menace"   , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5                , SetFlag Periodic, SetFlag Durable ]-  , ieffects = [RefillHP 2, Explode "sparse shower"]+  , ieffects = [RefillHP 2, Explode S_BOILING_WATER]   , idesc    = ""   }-sulfurVent = armoredSkin+arsenicVent = armoredSkin   { iname    = "vent"-  , ifreq    = [("sulfur vent", 100)]-  , iflavour = zipPlain [BrYellow]+  , ifreq    = [(S_ARSENIC_VENT, 1)]+  , iflavour = zipPlain [Cyan]   , iverbHit = "menace"   , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5                , SetFlag Periodic, SetFlag Durable ]-  , ieffects = [RefillHP 2, Explode "dense shower"]+  , ieffects = [RefillHP 2, Explode S_SPARSE_SHOWER]   , idesc    = ""   } @@ -455,7 +566,7 @@ bonusHP = armoredSkin   { isymbol  = 'H'  -- '+' reserved for conditions   , iname    = "bonus HP"-  , ifreq    = [("bonus HP", 1)]+  , ifreq    = [(S_BONUS_HP, 1)]   , iflavour = zipPlain [BrBlue]   , iverbHit = "intimidate"   , iweight  = 0@@ -465,7 +576,7 @@ braced = armoredSkin   { isymbol  = 'B'   , iname    = "braced"-  , ifreq    = [("braced", 1)]+  , ifreq    = [(S_BRACED, 1)]   , iflavour = zipPlain [BrGreen]   , iverbHit = "brace"   , iweight  = 0@@ -477,7 +588,7 @@ asleep = armoredSkin   { isymbol  = 'S'   , iname    = "asleep"-  , ifreq    = [("asleep", 1)]+  , ifreq    = [(S_ASLEEP, 1)]   , iflavour = zipPlain [BrGreen]  -- regenerates HP (very slowly)   , icount   = 5   , iverbHit = "slay"@@ -490,15 +601,15 @@   } impressed = armoredSkin   { isymbol  = 'I'-  , iname    = "impressed"-  , ifreq    = [("impressed", 1), ("condition", 1)]+  , iname    = "impressed"  -- keep the same as in @ifreq@, to simplify code+  , ifreq    = [(S_IMPRESSED, 1), (CONDITION, 1)]   , iflavour = zipPlain [BrRed]   , iverbHit = "confuse"   , iweight  = 0   , iaspects = [ AddSkill SkMaxCalm (-1)  -- to help player notice on HUD                                           -- and to count as bad condition                , SetFlag Fragile  -- to announce "no longer" only when-                                  -- all impressions gone+                                  -- all copies gone                , SetFlag Condition ]  -- this is really a condition,                                       -- just not a timed condition   , ieffects = [ OnSmash $ verbMsgLess "impressed"@@ -511,7 +622,7 @@  tooth = fist   { iname    = "tooth"-  , ifreq    = [("tooth", 20)]+  , ifreq    = [(S_TOOTH, 1)]   , icount   = 3   , iverbHit = "nail"   , idamage  = 2 `d` 1@@ -519,62 +630,43 @@   } lash = fist   { iname    = "lash"-  , ifreq    = [("lash", 100)]+  , ifreq    = [(S_LASH, 1)]   , icount   = 1   , iverbHit = "lash"   , idamage  = 3 `d` 1   , idesc    = ""   }-noseTip = fist-  { iname    = "tip"-  , ifreq    = [("nose tip", 50)]-  , icount   = 1-  , iverbHit = "poke"-  , idamage  = 2 `d` 1-  , idesc    = ""-  }-lip = fist-  { iname    = "lip"-  , ifreq    = [("lip", 10)]-  , icount   = 1-  , iverbHit = "lap"-  , idamage  = 1 `d` 1-  , iaspects = Timeout (3 + 1 `d` 2)-               : iaspects fist-  , ieffects = [toOrganBad "weakened" (2 + 1 `dL` 3)]-  , idesc    = ""-  } torsionRight = fist   { iname    = "right torsion"-  , ifreq    = [("right torsion", 100)]+  , ifreq    = [(S_RIGHT_TORSION, 1)]   , icount   = 1   , iverbHit = "twist"   , idamage  = 13 `d` 1   , iaspects = [Timeout $ 5 + 1 `d` 5, AddSkill SkHurtMelee 20]                ++ iaspects fist-  , ieffects = [toOrganBad "slowed" (3 + 1 `d` 3)]+  , ieffects = [toOrganBad S_SLOWED (3 + 1 `d` 3)]   , idesc    = ""   } torsionLeft = fist   { iname    = "left torsion"-  , ifreq    = [("left torsion", 100)]+  , ifreq    = [(S_LEFT_TORSION, 1)]   , icount   = 1   , iverbHit = "untwist"   , idamage  = 13 `d` 1   , iaspects = [Timeout $ 5 + 1 `d` 5, AddSkill SkHurtMelee 20]                ++ iaspects fist-  , ieffects = [toOrganBad "weakened" (3 + 1 `d` 3)]+  , ieffects = [toOrganBad S_WEAKENED (3 + 1 `d` 3)]   , idesc    = ""   } pupil = fist   { iname    = "pupil"-  , ifreq    = [("pupil", 100)]+  , ifreq    = [(S_PUPIL, 1)]   , icount   = 1   , iverbHit = "gaze at"   , idamage  = 1 `d` 1   , iaspects = [AddSkill SkSight 12, Timeout 12]                ++ iaspects fist-  , ieffects = [DropItem 1 maxBound COrgan "condition", RefillCalm (-10)]+  , ieffects = [DropItem 1 maxBound COrgan CONDITION, RefillCalm (-10)]                  -- can be useful for the player, but Calm drain is a risk   , idesc    = ""   }

GameDefinition/Content/ItemKindTemporary.hs view

@@ -1,6 +1,12 @@ -- | Temporary pseudo-organ (condition) definitions. module Content.ItemKindTemporary-  ( temporaries+  ( -- * Group name patterns+    pattern S_IMMOBILE, pattern S_PACIFIED, pattern S_IRREPLACEABLE, pattern S_RETAINING, pattern S_IMPATIENT, pattern S_DISPOSSESSED, pattern S_WITHHOLDING, pattern S_PARSIMONIOUS+  , pattern S_MORE_MOBILE, pattern S_MORE_COMBATIVE, pattern S_MORE_DISPLACING, pattern S_MORE_MODIFYING, pattern S_MORE_PATIENT, pattern S_MORE_TIDY, pattern S_MORE_PROJECTING, pattern S_MORE_PRACTICAL+  , pattern S_STRENGTHENED, pattern S_WEAKENED, pattern S_PROTECTED_FROM_MELEE, pattern S_PROTECTED_FROM_RANGED, pattern S_DEFENSELESS, pattern S_RESOLUTE, pattern S_HASTED, pattern S_SLOWED, pattern S_FAR_SIGHTED, pattern S_BLIND, pattern S_KEEN_SMELLING, pattern S_FOUL_SMELLING, pattern S_ROSE_SMELLING, pattern S_RANGED_DEFLECTING, pattern S_MELEE_DEFLECTING, pattern S_SHINY_EYED, pattern S_DEAFENED, pattern S_DEAF, pattern S_DRUNK, pattern S_FRENZIED, pattern S_REGENERATING, pattern S_POISONED, pattern S_SLOW_RESISTANT, pattern S_POISON_RESISTANT+  , temporariesGNSingleton, noStatGN, bonusStatGN+  , -- * Content+    temporaries   ) where  import Prelude ()@@ -14,116 +20,190 @@ import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour +-- * Group name patterns++noStatGN :: [GroupName ItemKind]+noStatGN =+       [S_IMMOBILE, S_PACIFIED, S_IRREPLACEABLE, S_RETAINING, S_IMPATIENT, S_DISPOSSESSED, S_WITHHOLDING, S_PARSIMONIOUS]++bonusStatGN :: [GroupName ItemKind]+bonusStatGN =+       [S_MORE_MOBILE, S_MORE_COMBATIVE, S_MORE_DISPLACING, S_MORE_MODIFYING, S_MORE_PATIENT, S_MORE_TIDY, S_MORE_PROJECTING, S_MORE_PRACTICAL]++temporariesGNSingleton :: [GroupName ItemKind]+temporariesGNSingleton =+       [S_STRENGTHENED, S_WEAKENED, S_PROTECTED_FROM_MELEE, S_PROTECTED_FROM_RANGED, S_DEFENSELESS, S_RESOLUTE, S_HASTED, S_SLOWED, S_FAR_SIGHTED, S_BLIND, S_KEEN_SMELLING, S_FOUL_SMELLING, S_ROSE_SMELLING, S_RANGED_DEFLECTING, S_MELEE_DEFLECTING, S_SHINY_EYED, S_DEAFENED, S_DEAF, S_DRUNK, S_FRENZIED, S_REGENERATING, S_POISONED, S_SLOW_RESISTANT, S_POISON_RESISTANT]+    ++ noStatGN ++ bonusStatGN++pattern S_IMMOBILE, S_PACIFIED, S_IRREPLACEABLE, S_RETAINING, S_IMPATIENT, S_DISPOSSESSED, S_WITHHOLDING, S_PARSIMONIOUS :: GroupName ItemKind++pattern S_MORE_MOBILE, S_MORE_COMBATIVE, S_MORE_DISPLACING, S_MORE_MODIFYING, S_MORE_PATIENT, S_MORE_TIDY, S_MORE_PROJECTING, S_MORE_PRACTICAL :: GroupName ItemKind++pattern S_STRENGTHENED, S_WEAKENED, S_PROTECTED_FROM_MELEE, S_PROTECTED_FROM_RANGED, S_DEFENSELESS, S_RESOLUTE, S_HASTED, S_SLOWED, S_FAR_SIGHTED, S_BLIND, S_KEEN_SMELLING, S_FOUL_SMELLING, S_ROSE_SMELLING, S_RANGED_DEFLECTING, S_MELEE_DEFLECTING, S_SHINY_EYED, S_DEAFENED, S_DEAF, S_DRUNK, S_FRENZIED, S_REGENERATING, S_POISONED, S_SLOW_RESISTANT, S_POISON_RESISTANT :: GroupName ItemKind++pattern S_STRENGTHENED = GroupName "strengthened"+pattern S_WEAKENED = GroupName "weakened"+pattern S_PROTECTED_FROM_MELEE = GroupName "protected from melee"+pattern S_PROTECTED_FROM_RANGED = GroupName "protected from ranged"+pattern S_DEFENSELESS = GroupName "defenseless"+pattern S_RESOLUTE = GroupName "resolute"+pattern S_HASTED = GroupName "hasted"+pattern S_SLOWED = GroupName "slowed"+pattern S_FAR_SIGHTED = GroupName "far-sighted"+pattern S_BLIND = GroupName "blind"+pattern S_KEEN_SMELLING = GroupName "keen-smelling"+pattern S_FOUL_SMELLING = GroupName "foul-smelling"+pattern S_ROSE_SMELLING = GroupName "rose-smelling"+pattern S_RANGED_DEFLECTING = GroupName "ranged-deflecting"+pattern S_MELEE_DEFLECTING = GroupName "melee-deflecting"+pattern S_SHINY_EYED = GroupName "shiny-eyed"+pattern S_DEAFENED = GroupName "deafened"+pattern S_DEAF = GroupName "deaf"+pattern S_DRUNK = GroupName "drunk"+pattern S_FRENZIED = GroupName "frenzied"+pattern S_REGENERATING = GroupName "regenerating"+pattern S_POISONED = GroupName "poisoned"+pattern S_SLOW_RESISTANT = GroupName "slow resistant"+pattern S_POISON_RESISTANT = GroupName "poison resistant"+pattern S_IMMOBILE = GroupName "immobile"+pattern S_PACIFIED = GroupName "pacified"+pattern S_IRREPLACEABLE = GroupName "irreplaceable"+pattern S_RETAINING = GroupName "retaining"+pattern S_IMPATIENT = GroupName "impatient"+pattern S_DISPOSSESSED = GroupName "dispossessed"+pattern S_WITHHOLDING = GroupName "withholding"+pattern S_PARSIMONIOUS = GroupName "parsimonious"+pattern S_MORE_MOBILE = GroupName "super-mobile"+pattern S_MORE_COMBATIVE = GroupName "super-combative"+pattern S_MORE_DISPLACING = GroupName "super-displacing"+pattern S_MORE_MODIFYING = GroupName "super-modifying"+pattern S_MORE_PATIENT = GroupName "super-patient"+pattern S_MORE_TIDY = GroupName "super-tidy"+pattern S_MORE_PROJECTING = GroupName "super-projecting"+pattern S_MORE_PRACTICAL = GroupName "super-practical"++-- * Content+ temporaries :: [ItemKind] temporaries =-  [tmpStrengthened, tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpVulnerable, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant]+  [tmpStrengthened, tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpDefenseless, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpRangedDeflecting, tmpMeleeDeflecting, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply] -tmpStrengthened,    tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpVulnerable, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant :: ItemKind+tmpStrengthened,    tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpDefenseless, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpRangedDeflecting, tmpMeleeDeflecting, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply :: ItemKind  -- The @name@ is be used in item description, so it should be an adjective -- describing the temporary set of aspects. -- The messages are needed also under @OnSmash@ to display when item removed -- via @DropItem@ and not via natural periodic activation.-tmpAspects :: Text -> [Aspect] -> ItemKind-tmpAspects name aspects = ItemKind-  { isymbol  = '+'-  , iname    = name-  , ifreq    = [(toGroupName name, 1), ("condition", 1)]-  , iflavour = zipPlain [BrWhite]-  , icount   = 1-  , irarity  = [(1, 1)]-  , iverbHit = "affect"-  , iweight  = 0-  , idamage  = 0-  , iaspects = -- timeout is 0; activates and vanishes soon,-               -- depending on initial timer setting-               aspects ++ [SetFlag Periodic, SetFlag Fragile, SetFlag Condition]-  , ieffects = [ OnSmash $ verbMsgLess name  -- announce partial neutralization-               -- not spamming for normal periodic wear each turn-               , OnSmash $ verbMsgNoLonger name  -- for forced neutralization-               , verbMsgNoLonger name ]  -- for periodic wear of last copy-  , idesc    = ""  -- no description needed; powers are enough-  , ikit     = []-  }+tmpAspects :: GroupName ItemKind -> [Aspect] -> ItemKind+tmpAspects grp aspects =+  let name = fromGroupName grp  -- @iname@ must match @ifreq@, see @myBadGrps@+  in ItemKind+    { isymbol  = '+'+    , iname    = name+    , ifreq    = [(grp, 1), (CONDITION, 1)]+    , iflavour = zipPlain [BrWhite]+    , icount   = 1+    , irarity  = [(1, 1)]+    , iverbHit = "affect"+    , iweight  = 0+    , idamage  = 0+    , iaspects = -- timeout is 0; activates and vanishes soon,+                 -- depending on initial timer setting+                 aspects+                 ++ [SetFlag Periodic, SetFlag Fragile, SetFlag Condition]+    , ieffects = [ OnSmash $ verbMsgLess name+                   -- announce partial neutralization, but don't spam+                   -- about normal periodic wear each turn+                 , OnSmash $ verbMsgNoLonger name  -- for forced neutralization+                 , verbMsgNoLonger name ]  -- for periodic wear of last copy+    , idesc    = ""  -- no description needed; powers are enough+    , ikit     = []+    } -tmpEffects :: Text -> Dice -> [Effect] -> ItemKind-tmpEffects name icount effects =-  let tmp = tmpAspects name []+tmpEffects :: GroupName ItemKind -> Dice -> [Effect] -> ItemKind+tmpEffects grp icount effects =+  let tmp = tmpAspects grp []   in tmp { icount          , ieffects = effects ++ ieffects tmp          } -tmpStrengthened = tmpAspects "strengthened" [AddSkill SkHurtMelee 20]-tmpWeakened = tmpAspects "weakened"+tmpStrengthened = tmpAspects S_STRENGTHENED [AddSkill SkHurtMelee 20]+tmpWeakened = tmpAspects S_WEAKENED                          [AddSkill SkHurtMelee (-30)]  -- don't cancel out ^-tmpProtectedMelee = tmpAspects "protected from melee"+tmpProtectedMelee = tmpAspects S_PROTECTED_FROM_MELEE                                [AddSkill SkArmorMelee 50]-tmpProtectedRanged = tmpAspects "protected from ranged"+tmpProtectedRanged = tmpAspects S_PROTECTED_FROM_RANGED                                 [AddSkill SkArmorRanged 25]-tmpVulnerable = tmpAspects "defenseless" [ AddSkill SkArmorMelee (-50)-                                         , AddSkill SkArmorRanged (-25) ]-tmpResolute = tmpAspects "resolute" [AddSkill SkMaxCalm 60]-tmpFast20 = tmpAspects "hasted" [AddSkill SkSpeed 20]-tmpSlow10 = tmpAspects "slowed" [AddSkill SkSpeed (-10)]-tmpFarSighted = tmpAspects "far-sighted" [AddSkill SkSight 5]-tmpBlind = tmpAspects "blind" [AddSkill SkSight (-99)]-tmpKeenSmelling = tmpAspects "keen-smelling" [AddSkill SkSmell 2]-tmpFoulSmelling = tmpAspects "foul-smelling" [AddSkill SkOdor 2]-tmpRoseSmelling = tmpAspects "rose-smelling" [AddSkill SkOdor (-4)]-tmpNoctovision = tmpAspects "shiny-eyed" [AddSkill SkNocto 2]-tmpDeafened = tmpAspects "deafened" [AddSkill SkHearing (-10)]-tmpDeaf = tmpAspects "deaf" [AddSkill SkHearing (-99)]-tmpDrunk = tmpAspects "drunk" [ AddSkill SkHurtMelee 30  -- fury-                              , AddSkill SkArmorMelee (-20)-                              , AddSkill SkArmorRanged (-20)-                              , AddSkill SkSight (-8)-                              ]+tmpDefenseless = tmpAspects S_DEFENSELESS [ AddSkill SkArmorMelee (-50)+                                          , AddSkill SkArmorRanged (-25) ]+tmpResolute = tmpAspects S_RESOLUTE [AddSkill SkMaxCalm 60]+tmpFast20 = tmpAspects S_HASTED [AddSkill SkSpeed 20]+tmpSlow10 = tmpAspects S_SLOWED [AddSkill SkSpeed (-10)]+tmpFarSighted = tmpAspects S_FAR_SIGHTED [AddSkill SkSight 5]+tmpBlind = tmpAspects S_BLIND [ AddSkill SkSight (-99)+                              , AddSkill SkArmorMelee (-30) ]+tmpKeenSmelling = tmpAspects S_KEEN_SMELLING [AddSkill SkSmell 2]+tmpFoulSmelling = tmpAspects S_FOUL_SMELLING [AddSkill SkOdor 2]+tmpRoseSmelling = tmpAspects S_ROSE_SMELLING [AddSkill SkOdor (-4)]+tmpRangedDeflecting =+  tmpAspects S_RANGED_DEFLECTING [AddSkill SkDeflectRanged 1]+tmpMeleeDeflecting =+  tmpAspects S_MELEE_DEFLECTING [AddSkill SkDeflectMelee 1]+tmpNoctovision = tmpAspects S_SHINY_EYED [AddSkill SkNocto 2]+tmpDeafened = tmpAspects S_DEAFENED [AddSkill SkHearing (-6)]+tmpDeaf = tmpAspects S_DEAF [ AddSkill SkHearing (-99)+                            , AddSkill SkArmorMelee (-30) ]+tmpDrunk = tmpAspects S_DRUNK [ AddSkill SkHurtMelee 30  -- fury+                              , AddSkill SkArmorRanged (-30)+                              , AddSkill SkSight (-8) ]+ tmpBonusSkAggresion =-  tmpAspects "frenzied" [AddSkill SkAggression 5]+  tmpAspects S_FRENZIED [ AddSkill SkAggression 5+                        , AddSkill SkArmorMelee (-30) ] +tmpRegenerating =+  tmpEffects S_REGENERATING (4 + 1 `d` 2) [RefillHP 1]+tmpPoisoned =+  tmpEffects S_POISONED (3 + 1 `d` 2) [RefillHP (-1)]+tmpSlow10Resistant =+  tmpEffects S_SLOW_RESISTANT (8 + 1 `d` 4)+             [DropItem 1 1 COrgan S_SLOWED]+tmpPoisonResistant =+  tmpEffects S_POISON_RESISTANT (8 + 1 `d` 4)+             [DropItem 1 maxBound COrgan S_POISONED]+ tmpNoSkMove =-  tmpAspects "immobile" [AddSkill SkMove (-99)]+  tmpAspects S_IMMOBILE [AddSkill SkMove (-99)] tmpNoSkMelee =-  tmpAspects "pacified" [AddSkill SkMelee (-99)]+  tmpAspects S_PACIFIED [AddSkill SkMelee (-99)] tmpNoSkDisplace =-  tmpAspects "irreplaceable" [AddSkill SkDisplace (-99)]+  tmpAspects S_IRREPLACEABLE [AddSkill SkDisplace (-99)] tmpNoSkAlter =-  tmpAspects "retaining" [AddSkill SkAlter (-99)]+  tmpAspects S_RETAINING [AddSkill SkAlter (-99)] tmpNoSkWait =-  tmpAspects "impatient" [AddSkill SkWait (-99)]+  tmpAspects S_IMPATIENT [AddSkill SkWait (-99)] tmpNoSkMoveItem =-  tmpAspects "dispossessed" [AddSkill SkMoveItem (-99)]+  tmpAspects S_DISPOSSESSED [AddSkill SkMoveItem (-99)] tmpNoSkProject =-  tmpAspects "withholding" [AddSkill SkProject (-99)]+  tmpAspects S_WITHHOLDING [AddSkill SkProject (-99)] tmpNoSkApply =-  tmpAspects "parsimonious" [AddSkill SkApply (-99)]+  tmpAspects S_PARSIMONIOUS [AddSkill SkApply (-99)]  tmpBonusSkMove =-  tmpAspects "more mobile" [AddSkill SkMove 5]+  tmpAspects S_MORE_MOBILE [AddSkill SkMove 5] tmpBonusSkMelee =-  tmpAspects "more combative" [AddSkill SkMelee 5]+  tmpAspects S_MORE_COMBATIVE [AddSkill SkMelee 5] tmpBonusSkDisplace =-  tmpAspects "more displacing" [AddSkill SkDisplace 5]+  tmpAspects S_MORE_DISPLACING [AddSkill SkDisplace 5] tmpBonusSkAlter =-  tmpAspects "more altering" [AddSkill SkAlter 5]+  tmpAspects S_MORE_MODIFYING [AddSkill SkAlter 5] tmpBonusSkWait =-  tmpAspects "more patient" [AddSkill SkWait 5]+  tmpAspects S_MORE_PATIENT [AddSkill SkWait 5] tmpBonusSkMoveItem =-  tmpAspects "more tidy" [AddSkill SkMoveItem 5]+  tmpAspects S_MORE_TIDY [AddSkill SkMoveItem 5] tmpBonusSkProject =-  tmpAspects "more projecting" [AddSkill SkProject 8]-    -- TODO: 11, but let player control potion throwing by henchmen;+  tmpAspects S_MORE_PROJECTING [AddSkill SkProject 8]+    -- TODO: 11, but let player control potion throwing by non-pointmen;     -- beware also of capReinforced and other sources of the skill tmpBonusSkApply =-  tmpAspects "more practical" [AddSkill SkApply 5]--tmpRegenerating =-  tmpEffects "regenerating" (4 + 1 `d` 2) [RefillHP 1]-tmpPoisoned =-  tmpEffects "poisoned" (4 + 1 `d` 2) [RefillHP (-1)]-tmpSlow10Resistant =-  tmpEffects "slow resistant" (8 + 1 `d` 4)-             [DropItem 1 1 COrgan "slowed"]-tmpPoisonResistant =-  tmpEffects "poison resistant" (8 + 1 `d` 4)-             [DropItem 1 maxBound COrgan "poisoned"]+  tmpAspects S_MORE_PRACTICAL [AddSkill SkApply 5]

GameDefinition/Content/ModeKind.hs view

@@ -1,23 +1,74 @@--- | Game mode definitions.+-- | The type of game mode definitions. module Content.ModeKind-  ( content+  ( -- * Group names+    groupNamesSingleton, groupNames+  , -- * Content+    content+#ifdef EXPOSE_INTERNAL+  -- * Group name patterns+  , pattern RAID, pattern BRAWL, pattern LONG, pattern CRAWL, pattern FOGGY, pattern SHOOTOUT, pattern PERILOUS, pattern HUNT, pattern NIGHT, pattern ESCAPE, pattern BURNING, pattern ZOO, pattern RANGED, pattern AMBUSH, pattern SAFARI, pattern DIG, pattern SEE, pattern SHORT, pattern CRAWL_EMPTY, pattern CRAWL_SURVIVAL, pattern SAFARI_SURVIVAL, pattern BATTLE, pattern BATTLE_DEFENSE, pattern BATTLE_SURVIVAL, pattern DEFENSE, pattern DEFENSE_EMPTY+#endif   ) where  import Prelude ()  import Game.LambdaHack.Core.Prelude +import qualified Data.Text as T++import Content.CaveKind hiding (content, groupNames, groupNamesSingleton)+import Content.ItemKindActor import Content.ModeKindPlayer-import Game.LambdaHack.Content.CaveKind (CaveKind)+import Game.LambdaHack.Content.CaveKind (CaveKind, pattern DEFAULT_RANDOM) import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Defs +-- * Group name patterns++groupNamesSingleton :: [GroupName ModeKind]+groupNamesSingleton =+       [RAID, BRAWL, LONG, CRAWL, FOGGY, SHOOTOUT, PERILOUS, HUNT, NIGHT, ESCAPE, BURNING, ZOO, RANGED, AMBUSH, SAFARI, DIG, SEE, SHORT, CRAWL_EMPTY, CRAWL_SURVIVAL, SAFARI_SURVIVAL, BATTLE, BATTLE_DEFENSE, BATTLE_SURVIVAL, DEFENSE, DEFENSE_EMPTY]++pattern RAID, BRAWL, LONG, CRAWL, FOGGY, SHOOTOUT, PERILOUS, HUNT, NIGHT, ESCAPE, BURNING, ZOO, RANGED, AMBUSH, SAFARI, DIG, SEE, SHORT, CRAWL_EMPTY, CRAWL_SURVIVAL, SAFARI_SURVIVAL, BATTLE, BATTLE_DEFENSE, BATTLE_SURVIVAL, DEFENSE, DEFENSE_EMPTY :: GroupName ModeKind++groupNames :: [GroupName ModeKind]+groupNames = [NO_CONFIRMS]++pattern RAID = GroupName "raid"+pattern BRAWL = GroupName "brawl"+pattern LONG = GroupName "long crawl"+pattern CRAWL = GroupName "crawl"+pattern FOGGY = GroupName "foggy shootout"+pattern SHOOTOUT = GroupName "shootout"+pattern PERILOUS = GroupName "perilous hunt"+pattern HUNT = GroupName "hunt"+pattern NIGHT = GroupName "night escape"+pattern ESCAPE = GroupName "escape"+pattern BURNING = GroupName "burning zoo"+pattern ZOO = GroupName "zoo"+pattern RANGED = GroupName "ranged ambush"+pattern AMBUSH = GroupName "ambush"+pattern SAFARI = GroupName "safari"+pattern DIG = GroupName "dig"+pattern SEE = GroupName "see"+pattern SHORT = GroupName "short"+pattern CRAWL_EMPTY = GroupName "crawlEmpty"  -- only the first word matters+pattern CRAWL_SURVIVAL = GroupName "crawlSurvival"+pattern SAFARI_SURVIVAL = GroupName "safariSurvival"+pattern BATTLE = GroupName "battle"+pattern BATTLE_DEFENSE = GroupName "battleDefense"+pattern BATTLE_SURVIVAL = GroupName "battleSurvival"+pattern DEFENSE = GroupName "defense"+pattern DEFENSE_EMPTY = GroupName "defenseEmpty"++-- * Content+ content :: [ModeKind] content =-  [raid, brawl, shootout, hunt, escape, zoo, ambush, crawl, crawlEmpty, crawlSurvival, dig, see, safari, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverRaid, screensaverBrawl, screensaverShootout, screensaverHunt, screensaverEscape, screensaverZoo, screensaverAmbush, screensaverCrawl, screensaverSafari]+  [raid, brawl, crawl, shootout, hunt, escape, zoo, ambush, safari, dig, see, short, crawlEmpty, crawlSurvival, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverRaid, screensaverBrawl, screensaverCrawl, screensaverShootout, screensaverHunt, screensaverEscape, screensaverZoo, screensaverAmbush, screensaverSafari] -raid,    brawl, shootout, hunt, escape, zoo, ambush, crawl, crawlEmpty, crawlSurvival, dig, see, safari, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverRaid, screensaverBrawl, screensaverShootout, screensaverHunt, screensaverEscape, screensaverZoo, screensaverAmbush, screensaverCrawl, screensaverSafari :: ModeKind+raid,    brawl, crawl, shootout, hunt, escape, zoo, ambush, safari, dig, see, short, crawlEmpty, crawlSurvival, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverRaid, screensaverBrawl, screensaverCrawl, screensaverShootout, screensaverHunt, screensaverEscape, screensaverZoo, screensaverAmbush, screensaverSafari :: ModeKind  -- What other symmetric (two only-one-moves factions) and asymmetric vs crowd -- scenarios make sense (e.g., are good for a tutorial or for standalone@@ -32,28 +83,68 @@ -- crowd ranged: no, fish in a barrel, less predictable and more fun inside --   crawl, even without reaction fire -raid = ModeKind  -- mini-crawl+raid = ModeKind   { msymbol = 'r'-  , mname   = "solo raid (1)"-  , mfreq   = [("solo", 1), ("raid", 1), ("campaign scenario", 1)]+  , mname   = "raid (tutorial, 1)"+  , mfreq   = [(RAID, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = True   , mroster = rosterRaid   , mcaves  = cavesRaid   , mendMsg = [ (Killed, "This expedition has gone wrong. However, scientific mind does not despair, but analyzes and corrects. Did you perchance awake one animal too many? Did you remember to try using all consumables at your disposal for your immediate survival? Did you choose a challenge with difficulty level within your means? Answer honestly, ponder wisely, experiment methodically.")               , (Defeated, "Regrettably, the other team snatched the grant, while you were busy contemplating natural phenomena. Science is a competitive sport, as sad as it sounds. It's not enough to make a discovery, you have to get there first.")               , (Escape, "You've got hold of the machine! Think of the hours of fun taking it apart and putting it back together again! That's a great first step on your quest to solve the typing problems of the world.") ]+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Two heroes vs. Spawned enemies"+      , "* Gather gold"+      , "* Find exit and escape ASAP"+      ]   , mdesc   = "An incredibly advanced typing machine worth 100 gold is buried at the exit of this maze. Be the first to find it and fund a research team that makes typing accurate and dependable forever."+  , mreason = "In addition to initiating the (loose) game plot, this adventure provides an introductory tutorial. Relax, explore, gather loot, find the exit and escape. With some luck, you won't even need to fight anything."+  , mhint   = "You can't use gathered items in your next encounters, so trigger any consumables at will. Feel free to scout with only one of the heroes and keep the other one immobile, e.g., standing guard over the squad's shared inventory stash. If in grave danger, retreat with the scout to join forces with the guard. The more gold collected and the faster the victory, the higher your score in this encounter."   }  brawl = ModeKind  -- sparse melee in daylight, with shade for melee ambush   { msymbol = 'k'-  , mname   = "melee brawl (2)"-  , mfreq   = [("melee", 1), ("brawl", 1), ("campaign scenario", 1)]+  , mname   = "brawl (tutorial, 2)"+  , mfreq   = [(BRAWL, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = True   , mroster = rosterBrawl   , mcaves  = cavesBrawl-  , mendMsg = []-  , mdesc   = "Your engineering team disagrees over a drink with some gentlemen scientists about premises of a relative completeness theorem and there's only one way to settle that. Remember to keep your party together, or the opposing team might be tempted to gang upon a solitary disputant."+  , mendMsg = [ (Killed, "The inquisitive scholars turned out to be envious of our deep insight to the point of outright violence. It would still not result in such a defeat and recanting of our thesis if we figured out to use terrain to protect us from missiles or even completely hide our presence. It would also help if we honourably kept our ground together to the end, at the same time preventing the overwhelming enemy forces from brutishly ganging up on our modest-sized, though valiant, research team.")+              , (Conquer, "That's settled: local compactness *is* necessary for relative completeness, given the assumptions.") ]+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Three heroes vs. Three human enemies"+      , "* Minimize losses"+      , "* Incapacitate all enemies ASAP"+      ]+  , mdesc   = "Your research team disagrees over a drink with some gentlemen scientists about premises of a relative completeness theorem and there's only one way to settle that."+      -- Not enough space with square fonts and also this is more of a hint than a flavour: Remember to keep your party together when opponents are spotted, or they might be tempted to silence solitary disputants one by one and so win the altercation.+  , mreason = "In addition to advancing game plot, this encounter trains melee, squad formation and stealth. The battle is symmetric in goals (incapacitate all enemies) and in squad capabilities (only the pointman moves, others either melee or wait)."+  , mhint   = "Run a short distance with Shift or LMB, switch the pointman with Tab, repeat. In open terrain, if you keep distance between teammates, this resembles the leap frog infantry tactics. For best effects, end each sprint behind a cover or concealment.\nObserve and mimic the enemies. If you can't see an enemy that apparently can see you, in reversed circumstances you would have the same advantage. Savour the relative fairness --- you won't find any in the main crawl adventure that follows.\nIf you get beaten repeatedly, try using all consumables you find. Ponder the hints from the defeat message, in particular the one about keeping your party together once the opponents are spotted. However, if you want to discover a winning tactics on your own, make sure to ignore any such tips until you succeed."   } +crawl = ModeKind+  { msymbol = 'c'+  , mname   = "long crawl (main)"+  , mfreq   = [(LONG, 1), (CRAWL, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = False+  , mroster = rosterCrawl+  , mcaves  = cavesCrawl+  , mendMsg = [ (Killed, "To think that followers of science and agents of enlightenment would earn death as their reward! Where did we err in our ways? Perhaps nature should not have been disturbed so brashly and the fell beasts woken up from their slumber so eagerly? Perhaps the gathered items should have been used for scientific experiments on the spot rather than hoarded as if of base covetousness? Or perhaps the challenge, chosen freely but without the foreknowledge of the grisly difficulty, was insurmountable and forlorn from the start, despite the enormous power of educated reason at out disposal?")+              , (Escape, "It's better to live to tell the tale than to choke on more than one can swallow. There was no more exquisite cultural artifacts and glorious scientific wonders in these forbidding tunnels anyway. Or were there?") ]+  , mrules  = T.intercalate "\n"+      [ "* Many levels"+      , "* Three heroes vs. Spawned enemies"+      , "* Gather gold, gems and elixirs"+      , "* Find exit and escape ASAP"+      ]+  , mdesc   = "Enjoy the peaceful seclusion of these cold austere tunnels, but don't let wanton curiosity, greed and the ever-creeping abstraction madness keep you down there for too long. If you find survivors (whole or perturbed or segmented) of the past scientific missions, exercise extreme caution and engage or ignore at your discretion."+  , mreason = "This is the main, longest and most replayable scenario of the game."+  , mhint   = "If you keep dying, attempt the subsequent adventures as a breather (perhaps at lowered difficulty). They fill the gaps in the plot and teach particular skills that may come in handy and help you discover new tactics of your own or come up with a strategy for staving off the attrition. Also experimenting with the initial adventures may answer some questions you didn't have when you attempted them originally."+  }+ -- The trajectory tip is important because of tactics of scout looking from -- behind a bush and others hiding in mist. If no suitable bushes, -- fire once and flee into mist or behind cover. Then whomever is out of LOS@@ -65,41 +156,78 @@ shootout = ModeKind  -- sparse ranged in daylight   { msymbol = 's'   , mname   = "foggy shootout (3)"-  , mfreq   = [("foggy", 1), ("shootout", 1), ("campaign scenario", 1)]+  , mfreq   = [(FOGGY, 1), (SHOOTOUT, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = False   , mroster = rosterShootout   , mcaves  = cavesShootout   , mendMsg = []-  , mdesc   = "Whose arguments are most striking and whose ideas fly fastest? Let's scatter up, attack the problems from different angles and find out. (To display the trajectory of any soaring entity, point it with the crosshair in aiming mode.)"+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Three heroes vs. Three human enemies"+      , "* Minimize losses"+      , "* Incapacitate all enemies ASAP"+      ]+  , mdesc   = "Whose arguments are most striking and whose ideas fly fastest? Let's scatter up, attack the problems from different angles and find out."+  , mreason = "This adventure teaches the ranged combat skill in the simplified setup of fully symmetric battle."+  , mhint   = "Try to come up with the best squad formation for this tactical challenge. Don't despair if you run out of ammo, because if you aim truly, enemy has few hit points left at this point. In turn, when trying to avoid enemy projectiles, you can display the trajectory of any soaring entity by pointing it with the crosshair in aiming mode."   }  hunt = ModeKind  -- melee vs ranged with reaction fire in daylight   { msymbol = 'h'   , mname   = "perilous hunt (4)"-  , mfreq   = [("perilous", 1), ("hunt", 1), ("campaign scenario", 1)]+  , mfreq   = [(PERILOUS, 1), (HUNT, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = False   , mroster = rosterHunt   , mcaves  = cavesHunt   , mendMsg = []-  , mdesc   = "Who is the hunter and who is the prey?"+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Seven heroes vs. Seven human enemies capable of concurrent attacks"+      , "* Minimize losses"+      , "* Incapacitate all enemies ASAP"+      ]+  , mdesc   = "Who is the hunter and who is the prey? The only criterion is last man standing when the chase ends."+  , mreason = "This adventure is quite a tactical challenge, because enemies are allowed to fling their ammo simultaneously at your team, which has no such ability."+  , mhint   = "Try not to outshoot the enemy, but to instead focus more on melee tactics. A useful concept here is communication overhead. Any team member that is not waiting and spotting for everybody, but acts, e.g., melees or moves or manages items, slows down all other team members by rougly 10%, because they need to keep track of his actions. Therefore, if other heroes melee, consider carefully if it makes sense to come to their aid, slowing them while you move, or if it's better to stay put and monitor the perimeter. This is true for all factions and all actors on each level separately, except the pointman of each faction, if any."  -- this also eliminates lag in big battles and helps the player to focus on combat and not get distracted by distant team members frantically trying to reach the battleground in time   }  escape = ModeKind  -- asymmetric ranged and stealth race at night   { msymbol = 'e'   , mname   = "night escape (5)"-  , mfreq   = [("night", 1), ("escape", 1), ("campaign scenario", 1)]+  , mfreq   = [(NIGHT, 1), (ESCAPE, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = False   , mroster = rosterEscape   , mcaves  = cavesEscape   , mendMsg = []+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Three heroes vs. Seven human enemies capable of concurrent attacks"+      , "* Minimize losses"+      , "* Gather gems"+      , "* Find exit and escape ASAP"+      ]   , mdesc   = "Dwelling into dark matters is dangerous, so avoid the crowd of firebrand disputants, catch any gems of thought, find a way out and bring back a larger team to shed new light on the field."+  , mreason = "The focus of this installment is on stealthy exploration under the threat of numerically superior enemy."+  , mhint   = ""   }  zoo = ModeKind  -- asymmetric crowd melee at night   { msymbol = 'b'   , mname   = "burning zoo (6)"-  , mfreq   = [("burning", 1), ("zoo", 1), ("campaign scenario", 1)]+  , mfreq   = [(BURNING, 1), (ZOO, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = False   , mroster = rosterZoo   , mcaves  = cavesZoo   , mendMsg = []+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Five heroes vs. Many enemies"+      , "* Minimize losses"+      , "* Incapacitate all enemies ASAP"+      ]   , mdesc   = "The heat of the dispute reaches the nearby Wonders of Science and Nature exhibition, igniting greenery, nets and cages. Crazed animals must be dissuaded from ruining precious scientific equipment and setting back the otherwise fruitful exchange of ideas."+  , mreason = "This is a crowd control exercise, at night, with a raging fire."+  , mhint   = "Note that communication overhead, as explained in perilous hunt adventure hints, makes it impossible for any faction to hit your heroes by more than 10 normal speed actors each turn. However, this is still too much, so position is everything."   }  -- The tactic is to sneak in the dark, highlight enemy with thrown torches@@ -113,32 +241,39 @@ ambush = ModeKind  -- dense ranged with reaction fire vs melee at night   { msymbol = 'm'   , mname   = "ranged ambush (7)"-  , mfreq   = [("ranged", 1), ("ambush", 1), ("campaign scenario", 1)]+  , mfreq   = [(RANGED, 1), (AMBUSH, 1), (CAMPAIGN_SCENARIO, 1)]+  , mtutorial = False   , mroster = rosterAmbush   , mcaves  = cavesAmbush   , mendMsg = []+  , mrules  = T.intercalate "\n"+      [ "* One level only"+      , "* Three heroes with concurrent attacks vs. Unidentified foes"+      , "* Minimize losses"+      , "* Assert control of the situation ASAP"+      ]   , mdesc   = "Prevent hijacking of your ideas at all cost! Be stealthy, be observant, be aggressive. Fast execution is what makes or breaks a creative team."-  }--crawl = ModeKind-  { msymbol = 'c'-  , mname   = "deep crawl (long)"-  , mfreq   = [("deep", 1), ("crawl", 1), ("campaign scenario", 1)]-  , mroster = rosterCrawl-  , mcaves  = cavesCrawl-  , mendMsg = [ (Killed, "To think that followers of science and agents of enlightenment would earn death as their reward! Where did we err in our ways? Perhaps nature should not have been disturbed so brashly and the fell beasts woken up from their slumber so eagerly? Perhaps the gathered items should have been used for scientific experiments on the spot rather than hoarded as if of base covetousness? Or perhaps the challenge, chosen freely but without the foreknowledge of the grisly difficulty, was insurmountable and forlorn from the start, despite the enormous power of educated reason at out disposal?")-              , (Escape, "It's better to live to tell the tale than to choke on more than one can swallow. There was no more exquisite cultural artifacts and glorious scientific wonders in these forbidding tunnels anyway. Or were there?") ]-  , mdesc   = "Enjoy the peaceful seclusion of these cold austere tunnels, but don't let wanton curiosity, greed and the ever-creeping abstraction madness keep you down there for too long. If you find survivors (whole or perturbed or segmented) of the past scientific missions, exercise extreme caution and engage or ignore at your discretion."+  , mreason = "In this adventure, finally, your heroes are able to all use ranged attacks at once, given enough ammunition."+  , mhint   = ""   }  safari = ModeKind  -- Easter egg available only via screensaver   { msymbol = 'f'   , mname   = "safari"-  , mfreq   = [("safari", 1)]+  , mfreq   = [(SAFARI, 1)]+  , mtutorial = False   , mroster = rosterSafari   , mcaves  = cavesSafari   , mendMsg = []+  , mrules  = T.intercalate "\n"+      [ "* Three levels"+      , "* Many teammates capable of concurrent action vs. Many enemies"+      , "* Minimize losses"+      , "* Find exit and escape ASAP"+      ]   , mdesc   = "\"In this enactment you'll discover the joys of hunting the most exquisite of Earth's flora and fauna, both animal and semi-intelligent. Exit at the bottommost level.\" This is a drama script recovered from a monster nest debris."+  , mreason = "This is an Easter egg. The default squad doctrine is that all team members follow the pointman, but it can be changed from the settings submenu of the main menu."+  , mhint   = ""   }  -- * Testing modes@@ -146,178 +281,223 @@ dig = ModeKind   { msymbol = 'd'   , mname   = "dig"-  , mfreq   = [("dig", 1)]+  , mfreq   = [(DIG, 1)]+  , mtutorial = False   , mroster = rosterCrawlEmpty   , mcaves  = cavesDig   , mendMsg = []+  , mrules  = ""   , mdesc   = "Delve deeper!"+  , mreason = ""+  , mhint   = ""   }  see = ModeKind   { msymbol = 'a'   , mname   = "see"-  , mfreq   = [("see", 1)]+  , mfreq   = [(SEE, 1)]+  , mtutorial = False   , mroster = rosterCrawlEmpty   , mcaves  = cavesSee   , mendMsg = []+  , mrules  = ""   , mdesc   = "See all!"+  , mreason = ""+  , mhint   = ""   } +short = ModeKind+  { msymbol = 's'+  , mname   = "short"+  , mfreq   = [(SHORT, 1)]+  , mtutorial = False+  , mroster = rosterCrawlEmpty+  , mcaves  = cavesShort+  , mendMsg = []+  , mrules  = ""+  , mdesc   = "See all short scenarios!"+  , mreason = ""+  , mhint   = ""+  }+ crawlEmpty = ModeKind   { msymbol = 'c'   , mname   = "crawl empty"-  , mfreq   = [("crawl empty", 1)]+  , mfreq   = [(CRAWL_EMPTY, 1)]+  , mtutorial = False   , mroster = rosterCrawlEmpty-  , mcaves  = cavesCrawl+  , mcaves  = cavesCrawlEmpty   , mendMsg = []-  , mdesc   = "Enjoy the free space."+  , mrules  = ""+  , mdesc   = "Enjoy the extra legroom."+  , mreason = ""+  , mhint   = ""   }  crawlSurvival = ModeKind   { msymbol = 'd'   , mname   = "crawl survival"-  , mfreq   = [("crawl survival", 1)]+  , mfreq   = [(CRAWL_SURVIVAL, 1)]+  , mtutorial = False   , mroster = rosterCrawlSurvival   , mcaves  = cavesCrawl   , mendMsg = []+  , mrules  = ""   , mdesc   = "Lure the human intruders deeper and deeper."+  , mreason = ""+  , mhint   = ""   }  safariSurvival = ModeKind   { msymbol = 'u'   , mname   = "safari survival"-  , mfreq   = [("safari survival", 1)]+  , mfreq   = [(SAFARI_SURVIVAL, 1)]+  , mtutorial = False   , mroster = rosterSafariSurvival   , mcaves  = cavesSafari   , mendMsg = []+  , mrules  = ""   , mdesc   = "In this enactment you'll discover the joys of being hunted among the most exquisite of Earth's flora and fauna, both animal and semi-intelligent."+  , mreason = ""+  , mhint   = ""   }  battle = ModeKind   { msymbol = 'b'   , mname   = "battle"-  , mfreq   = [("battle", 1)]+  , mfreq   = [(BATTLE, 1)]+  , mtutorial = False   , mroster = rosterBattle   , mcaves  = cavesBattle   , mendMsg = []+  , mrules  = ""   , mdesc   = "Odds are stacked against those that unleash the horrors of abstraction."+  , mreason = ""+  , mhint   = ""   }  battleDefense = ModeKind   { msymbol = 'f'   , mname   = "battle defense"-  , mfreq   = [("battle defense", 1)]+  , mfreq   = [(BATTLE_DEFENSE, 1)]+  , mtutorial = False   , mroster = rosterBattleDefense   , mcaves  = cavesBattle   , mendMsg = []+  , mrules  = ""   , mdesc   = "Odds are stacked for those that breathe mathematics."+  , mreason = ""+  , mhint   = ""   }  battleSurvival = ModeKind   { msymbol = 'i'   , mname   = "battle survival"-  , mfreq   = [("battle survival", 1)]+  , mfreq   = [(BATTLE_SURVIVAL, 1)]+  , mtutorial = False   , mroster = rosterBattleSurvival   , mcaves  = cavesBattle   , mendMsg = []+  , mrules  = ""   , mdesc   = "Odds are stacked for those that ally with the strongest."+  , mreason = ""+  , mhint   = ""   }  defense = ModeKind  -- perhaps a real scenario in the future   { msymbol = 'e'   , mname   = "defense"-  , mfreq   = [("defense", 1)]+  , mfreq   = [(DEFENSE, 1)]+  , mtutorial = False   , mroster = rosterDefense   , mcaves  = cavesCrawl   , mendMsg = []+  , mrules  = ""   , mdesc   = "Don't let human interlopers defile your abstract secrets and flee unpunished!"+  , mreason = "This is an initial sketch of the reversed crawl game mode. Play on high difficulty to avoid guaranteed victories against the pitiful humans."+  , mhint   = ""   }  defenseEmpty = ModeKind   { msymbol = 'e'   , mname   = "defense empty"-  , mfreq   = [("defense empty", 1)]+  , mfreq   = [(DEFENSE_EMPTY, 1)]+  , mtutorial = False   , mroster = rosterDefenseEmpty-  , mcaves  = cavesCrawl+  , mcaves  = cavesCrawlEmpty   , mendMsg = []-  , mdesc   = "Lord over."+  , mrules  = ""+  , mdesc   = "Lord over empty halls."+  , mreason = ""+  , mhint   = ""   }  -- * Screensaver modes -screensave :: AutoLeader -> Roster -> Roster-screensave auto r =-  let f [] = []-      f ((player, initial) : rest) =-        (player {fleaderMode = LeaderAI auto}, initial) : rest-  in r {rosterList = f $ rosterList r}--screensaverRaid = raid+screensaverRaid = screensave (AutoLeader False False) $ raid   { mname   = "auto-raid (1)"-  , mfreq   = [("insert coin", 1), ("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterRaid+  , mfreq   = [(INSERT_COIN, 2), (NO_CONFIRMS, 1)]   } -screensaverBrawl = brawl+screensaverBrawl = screensave (AutoLeader False False) $ brawl   { mname   = "auto-brawl (2)"-  , mfreq   = [("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterBrawl+  , mfreq   = [(NO_CONFIRMS, 1)]   } -screensaverShootout = shootout+screensaverCrawl = screensave (AutoLeader False False) $ crawl+  { mname   = "auto-crawl (long)"+  , mfreq   = [(NO_CONFIRMS, 1)]+  }++screensaverShootout = screensave (AutoLeader False False) $ shootout   { mname   = "auto-shootout (3)"-  , mfreq   = [("insert coin", 1), ("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterShootout+  , mfreq   = [(INSERT_COIN, 2), (NO_CONFIRMS, 1)]   } -screensaverHunt = hunt+screensaverHunt = screensave (AutoLeader False False) $ hunt   { mname   = "auto-hunt (4)"-  , mfreq   = [("insert coin", 1), ("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterHunt+  , mfreq   = [(INSERT_COIN, 2), (NO_CONFIRMS, 1)]   } -screensaverEscape = escape+screensaverEscape = screensave (AutoLeader False False) $ escape   { mname   = "auto-escape (5)"-  , mfreq   = [("insert coin", 1), ("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterEscape+  , mfreq   = [(INSERT_COIN, 2), (NO_CONFIRMS, 1)]   } -screensaverZoo = zoo+screensaverZoo = screensave (AutoLeader False False) $ zoo   { mname   = "auto-zoo (6)"-  , mfreq   = [("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterZoo+  , mfreq   = [(NO_CONFIRMS, 1)]   } -screensaverAmbush = ambush+screensaverAmbush = screensave (AutoLeader False False) $ ambush   { mname   = "auto-ambush (7)"-  , mfreq   = [("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterAmbush-  }--screensaverCrawl = crawl-  { mname   = "auto-crawl (long)"-  , mfreq   = [("no confirms", 1)]-  , mroster = screensave (AutoLeader False False) rosterCrawl+  , mfreq   = [(NO_CONFIRMS, 1)]   } -screensaverSafari = safari+-- changing leader by client needed, because of TFollow+screensaverSafari = screensave (AutoLeader False True) $ safari   { mname   = "auto-safari"-  , mfreq   = [("insert coin", 1), ("no confirms", 1)]-  , mroster = -- changing leader by client needed, because of TFollow-              screensave (AutoLeader False True) rosterSafari+  , mfreq   = [(INSERT_COIN, 1), (NO_CONFIRMS, 1)]   } -rosterRaid, rosterBrawl, rosterShootout, rosterHunt, rosterEscape, rosterZoo, rosterAmbush, rosterCrawl, rosterCrawlEmpty, rosterCrawlSurvival, rosterSafari, rosterSafariSurvival, rosterBattle, rosterBattleDefense, rosterBattleSurvival, rosterDefense, rosterDefenseEmpty :: Roster+teamCompetitor, teamCivilian :: TeamContinuity+teamCompetitor = TeamContinuity 2+teamCivilian = TeamContinuity 3 +rosterRaid, rosterBrawl, rosterCrawl, rosterShootout, rosterHunt, rosterEscape, rosterZoo, rosterAmbush, rosterSafari, rosterCrawlEmpty, rosterCrawlSurvival, rosterSafariSurvival, rosterBattle, rosterBattleDefense, rosterBattleSurvival, rosterDefense, rosterDefenseEmpty :: Roster+ rosterRaid = Roster   { rosterList = [ ( playerHero {fhiCondPoly = hiHeroShort}-                   , [(-2, 1, "hero")] )+                   , Just teamExplorer+                   , [(-2, 2, HERO)] )                  , ( playerAntiHero { fname = "Indigo Founder"                                     , fhiCondPoly = hiHeroShort }-                   , [(-2, 1, "hero")] )+                   , Just teamCompetitor+                   , [(-2, 1, HERO)] )                  , ( playerAnimal  -- starting over escape-                   , [(-2, 2, "animal")] )-                 , (playerHorror, []) ]  -- for summoned monsters+                   , Nothing+                   , [(-2, 2, ANIMAL)] )+                 , (playerHorror, Nothing, []) ]  -- for summoned monsters   , rosterEnemy = [ ("Explorer", "Animal Kingdom")                   , ("Explorer", "Horror Den")                   , ("Indigo Founder", "Animal Kingdom")@@ -327,17 +507,36 @@ rosterBrawl = Roster   { rosterList = [ ( playerHero { fcanEscape = False                                 , fhiCondPoly = hiHeroMedium }-                   , [(-3, 3, "hero")] )+                   , Just teamExplorer+                   , [(-2, 3, BRAWLER_HERO)] )                  , ( playerAntiHero { fname = "Indigo Researcher"                                     , fcanEscape = False                                     , fhiCondPoly = hiHeroMedium }-                   , [(-3, 3, "hero")] )-                 , (playerHorror, []) ]+                   , Just teamCompetitor+                   , [(-2, 3, BRAWLER_HERO)] )+                 , (playerHorror, Nothing, []) ]   , rosterEnemy = [ ("Explorer", "Indigo Researcher")                   , ("Explorer", "Horror Den")                   , ("Indigo Researcher", "Horror Den") ]   , rosterAlly = [] } +rosterCrawl = Roster+  { rosterList = [ ( playerHero+                   , Just teamExplorer+                   , [(-1, 3, HERO)] )+                 , ( playerMonster+                   , Nothing+                   , [(-4, 1, SCOUT_MONSTER), (-4, 3, MONSTER)] )+                 , ( playerAnimal+                   , Nothing+                   , -- Fun from the start to avoid empty initial level:+                     [ (-1, 1 + 1 `d` 2, ANIMAL)+                     -- Huge battle at the end:+                     , (-10, 100, MOBILE_ANIMAL) ] ) ]+  , rosterEnemy = [ ("Explorer", "Monster Hive")+                  , ("Explorer", "Animal Kingdom") ]+  , rosterAlly = [("Monster Hive", "Animal Kingdom")] }+ -- Exactly one scout gets a sight boost, to help the aggressor, because he uses -- the scout for initial attack, while camper (on big enough maps) -- can't guess where the attack would come and so can't position his single@@ -345,12 +544,14 @@ rosterShootout = Roster   { rosterList = [ ( playerHero { fcanEscape = False                                 , fhiCondPoly = hiHeroMedium }-                   , [(-5, 1, "scout hero"), (-5, 2, "ranger hero")] )+                   , Just teamExplorer+                   , [(-5, 2, RANGER_HERO), (-5, 1, SCOUT_HERO)] )                  , ( playerAntiHero { fname = "Indigo Researcher"                                     , fcanEscape = False                                     , fhiCondPoly = hiHeroMedium }-                   , [(-5, 1, "scout hero"), (-5, 2, "ranger hero")] )-                 , (playerHorror, []) ]+                   , Just teamCompetitor+                   , [(-5, 2, RANGER_HERO), (-5, 1, SCOUT_HERO)] )+                 , (playerHorror, Nothing, []) ]   , rosterEnemy = [ ("Explorer", "Indigo Researcher")                   , ("Explorer", "Horror Den")                   , ("Indigo Researcher", "Horror Den") ]@@ -359,26 +560,31 @@ rosterHunt = Roster   { rosterList = [ ( playerHero { fcanEscape = False                                 , fhiCondPoly = hiHeroMedium }-                   , [(-6, 7, "soldier hero")] )+                   , Just teamExplorer+                   , [(-6, 7, SOLDIER_HERO)] )                  , ( playerAntiHero { fname = "Indigo Researcher"                                     , fcanEscape = False                                     , fhiCondPoly = hiHeroMedium }-                   , [(-6, 1, "scout hero"), (-6, 6, "ambusher hero")] )-                 , (playerHorror, []) ]+                   , Just teamCompetitor+                   , [(-6, 6, AMBUSHER_HERO), (-6, 1, SCOUT_HERO)] )+                 , (playerHorror, Nothing, []) ]   , rosterEnemy = [ ("Explorer", "Indigo Researcher")                   , ("Explorer", "Horror Den")                   , ("Indigo Researcher", "Horror Den") ]   , rosterAlly = [] }  rosterEscape = Roster-  { rosterList = [ ( playerHero {fhiCondPoly = hiHeroMedium}-                   , [(-7, 1, "scout hero"), (-7, 2, "escapist hero")] )-                 , ( playerAntiHero { fname = "Indigo Researcher"+  { rosterList = [ ( playerAntiHero { fname = "Indigo Researcher"                                     , fcanEscape = False  -- start on escape                                     , fneverEmpty = False  -- loot after killing                                     , fhiCondPoly = hiHeroMedium }-                   , [(-7, 1, "scout hero"), (-7, 6, "ambusher hero")] )-                 , (playerHorror, []) ]+                   , Just teamCompetitor+                   , [(-7, 6, AMBUSHER_HERO), (-7, 1, SCOUT_HERO)] )+                 , ( playerHero {fhiCondPoly = hiHeroMedium}+                   , Just teamExplorer+                   , [(-7, 2, ESCAPIST_HERO), (-7, 1, SCOUT_HERO)] )+                     -- second on the list to let foes occupy the exit+                 , (playerHorror, Nothing, []) ]   , rosterEnemy = [ ("Explorer", "Indigo Researcher")                   , ("Explorer", "Horror Den")                   , ("Indigo Researcher", "Horror Den") ]@@ -387,10 +593,12 @@ rosterZoo = Roster   { rosterList = [ ( playerHero { fcanEscape = False                                 , fhiCondPoly = hiHeroLong }-                   , [(-8, 5, "soldier hero")] )+                   , Just teamExplorer+                   , [(-8, 5, SOLDIER_HERO)] )                  , ( playerAnimal {fneverEmpty = True}-                   , [(-8, 100, "mobile animal")] )-                 , (playerHorror, []) ]  -- for summoned monsters+                   , Nothing+                   , [(-8, 100, MOBILE_ANIMAL)] )+                 , (playerHorror, Nothing, []) ]  -- for summoned monsters   , rosterEnemy = [ ("Explorer", "Animal Kingdom")                   , ("Explorer", "Horror Den") ]   , rosterAlly = [] }@@ -398,59 +606,33 @@ rosterAmbush = Roster   { rosterList = [ ( playerHero { fcanEscape = False                                 , fhiCondPoly = hiHeroMedium }-                   , [(-9, 1, "scout hero"), (-9, 5, "ambusher hero")] )+                   , Just teamExplorer+                   , [(-9, 5, AMBUSHER_HERO), (-9, 1, SCOUT_HERO)] )                  , ( playerAntiHero { fname = "Indigo Researcher"                                     , fcanEscape = False                                     , fhiCondPoly = hiHeroMedium }-                   , [(-9, 12, "soldier hero")] )-                 , (playerHorror, []) ]+                   , Just teamCompetitor+                   , [(-9, 12, SOLDIER_HERO)] )+                 , (playerHorror, Nothing, []) ]   , rosterEnemy = [ ("Explorer", "Indigo Researcher")                   , ("Explorer", "Horror Den")                   , ("Indigo Researcher", "Horror Den") ]   , rosterAlly = [] } -rosterCrawl = Roster-  { rosterList = [ ( playerHero-                   , [(-1, 3, "hero")] )-                 , ( playerMonster-                   , [(-4, 1, "scout monster"), (-4, 3, "monster")] )-                 , ( playerAnimal-                   , -- Fun from the start to avoid empty initial level:-                     [ (-1, 1 + 1 `d` 2, "animal")-                     -- Huge battle at the end:-                     , (-10, 100, "mobile animal") ] ) ]-  , rosterEnemy = [ ("Explorer", "Monster Hive")-                  , ("Explorer", "Animal Kingdom") ]-  , rosterAlly = [("Monster Hive", "Animal Kingdom")] }--rosterCrawlEmpty = Roster-  { rosterList = [ ( playerHero-                   , [(-1, 1, "hero")] )-                 , (playerHorror, []) ]  -- for spawned and summoned monsters-  , rosterEnemy = []-  , rosterAlly = [] }--rosterCrawlSurvival = rosterCrawl-  { rosterList = [ ( playerAntiHero-                   , [(-1, 3, "hero")] )-                 , ( playerMonster-                   , [(-4, 1, "scout monster"), (-4, 3, "monster")] )-                 , ( playerAnimal {fhasUI = True}-                   , -- Fun from the start to avoid empty initial level:-                     [ (-1, 1 + 1 `d` 2, "animal")-                     -- Huge battle at the end:-                     , (-10, 100, "mobile animal") ] ) ] }- -- No horrors faction needed, because spawned heroes land in civilian faction. rosterSafari = Roster   { rosterList = [ ( playerMonsterTourist-                   , [(-4, 15, "monster")] )+                   , Nothing+                   , [(-4, 15, MONSTER)] )                  , ( playerHunamConvict-                   , [(-4, 2, "civilian")] )+                   , Just teamCivilian+                   , [(-4, 2, CIVILIAN)] )                  , ( playerAnimalMagnificent-                   , [(-7, 15, "mobile animal")] )+                   , Nothing+                   , [(-7, 15, MOBILE_ANIMAL)] )                  , ( playerAnimalExquisite  -- start on escape-                   , [(-10, 20, "mobile animal")] ) ]+                   , Nothing+                   , [(-10, 20, MOBILE_ANIMAL)] ) ]   , rosterEnemy = [ ("Monster Tourist Office", "Hunam Convict")                   , ( "Monster Tourist Office"                     , "Animal Magnificent Specimen Variety" )@@ -463,28 +645,58 @@   , rosterAlly = [ ( "Animal Magnificent Specimen Variety"                    , "Animal Exquisite Herds and Packs Galore" ) ] } +rosterCrawlEmpty = Roster+  { rosterList = [ ( playerHero+                   , Just teamExplorer+                   , [(-1, 1, HERO)] )+                 , (playerHorror, Nothing, []) ]+                     -- for spawned and summoned monsters+  , rosterEnemy = []+  , rosterAlly = [] }++rosterCrawlSurvival = rosterCrawl+  { rosterList = [ ( playerAntiHero+                   , Just teamExplorer+                   , [(-1, 3, HERO)] )+                 , ( playerMonster+                   , Nothing+                   , [(-4, 1, SCOUT_MONSTER), (-4, 3, MONSTER)] )+                 , ( playerAnimal {fhasUI = True}+                   , Nothing+                   , -- Fun from the start to avoid empty initial level:+                     [ (-1, 1 + 1 `d` 2, ANIMAL)+                     -- Huge battle at the end:+                     , (-10, 100, MOBILE_ANIMAL) ] ) ] }+ rosterSafariSurvival = rosterSafari   { rosterList = [ ( playerMonsterTourist                        { fleaderMode = LeaderAI $ AutoLeader True True                        , fhasUI = False }-                   , [(-4, 15, "monster")] )+                   , Nothing+                   , [(-4, 15, MONSTER)] )                  , ( playerHunamConvict-                   , [(-4, 3, "civilian")] )+                   , Just teamCivilian+                   , [(-4, 3, CIVILIAN)] )                  , ( playerAnimalMagnificent                        { fleaderMode = LeaderUI $ AutoLeader True False                        , fhasUI = True }-                   , [(-7, 20, "mobile animal")] )+                   , Nothing+                   , [(-7, 20, MOBILE_ANIMAL)] )                  , ( playerAnimalExquisite-                   , [(-10, 30, "mobile animal")] ) ] }+                   , Nothing+                   , [(-10, 30, MOBILE_ANIMAL)] ) ] }  rosterBattle = Roster   { rosterList = [ ( playerHero { fcanEscape = False                                 , fhiCondPoly = hiHeroLong }-                   , [(-5, 5, "soldier hero")] )+                   , Just teamExplorer+                   , [(-5, 5, SOLDIER_HERO)] )                  , ( playerMonster {fneverEmpty = True}-                   , [(-5, 35, "mobile monster")] )+                   , Nothing+                   , [(-5, 35, MOBILE_MONSTER)] )                  , ( playerAnimal {fneverEmpty = True}-                   , [(-5, 30, "mobile animal")] ) ]+                   , Nothing+                   , [(-5, 30, MOBILE_ANIMAL)] ) ]   , rosterEnemy = [ ("Explorer", "Monster Hive")                   , ("Explorer", "Animal Kingdom") ]   , rosterAlly = [("Monster Hive", "Animal Kingdom")] }@@ -495,12 +707,15 @@                                 , fleaderMode =                                     LeaderAI $ AutoLeader False False                                 , fhasUI = False }-                   , [(-5, 5, "soldier hero")] )+                   , Just teamExplorer+                   , [(-5, 5, SOLDIER_HERO)] )                  , ( playerMonster { fneverEmpty = True                                    , fhasUI = True }-                   , [(-5, 35, "mobile monster")] )+                   , Nothing+                   , [(-5, 35, MOBILE_MONSTER)] )                  , ( playerAnimal {fneverEmpty = True}-                   , [(-5, 30, "mobile animal")] ) ] }+                   , Nothing+                   , [(-5, 30, MOBILE_ANIMAL)] ) ] }  rosterBattleSurvival = rosterBattle   { rosterList = [ ( playerHero { fcanEscape = False@@ -508,78 +723,92 @@                                 , fleaderMode =                                     LeaderAI $ AutoLeader False False                                 , fhasUI = False }-                   , [(-5, 5, "soldier hero")] )+                   , Just teamExplorer+                   , [(-5, 5, SOLDIER_HERO)] )                  , ( playerMonster {fneverEmpty = True}-                   , [(-5, 35, "mobile monster")] )+                   , Nothing+                   , [(-5, 35, MOBILE_MONSTER)] )                  , ( playerAnimal { fneverEmpty = True                                   , fhasUI = True }-                   , [(-5, 30, "mobile animal")] ) ] }+                   , Nothing+                   , [(-5, 30, MOBILE_ANIMAL)] ) ] }  rosterDefense = rosterCrawl   { rosterList = [ ( playerAntiHero-                   , [(-1, 3, "hero")] )+                   , Just teamExplorer+                   , [(-1, 3, HERO)] )                  , ( playerAntiMonster-                   , [(-4, 1, "scout monster"), (-4, 3, "monster")] )+                   , Nothing+                   , [(-4, 1, SCOUT_MONSTER), (-4, 3, MONSTER)] )                  , ( playerAnimal-                   , [ (-1, 1 + 1 `d` 2, "animal")-                     , (-10, 100, "mobile animal") ] ) ] }+                   , Nothing+                   , [ (-1, 1 + 1 `d` 2, ANIMAL)+                     , (-10, 100, MOBILE_ANIMAL) ] ) ] }  rosterDefenseEmpty = rosterCrawl   { rosterList = [ ( playerAntiMonster {fneverEmpty = True}-                   , [(-4, 1, "scout monster")] )-                 , (playerHorror, []) ]  -- for spawned and summoned animals+                   , Nothing+                   , [(-4, 1, SCOUT_MONSTER)] )+                 , (playerHorror, Nothing, []) ]+                     -- for spawned and summoned animals   , rosterEnemy = []   , rosterAlly = [] } -cavesRaid, cavesBrawl, cavesShootout, cavesHunt, cavesEscape, cavesZoo, cavesAmbush, cavesCrawl, cavesDig, cavesSee, cavesSafari, cavesBattle :: Caves+cavesRaid, cavesBrawl, cavesCrawl, cavesShootout, cavesHunt, cavesEscape, cavesZoo, cavesAmbush, cavesSafari, cavesDig, cavesSee, cavesShort, cavesCrawlEmpty, cavesBattle :: Caves -cavesRaid = [([-2], ["caveRaid"])]+cavesRaid = [([-2], [CAVE_RAID])] -cavesBrawl = [([-3], ["caveBrawl"])]+cavesBrawl = [([-2], [CAVE_BRAWL])] -cavesShootout = [([-5], ["caveShootout"])]+listCrawl :: [([Int], [GroupName CaveKind])]+listCrawl =+  [ ([-1], [CAVE_OUTERMOST])+  , ([-2], [CAVE_SHALLOW_ROGUE])+  , ([-3], [CAVE_EMPTY])+  , ([-4, -5, -6], [DEFAULT_RANDOM, CAVE_ROGUE, CAVE_ARENA])+  , ([-7, -8], [CAVE_ROGUE, CAVE_SMOKING])+  , ([-9], [CAVE_LABORATORY])+  , ([-10], [CAVE_MINE]) ] -cavesHunt = [([-6], ["caveHunt"])]+cavesCrawl = listCrawl -cavesEscape = [([-7], ["caveEscape"])]+cavesShootout = [([-5], [CAVE_SHOOTOUT])] -cavesZoo = [([-8], ["caveZoo"])]+cavesHunt = [([-6], [CAVE_HUNT])] -cavesAmbush = [([-9], ["caveAmbush"])]+cavesEscape = [([-7], [CAVE_ESCAPE])] -listCrawl :: [([Int], [GroupName CaveKind])]-listCrawl =-  [ ([-1], ["caveOutermost"])-  , ([-2], ["caveShallowRogue"])-  , ([-3], ["caveEmpty"])-  , ([-4, -5, -6], ["default random", "caveRogue", "caveArena"])-  , ([-7, -8], ["caveRogue", "caveSmoking"])-  , ([-9], ["caveLaboratory"])-  , ([-10], ["caveMine"]) ]+cavesZoo = [([-8], [CAVE_ZOO])] -cavesCrawl = listCrawl+cavesAmbush = [([-9], [CAVE_AMBUSH])] -renumberCaves :: Int -> ([Int], [GroupName CaveKind])-              -> ([Int], [GroupName CaveKind])-renumberCaves offset (ns, l) = (map (+ offset) ns, l)+cavesSafari = [ ([-4], [CAVE_SAFARI_1])+              , ([-7], [CAVE_SAFARI_2])+              , ([-10], [CAVE_SAFARI_3]) ]  cavesDig = concat $ zipWith (map . renumberCaves)                             [0, -10 ..]                             (replicate 100 listCrawl) +renumberCaves :: Int -> ([Int], [GroupName CaveKind])+              -> ([Int], [GroupName CaveKind])+renumberCaves offset (ns, l) = (map (+ offset) ns, l)+ cavesSee = let numberCaves n c = ([n], [c])            in zipWith numberCaves [-1, -2 ..]-              $ concatMap (replicate 8) allCaves+              $ concatMap (replicate 10) allCaves +cavesShort = let numberCaves n c = ([n], [c])+             in zipWith numberCaves [-1, -2 ..]+                $ concatMap (replicate 100) $ take 7 allCaves+ allCaves :: [GroupName CaveKind] allCaves =-  [ "caveRaid", "caveBrawl", "caveShootout", "caveHunt", "caveEscape", "caveZoo"-  , "caveAmbush"-  , "caveRogue", "caveLaboratory", "caveEmpty", "caveArena", "caveSmoking"-  , "caveNoise", "caveMine" ]+  [ CAVE_RAID, CAVE_BRAWL, CAVE_SHOOTOUT, CAVE_HUNT, CAVE_ESCAPE, CAVE_ZOO+  , CAVE_AMBUSH+  , CAVE_ROGUE, CAVE_LABORATORY, CAVE_EMPTY, CAVE_ARENA, CAVE_SMOKING+  , CAVE_NOISE, CAVE_MINE ] -cavesSafari = [ ([-4], ["caveSafari1"])-              , ([-7], ["caveSafari2"])-              , ([-10], ["caveSafari3"]) ]+cavesCrawlEmpty = cavesCrawl -cavesBattle = [([-5], ["caveBattle"])]+cavesBattle = [([-5], [CAVE_BATTLE])]

GameDefinition/Content/ModeKindPlayer.hs view

@@ -11,20 +11,23 @@  import Game.LambdaHack.Core.Prelude -import Game.LambdaHack.Content.ModeKind-import Game.LambdaHack.Definition.Ability+import           Content.ItemKindActor+import           Content.ItemKindOrgan+import qualified Game.LambdaHack.Content.ItemKind as IK+import           Game.LambdaHack.Content.ModeKind+import           Game.LambdaHack.Definition.Ability  playerHero, playerAntiHero, playerCivilian, playerMonster, playerAntiMonster, playerAnimal, playerHorror, playerMonsterTourist, playerHunamConvict, playerAnimalMagnificent, playerAnimalExquisite :: Player  playerHero = Player   { fname = "Explorer"-  , fgroups = ["hero"]+  , fgroups = [HERO]   , fskillsOther = meleeAdjacent   , fcanEscape = True   , fneverEmpty = True   , fhiCondPoly = hiHeroLong   , fhasGender = True-  , ftactic = TExplore+  , fdoctrine = TExplore   , fleaderMode = LeaderUI $ AutoLeader False False   , fhasUI = True   }@@ -36,26 +39,26 @@  playerCivilian = Player   { fname = "Civilian"-  , fgroups = ["hero", "civilian"]+  , fgroups = [HERO, CIVILIAN]   , fskillsOther = zeroSkills  -- not coordinated by any leadership   , fcanEscape = False   , fneverEmpty = True   , fhiCondPoly = hiHeroMedium   , fhasGender = True-  , ftactic = TPatrol+  , fdoctrine = TPatrol   , fleaderMode = LeaderNull  -- unorganized   , fhasUI = False   }  playerMonster = Player   { fname = "Monster Hive"-  , fgroups = ["monster", "mobile monster"]+  , fgroups = [MONSTER, MOBILE_MONSTER]   , fskillsOther = zeroSkills   , fcanEscape = False   , fneverEmpty = False   , fhiCondPoly = hiDweller   , fhasGender = False-  , ftactic = TExplore+  , fdoctrine = TExplore   , fleaderMode =       -- No point changing leader on level, since all move and they       -- don't follow the leader.@@ -70,13 +73,13 @@  playerAnimal = Player   { fname = "Animal Kingdom"-  , fgroups = ["animal", "mobile animal", "immobile animal", "scavenger"]+  , fgroups = [ANIMAL, MOBILE_ANIMAL, IMMOBILE_ANIMAL, SCAVENGER]   , fskillsOther = zeroSkills   , fcanEscape = False   , fneverEmpty = False   , fhiCondPoly = hiDweller   , fhasGender = False-  , ftactic = TRoam  -- can't pick up, so no point exploring+  , fdoctrine = TRoam  -- can't pick up, so no point exploring   , fleaderMode = LeaderNull   , fhasUI = False   }@@ -88,13 +91,13 @@ -- should be present or a horror player should be added to host them. playerHorror = Player   { fname = "Horror Den"-  , fgroups = [horrorGroup]+  , fgroups = [IK.HORROR]   , fskillsOther = zeroSkills   , fcanEscape = False   , fneverEmpty = False   , fhiCondPoly = []   , fhasGender = False-  , ftactic = TPatrol  -- disoriented+  , fdoctrine = TPatrol  -- disoriented   , fleaderMode = LeaderNull   , fhasUI = False   }@@ -104,7 +107,7 @@                     , fcanEscape = True                     , fneverEmpty = True  -- no spawning                     , fhiCondPoly = hiHeroMedium-                    , ftactic = TFollow  -- follow-the-guide, as tourists do+                    , fdoctrine = TFollow  -- follow-the-guide, as tourists do                     , fleaderMode = LeaderUI $ AutoLeader False False }  playerHunamConvict =@@ -119,9 +122,6 @@   playerAnimal { fname = "Animal Exquisite Herds and Packs Galore"                , fneverEmpty = True } -victoryOutcomes :: [Outcome]-victoryOutcomes = [Conquer, Escape]- hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller :: HiCondPoly  hiHeroShort =@@ -132,7 +132,7 @@   , ( [(HiSprint, -500)]  -- speed matters, but only if fast enough     , victoryOutcomes )   , ( [(HiSurvival, 10)]  -- few points for surviving long-    , [minBound..maxBound] \\ victoryOutcomes )+    , deafeatOutcomes )   ]  hiHeroMedium =@@ -145,7 +145,7 @@   , ( [(HiBlitz, -100)]  -- speed matters always     , victoryOutcomes )   , ( [(HiSurvival, 10)]  -- few points for surviving long-    , [minBound..maxBound] \\ victoryOutcomes )+    , deafeatOutcomes )   ]  -- Heroes in long crawls rejoice in loot.@@ -157,7 +157,7 @@   , ( [(HiBlitz, -100)]  -- speed matters always     , victoryOutcomes )   , ( [(HiSurvival, 10)]  -- few points for surviving long-    , [minBound..maxBound] \\ victoryOutcomes )+    , deafeatOutcomes )   ]  -- Spawners get no points from loot, but try to kill@@ -171,5 +171,5 @@             , ( [(HiBlitz, -100)]  -- speed matters               , victoryOutcomes )             , ( [(HiSurvival, 100)]-              , [minBound..maxBound] \\ victoryOutcomes )+              , deafeatOutcomes )             ]

GameDefinition/Content/PlaceKind.hs view

@@ -1,6 +1,12 @@--- | Room, hall and passage definitions.+-- | Definitions of place kinds. Every room in the game is an instantiated+-- place kind. module Content.PlaceKind-  ( content+  ( -- * Group name patterns+    pattern ROGUE, pattern LABORATORY, pattern ZOO, pattern BRAWL, pattern SHOOTOUT, pattern ARENA, pattern ESCAPE, pattern AMBUSH, pattern BATTLE, pattern NOISE, pattern MINE, pattern EMPTY+  , pattern INDOOR_ESCAPE_DOWN, pattern INDOOR_ESCAPE_UP, pattern OUTDOOR_ESCAPE_DOWN, pattern TINY_STAIRCASE, pattern OPEN_STAIRCASE, pattern CLOSED_STAIRCASE, pattern WALLED_STAIRCASE, pattern GATED_TINY_STAIRCASE, pattern GATED_OPEN_STAIRCASE, pattern GATED_CLOSED_STAIRCASE, pattern OUTDOOR_TINY_STAIRCASE, pattern OUTDOOR_CLOSED_STAIRCASE, pattern OUTDOOR_WALLED_STAIRCASE+  , groupNamesSingleton, groupNames+  , -- * Content+    content   ) where  import Prelude ()@@ -9,31 +15,83 @@  import qualified Data.Text as T +import Content.TileKind hiding (content, groupNames, groupNamesSingleton) import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Definition.Defs +-- * Group name patterns++groupNamesSingleton :: [GroupName PlaceKind]+groupNamesSingleton = []++-- TODO: if we stick to the current system of generating extra kinds and their+-- group names, let's also add the generated group names to @groupNames@.+groupNames :: [GroupName PlaceKind]+groupNames =+       [ROGUE, LABORATORY, ZOO, BRAWL, SHOOTOUT, ARENA, ESCAPE, AMBUSH, BATTLE, NOISE, MINE, EMPTY]+    ++ [INDOOR_ESCAPE_DOWN, INDOOR_ESCAPE_UP, OUTDOOR_ESCAPE_DOWN, TINY_STAIRCASE, OPEN_STAIRCASE, CLOSED_STAIRCASE, WALLED_STAIRCASE]+    ++ fst generatedStairs++pattern ROGUE, LABORATORY, ZOO, BRAWL, SHOOTOUT, ARENA, ESCAPE, AMBUSH, BATTLE, NOISE, MINE, EMPTY :: GroupName PlaceKind++pattern INDOOR_ESCAPE_DOWN, INDOOR_ESCAPE_UP, OUTDOOR_ESCAPE_DOWN, TINY_STAIRCASE, OPEN_STAIRCASE, CLOSED_STAIRCASE, WALLED_STAIRCASE, GATED_TINY_STAIRCASE, GATED_OPEN_STAIRCASE, GATED_CLOSED_STAIRCASE, OUTDOOR_TINY_STAIRCASE, OUTDOOR_CLOSED_STAIRCASE, OUTDOOR_WALLED_STAIRCASE :: GroupName PlaceKind++pattern ROGUE = GroupName "rogue"+pattern LABORATORY = GroupName "laboratory"+pattern ZOO = GroupName "zoo"+pattern BRAWL = GroupName "brawl"+pattern SHOOTOUT = GroupName "shootout"+pattern ARENA = GroupName "arena"+pattern ESCAPE = GroupName "escape"+pattern AMBUSH = GroupName "ambush"+pattern BATTLE = GroupName "battle"+pattern NOISE = GroupName "noise"+pattern MINE = GroupName "mine"+pattern EMPTY = GroupName "empty"++pattern INDOOR_ESCAPE_DOWN = GroupName "escape down"+pattern INDOOR_ESCAPE_UP = GroupName "escape up"+pattern OUTDOOR_ESCAPE_DOWN = GroupName "outdoor escape route"+pattern TINY_STAIRCASE = GroupName "tiny staircase"+pattern OPEN_STAIRCASE = GroupName "open staircase"+pattern CLOSED_STAIRCASE = GroupName "closed staircase"+pattern WALLED_STAIRCASE = GroupName "walled staircase"++-- This is a rotten compromise, because these are synthesized below,+-- so typos can happen.+pattern GATED_TINY_STAIRCASE = GroupName "gated tiny staircase"+pattern GATED_OPEN_STAIRCASE = GroupName "gated open staircase"+pattern GATED_CLOSED_STAIRCASE = GroupName "gated closed staircase"+pattern OUTDOOR_TINY_STAIRCASE = GroupName "outdoor tiny staircase"+pattern OUTDOOR_CLOSED_STAIRCASE = GroupName "outdoor closed staircase"+pattern OUTDOOR_WALLED_STAIRCASE = GroupName "outdoor walled staircase"++-- * Content+ content :: [PlaceKind] content =-  [deadEnd, rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37]+  [deadEnd, rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, bushClump2, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37]   -- automatically generated-  ++ generatedStairs ++ generatedEscapes+  ++ snd generatedStairs ++ generatedEscapes -deadEnd,    rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37 :: PlaceKind+deadEnd,    rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, bushClump2, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37 :: PlaceKind  staircase :: PlaceKind  -- template  staircaseBasic :: [PlaceKind] staircaseBasic = [staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37] -generatedStairs :: [PlaceKind]+generatedStairs :: ([GroupName PlaceKind], [PlaceKind]) generatedStairs =   let gatedStairs = map switchStaircaseToGated staircaseBasic       outdoorStairs = map switchStaircaseToOutdoor staircaseBasic       stairsAll = staircaseBasic ++ gatedStairs ++ outdoorStairs-  in gatedStairs ++ outdoorStairs-     ++ map switchStaircaseToUp stairsAll-     ++ map switchStaircaseToDown stairsAll+      upStairs = map switchStaircaseToUp stairsAll+      downStairs = map switchStaircaseToDown stairsAll+      genStairs = gatedStairs ++ outdoorStairs ++ upStairs ++ downStairs+  in ( nub $ sort $ concatMap (map fst . pfreq) genStairs+     , genStairs )  escapeDownBasic :: [PlaceKind] escapeDownBasic =@@ -45,7 +103,7 @@       outdoorEscapes = map switchEscapeToOutdoorDown escapeDownBasic   in upEscapes ++ outdoorEscapes --- The dots below are @Char.chr 183@, as defined in @TileKind.floorSymbol@.+-- The dots below are @'\x00B7'@, as defined in @TileKind.floorSymbol@. deadEnd = PlaceKind  -- needs to have index 0   { psymbol  = 'd'   , pname    = "a dead end"@@ -60,7 +118,7 @@ rect = PlaceKind  -- Valid for any nonempty area, hence low frequency.   { psymbol  = 'r'   , pname    = "a chamber"-  , pfreq    = [("rogue", 30), ("laboratory", 10)]+  , pfreq    = [(ROGUE, 30), (LABORATORY, 10)]   , prarity  = [(1, 10), (10, 6)]   , pcover   = CStretch   , pfence   = FNone@@ -72,66 +130,66 @@   } rect2 = rect   { pname    = "a pen"-  , pfreq    = [("zoo", 3)]+  , pfreq    = [(ZOO, 3)]   } rect3 = rect   { pname    = "a shed"-  , pfreq    = [("brawl", 10), ("shootout", 1)]-  , poverrideDark = [ ('|', "wall Lit")  -- visible from afar-                    , ('-', "wallH Lit") ]-  , poverrideLit = [ ('|', "wall Lit")-                   , ('-', "wallH Lit") ]+  , pfreq    = [(BRAWL, 10), (SHOOTOUT, 1)]+  , poverrideDark = [ ('|', S_WALL_LIT)  -- visible from afar+                    , ('-', S_WALL_HORIZONTAL_LIT) ]+  , poverrideLit = [ ('|', S_WALL_LIT)+                   , ('-', S_WALL_HORIZONTAL_LIT) ]   } rect4 = rect3   { pname    = "cabinet"-  , pfreq    = [("arena", 10)]+  , pfreq    = [(ARENA, 10)]   } rectWindows = PlaceKind   { psymbol  = 'w'   , pname    = "a hut"-  , pfreq    = [("escape", 10), ("ambush", 7)]+  , pfreq    = [(ESCAPE, 10), (AMBUSH, 7)]   , prarity  = [(1, 10), (10, 10)]   , pcover   = CStretch   , pfence   = FNone   , ptopLeft = [ "-="                , "!·"                ]-  , poverrideDark = [ ('=', "rectWindowsOver_=_Dark")-                    , ('!', "rectWindowsOver_!_Dark") ]-  , poverrideLit = [ ('=', "rectWindowsOver_=_Lit")-                   , ('!', "rectWindowsOver_!_Lit") ]+  , poverrideDark = [ ('=', RECT_WINDOWS_HORIZONTAL_DARK)+                    , ('!', RECT_WINDOWS_VERTICAL_DARK) ]+  , poverrideLit = [ ('=', RECT_WINDOWS_HORIZONTAL_LIT)+                   , ('!', RECT_WINDOWS_VERTICAL_LIT) ]   } glasshouse = PlaceKind   { psymbol  = 'g'   , pname    = "a glasshouse"-  , pfreq    = [("shootout", 4)]+  , pfreq    = [(SHOOTOUT, 4)]   , prarity  = [(1, 10), (10, 7)]   , pcover   = CStretch   , pfence   = FNone   , ptopLeft = [ "=="                , "!·"                ]-  , poverrideDark = [ ('=', "glasshouseOver_=_Lit")  -- visible from afar-                    , ('!', "glasshouseOver_!_Lit") ]-  , poverrideLit = [ ('=', "glasshouseOver_=_Lit")-                   , ('!', "glasshouseOver_!_Lit") ]+  , poverrideDark = [ ('=', GLASSHOUSE_HORIZONTAL_LIT)  -- visible from afar+                    , ('!', GLASSHOUSE_VERTICAL_LIT) ]+  , poverrideLit = [ ('=', GLASSHOUSE_HORIZONTAL_LIT)+                   , ('!', GLASSHOUSE_VERTICAL_LIT) ]   } glasshouse2 = glasshouse   { pname    = "a glass cage"-  , pfreq    = [("zoo", 10)]-  , poverrideDark = [ ('=', "glasshouseOver_=_Dark")-                    , ('!', "glasshouseOver_!_Dark") ]-  , poverrideLit = [ ('=', "glasshouseOver_=_Lit")-                   , ('!', "glasshouseOver_!_Lit") ]+  , pfreq    = [(ZOO, 10)]+  , poverrideDark = [ ('=', GLASSHOUSE_HORIZONTAL_DARK)+                    , ('!', GLASSHOUSE_VERTICAL_DARK) ]+  , poverrideLit = [ ('=', GLASSHOUSE_HORIZONTAL_LIT)+                   , ('!', GLASSHOUSE_VERTICAL_LIT) ]   } glasshouse3 = glasshouse   { pname    = "a reading room"-  , pfreq    = [("arena", 40)]+  , pfreq    = [(ARENA, 40)]   } pulpit = PlaceKind   { psymbol  = 'p'   , pname    = "a stand dais"-  , pfreq    = [("arena", 200), ("zoo", 200)]+  , pfreq    = [(ARENA, 200), (ZOO, 200)]   , prarity  = [(1, 1)]   , pcover   = CMirror   , pfence   = FGround@@ -139,18 +197,18 @@                , "!··"                , "··0"                ]-  , poverrideDark = [ ('=', "glasshouseOver_=_Lit")-                    , ('!', "glasshouseOver_!_Lit")-                    , ('0', "pulpit") ]-  , poverrideLit = [ ('=', "glasshouseOver_=_Lit")-                   , ('!', "glasshouseOver_!_Lit")-                   , ('0', "pulpit") ]+  , poverrideDark = [ ('=', GLASSHOUSE_HORIZONTAL_LIT)+                    , ('!', GLASSHOUSE_VERTICAL_LIT)+                    , ('0', S_PULPIT) ]+  , poverrideLit = [ ('=', GLASSHOUSE_HORIZONTAL_LIT)+                   , ('!', GLASSHOUSE_VERTICAL_LIT)+                   , ('0', S_PULPIT) ]       -- except for floor, this will all be lit, regardless of night/dark; OK   } ruin = PlaceKind   { psymbol  = 'R'   , pname    = "ruins"-  , pfreq    = [("battle", 330)]+  , pfreq    = [(BATTLE, 330)]   , prarity  = [(1, 1)]   , pcover   = CStretch   , pfence   = FNone@@ -162,16 +220,16 @@   } ruin2 = ruin   { pname    = "blasted walls"-  , pfreq    = [("ambush", 50)]-  , poverrideDark = [ ('|', "wall Lit")  -- visible from afar-                    , ('-', "wallH Lit") ]-  , poverrideLit = [ ('|', "wall Lit")-                   , ('-', "wallH Lit") ]+  , pfreq    = [(AMBUSH, 50)]+  , poverrideDark = [ ('|', S_WALL_LIT)  -- visible from afar+                    , ('-', S_WALL_HORIZONTAL_LIT) ]+  , poverrideLit = [ ('|', S_WALL_LIT)+                   , ('-', S_WALL_HORIZONTAL_LIT) ]   } collapsed = PlaceKind   { psymbol  = 'c'   , pname    = "a collapsed cavern"-  , pfreq    = [("noise", 1)]+  , pfreq    = [(NOISE, 1)]       -- no point taking up space if very little space taken,       -- but if no other place can be generated, a failsafe is useful   , prarity  = [(1, 1)]@@ -183,39 +241,39 @@   , poverrideLit = []   } collapsed2 = collapsed-  { pfreq    = [("noise", 1000), ("battle", 200)]+  { pfreq    = [(NOISE, 1000), (BATTLE, 200)]   , ptopLeft = [ "X0"                , "00"                ]   } collapsed3 = collapsed-  { pfreq    = [("noise", 2000), ("battle", 200)]+  { pfreq    = [(NOISE, 2000), (BATTLE, 200)]   , ptopLeft = [ "XX0"                , "000"                ]   } collapsed4 = collapsed-  { pfreq    = [("noise", 2000), ("battle", 200)]+  { pfreq    = [(NOISE, 2000), (BATTLE, 200)]   , ptopLeft = [ "XXX0"                , "0000"                ]   } collapsed5 = collapsed-  { pfreq    = [("noise", 3000), ("battle", 500)]+  { pfreq    = [(NOISE, 3000), (BATTLE, 500)]   , ptopLeft = [ "XX0"                , "X00"                , "000"                ]   } collapsed6 = collapsed-  { pfreq    = [("noise", 4000), ("battle", 1000)]+  { pfreq    = [(NOISE, 4000), (BATTLE, 1000)]   , ptopLeft = [ "XXX0"                , "X000"                , "0000"                ]   } collapsed7 = collapsed-  { pfreq    = [("noise", 4000), ("battle", 1000)]+  { pfreq    = [(NOISE, 4000), (BATTLE, 1000)]   , ptopLeft = [ "XXX0"                , "XX00"                , "0000"@@ -224,7 +282,7 @@ pillar = PlaceKind   { psymbol  = 'p'   , pname    = "a hall"-  , pfreq    = [("rogue", 600), ("laboratory", 2000)]+  , pfreq    = [(ROGUE, 600), (LABORATORY, 2000)]   , prarity  = [(1, 1)]   , pcover   = CStretch   , pfence   = FNone@@ -238,7 +296,7 @@   , poverrideLit = []   } pillar2 = pillar-  { pfreq    = [("rogue", 60), ("laboratory", 200)]+  { pfreq    = [(ROGUE, 60), (LABORATORY, 200)]   , ptopLeft = [ "----"                , "|0··"                , "|···"@@ -246,7 +304,7 @@                ]   } pillar3 = pillar-  { pfreq    = [("rogue", 8000), ("laboratory", 25000)]+  { pfreq    = [(ROGUE, 8000), (LABORATORY, 25000)]   , ptopLeft = [ "-----"                , "|0···"                , "|····"@@ -256,34 +314,34 @@   } pillar4 = pillar   { pname    = "an exquisite hall"-  , pfreq    = [("rogue", 30000), ("laboratory", 100000)]+  , pfreq    = [(ROGUE, 30000), (LABORATORY, 100000)]   , ptopLeft = [ "-----"                , "|&·0·"                , "|····"                , "|0·0·"                , "|····"                ]-  , poverrideDark = [('&', "cache")]-  , poverrideLit = [('&', "cache")]+  , poverrideDark = [('&', CACHE)]+  , poverrideLit = [('&', CACHE)]   } pillar5 = pillar   { pname    = "a decorated hall"-  , pfreq    = [("rogue", 30000), ("laboratory", 100000)]+  , pfreq    = [(ROGUE, 30000), (LABORATORY, 100000)]   , ptopLeft = [ "-----"                , "|&·0·"                , "|····"                , "|0···"                , "|····"                ]-  , poverrideDark = [('&', "cache")]-  , poverrideLit = [('&', "cache")]+  , poverrideDark = [('&', CACHE)]+  , poverrideLit = [('&', CACHE)]   } colonnade = PlaceKind   { psymbol  = 'c'   , pname    = "a colonnade"-  , pfreq    = [ ("rogue", 3), ("arena", 20), ("laboratory", 2)-               , ("empty", 10000), ("mine", 1000), ("brawl", 4)-               , ("escape", 40), ("ambush", 40) ]+  , pfreq    = [ (ROGUE, 3), (ARENA, 20), (LABORATORY, 2)+               , (EMPTY, 10000), (MINE, 1000), (BRAWL, 4)+               , (ESCAPE, 40), (AMBUSH, 40) ]   , prarity  = [(1, 10), (10, 10)]   , pcover   = CAlternate   , pfence   = FFloor@@ -329,7 +387,7 @@ lampPost = PlaceKind   { psymbol  = 'l'   , pname    = "a lamp-lit area"-  , pfreq    = [("escape", 200), ("ambush", 200), ("zoo", 100), ("battle", 100)]+  , pfreq    = [(ESCAPE, 200), (AMBUSH, 200), (ZOO, 100), (BATTLE, 100)]   , prarity  = [(1, 1)]   , pcover   = CVerbatim   , pfence   = FNone@@ -337,8 +395,8 @@                , "·0·"                , "X·X"                ]-  , poverrideDark = [('0', "lampPostOver_0"), ('·', "floorActorLit")]-  , poverrideLit = [('0', "lampPostOver_0"), ('·', "floorActorLit")]+  , poverrideDark = [('0', S_LAMP_POST), ('·', S_FLOOR_ACTOR_LIT)]+  , poverrideLit = [('0', S_LAMP_POST), ('·', S_FLOOR_ACTOR_LIT)]   } lampPost2 = lampPost   { ptopLeft = [ "···"@@ -347,8 +405,8 @@                ]   } lampPost3 = lampPost-  { pfreq    = [ ("escape", 3000), ("ambush", 3000), ("zoo", 50)-               , ("battle", 110) ]+  { pfreq    = [ (ESCAPE, 3000), (AMBUSH, 3000), (ZOO, 50)+               , (BATTLE, 110) ]   , ptopLeft = [ "XX·XX"                , "X···X"                , "··0··"@@ -357,7 +415,7 @@                ]   } lampPost4 = lampPost-  { pfreq    = [("escape", 3000), ("ambush", 3000), ("zoo", 50), ("battle", 60)]+  { pfreq    = [(ESCAPE, 3000), (AMBUSH, 3000), (ZOO, 50), (BATTLE, 60)]   , ptopLeft = [ "X···X"                , "·····"                , "··0··"@@ -368,7 +426,7 @@ treeShade = PlaceKind   { psymbol  = 't'   , pname    = "a tree shade"-  , pfreq    = [("brawl", 1000)]+  , pfreq    = [(BRAWL, 1000)]   , prarity  = [(1, 1)]   , pcover   = CMirror   , pfence   = FNone@@ -376,17 +434,17 @@                , "s0·"                , "Xs·"                ]-  , poverrideDark = [ ('0', "treeShadeOver_0_Dark")-                    , ('s', "treeShadeOver_s_Dark")-                    , ('·', "shaded ground") ]-  , poverrideLit = [ ('0', "treeShadeOver_0_Lit")-                   , ('s', "treeShadeOver_s_Lit")-                   , ('·', "shaded ground") ]+  , poverrideDark = [ ('0', S_TREE_DARK)+                    , ('s', TREE_SHADE_WALKABLE_DARK)+                    , ('·', S_SHADED_GROUND) ]+  , poverrideLit = [ ('0', S_TREE_LIT)+                   , ('s', TREE_SHADE_WALKABLE_LIT)+                   , ('·', S_SHADED_GROUND) ]   } fogClump = PlaceKind   { psymbol  = 'f'   , pname    = "a foggy patch"-  , pfreq    = [("shootout", 150), ("empty", 15)]+  , pfreq    = [(SHOOTOUT, 150), (EMPTY, 15)]   , prarity  = [(1, 1)]   , pcover   = CMirror   , pfence   = FNone@@ -394,11 +452,11 @@                , ";f"                , ";X"                ]-  , poverrideDark = [('f', "fogClumpOver_f_Dark"), (';', "fog Lit")]-  , poverrideLit = [('f', "fogClumpOver_f_Lit"), (';', "fog Lit")]+  , poverrideDark = [('f', FOG_CLUMP_DARK), (';', S_FOG_LIT)]+  , poverrideLit = [('f', FOG_CLUMP_LIT), (';', S_FOG_LIT)]   } fogClump2 = fogClump-  { pfreq    = [("shootout", 500), ("empty", 50)]+  { pfreq    = [(SHOOTOUT, 500), (EMPTY, 50)]   , ptopLeft = [ "X;f"                , "f;f"                , ";;f"@@ -408,7 +466,7 @@ smokeClump = PlaceKind   { psymbol  = 's'   , pname    = "a smoky patch"-  , pfreq    = [("zoo", 50)]+  , pfreq    = [(ZOO, 50)]   , prarity  = [(1, 1)]   , pcover   = CMirror   , pfence   = FNone@@ -416,13 +474,13 @@                , ";f"                , ";X"                ]-  , poverrideDark = [ ('f', "smokeClumpOver_f_Dark"), (';', "smoke Lit")-                    , ('·', "floorActorDark") ]-  , poverrideLit = [ ('f', "smokeClumpOver_f_Lit"), (';', "smoke Lit")-                   , ('·', "floorActorLit") ]+  , poverrideDark = [ ('f', SMOKE_CLUMP_DARK), (';', S_SMOKE_LIT)+                    , ('·', S_FLOOR_ACTOR_DARK) ]+  , poverrideLit = [ ('f', SMOKE_CLUMP_LIT), (';', S_SMOKE_LIT)+                   , ('·', S_FLOOR_ACTOR_LIT) ]   } smokeClump2 = smokeClump-  { pfreq    = [("zoo", 500)]+  { pfreq    = [(ZOO, 500)]   , ptopLeft = [ "X;f"                , "f;f"                , ";;f"@@ -431,7 +489,7 @@   } smokeClump3FGround = smokeClump   { pname    = "a burned out area"-  , pfreq    = [("laboratory", 150)]+  , pfreq    = [(LABORATORY, 150)]   , prarity  = [(1, 1)]   , pcover   = CVerbatim   , pfence   = FGround@@ -446,35 +504,43 @@ bushClump = PlaceKind   { psymbol  = 'b'   , pname    = "a bushy patch"-  , pfreq    = [("shootout", 80)]+  , pfreq    = [(SHOOTOUT, 40)]   , prarity  = [(1, 1)]   , pcover   = CMirror   , pfence   = FNone-  , ptopLeft = [ "f;"-               , ";X"  -- one sure exit needed not to block a corner-               , ";f"+  , ptopLeft = [ "Xf"  -- one sure exit needed not to block a corner+               , ";X"+               , ";;"                ]-  , poverrideDark = [('f', "bushClumpOver_f_Dark"), (';', "bush Lit")]-  , poverrideLit = [('f', "bushClumpOver_f_Lit"), (';', "bush Lit")]+  , poverrideDark = [('f', BUSH_CLUMP_DARK), (';', S_BUSH_LIT)]+  , poverrideLit = [('f', BUSH_CLUMP_LIT), (';', S_BUSH_LIT)]       -- should not be used in caves with trails, because bushes can't       -- grow over such artificial trails   }+bushClump2 = bushClump+  { pfreq    = [(SHOOTOUT, 80)]+  , ptopLeft = [ "Xf"  -- one sure exit needed not to block a corner+               , ";X"+               , ";X"+               , ";;"+               ]+  } escapeDown = PlaceKind   { psymbol  = '>'   , pname    = "an escape down"-  , pfreq    = [("escape down", 1)]+  , pfreq    = [(INDOOR_ESCAPE_DOWN, 1)]   , prarity  = [(1, 1)]   , pcover   = CVerbatim   , pfence   = FGround   , ptopLeft = [ ">"                ]-  , poverrideDark = [ ('|', "wall Lit")  -- visible from afar-                    , ('-', "wallH Lit") ]-  , poverrideLit = [ ('|', "wall Lit")-                   , ('-', "wallH Lit") ]+  , poverrideDark = [ ('|', S_WALL_LIT)  -- visible from afar+                    , ('-', S_WALL_HORIZONTAL_LIT) ]+  , poverrideLit = [ ('|', S_WALL_LIT)+                   , ('-', S_WALL_HORIZONTAL_LIT) ]   } escapeDown2 = escapeDown-  { pfreq    = [("escape down", 1000)]+  { pfreq    = [(INDOOR_ESCAPE_DOWN, 1000)]   , pfence   = FFloor   , ptopLeft = [ "0·0"                , "·>·"@@ -482,7 +548,7 @@                ]   } escapeDown3 = escapeDown-  { pfreq    = [("escape down", 2000)]+  { pfreq    = [(INDOOR_ESCAPE_DOWN, 2000)]   , pfence   = FNone   , ptopLeft = [ "-----"                , "|0·0|"@@ -492,7 +558,7 @@                ]   } escapeDown4 = escapeDown-  { pfreq    = [("escape down", 1000)]+  { pfreq    = [(INDOOR_ESCAPE_DOWN, 1000)]   , pcover   = CMirror   , pfence   = FFloor   , ptopLeft = [ "0··"@@ -501,7 +567,7 @@                ]   } escapeDown5 = escapeDown-  { pfreq    = [("escape down", 2000)]+  { pfreq    = [(INDOOR_ESCAPE_DOWN, 2000)]   , pcover   = CMirror   , pfence   = FNone   , ptopLeft = [ "-----"@@ -514,24 +580,26 @@ staircase = PlaceKind   { psymbol  = '/'   , pname    = "a staircase"-  , pfreq    = [("tiny staircase", 1)]  -- no cover when arriving; low freq+  , pfreq    = [(TINY_STAIRCASE, 1)]  -- no cover when arriving; low freq   , prarity  = [(1, 100), (10, 100)]   , pcover   = CVerbatim   , pfence   = FGround   , ptopLeft = [ "<·>"                ]-  , poverrideDark = [ ('<', "staircase up"), ('>', "staircase down")-                    , ('I', "signboard")-                    , ('|', "wall Lit"), ('-', "wallH Lit") ]  -- seen from afar-  , poverrideLit = [ ('<', "staircase up"), ('>', "staircase down")-                   , ('I', "signboard")-                   , ('|', "wall Lit"), ('-', "wallH Lit") ]  -- seen from afar+  , poverrideDark = [ ('<', STAIRCASE_UP), ('>', STAIRCASE_DOWN)+                    , ('I', SIGNBOARD)+                    , ('|', S_WALL_LIT), ('-', S_WALL_HORIZONTAL_LIT) ]+                      -- seen from afar+  , poverrideLit = [ ('<', STAIRCASE_UP), ('>', STAIRCASE_DOWN)+                   , ('I', SIGNBOARD)+                   , ('|', S_WALL_LIT), ('-', S_WALL_HORIZONTAL_LIT) ]+                     -- seen from afar   } staircase1 = staircase   { prarity  = [(1, 1)]  -- no cover when arriving; so low rarity   } staircase2 = staircase-  { pfreq    = [("tiny staircase", 3)]+  { pfreq    = [(TINY_STAIRCASE, 3)]   , prarity  = [(1, 1)]   , pfence   = FGround   , ptopLeft = [ "·<·>·"@@ -546,7 +614,7 @@   , prarity  = [(1, 1)]   } staircase5 = staircase-  { pfreq    = [("open staircase", 200)]  -- no cover, open+  { pfreq    = [(OPEN_STAIRCASE, 200)]  -- no cover, open   , pfence   = FGround   , ptopLeft = [ "0·0"                , "···"@@ -556,7 +624,7 @@                ]   } staircase6 = staircase-  { pfreq    = [("open staircase", 300)]+  { pfreq    = [(OPEN_STAIRCASE, 300)]   , pfence   = FGround   , ptopLeft = [ "0·0·0"                , "·····"@@ -566,7 +634,7 @@                ]   } staircase7 = staircase-  { pfreq    = [("open staircase", 500)]+  { pfreq    = [(OPEN_STAIRCASE, 500)]   , pfence   = FGround   , ptopLeft = [ "0·0·0·0"                , "·······"@@ -576,7 +644,7 @@                ]   } staircase8 = staircase-  { pfreq    = [("open staircase", 2000)]+  { pfreq    = [(OPEN_STAIRCASE, 2000)]   , pfence   = FGround   , ptopLeft = [ "·0·I·0·"                , "0·····0"@@ -586,7 +654,7 @@                ]   } staircase9 = staircase-  { pfreq    = [("open staircase", 500)]+  { pfreq    = [(OPEN_STAIRCASE, 500)]   , pfence   = FGround   , ptopLeft = [ "0·······0"                , "···<·>···"@@ -594,7 +662,7 @@                ]   } staircase10 = staircase-  { pfreq    = [("open staircase", 500)]+  { pfreq    = [(OPEN_STAIRCASE, 500)]   , pfence   = FGround   , ptopLeft = [ "0·····0"                , "··<·>··"@@ -602,7 +670,7 @@                ]   } staircase11 = staircase-  { pfreq    = [("closed staircase", 2000)]  -- weak cover, low freq+  { pfreq    = [(CLOSED_STAIRCASE, 2000)]  -- weak cover, low freq   , pfence   = FFloor   , ptopLeft = [ "·0·"                , "0·0"@@ -614,7 +682,7 @@                ]   } staircase12 = staircase-  { pfreq    = [("closed staircase", 4000)]+  { pfreq    = [(CLOSED_STAIRCASE, 4000)]   , pfence   = FFloor   , ptopLeft = [ "·0·0·"                , "0·0·0"@@ -626,7 +694,7 @@                ]   } staircase13 = staircase-  { pfreq    = [("closed staircase", 6000)]+  { pfreq    = [(CLOSED_STAIRCASE, 6000)]   , pfence   = FFloor   , ptopLeft = [ "·0·0·0·"                , "0·0·0·0"@@ -638,7 +706,7 @@                ]   } staircase14 = staircase-  { pfreq    = [("closed staircase", 10000)]+  { pfreq    = [(CLOSED_STAIRCASE, 10000)]   , pfence   = FFloor   , ptopLeft = [ "0·0·0·0"                , "·0·0·0·"@@ -650,7 +718,7 @@                ]   } staircase15 = staircase-  { pfreq    = [("closed staircase", 20000)]+  { pfreq    = [(CLOSED_STAIRCASE, 20000)]   , pfence   = FFloor   , ptopLeft = [ "·0·0·0·0·"                , "0·0·0·0·0"@@ -662,7 +730,7 @@                ]   } staircase16 = staircase-  { pfreq    = [("closed staircase", 20000)]+  { pfreq    = [(CLOSED_STAIRCASE, 20000)]   , pfence   = FFloor   , ptopLeft = [ "0·0·0·0·0"                , "·0·0·0·0·"@@ -674,7 +742,7 @@                ]   } staircase17 = staircase-  { pfreq    = [("closed staircase", 20000)]+  { pfreq    = [(CLOSED_STAIRCASE, 20000)]   , pfence   = FFloor   , ptopLeft = [ "0·0·0·0·0·0"                , "·0·0·0·0·0·"@@ -686,7 +754,7 @@                ]   } staircase18 = staircase-  { pfreq    = [("closed staircase", 80000)]+  { pfreq    = [(CLOSED_STAIRCASE, 80000)]   , pfence   = FFloor   , ptopLeft = [ "··0·0·0·0··"                , "·0·0·0·0·0·"@@ -698,7 +766,7 @@                ]   } staircase19 = staircase-  { pfreq    = [("closed staircase", 20000)]+  { pfreq    = [(CLOSED_STAIRCASE, 20000)]   , pfence   = FFloor   , ptopLeft = [ "·0·0·0·0·0·"                , "0·0·0·0·0·0"@@ -710,7 +778,7 @@                ]   } staircase20 = staircase-  { pfreq    = [("closed staircase", 5000)]+  { pfreq    = [(CLOSED_STAIRCASE, 5000)]   , pfence   = FFloor   , ptopLeft = [ "·0·0·0·0·0·"                , "0·0·····0·0"@@ -720,7 +788,7 @@                ]   } staircase21 = staircase-  { pfreq    = [("closed staircase", 5000)]+  { pfreq    = [(CLOSED_STAIRCASE, 5000)]   , pfence   = FFloor   , ptopLeft = [ "0·0·I·0·0"                , "·0·····0·"@@ -730,7 +798,7 @@                ]   } staircase22 = staircase-  { pfreq    = [("closed staircase", 2000)]+  { pfreq    = [(CLOSED_STAIRCASE, 2000)]   , pfence   = FFloor   , ptopLeft = [ "0·0·····0·0"                , "·0··<·>··0·"@@ -738,7 +806,7 @@                ]   } staircase23 = staircase-  { pfreq    = [("closed staircase", 1000)]+  { pfreq    = [(CLOSED_STAIRCASE, 1000)]   , pfence   = FFloor   , ptopLeft = [ "·0·······0·"                , "0·0·<·>·0·0"@@ -746,7 +814,7 @@                ]   } staircase24 = staircase-  { pfreq    = [("closed staircase", 1000)]+  { pfreq    = [(CLOSED_STAIRCASE, 1000)]   , pfence   = FFloor   , ptopLeft = [ "·0·····0·"                , "0··<·>··0"@@ -754,7 +822,7 @@                ]   } staircase25 = staircase-  { pfreq    = [("walled staircase", 10)]+  { pfreq    = [(WALLED_STAIRCASE, 10)]   , pfence   = FNone   , ptopLeft = [ "-------"                , "|·····|"@@ -764,7 +832,7 @@                ]   } staircase26 = staircase-  { pfreq    = [("walled staircase", 50)]+  { pfreq    = [(WALLED_STAIRCASE, 50)]   , pfence   = FNone   , ptopLeft = [ "---------"                , "|·······|"@@ -774,7 +842,7 @@                ]   } staircase27 = staircase-  { pfreq    = [("walled staircase", 100)]+  { pfreq    = [(WALLED_STAIRCASE, 100)]   , pfence   = FNone   , ptopLeft = [ "---------"                , "|0·····0|"@@ -784,7 +852,7 @@                ]   } staircase28 = staircase-  { pfreq    = [("walled staircase", 1000)]+  { pfreq    = [(WALLED_STAIRCASE, 1000)]   , pfence   = FNone   , ptopLeft = [ "-------"                , "|·····|"@@ -796,7 +864,7 @@                ]   } staircase29 = staircase-  { pfreq    = [("walled staircase", 1000)]+  { pfreq    = [(WALLED_STAIRCASE, 1000)]   , pfence   = FNone   , ptopLeft = [ "-------"                , "|0···0|"@@ -808,7 +876,7 @@                ]   } staircase30 = staircase-  { pfreq    = [("walled staircase", 1000)]+  { pfreq    = [(WALLED_STAIRCASE, 1000)]   , pfence   = FNone   , ptopLeft = [ "-------"                , "|0·0·0|"@@ -820,7 +888,7 @@                ]   } staircase31 = staircase-  { pfreq    = [("walled staircase", 2000)]+  { pfreq    = [(WALLED_STAIRCASE, 2000)]   , pfence   = FNone   , ptopLeft = [ "---------"                , "|·······|"@@ -832,7 +900,7 @@                ]   } staircase32 = staircase-  { pfreq    = [("walled staircase", 5000)]+  { pfreq    = [(WALLED_STAIRCASE, 5000)]   , pfence   = FNone   , ptopLeft = [ "---------"                , "|0·····0|"@@ -844,7 +912,7 @@                ]   } staircase33 = staircase-  { pfreq    = [("walled staircase", 5000)]+  { pfreq    = [(WALLED_STAIRCASE, 5000)]   , pfence   = FNone   , ptopLeft = [ "---------"                , "|0·0·0·0|"@@ -856,7 +924,7 @@                ]   } staircase34 = staircase-  { pfreq    = [("walled staircase", 5000)]+  { pfreq    = [(WALLED_STAIRCASE, 5000)]   , pfence   = FNone   , ptopLeft = [ "---------"                , "|·0·0·0·|"@@ -868,7 +936,7 @@                ]   } staircase35 = staircase-  { pfreq    = [("walled staircase", 200)]+  { pfreq    = [(WALLED_STAIRCASE, 200)]   , pfence   = FNone   , ptopLeft = [ "-----------"                , "|·········|"@@ -878,7 +946,7 @@                ]   } staircase36 = staircase-  { pfreq    = [("walled staircase", 500)]+  { pfreq    = [(WALLED_STAIRCASE, 500)]   , pfence   = FNone   , ptopLeft = [ "-----------"                , "|·0·····0·|"@@ -888,7 +956,7 @@                ]   } staircase37 = staircase-  { pfreq    = [("walled staircase", 500)]+  { pfreq    = [(WALLED_STAIRCASE, 500)]   , pfence   = FNone   , ptopLeft = [ "-----------"                , "|0·······0|"@@ -902,11 +970,11 @@ switchStaircaseToUp s = s  { psymbol   = '<'  , pname     = pname s <+> "up"- , pfreq     = map (\(t, k) -> (toGroupName $ fromGroupName t <+> "up", k))+ , pfreq     = map (\(t, k) -> (GroupName $ fromGroupName t <+> "up", k))                $ pfreq s- , poverrideDark = ('>', "stair terminal Dark")+ , poverrideDark = ('>', STAIR_TERMINAL_DARK)                    : filter ((/= '>') . fst) (poverrideDark s)- , poverrideLit = ('>', "stair terminal Lit")+ , poverrideLit = ('>', STAIR_TERMINAL_LIT)                   : filter ((/= '>') . fst) (poverrideLit s)  } @@ -914,25 +982,25 @@ switchStaircaseToDown s = s  { psymbol   = '>'  , pname     = pname s <+> "down"- , pfreq     = map (\(t, k) -> (toGroupName $ fromGroupName t <+> "down", k))+ , pfreq     = map (\(t, k) -> (GroupName $ fromGroupName t <+> "down", k))                $ pfreq s- , poverrideDark = ('<', "stair terminal Dark")+ , poverrideDark = ('<', STAIR_TERMINAL_DARK)                    : filter ((/= '<') . fst) (poverrideDark s)- , poverrideLit = ('<', "stair terminal Lit")+ , poverrideLit = ('<', STAIR_TERMINAL_LIT)                   : filter ((/= '<') . fst) (poverrideLit s)  }  overrideGated :: [(Char, GroupName TileKind)] overrideGated =-  [ ('<', "gated staircase up"), ('>', "gated staircase down")-  , ('I', "signboard")-  , ('|', "wall Lit"), ('-', "wallH Lit") ]  -- visible from afar+  [ ('<', GATED_STAIRCASE_UP), ('>', GATED_STAIRCASE_DOWN)+  , ('I', SIGNBOARD)+  , ('|', S_WALL_LIT), ('-', S_WALL_HORIZONTAL_LIT) ]  -- visible from afar  switchStaircaseToGated :: PlaceKind -> PlaceKind switchStaircaseToGated s = s  { psymbol   = 'g'  , pname     = T.unwords $ "a gated" : tail (T.words (pname s))- , pfreq     = map (first (\t -> toGroupName $ "gated" <+> fromGroupName t))+ , pfreq     = map (first (\t -> GroupName $ "gated" <+> fromGroupName t))                $ pfreq s  , poverrideDark = overrideGated  , poverrideLit = overrideGated@@ -940,15 +1008,15 @@  overrideOutdoor :: [(Char, GroupName TileKind)] overrideOutdoor =-  [ ('<', "staircase outdoor up"), ('>', "staircase outdoor down")-  , ('I', "signboard")-  , ('|', "wall Lit"), ('-', "wallH Lit") ]  -- visible from afar+  [ ('<', STAIRCASE_OUTDOOR_UP), ('>', STAIRCASE_OUTDOOR_DOWN)+  , ('I', SIGNBOARD)+  , ('|', S_WALL_LIT), ('-', S_WALL_HORIZONTAL_LIT) ]  -- visible from afar  switchStaircaseToOutdoor :: PlaceKind -> PlaceKind switchStaircaseToOutdoor s = s  { psymbol   = 'o'  , pname     = "an outdoor area exit"- , pfreq     = map (first (\t -> toGroupName $ "outdoor" <+> fromGroupName t))+ , pfreq     = map (first (\t -> GroupName $ "outdoor" <+> fromGroupName t))                $ pfreq s  , poverrideDark = overrideOutdoor  , poverrideLit = overrideOutdoor@@ -958,15 +1026,15 @@ switchEscapeToUp s = s  { psymbol   = '<'  , pname     = "an escape up"- , pfreq     = map (\(_, n) -> ("escape up", n)) $ pfreq s- , poverrideDark = ('>', "escape up") : poverrideDark s- , poverrideLit = ('>', "escape up") : poverrideLit s+ , pfreq     = map (\(_, n) -> (INDOOR_ESCAPE_UP, n)) $ pfreq s+ , poverrideDark = ('>', ESCAPE_UP) : poverrideDark s+ , poverrideLit = ('>', ESCAPE_UP) : poverrideLit s  }  switchEscapeToOutdoorDown :: PlaceKind -> PlaceKind switchEscapeToOutdoorDown s = s  { pname     = "outdoor escape route"- , pfreq     = map (\(_, n) -> ("escape outdoor down", n)) $ pfreq s- , poverrideDark = ('>', "escape outdoor down") : poverrideDark s- , poverrideLit = ('>', "escape outdoor down") : poverrideLit s+ , pfreq     = map (\(_, n) -> (OUTDOOR_ESCAPE_DOWN, n)) $ pfreq s+ , poverrideDark = ('>', ESCAPE_OUTDOOR_DOWN) : poverrideDark s+ , poverrideLit = ('>', ESCAPE_OUTDOOR_DOWN) : poverrideLit s  }

GameDefinition/Content/RuleKind.hs view

@@ -6,12 +6,17 @@  import Prelude () -import Language.Haskell.TH.Syntax-import System.FilePath-import System.IO (readFile)+import Game.LambdaHack.Core.Prelude +import qualified Data.Ini.Reader as Ini+import           Instances.TH.Lift ()+import           Language.Haskell.TH.Syntax+import           System.FilePath+import           System.IO+  (IOMode (ReadMode), hGetContents, hSetEncoding, openFile, utf8)+ -- Cabal-import qualified Paths_LambdaHack as Self (getDataFileName, version)+import qualified Paths_LambdaHack as Self (version)  import Game.LambdaHack.Content.RuleKind @@ -20,9 +25,6 @@   { rtitle = "LambdaHack"   , rXmax = 80   , rYmax = 21-  , rfontDir = $(do-      x <- qRunIO (Self.getDataFileName "GameDefinition/fonts")-      lift x)   , rexeVersion = Self.version   -- The strings containing the default configuration file   -- included from config.ui.default.@@ -30,8 +32,14 @@   , rcfgUIDefault = $(do       let path = "GameDefinition" </> "config.ui" <.> "default"       qAddDependentFile path-      x <- qRunIO (readFile path)-      lift x)+      s <- qRunIO $ do+        inputHandle <- openFile path ReadMode+        hSetEncoding inputHandle utf8+        hGetContents inputHandle+      let cfgUIDefault =+            either (error . ("Ini.parse of default config" `showFailure`)) id+            $ Ini.parse s+      lift (s, cfgUIDefault))   , rwriteSaveClips = 1000   , rleadLevelClips = 50   , rscoresFile = "LambdaHack.scores"

GameDefinition/Content/TileKind.hs view

@@ -1,6 +1,16 @@--- | Terrain tile definitions.+-- | Definitions of tile kinds. Every terrain tile in the game is+-- an instantiated tile kind. module Content.TileKind-  ( content+  ( -- * Group name patterns+    -- ** Used in CaveKind and perhaps elsewhere.+    pattern FILLER_WALL, pattern FLOOR_CORRIDOR_LIT, pattern FLOOR_CORRIDOR_DARK, pattern TRAIL_LIT, pattern SAFE_TRAIL_LIT, pattern LAB_TRAIL_LIT, pattern DAMP_FLOOR_LIT, pattern DAMP_FLOOR_DARK, pattern OUTDOOR_OUTER_FENCE, pattern DIRT_LIT, pattern DIRT_DARK, pattern FLOOR_ARENA_LIT, pattern FLOOR_ARENA_DARK+  , pattern EMPTY_SET_LIT, pattern EMPTY_SET_DARK, pattern NOISE_SET_LIT, pattern POWER_SET_LIT, pattern POWER_SET_DARK, pattern BATTLE_SET_LIT, pattern BATTLE_SET_DARK, pattern BRAWL_SET_LIT, pattern SHOOTOUT_SET_LIT, pattern ZOO_SET_LIT, pattern ZOO_SET_DARK, pattern ESCAPE_SET_LIT, pattern ESCAPE_SET_DARK, pattern AMBUSH_SET_LIT, pattern AMBUSH_SET_DARK, pattern ARENA_SET_LIT, pattern ARENA_SET_DARK+    -- ** Used in PlaceKind, but not in CaveKind.+  , pattern RECT_WINDOWS_VERTICAL_LIT, pattern RECT_WINDOWS_VERTICAL_DARK, pattern RECT_WINDOWS_HORIZONTAL_LIT, pattern RECT_WINDOWS_HORIZONTAL_DARK, pattern TREE_SHADE_WALKABLE_LIT, pattern TREE_SHADE_WALKABLE_DARK, pattern SMOKE_CLUMP_LIT, pattern SMOKE_CLUMP_DARK, pattern GLASSHOUSE_VERTICAL_LIT, pattern GLASSHOUSE_VERTICAL_DARK, pattern GLASSHOUSE_HORIZONTAL_LIT, pattern GLASSHOUSE_HORIZONTAL_DARK, pattern BUSH_CLUMP_LIT, pattern BUSH_CLUMP_DARK, pattern FOG_CLUMP_LIT, pattern FOG_CLUMP_DARK, pattern STAIR_TERMINAL_LIT, pattern STAIR_TERMINAL_DARK, pattern CACHE, pattern SIGNBOARD, pattern STAIRCASE_UP, pattern ORDINARY_STAIRCASE_UP, pattern STAIRCASE_OUTDOOR_UP, pattern GATED_STAIRCASE_UP, pattern STAIRCASE_DOWN, pattern ORDINARY_STAIRCASE_DOWN, pattern STAIRCASE_OUTDOOR_DOWN, pattern GATED_STAIRCASE_DOWN, pattern ESCAPE_UP, pattern ESCAPE_DOWN, pattern ESCAPE_OUTDOOR_DOWN+  , pattern S_LAMP_POST, pattern S_TREE_LIT, pattern S_TREE_DARK, pattern S_WALL_LIT, pattern S_WALL_HORIZONTAL_LIT, pattern S_PULPIT, pattern S_BUSH_LIT, pattern S_FOG_LIT, pattern S_SMOKE_LIT, pattern S_FLOOR_ACTOR_LIT, pattern S_FLOOR_ACTOR_DARK, pattern S_FLOOR_ASHES_LIT, pattern S_FLOOR_ASHES_DARK, pattern S_SHADED_GROUND+  , groupNamesSingleton, groupNames+    -- * Content+  , content   ) where  import Prelude ()@@ -9,10 +19,186 @@  import qualified Data.Text as T +import Content.ItemKindEmbed import Game.LambdaHack.Content.TileKind import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs +-- * Group name patterns++-- Warning, many of these are also sythesized, so typos can happen.++groupNamesSingleton :: [GroupName TileKind]+groupNamesSingleton =+       [S_LAMP_POST, S_TREE_LIT, S_TREE_DARK, S_WALL_LIT, S_WALL_HORIZONTAL_LIT, S_PULPIT, S_BUSH_LIT, S_FOG_LIT, S_SMOKE_LIT, S_FLOOR_ACTOR_LIT, S_FLOOR_ACTOR_DARK, S_FLOOR_ASHES_LIT, S_FLOOR_ASHES_DARK, S_SHADED_GROUND]+    ++ [S_SUSPECT_VERTICAL_WALL_LIT, S_SUSPECT_HORIZONTAL_WALL_LIT, S_CLOSED_VERTICAL_DOOR_LIT, S_CLOSED_HORIZONTAL_DOOR_LIT, S_OPEN_VERTICAL_DOOR_LIT, S_OPEN_HORIZONTAL_DOOR_LIT, S_RUBBLE_PILE, S_SHALLOW_WATER_LIT, S_SIGNBOARD_UNREAD]+    ++ [S_BUSH_DARK, S_CLOSED_HORIZONTAL_DOOR_DARK, S_CLOSED_VERTICAL_DOOR_DARK, S_OPEN_HORIZONTAL_DOOR_DARK, S_OPEN_VERTICAL_DOOR_DARK, S_SHALLOW_WATER_DARK, S_SUSPECT_HORIZONTAL_WALL_DARK, S_SUSPECT_VERTICAL_WALL_DARK, S_WALL_DARK, S_WALL_HORIZONTAL_DARK]++-- ** Used in PlaceKind, but not in CaveKind.+pattern S_LAMP_POST, S_TREE_LIT, S_TREE_DARK, S_WALL_LIT, S_WALL_HORIZONTAL_LIT, S_PULPIT, S_BUSH_LIT, S_FOG_LIT, S_SMOKE_LIT, S_FLOOR_ACTOR_LIT, S_FLOOR_ACTOR_DARK, S_FLOOR_ASHES_LIT, S_FLOOR_ASHES_DARK, S_SHADED_GROUND :: GroupName TileKind++-- ** Used only internally in other TileKind definitions or never used.+pattern S_SUSPECT_VERTICAL_WALL_LIT, S_SUSPECT_HORIZONTAL_WALL_LIT, S_CLOSED_VERTICAL_DOOR_LIT, S_CLOSED_HORIZONTAL_DOOR_LIT, S_OPEN_VERTICAL_DOOR_LIT, S_OPEN_HORIZONTAL_DOOR_LIT, S_RUBBLE_PILE, S_SHALLOW_WATER_LIT, S_SIGNBOARD_UNREAD :: GroupName TileKind++-- * Not used, but needed, because auto-generated. Singletons.+pattern S_BUSH_DARK, S_CLOSED_HORIZONTAL_DOOR_DARK, S_CLOSED_VERTICAL_DOOR_DARK, S_OPEN_HORIZONTAL_DOOR_DARK, S_OPEN_VERTICAL_DOOR_DARK, S_SHALLOW_WATER_DARK, S_SUSPECT_HORIZONTAL_WALL_DARK, S_SUSPECT_VERTICAL_WALL_DARK, S_WALL_DARK, S_WALL_HORIZONTAL_DARK :: GroupName TileKind++-- TODO: if we stick to the current system of generating extra kinds and their+-- group names, let's also add the generated group names to @groupNames@.+groupNames :: [GroupName TileKind]+groupNames =+       [FILLER_WALL, FLOOR_CORRIDOR_LIT, FLOOR_CORRIDOR_DARK, TRAIL_LIT, SAFE_TRAIL_LIT, LAB_TRAIL_LIT, DAMP_FLOOR_LIT, DAMP_FLOOR_DARK, OUTDOOR_OUTER_FENCE, DIRT_LIT, DIRT_DARK, FLOOR_ARENA_LIT, FLOOR_ARENA_DARK]+    ++ [EMPTY_SET_LIT, EMPTY_SET_DARK, NOISE_SET_LIT, POWER_SET_LIT, POWER_SET_DARK, BATTLE_SET_LIT, BATTLE_SET_DARK, BRAWL_SET_LIT, SHOOTOUT_SET_LIT, ZOO_SET_LIT, ZOO_SET_DARK, ESCAPE_SET_LIT, ESCAPE_SET_DARK, AMBUSH_SET_LIT, AMBUSH_SET_DARK, ARENA_SET_LIT, ARENA_SET_DARK]+    ++ [RECT_WINDOWS_VERTICAL_LIT, RECT_WINDOWS_VERTICAL_DARK, RECT_WINDOWS_HORIZONTAL_LIT, RECT_WINDOWS_HORIZONTAL_DARK, TREE_SHADE_WALKABLE_LIT, TREE_SHADE_WALKABLE_DARK, SMOKE_CLUMP_LIT, SMOKE_CLUMP_DARK, GLASSHOUSE_VERTICAL_LIT, GLASSHOUSE_VERTICAL_DARK, GLASSHOUSE_HORIZONTAL_LIT, GLASSHOUSE_HORIZONTAL_DARK, BUSH_CLUMP_LIT, BUSH_CLUMP_DARK, FOG_CLUMP_LIT, FOG_CLUMP_DARK, STAIR_TERMINAL_LIT, STAIR_TERMINAL_DARK, CACHE, SIGNBOARD, STAIRCASE_UP, ORDINARY_STAIRCASE_UP, STAIRCASE_OUTDOOR_UP, GATED_STAIRCASE_UP, STAIRCASE_DOWN, ORDINARY_STAIRCASE_DOWN, STAIRCASE_OUTDOOR_DOWN, GATED_STAIRCASE_DOWN, ESCAPE_UP, ESCAPE_DOWN, ESCAPE_OUTDOOR_DOWN]+    ++ [OBSCURED_VERTICAL_WALL_LIT, OBSCURED_HORIZONTAL_WALL_LIT, TRAPPED_VERTICAL_DOOR_LIT, TRAPPED_HORIZONAL_DOOR_LIT, TREE_BURNING_OR_NOT, BUSH_BURNING_OR_NOT, CACHE_OR_NOT]+    ++ [BRAWL_SET_DARK, NOISE_SET_DARK, OBSCURED_HORIZONTAL_WALL_DARK, OBSCURED_VERTICAL_WALL_DARK, SHOOTOUT_SET_DARK, TRAPPED_HORIZONAL_DOOR_DARK, TRAPPED_VERTICAL_DOOR_DARK]++pattern FILLER_WALL, FLOOR_CORRIDOR_LIT, FLOOR_CORRIDOR_DARK, TRAIL_LIT, SAFE_TRAIL_LIT, LAB_TRAIL_LIT, DAMP_FLOOR_LIT, DAMP_FLOOR_DARK, OUTDOOR_OUTER_FENCE, DIRT_LIT, DIRT_DARK, FLOOR_ARENA_LIT, FLOOR_ARENA_DARK :: GroupName TileKind++pattern EMPTY_SET_LIT, EMPTY_SET_DARK, NOISE_SET_LIT, POWER_SET_LIT, POWER_SET_DARK, BATTLE_SET_LIT, BATTLE_SET_DARK, BRAWL_SET_LIT, SHOOTOUT_SET_LIT, ZOO_SET_LIT, ZOO_SET_DARK, ESCAPE_SET_LIT, ESCAPE_SET_DARK, AMBUSH_SET_LIT, AMBUSH_SET_DARK, ARENA_SET_LIT, ARENA_SET_DARK :: GroupName TileKind++-- ** Used in PlaceKind, but not in CaveKind.+pattern RECT_WINDOWS_VERTICAL_LIT, RECT_WINDOWS_VERTICAL_DARK, RECT_WINDOWS_HORIZONTAL_LIT, RECT_WINDOWS_HORIZONTAL_DARK, TREE_SHADE_WALKABLE_LIT, TREE_SHADE_WALKABLE_DARK, SMOKE_CLUMP_LIT, SMOKE_CLUMP_DARK, GLASSHOUSE_VERTICAL_LIT, GLASSHOUSE_VERTICAL_DARK, GLASSHOUSE_HORIZONTAL_LIT, GLASSHOUSE_HORIZONTAL_DARK, BUSH_CLUMP_LIT, BUSH_CLUMP_DARK, FOG_CLUMP_LIT, FOG_CLUMP_DARK, STAIR_TERMINAL_LIT, STAIR_TERMINAL_DARK, CACHE, SIGNBOARD, STAIRCASE_UP, ORDINARY_STAIRCASE_UP, STAIRCASE_OUTDOOR_UP, GATED_STAIRCASE_UP, STAIRCASE_DOWN, ORDINARY_STAIRCASE_DOWN, STAIRCASE_OUTDOOR_DOWN, GATED_STAIRCASE_DOWN, ESCAPE_UP, ESCAPE_DOWN, ESCAPE_OUTDOOR_DOWN :: GroupName TileKind++-- ** Used only internally in other TileKind definitions or never used.+pattern OBSCURED_VERTICAL_WALL_LIT, OBSCURED_HORIZONTAL_WALL_LIT, TRAPPED_VERTICAL_DOOR_LIT, TRAPPED_HORIZONAL_DOOR_LIT, TREE_BURNING_OR_NOT, BUSH_BURNING_OR_NOT, CACHE_OR_NOT :: GroupName TileKind++-- * Not used, but needed, because auto-generated. Not singletons.+pattern BRAWL_SET_DARK, NOISE_SET_DARK, OBSCURED_HORIZONTAL_WALL_DARK, OBSCURED_VERTICAL_WALL_DARK, SHOOTOUT_SET_DARK, TRAPPED_HORIZONAL_DOOR_DARK, TRAPPED_VERTICAL_DOOR_DARK :: GroupName TileKind++-- ** Used in CaveKind and perhaps elsewhere (or a dark/lit version thereof).+pattern FILLER_WALL = GroupName "fillerWall"+pattern FLOOR_CORRIDOR_LIT = GroupName "floorCorridorLit"+pattern FLOOR_CORRIDOR_DARK = GroupName "floorCorridorDark"+pattern TRAIL_LIT = GroupName "trailLit"+pattern SAFE_TRAIL_LIT = GroupName "safeTrailLit"+pattern LAB_TRAIL_LIT = GroupName "labTrailLit"+  -- these three would work without @_LIT@, but it will be needed when+  -- in the future a lit trail is made from terrain that has an autogenerated+  -- dark variant+pattern DAMP_FLOOR_LIT = GroupName "damp floor Lit"+pattern DAMP_FLOOR_DARK = GroupName "damp floor Dark"+pattern OUTDOOR_OUTER_FENCE = GroupName "outdoor outer fence"+pattern DIRT_LIT = GroupName "dirt Lit"+pattern DIRT_DARK = GroupName "dirt Dark"+pattern FLOOR_ARENA_LIT = GroupName "floorArenaLit"+pattern FLOOR_ARENA_DARK = GroupName "floorArenaDark"++-- ** Used in CaveKind and perhaps elsewhere; sets of tiles for filling cave.+pattern EMPTY_SET_LIT = GroupName "emptySetLit"+pattern EMPTY_SET_DARK = GroupName "emptySetDark"+pattern NOISE_SET_LIT = GroupName "noiseSetLit"+pattern POWER_SET_LIT = GroupName "powerSetLit"+pattern POWER_SET_DARK = GroupName "powerSetDark"+pattern BATTLE_SET_LIT = GroupName "battleSetLit"+pattern BATTLE_SET_DARK = GroupName "battleSetDark"+pattern BRAWL_SET_LIT = GroupName "brawlSetLit"+pattern SHOOTOUT_SET_LIT = GroupName "shootoutSetLit"+pattern ZOO_SET_LIT = GroupName "zooSetLit"+pattern ZOO_SET_DARK = GroupName "zooSetDark"+pattern ESCAPE_SET_LIT = GroupName "escapeSetLit"+pattern ESCAPE_SET_DARK = GroupName "escapeSetDark"+pattern AMBUSH_SET_LIT = GroupName "ambushSetLit"+pattern AMBUSH_SET_DARK = GroupName "ambushSetDark"+pattern ARENA_SET_LIT = GroupName "arenaSetLit"+pattern ARENA_SET_DARK = GroupName "arenaSetDark"++-- ** Used in PlaceKind, but not in CaveKind. Not singletons.+pattern RECT_WINDOWS_VERTICAL_LIT = GroupName "rectWindowsVerticalLit"+pattern RECT_WINDOWS_VERTICAL_DARK = GroupName "rectWindowsVerticalDark"+pattern RECT_WINDOWS_HORIZONTAL_LIT = GroupName "rectWindowsHorizontalLit"+pattern RECT_WINDOWS_HORIZONTAL_DARK = GroupName "rectWindowsHorizontalDark"+pattern TREE_SHADE_WALKABLE_LIT = GroupName "treeShadeWalkableLit"+pattern TREE_SHADE_WALKABLE_DARK = GroupName "treeShadeWalkableDark"+pattern SMOKE_CLUMP_LIT = GroupName "smokeClumpLit"+pattern SMOKE_CLUMP_DARK = GroupName "smokeClumpDark"+pattern GLASSHOUSE_VERTICAL_LIT = GroupName "glasshouseVerticalLit"+pattern GLASSHOUSE_VERTICAL_DARK = GroupName "glasshouseVerticalDark"+pattern GLASSHOUSE_HORIZONTAL_LIT = GroupName "glasshouseHorizontalLit"+pattern GLASSHOUSE_HORIZONTAL_DARK = GroupName "glasshouseHorizontalDark"+pattern BUSH_CLUMP_LIT = GroupName "bushClumpLit"+pattern BUSH_CLUMP_DARK = GroupName "bushClumpDark"+pattern FOG_CLUMP_LIT = GroupName "fogClumpLit"+pattern FOG_CLUMP_DARK = GroupName "fogClumpDark"+pattern STAIR_TERMINAL_LIT = GroupName "stair terminal Lit"+pattern STAIR_TERMINAL_DARK = GroupName "stair terminal Dark"+pattern CACHE = GroupName "cache"+pattern SIGNBOARD = GroupName "signboard"+pattern STAIRCASE_UP = GroupName "staircase up"+pattern ORDINARY_STAIRCASE_UP = GroupName "ordinary staircase up"+pattern STAIRCASE_OUTDOOR_UP = GroupName "staircase outdoor up"+pattern GATED_STAIRCASE_UP = GroupName "gated staircase up"+pattern STAIRCASE_DOWN = GroupName "staircase down"+pattern ORDINARY_STAIRCASE_DOWN = GroupName "ordinary staircase down"+pattern STAIRCASE_OUTDOOR_DOWN = GroupName "staircase outdoor down"+pattern GATED_STAIRCASE_DOWN = GroupName "gated staircase down"+pattern ESCAPE_UP = GroupName "escape up"+pattern ESCAPE_DOWN = GroupName "escape down"+pattern ESCAPE_OUTDOOR_DOWN = GroupName "escape outdoor down"++-- ** Used in PlaceKind, but not in CaveKind. Singletons.+pattern S_LAMP_POST = GroupName "lamp post"+pattern S_TREE_LIT = GroupName "tree Lit"+pattern S_TREE_DARK = GroupName "tree Dark"+pattern S_WALL_LIT = GroupName "wall Lit"+pattern S_WALL_HORIZONTAL_LIT = GroupName "wall horizontal Lit"+pattern S_PULPIT = GroupName "pulpit"+pattern S_BUSH_LIT = GroupName "bush Lit"+pattern S_FOG_LIT = GroupName "fog Lit"+pattern S_SMOKE_LIT = GroupName "smoke Lit"+pattern S_FLOOR_ACTOR_LIT = GroupName "floor with actors Lit"+pattern S_FLOOR_ACTOR_DARK = GroupName "floor with actors Dark"+pattern S_FLOOR_ASHES_LIT = GroupName "floor with ashes Lit"+pattern S_FLOOR_ASHES_DARK = GroupName "floor with ashes Dark"+pattern S_SHADED_GROUND = GroupName "shaded ground"++-- ** Used only internally in other TileKind definitions. Not singletons.+pattern OBSCURED_VERTICAL_WALL_LIT = GroupName "obscured vertical wall Lit"+pattern OBSCURED_HORIZONTAL_WALL_LIT = GroupName "obscured horizontal wall Lit"+pattern TRAPPED_VERTICAL_DOOR_LIT = GroupName "trapped vertical door Lit"+pattern TRAPPED_HORIZONAL_DOOR_LIT = GroupName "trapped horizontal door Lit"+pattern TREE_BURNING_OR_NOT = GroupName "tree burning or not"+pattern BUSH_BURNING_OR_NOT = GroupName "bush burning or not"+pattern CACHE_OR_NOT = GroupName "cache or not"++-- ** Used only internally in other TileKind definitions. Singletons.+pattern S_SUSPECT_VERTICAL_WALL_LIT = GroupName "suspect vertical wall Lit"+pattern S_SUSPECT_HORIZONTAL_WALL_LIT = GroupName "suspect horizontal wall Lit"+pattern S_CLOSED_VERTICAL_DOOR_LIT = GroupName "closed vertical door Lit"+pattern S_CLOSED_HORIZONTAL_DOOR_LIT = GroupName "closed horizontal door Lit"+pattern S_OPEN_VERTICAL_DOOR_LIT = GroupName "open vertical door Lit"+pattern S_OPEN_HORIZONTAL_DOOR_LIT = GroupName "open horizontal door Lit"+pattern S_RUBBLE_PILE = GroupName "rubble pile"+pattern S_SHALLOW_WATER_LIT = GroupName "shallow water Lit"+pattern S_SIGNBOARD_UNREAD = GroupName "signboard unread"++-- * Not used, but needed, because auto-generated. Not singletons.+-- This is a rotten compromise, because these are synthesized below,+-- so typos can happen. Similarly below+pattern BRAWL_SET_DARK = GroupName "brawlSetDark"+pattern NOISE_SET_DARK = GroupName "noiseSetDark"+pattern OBSCURED_HORIZONTAL_WALL_DARK =+  GroupName "obscured horizontal wall Dark"+pattern OBSCURED_VERTICAL_WALL_DARK = GroupName "obscured vertical wall Dark"+pattern SHOOTOUT_SET_DARK = GroupName "shootoutSetDark"+pattern TRAPPED_HORIZONAL_DOOR_DARK = GroupName "trapped horizontal door Dark"+pattern TRAPPED_VERTICAL_DOOR_DARK = GroupName "trapped vertical door Dark"++-- * Not used, but needed, because auto-generated. Singletons.+pattern S_BUSH_DARK = GroupName "bush Dark"+pattern S_CLOSED_HORIZONTAL_DOOR_DARK = GroupName "closed horizontal door Dark"+pattern S_CLOSED_VERTICAL_DOOR_DARK = GroupName "closed vertical door Dark"+pattern S_OPEN_HORIZONTAL_DOOR_DARK = GroupName "open horizontal door Dark"+pattern S_OPEN_VERTICAL_DOOR_DARK = GroupName "open vertical door Dark"+pattern S_SHALLOW_WATER_DARK = GroupName "shallow water Dark"+pattern S_SUSPECT_HORIZONTAL_WALL_DARK =+  GroupName "suspect horizontal wall Dark"+pattern S_SUSPECT_VERTICAL_WALL_DARK = GroupName "suspect vertical wall Dark"+pattern S_WALL_DARK = GroupName "wall Dark"+pattern S_WALL_HORIZONTAL_DARK = GroupName "wall horizontal Dark"++-- * Content+ content :: [TileKind] content =   [unknown, unknownOuterFence, basicOuterFence, bedrock, wall, wallSuspect, wallObscured, wallH, wallSuspectH, wallObscuredDefacedH, wallObscuredFrescoedH, pillar, pillarCache, lampPost, signboardUnread, signboardRead, tree, treeBurnt, treeBurning, rubble, rubbleSpice, doorTrapped, doorClosed, doorTrappedH, doorClosedH, stairsUp, stairsTrappedUp, stairsOutdoorUp, stairsGatedUp, stairsDown, stairsTrappedDown, stairsOutdoorDown, stairsGatedDown, escapeUp, escapeDown, escapeOutdoorDown, wallGlass, wallGlassSpice, wallGlassH, wallGlassHSpice, pillarIce, pulpit, bush, bushBurnt, bushBurning, fog, fogDark, smoke, smokeDark, doorOpen, doorOpenH, floorCorridor, floorArena, floorDamp, floorDirt, floorDirtSpice, floorActor, floorActorItem, floorAshes, shallowWater, shallowWaterSpice, floorRed, floorBlue, floorGreen, floorBrown, floorArenaShade, outdoorFence ]@@ -39,6 +225,9 @@ -- : (curtain, etc., not flowing, but solid and static) -- `' (not visible enough when immobile) +-- White, cyan and green terrain is usually inert, red is burning or trapped,+-- blue activable or trapped, magenta searchable or activable.+ -- Note that for AI hints and UI comfort, most multiple-use @Embed@ tiles -- should have a variant, which after first use transforms into a different -- colour tile without @ChangeTo@ and similar (which then AI no longer touches).@@ -54,7 +243,7 @@ unknown = TileKind  -- needs to have index 0 and alter 1; no other with 1   { tsymbol  = ' '   , tname    = "unknown space"-  , tfreq    = [("unknown space", 1)]+  , tfreq    = [(S_UNKNOWN_SPACE, 1)]   , tcolor   = defFG   , tcolor2  = defFG   , talter   = 1@@ -63,7 +252,7 @@ unknownOuterFence = TileKind   { tsymbol  = ' '   , tname    = "unknown space"-  , tfreq    = [("unknown outer fence", 1)]+  , tfreq    = [(S_UNKNOWN_OUTER_FENCE, 1)]   , tcolor   = defFG   , tcolor2  = defFG   , talter   = maxBound  -- impenetrable@@ -72,7 +261,7 @@ basicOuterFence = TileKind   { tsymbol  = ' '   , tname    = "impenetrable bedrock"-  , tfreq    = [("basic outer fence", 1)]+  , tfreq    = [(S_BASIC_OUTER_FENCE, 1)]   , tcolor   = defFG   , tcolor2  = defFG   , talter   = maxBound  -- impenetrable@@ -81,7 +270,7 @@ bedrock = TileKind   { tsymbol  = ' '   , tname    = "bedrock"-  , tfreq    = [("fillerWall", 1), ("legendLit", 100), ("legendDark", 100)]+  , tfreq    = [(FILLER_WALL, 1), (LEGEND_LIT, 100), (LEGEND_DARK, 100)]   , tcolor   = defFG   , tcolor2  = defFG   , talter   = 100@@ -101,89 +290,89 @@ wall = TileKind   { tsymbol  = '|'   , tname    = "granite wall"-  , tfreq    = [ ("legendLit", 100), ("wall Lit", 100)-               , ("rectWindowsOver_!_Lit", 80) ]+  , tfreq    = [ (LEGEND_LIT, 100), (S_WALL_LIT, 100)+               , (RECT_WINDOWS_VERTICAL_LIT, 80) ]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 100-  , tfeature = [BuildAs "suspect vertical wall Lit"]+  , tfeature = [BuildAs S_SUSPECT_VERTICAL_WALL_LIT]   } wallSuspect = TileKind  -- only on client   { tsymbol  = '|'   , tname    = "suspect uneven wall"-  , tfreq    = [("suspect vertical wall Lit", 1)]+  , tfreq    = [(S_SUSPECT_VERTICAL_WALL_LIT, 1)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 2-  , tfeature = [ RevealAs "trapped vertical door Lit"-               , ObscureAs "obscured vertical wall Lit"+  , tfeature = [ RevealAs TRAPPED_VERTICAL_DOOR_LIT+               , ObscureAs OBSCURED_VERTICAL_WALL_LIT                ]   } wallObscured = TileKind   { tsymbol  = '|'   , tname    = "scratched wall"-  , tfreq    = [("obscured vertical wall Lit", 1)]+  , tfreq    = [(OBSCURED_VERTICAL_WALL_LIT, 1)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 5-  , tfeature = [ Embed "scratch on wall"-               , HideAs "suspect vertical wall Lit"+  , tfeature = [ Embed SCRATCH_ON_WALL+               , HideAs S_SUSPECT_VERTICAL_WALL_LIT                ]   } wallH = TileKind   { tsymbol  = '-'   , tname    = "sandstone wall"-  , tfreq    = [ ("legendLit", 100), ("wallH Lit", 100)-               , ("rectWindowsOver_=_Lit", 80) ]+  , tfreq    = [ (LEGEND_LIT, 100), (S_WALL_HORIZONTAL_LIT, 100)+               , (RECT_WINDOWS_HORIZONTAL_LIT, 80) ]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 100-  , tfeature = [BuildAs "suspect horizontal wall Lit"]+  , tfeature = [BuildAs S_SUSPECT_HORIZONTAL_WALL_LIT]   } wallSuspectH = TileKind  -- only on client   { tsymbol  = '-'   , tname    = "suspect painted wall"-  , tfreq    = [("suspect horizontal wall Lit", 1)]+  , tfreq    = [(S_SUSPECT_HORIZONTAL_WALL_LIT, 1)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 2-  , tfeature = [ RevealAs "trapped horizontal door Lit"-               , ObscureAs "obscured horizontal wall Lit"+  , tfeature = [ RevealAs TRAPPED_HORIZONAL_DOOR_LIT+               , ObscureAs OBSCURED_HORIZONTAL_WALL_LIT                ]   } wallObscuredDefacedH = TileKind   { tsymbol  = '-'   , tname    = "defaced wall"-  , tfreq    = [("obscured horizontal wall Lit", 90)]+  , tfreq    = [(OBSCURED_HORIZONTAL_WALL_LIT, 90)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 5-  , tfeature = [ Embed "obscene pictogram"-               , HideAs "suspect horizontal wall Lit"+  , tfeature = [ Embed OBSCENE_PICTOGRAM+               , HideAs S_SUSPECT_HORIZONTAL_WALL_LIT                ]   } wallObscuredFrescoedH = TileKind   { tsymbol  = '-'   , tname    = "frescoed wall"-  , tfreq    = [("obscured horizontal wall Lit", 10)]+  , tfreq    = [(OBSCURED_HORIZONTAL_WALL_LIT, 10)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 5-  , tfeature = [ Embed "subtle fresco"-               , HideAs "suspect horizontal wall Lit"+  , tfeature = [ Embed SUBTLE_FRESCO+               , HideAs S_SUSPECT_HORIZONTAL_WALL_LIT                ]  -- a bit beneficial, but AI would loop if allowed to trigger                   -- so no @ConsideredByAI@   } pillar = TileKind   { tsymbol  = '0'-  , tname    = "rock"-  , tfreq    = [ ("cachable", 70)-               , ("stair terminal Lit", 100), ("stair terminal Dark", 100)-               , ("legendLit", 100), ("legendDark", 100)-               , ("emptySetLit", 20), ("noiseSetLit", 700)-               , ("powerSetDark", 700)-               , ("battleSetDark", 200), ("brawlSetLit", 50)-               , ("shootoutSetLit", 10), ("zooSetDark", 10) ]+  , tname    = "rock outcrop"+  , tfreq    = [ (CACHE_OR_NOT, 70)+               , (STAIR_TERMINAL_LIT, 100), (STAIR_TERMINAL_DARK, 100)+               , (LEGEND_LIT, 100), (LEGEND_DARK, 100)+               , (EMPTY_SET_LIT, 20), (NOISE_SET_LIT, 700)+               , (POWER_SET_DARK, 700)+               , (BATTLE_SET_DARK, 200), (BRAWL_SET_LIT, 50)+               , (SHOOTOUT_SET_LIT, 10), (ZOO_SET_DARK, 10) ]   , tcolor   = BrCyan  -- not BrWhite, to tell from heroes   , tcolor2  = Cyan   , talter   = 100@@ -191,21 +380,21 @@   } pillarCache = TileKind   { tsymbol  = '0'-  , tname    = "smoothed rock"-  , tfreq    = [("cachable", 30), ("cache", 1), ("stair terminal Dark", 4)]+  , tname    = "smoothed outcrop"+  , tfreq    = [(CACHE_OR_NOT, 30), (CACHE, 1), (STAIR_TERMINAL_DARK, 4)]                  -- treasure only in dark staircases   , tcolor   = BrBlue   , tcolor2  = Blue   , talter   = 5-  , tfeature = [ Embed "treasure cache", Embed "treasure cache trap"-               , ChangeTo "cachable", ConsideredByAI ]+  , tfeature = [ Embed TREASURE_CACHE, Embed TREASURE_CACHE_TRAP+               , ChangeTo CACHE_OR_NOT, ConsideredByAI ]       -- Not explorable, but prominently placed, so hard to miss.       -- Very beneficial, so AI eager to trigger, unless wary of traps.   } lampPost = TileKind   { tsymbol  = '0'   , tname    = "lamp post"-  , tfreq    = [("lampPostOver_0", 1)]+  , tfreq    = [(S_LAMP_POST, 1)]   , tcolor   = BrYellow   , tcolor2  = Brown   , talter   = 100@@ -214,29 +403,29 @@ signboardUnread = TileKind  -- client only, indicates never used by this faction   { tsymbol  = '0'   , tname    = "signboard"-  , tfreq    = [("signboard unread", 1)]+  , tfreq    = [(S_SIGNBOARD_UNREAD, 1)]   , tcolor   = BrCyan   , tcolor2  = Cyan   , talter   = 5   , tfeature = [ ConsideredByAI  -- changes after use, so safe for AI-               , RevealAs "signboard"  -- to display as hidden+               , RevealAs SIGNBOARD  -- to display as hidden                ]   } signboardRead = TileKind   { tsymbol  = '0'   , tname    = "signboard"-  , tfreq    = [("signboard", 1), ("escapeSetDark", 1)]+  , tfreq    = [(SIGNBOARD, 1), (ESCAPE_SET_DARK, 1)]   , tcolor   = BrCyan   , tcolor2  = Cyan   , talter   = 5-  , tfeature = [Embed "signboard", HideAs "signboard unread"]+  , tfeature = [Embed SIGNAGE, HideAs S_SIGNBOARD_UNREAD]   } tree = TileKind   { tsymbol  = '0'   , tname    = "tree"-  , tfreq    = [ ("brawlSetLit", 140), ("shootoutSetLit", 10)-               , ("escapeSetLit", 35), ("ambushSetLit", 3)-               , ("treeShadeOver_0_Lit", 1) ]+  , tfreq    = [ (BRAWL_SET_LIT, 140), (SHOOTOUT_SET_LIT, 10)+               , (ESCAPE_SET_LIT, 35), (AMBUSH_SET_LIT, 3)+               , (S_TREE_LIT, 1) ]   , tcolor   = BrGreen   , tcolor2  = Green   , talter   = 50@@ -244,164 +433,162 @@   } treeBurnt = tree   { tname    = "burnt tree"-  , tfreq    = [ ("ambushSetDark", 3), ("zooSetDark", 7), ("battleSetDark", 50)-               , ("tree with fire", 30) ]+  , tfreq    = [ (AMBUSH_SET_DARK, 3), (ZOO_SET_DARK, 7), (BATTLE_SET_DARK, 50)+               , (TREE_BURNING_OR_NOT, 30) ]   , tcolor   = BrBlack   , tcolor2  = BrBlack   , tfeature = Dark : tfeature tree   } treeBurning = tree   { tname    = "burning tree"-  , tfreq    = [ ("ambushSetDark", 15), ("zooSetDark", 70)-               , ("tree with fire", 70) ]+  , tfreq    = [ (AMBUSH_SET_DARK, 15), (ZOO_SET_DARK, 70)+               , (TREE_BURNING_OR_NOT, 70) ]   , tcolor   = BrRed   , tcolor2  = Red   , talter   = 5-  , tfeature = Embed "big fire" : ChangeTo "tree with fire" : tfeature tree+  , tfeature = Embed BIG_FIRE : ChangeTo TREE_BURNING_OR_NOT : tfeature tree       -- TODO: dousing off the tree will have more sense when it periodically       -- explodes, hitting and lighting up the team and so betraying it   } rubble = TileKind   { tsymbol  = '&'   , tname    = "rubble pile"-  , tfreq    = [ ("rubble", 1), ("legendLit", 1), ("legendDark", 1)-               , ("stair terminal Lit", 4), ("stair terminal Dark", 4)-               , ("emptySetLit", 10), ("emptySetDark", 10)-               , ("noiseSetLit", 50), ("powerSetDark", 50)-               , ("zooSetDark", 100), ("ambushSetDark", 10) ]+  , tfreq    = [ (S_RUBBLE_PILE, 1), (LEGEND_LIT, 1), (LEGEND_DARK, 1)+               , (STAIR_TERMINAL_LIT, 4), (STAIR_TERMINAL_DARK, 4)+               , (EMPTY_SET_LIT, 10), (EMPTY_SET_DARK, 10)+               , (NOISE_SET_LIT, 50), (POWER_SET_DARK, 50)+               , (ZOO_SET_DARK, 100), (AMBUSH_SET_DARK, 10) ]   , tcolor   = BrYellow   , tcolor2  = Brown   , talter   = 4  -- boss can dig through-  , tfeature = [OpenTo "floorAshesLit", Embed "rubble"]-      -- It's not explorable, due to not being walkable nor clear and due-      -- to being a door (@OpenTo@), which is kind of OK, because getting-      -- the item is risky and, e.g., AI doesn't attempt it.+  , tfeature = [Embed RUBBLE, OpenTo S_FLOOR_ASHES_LIT]+      -- Getting the item is risky and, e.g., AI doesn't attempt it.       -- Also, AI doesn't go out of its way to clear the way for heroes.   } rubbleSpice = rubble-  { tfreq    = [("smokeClumpOver_f_Lit", 1), ("smokeClumpOver_f_Dark", 1)]+  { tfreq    = [(SMOKE_CLUMP_LIT, 1), (SMOKE_CLUMP_DARK, 1)]   , tfeature = Spice : tfeature rubble   } doorTrapped = TileKind   { tsymbol  = '+'   , tname    = "trapped door"-  , tfreq    = [("trapped vertical door Lit", 1)]+  , tfreq    = [(TRAPPED_VERTICAL_DOOR_LIT, 1)]   , tcolor   = BrRed   , tcolor2  = Red   , talter   = 2-  , tfeature = [ Embed "doorway trap"-               , OpenTo "open vertical door Lit"-               , HideAs "suspect vertical wall Lit"+  , tfeature = [ Embed DOORWAY_TRAP+               , OpenTo S_OPEN_VERTICAL_DOOR_LIT+               , HideAs S_SUSPECT_VERTICAL_WALL_LIT                ]   } doorClosed = TileKind   { tsymbol  = '+'   , tname    = "closed door"-  , tfreq    = [("closed vertical door Lit", 1)]+  , tfreq    = [(S_CLOSED_VERTICAL_DOOR_LIT, 1)]   , tcolor   = Brown   , tcolor2  = BrBlack   , talter   = 2-  , tfeature = [OpenTo "open vertical door Lit"]  -- never hidden+  , tfeature = [OpenTo S_OPEN_VERTICAL_DOOR_LIT]  -- never hidden   } doorTrappedH = TileKind   { tsymbol  = '+'   , tname    = "trapped door"-  , tfreq    = [("trapped horizontal door Lit", 1)]+  , tfreq    = [(TRAPPED_HORIZONAL_DOOR_LIT, 1)]   , tcolor   = BrRed   , tcolor2  = Red   , talter   = 2-  , tfeature = [ Embed "doorway trap"-               , OpenTo "open horizontal door Lit"-               , HideAs "suspect horizontal wall Lit"+  , tfeature = [ Embed DOORWAY_TRAP+               , OpenTo S_OPEN_HORIZONTAL_DOOR_LIT+               , HideAs S_SUSPECT_HORIZONTAL_WALL_LIT                ]   } doorClosedH = TileKind   { tsymbol  = '+'   , tname    = "closed door"-  , tfreq    = [("closed horizontal door Lit", 1)]+  , tfreq    = [(S_CLOSED_HORIZONTAL_DOOR_LIT, 1)]   , tcolor   = Brown   , tcolor2  = BrBlack   , talter   = 2-  , tfeature = [OpenTo "open horizontal door Lit"]  -- never hidden+  , tfeature = [OpenTo S_OPEN_HORIZONTAL_DOOR_LIT]  -- never hidden   } stairsUp = TileKind   { tsymbol  = '<'   , tname    = "staircase up"-  , tfreq    = [("staircase up", 9), ("ordinary staircase up", 1)]+  , tfreq    = [(STAIRCASE_UP, 9), (ORDINARY_STAIRCASE_UP, 1)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = talterForStairs-  , tfeature = [Embed "staircase up", ConsideredByAI]+  , tfeature = [Embed STAIRS_UP, ConsideredByAI]   } stairsTrappedUp = TileKind   { tsymbol  = '<'   , tname    = "windy staircase up"-  , tfreq    = [("staircase up", 1)]+  , tfreq    = [(STAIRCASE_UP, 1)]   , tcolor   = BrRed   , tcolor2  = Red   , talter   = talterForStairs-  , tfeature = [ Embed "staircase up", Embed "staircase trap up"-               , ConsideredByAI, ChangeTo "ordinary staircase up" ]+  , tfeature = [ Embed STAIRS_UP, Embed STAIRS_TRAP_UP+               , ConsideredByAI, ChangeTo ORDINARY_STAIRCASE_UP ]                  -- AI uses despite the trap; exploration more important   } stairsOutdoorUp = stairsUp   { tname    = "signpost pointing backward"-  , tfreq    = [("staircase outdoor up", 1)]+  , tfreq    = [(STAIRCASE_OUTDOOR_UP, 1)]   } stairsGatedUp = stairsUp   { tname    = "gated staircase up"-  , tfreq    = [("gated staircase up", 1)]+  , tfreq    = [(GATED_STAIRCASE_UP, 1)]   , talter   = talterForStairs + 2  -- animals and bosses can't use   } stairsDown = TileKind   { tsymbol  = '>'   , tname    = "staircase down"-  , tfreq    = [("staircase down", 9), ("ordinary staircase down", 1)]+  , tfreq    = [(STAIRCASE_DOWN, 9), (ORDINARY_STAIRCASE_DOWN, 1)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = talterForStairs-  , tfeature = [Embed "staircase down", ConsideredByAI]+  , tfeature = [Embed STAIRS_DOWN, ConsideredByAI]   } stairsTrappedDown = TileKind   { tsymbol  = '>'   , tname    = "crooked staircase down"-  , tfreq    = [("staircase down", 1)]+  , tfreq    = [(STAIRCASE_DOWN, 1)]   , tcolor   = BrRed   , tcolor2  = Red   , talter   = talterForStairs-  , tfeature = [ Embed "staircase down", Embed "staircase trap down"-               , ConsideredByAI, ChangeTo "ordinary staircase down" ]+  , tfeature = [ Embed STAIRS_DOWN, Embed STAIRS_TRAP_DOWN+               , ConsideredByAI, ChangeTo ORDINARY_STAIRCASE_DOWN ]   } stairsOutdoorDown = stairsDown   { tname    = "signpost pointing forward"-  , tfreq    = [("staircase outdoor down", 1)]+  , tfreq    = [(STAIRCASE_OUTDOOR_DOWN, 1)]   } stairsGatedDown = stairsDown   { tname    = "gated staircase down"-  , tfreq    = [("gated staircase down", 1)]+  , tfreq    = [(GATED_STAIRCASE_DOWN, 1)]   , talter   = talterForStairs + 2  -- animals and bosses can't use   } escapeUp = TileKind   { tsymbol  = '<'   , tname    = "exit hatch up"-  , tfreq    = [("legendLit", 1), ("legendDark", 1), ("escape up", 1)]+  , tfreq    = [(LEGEND_LIT, 1), (LEGEND_DARK, 1), (ESCAPE_UP, 1)]   , tcolor   = BrYellow   , tcolor2  = BrYellow   , talter   = 0  -- anybody can escape (or guard escape)-  , tfeature = [Embed "escape", ConsideredByAI]+  , tfeature = [Embed ESCAPE, ConsideredByAI]   } escapeDown = TileKind   { tsymbol  = '>'   , tname    = "exit trapdoor down"-  , tfreq    = [("legendLit", 1), ("legendDark", 1), ("escape down", 1)]+  , tfreq    = [(LEGEND_LIT, 1), (LEGEND_DARK, 1), (ESCAPE_DOWN, 1)]   , tcolor   = BrYellow   , tcolor2  = BrYellow   , talter   = 0  -- anybody can escape (or guard escape)-  , tfeature = [Embed "escape", ConsideredByAI]+  , tfeature = [Embed ESCAPE, ConsideredByAI]   } escapeOutdoorDown = escapeDown   { tname    = "exit back to town"-  , tfreq    = [("escape outdoor down", 1)]+  , tfreq    = [(ESCAPE_OUTDOOR_DOWN, 1)]   }  -- *** Clear@@ -409,56 +596,53 @@ wallGlass = TileKind   { tsymbol  = '|'   , tname    = "polished crystal wall"-  , tfreq    = [("glasshouseOver_!_Lit", 1)]+  , tfreq    = [(GLASSHOUSE_VERTICAL_LIT, 1)]   , tcolor   = BrBlue   , tcolor2  = Blue   , talter   = 10-  , tfeature = [BuildAs "closed vertical door Lit", Clear]+  , tfeature = [BuildAs S_CLOSED_VERTICAL_DOOR_LIT, Clear]   } wallGlassSpice = wallGlass-  { tfreq    = [("rectWindowsOver_!_Lit", 20)]+  { tfreq    = [(RECT_WINDOWS_VERTICAL_LIT, 20)]   , tfeature = Spice : tfeature wallGlass   } wallGlassH = TileKind   { tsymbol  = '-'   , tname    = "polished crystal wall"-  , tfreq    = [("glasshouseOver_=_Lit", 1)]+  , tfreq    = [(GLASSHOUSE_HORIZONTAL_LIT, 1)]   , tcolor   = BrBlue   , tcolor2  = Blue   , talter   = 10-  , tfeature = [BuildAs "closed horizontal door Lit", Clear]+  , tfeature = [BuildAs S_CLOSED_HORIZONTAL_DOOR_LIT, Clear]   } wallGlassHSpice = wallGlassH-  { tfreq    = [("rectWindowsOver_=_Lit", 20)]+  { tfreq    = [(RECT_WINDOWS_HORIZONTAL_LIT, 20)]   , tfeature = Spice : tfeature wallGlassH   } pillarIce = TileKind   { tsymbol  = '^'   , tname    = "icy outcrop"-  , tfreq    = [("powerSetDark", 300)]+  , tfreq    = [(POWER_SET_DARK, 300)]   , tcolor   = BrBlue   , tcolor2  = Blue   , talter   = 4  -- boss can dig through-  , tfeature = [Clear, Embed "frost", OpenTo "shallow water Lit"]-      -- Is door, due to @OpenTo@, so is not explorable, but it's OK, because-      -- it doesn't generate items nor clues. This saves on the need to-      -- get each ice pillar into sight range when exploring level.+  , tfeature = [Clear, Embed FROST, OpenTo S_SHALLOW_WATER_LIT]   } pulpit = TileKind   { tsymbol  = '%'   , tname    = "pulpit"-  , tfreq    = [("pulpit", 1)]+  , tfreq    = [(S_PULPIT, 1)]   , tcolor   = BrYellow   , tcolor2  = Brown   , talter   = 5-  , tfeature = [Clear, Embed "pulpit"]+  , tfeature = [Clear, Embed LECTERN]                  -- mixed blessing, so AI ignores, saved for player fun   } bush = TileKind   { tsymbol  = '%'   , tname    = "bush"-  , tfreq    = [ ("bush Lit", 1), ("shootoutSetLit", 30), ("escapeSetLit", 40)-               , ("ambushSetLit", 3), ("bushClumpOver_f_Lit", 1) ]+  , tfreq    = [ (S_BUSH_LIT, 1), (SHOOTOUT_SET_LIT, 30), (ESCAPE_SET_LIT, 40)+               , (AMBUSH_SET_LIT, 3), (BUSH_CLUMP_LIT, 1) ]   , tcolor   = BrGreen   , tcolor2  = Green   , talter   = 10@@ -466,20 +650,21 @@   } bushBurnt = bush   { tname    = "burnt bush"-  , tfreq    = [ ("battleSetDark", 30), ("zooSetDark", 30), ("ambushSetDark", 3)-               , ("bush with fire", 70) ]+  , tfreq    = [ (BATTLE_SET_DARK, 30), (ZOO_SET_DARK, 30), (AMBUSH_SET_DARK, 3)+               , (BUSH_BURNING_OR_NOT, 70) ]   , tcolor   = BrBlack   , tcolor2  = BrBlack   , tfeature = Dark : tfeature bush   } bushBurning = bush   { tname    = "burning bush"-  , tfreq    = [ ("ambushSetDark", 15), ("zooSetDark", 300)-               , ("bush with fire", 30) ]+  , tfreq    = [ (AMBUSH_SET_DARK, 15), (ZOO_SET_DARK, 300)+               , (BUSH_BURNING_OR_NOT, 30) ]   , tcolor   = BrRed   , tcolor2  = Red   , talter   = 5-  , tfeature = Embed "small fire" : ChangeTo "bush with fire" : tfeature bush+  , tfeature = Embed SMALL_FIRE : ChangeTo BUSH_BURNING_OR_NOT+               : tfeature bush   }  -- ** Walkable@@ -489,9 +674,9 @@ fog = TileKind   { tsymbol  = ';'   , tname    = "faint fog"-  , tfreq    = [ ("fog Lit", 1), ("emptySetLit", 50), ("noiseSetLit", 100)-               , ("shootoutSetLit", 20)-               , ("fogClumpOver_f_Lit", 60), ("fogClumpOver_f_Dark", 60) ]+  , tfreq    = [ (S_FOG_LIT, 1), (EMPTY_SET_LIT, 50), (NOISE_SET_LIT, 100)+               , (SHOOTOUT_SET_LIT, 20)+               , (FOG_CLUMP_LIT, 60), (FOG_CLUMP_DARK, 60) ]       -- lit fog is OK for shootout, because LOS is mutual, as opposed       -- to dark fog, and so camper has little advantage, especially       -- on big maps, where he doesn't know on which side of fog patch to hide@@ -502,15 +687,15 @@   } fogDark = fog   { tname    = "thick fog"-  , tfreq    = [ ("emptySetDark", 50), ("powerSetDark", 100)-               , ("escapeSetDark", 50) ]+  , tfreq    = [ (EMPTY_SET_DARK, 50), (POWER_SET_DARK, 100)+               , (ESCAPE_SET_DARK, 50) ]   , tfeature = Dark : tfeature fog   } smoke = TileKind   { tsymbol  = ';'   , tname    = "billowing smoke"-  , tfreq    = [ ("smoke Lit", 1), ("labTrailLit", 1), ("stair terminal Lit", 4)-               , ("smokeClumpOver_f_Lit", 3), ("smokeClumpOver_f_Dark", 3) ]+  , tfreq    = [ (S_SMOKE_LIT, 1), (LAB_TRAIL_LIT, 1), (STAIR_TERMINAL_LIT, 4)+               , (SMOKE_CLUMP_LIT, 3), (SMOKE_CLUMP_DARK, 3) ]   , tcolor   = Brown   , tcolor2  = BrBlack   , talter   = 0@@ -518,8 +703,8 @@   } smokeDark = smoke   { tname    = "lingering smoke"-  , tfreq    = [ ("stair terminal Dark", 4), ("ambushSetDark", 40)-               , ("zooSetDark", 20), ("battleSetDark", 5) ]+  , tfreq    = [ (STAIR_TERMINAL_DARK, 4), (AMBUSH_SET_DARK, 40)+               , (ZOO_SET_DARK, 20), (BATTLE_SET_DARK, 5) ]   , tfeature = Dark : tfeature smoke   } @@ -528,29 +713,31 @@ doorOpen = TileKind   { tsymbol  = '-'   , tname    = "open door"-  , tfreq    = [("open vertical door Lit", 1)]+  , tfreq    = [(S_OPEN_VERTICAL_DOOR_LIT, 1)]   , tcolor   = Brown   , tcolor2  = BrBlack   , talter   = 4   , tfeature = [ Walkable, Clear, NoItem, NoActor-               , CloseTo "closed vertical door Lit"+               , CloseTo S_CLOSED_VERTICAL_DOOR_LIT+                   -- not explorable due to that                ]   } doorOpenH = TileKind   { tsymbol  = '|'   , tname    = "open door"-  , tfreq    = [("open horizontal door Lit", 1)]+  , tfreq    = [(S_OPEN_HORIZONTAL_DOOR_LIT, 1)]   , tcolor   = Brown   , tcolor2  = BrBlack   , talter   = 4   , tfeature = [ Walkable, Clear, NoItem, NoActor-               , CloseTo "closed horizontal door Lit"+               , CloseTo S_CLOSED_HORIZONTAL_DOOR_LIT+                   -- not explorable due to that                ]   } floorCorridor = TileKind   { tsymbol  = '#'   , tname    = "corridor"-  , tfreq    = [("floorCorridorLit", 1)]+  , tfreq    = [(FLOOR_CORRIDOR_LIT, 1)]   , tcolor   = BrWhite   , tcolor2  = defFG   , talter   = 0@@ -559,35 +746,35 @@ floorArena = floorCorridor   { tsymbol  = floorSymbol   , tname    = "stone floor"-  , tfreq    = [ ("floorArenaLit", 1), ("arenaSetLit", 1), ("emptySetLit", 900)-               , ("zooSetLit", 600) ]+  , tfreq    = [ (FLOOR_ARENA_LIT, 1), (ARENA_SET_LIT, 1), (EMPTY_SET_LIT, 900)+               , (ZOO_SET_LIT, 600) ]   } floorDamp = floorArena   { tname    = "damp stone floor"-  , tfreq    = [ ("noiseSetLit", 600), ("powerSetLit", 600)-               , ("damp floor Lit", 1), ("stair terminal Lit", 20) ]+  , tfreq    = [ (NOISE_SET_LIT, 600), (POWER_SET_LIT, 600)+               , (DAMP_FLOOR_LIT, 1), (STAIR_TERMINAL_LIT, 20) ]   } floorDirt = floorArena-  { tname    = "dirt"-  , tfreq    = [ ("shootoutSetLit", 1000), ("escapeSetLit", 1000)-               , ("ambushSetLit", 1000), ("battleSetLit", 1000)-               , ("brawlSetLit", 1000), ("dirt Lit", 1) ]+  { tname    = "dirt floor"+  , tfreq    = [ (SHOOTOUT_SET_LIT, 1000), (ESCAPE_SET_LIT, 1000)+               , (AMBUSH_SET_LIT, 1000), (BATTLE_SET_LIT, 1000)+               , (BRAWL_SET_LIT, 1000), (DIRT_LIT, 1) ]   } floorDirtSpice = floorDirt-  { tfreq    = [("treeShadeOver_s_Lit", 1), ("bushClumpOver_f_Lit", 1)]+  { tfreq    = [(TREE_SHADE_WALKABLE_LIT, 1), (BUSH_CLUMP_LIT, 1)]   , tfeature = Spice : tfeature floorDirt   } floorActor = floorArena-  { tfreq    = [("floorActorLit", 1)]+  { tfreq    = [(S_FLOOR_ACTOR_LIT, 1)]   , tfeature = OftenActor : tfeature floorArena   } floorActorItem = floorActor-  { tfreq    = [("legendLit", 100)]+  { tfreq    = [(LEGEND_LIT, 100)]   , tfeature = VeryOftenItem : tfeature floorActor   } floorAshes = floorActor-  { tfreq    = [ ("smokeClumpOver_f_Lit", 2), ("smokeClumpOver_f_Dark", 2)-               , ("floorAshesLit", 1), ("floorAshesDark", 1) ]+  { tfreq    = [ (SMOKE_CLUMP_LIT, 2), (SMOKE_CLUMP_DARK, 2)+               , (S_FLOOR_ASHES_LIT, 1), (S_FLOOR_ASHES_DARK, 1) ]   , tname    = "dirt and ash pile"   , tcolor   = Brown   , tcolor2  = Brown@@ -595,48 +782,48 @@ shallowWater = TileKind   { tsymbol  = '~'   , tname    = "water puddle"-  , tfreq    = [ ("shallow water Lit", 1), ("legendLit", 100)-               , ("emptySetLit", 5), ("noiseSetLit", 20)-               , ("powerSetLit", 20), ("shootoutSetLit", 5) ]+  , tfreq    = [ (S_SHALLOW_WATER_LIT, 1), (LEGEND_LIT, 100)+               , (EMPTY_SET_LIT, 5), (NOISE_SET_LIT, 20)+               , (POWER_SET_LIT, 20), (SHOOTOUT_SET_LIT, 5) ]   , tcolor   = BrCyan   , tcolor2  = Cyan   , talter   = 0-  , tfeature = Embed "shallow water" : tfeature floorActor+  , tfeature = Embed SHALLOW_WATER : tfeature floorActor   } shallowWaterSpice = shallowWater-  { tfreq    = [("fogClumpOver_f_Lit", 40)]+  { tfreq    = [(FOG_CLUMP_LIT, 40)]   , tfeature = Spice : tfeature shallowWater   } floorRed = floorCorridor   { tsymbol  = floorSymbol   , tname    = "brick pavement"-  , tfreq    = [("trailLit", 70), ("safeTrailLit", 70)]+  , tfreq    = [(TRAIL_LIT, 70), (SAFE_TRAIL_LIT, 70)]   , tcolor   = BrRed   , tcolor2  = Red-  , tfeature = [Embed "straight path", Trail, Walkable, Clear]+  , tfeature = [Embed STRAIGHT_PATH, Trail, Walkable, Clear]   } floorBlue = floorRed   { tname    = "frozen trail"-  , tfreq    = [("trailLit", 100)]+  , tfreq    = [(TRAIL_LIT, 100)]   , tcolor   = BrBlue   , tcolor2  = Blue-  , tfeature = [Embed "frozen ground", Trail, Walkable, Clear]+  , tfeature = [Embed FROZEN_GROUND, Trail, Walkable, Clear]   } floorGreen = floorRed   { tname    = "mossy stone path"-  , tfreq    = [("trailLit", 70), ("safeTrailLit", 70)]+  , tfreq    = [(TRAIL_LIT, 70), (SAFE_TRAIL_LIT, 70)]   , tcolor   = BrGreen   , tcolor2  = Green   } floorBrown = floorRed   { tname    = "rotting mahogany deck"-  , tfreq    = [("trailLit", 50), ("safeTrailLit", 50)]+  , tfreq    = [(TRAIL_LIT, 50), (SAFE_TRAIL_LIT, 50)]   , tcolor   = BrMagenta   , tcolor2  = Magenta   } floorArenaShade = floorActor   { tname    = "shaded ground"-  , tfreq    = [("shaded ground", 1), ("treeShadeOver_s_Lit", 2)]+  , tfreq    = [(S_SHADED_GROUND, 1), (TREE_SHADE_WALKABLE_LIT, 2)]   , tcolor2  = BrBlack   , tfeature = Dark : NoItem : tfeature floorActor   }@@ -644,25 +831,34 @@ outdoorFence = TileKind   { tsymbol  = ' '   , tname    = "event horizon"-  , tfreq    = [("outdoor outer fence", 1)]+  , tfreq    = [(OUTDOOR_OUTER_FENCE, 1)]   , tcolor   = defFG   , tcolor2  = defFG   , talter   = maxBound  -- impenetrable   , tfeature = [Dark]   } +-- * Helper functions+ makeDark :: TileKind -> TileKind-makeDark k = let darkText :: GroupName TileKind -> GroupName TileKind-                 darkText t = maybe t (toGroupName . (<> "Dark"))+makeDark k = let darkenText :: GroupName TileKind -> GroupName TileKind+                 darkenText t = maybe t (GroupName . (<> "Dark"))                               $ T.stripSuffix "Lit" $ fromGroupName t-                 darkFrequency = map (first darkText) $ tfreq k-                 darkFeat (OpenTo t) = Just $ OpenTo $ darkText t-                 darkFeat (CloseTo t) = Just $ CloseTo $ darkText t-                 darkFeat (ChangeTo t) = Just $ ChangeTo $ darkText t-                 darkFeat (HideAs t) = Just $ HideAs $ darkText t-                 darkFeat (BuildAs t) = Just $ BuildAs $ darkText t-                 darkFeat (RevealAs t) = Just $ RevealAs $ darkText t-                 darkFeat (ObscureAs t) = Just $ ObscureAs $ darkText t+                 darkFrequency :: Freqs TileKind+                 darkFrequency = map (first darkenText) $ tfreq k+                 darkFeat (OpenTo t) = Just $ OpenTo $ darkenText t+                 darkFeat (CloseTo t) = Just $ CloseTo $ darkenText t+                 darkFeat (ChangeTo t) = Just $ ChangeTo $ darkenText t+                 darkFeat (OpenWith proj grps t) =+                   Just $ OpenWith proj grps $ darkenText t+                 darkFeat (CloseWith proj grps t) =+                   Just $ CloseWith proj grps $ darkenText t+                 darkFeat (ChangeWith proj grps t) =+                   Just $ ChangeWith proj grps $ darkenText t+                 darkFeat (HideAs t) = Just $ HideAs $ darkenText t+                 darkFeat (BuildAs t) = Just $ BuildAs $ darkenText t+                 darkFeat (RevealAs t) = Just $ RevealAs $ darkenText t+                 darkFeat (ObscureAs t) = Just $ ObscureAs $ darkenText t                  darkFeat VeryOftenItem = Just OftenItem                  darkFeat OftenItem = Nothing  -- items not common in the dark                  darkFeat feat = Just feat

− GameDefinition/InGameHelp.txt

@@ -1,184 +0,0 @@-This is a snapshot of in-game help, rendered with default config file.-For more general gameplay information see-https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/PLAYING.md---Minimal cheat sheet for casual play.-- Walk throughout a level with mouse or numeric keypad (left diagram below)- or the Vi editor keys (right) or with a compact laptop setup (middle) that- requires enabling in config.ui.ini. Run until disturbed with Shift or Control.- Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift).--                7 8 9          7 8 9          y k u-                 \|/            \|/            \|/-                4-5-6          u-i-o          h-.-l-                 /|\            /|\            /|\-                1 2 3          j k l          b j n-- In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair).- Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any- damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5`- (the same key with Shift or Control) to lurk 0.1 of a turn, without bracing.- Displace enemies by running into them with Shift/Control or S-LMB. Search,- open, descend and attack by bumping into walls, doors, stairs and enemies.- The best melee weapon is automatically chosen from your equipment- and from among your body parts.-- The following commands, joined with the basic set above,- let you accomplish anything in the game, though- not necessarily with the fewest keystrokes. You can also- play the game exclusively with a mouse, or both mouse- and keyboard. (See the ending help screens for mouse commands.)- Lastly, you can select a command with arrows or mouse directly- from the help screen or the dashboard and execute it on the spot.-- keys         command- E            manage equipment of the leader- g or ,       grab item(s)- ESC          open main menu/finish aiming- RET or INS   open dashboard/accept target- SPACE        clear messages and show history- S-TAB        cycle among all party members- KP_* or !    cycle x-hair among enemies- KP_/ or /    cycle x-hair among items- c            close door- %            yell/yawn---Here is the complete list of commands from the snapshot of in-game help.-For more general gameplay information see-https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/PLAYING.md--Item menu commands.-- keys         command- g or ,       grab item(s)- d or .       drop item(s)- f            fling projectile- C-f          auto-fling and keep choice- a            apply consumable- C-a          apply and keep choice- p or i       pack item- e            equip item- s            stash and share item-- Note how lower case item commands (pack an item, equip, stash)- let you move items into a particular item store.--Remaining item-related commands.-- keys         command- E            manage equipment of the leader- P or I       manage inventory pack of the leader- S            manage the shared party stash- G            manage items on the ground- A            manage all owned items- @            describe organs of the leader- #            show skill summary of the leader- ~            display known lore-- Note how upper case item commands (manage Pack, Equipment,- Stash, etc.) let you view and organize items within- a particular item store. Once a menu is opened, you can- switch stores at will, so each of the commands only- determines the starting item store. Each store- is accessible from the dashboard, as well.--All terrain exploration and alteration commands.-- keys         command- TAB          cycle among party members on the level- S-TAB        cycle among all party members- c            close door- C            open or close or alter- =            select (or deselect) party member- _            deselect (or select) all on the level- ;            go to x-hair for 25 steps- :            run to x-hair collectively for 25 steps- x            explore nearest unknown spot- X            autoexplore 25 times- R            rest (wait 25 times)- C-R          heed (lurk 0.1 turns 100 times)- 0, 1 ... 6   pick a particular actor as the new leader--Aiming commands.-- keys         command- ESC          open main menu/finish aiming- RET or INS   open dashboard/accept target- KP_* or !    cycle x-hair among enemies- KP_/ or /    cycle x-hair among items- +            swerve the aiming line- -            unswerve the aiming line- \            cycle aiming modes- C-?          set x-hair to nearest unknown spot- C-/          set x-hair to nearest item- C-{          set x-hair to nearest upstairs- C-}          set x-hair to nearest dnstairs- <            move aiming one level up- >            move aiming one level down- BACKSPACE    clear chosen item and x-hair--Mouse overview.-- Screen area and UI mode (exploration/aiming) determine- mouse click effects. First, we give an overview- of effects of each button over the game map area.- The list includes not only left and right buttons, but also- the optional middle mouse button (MMB) and the mouse wheel,- which is also used over menus, to page-scroll them.- (For mice without RMB, one can use Control key with LMB and for mice- without MMB, one can use C-RMB or C-S-LMB.)- Next we show mouse button effects per screen area,- in exploration mode and (if different) in aiming mode.-- keys         command- LMB          go to pointer for 25 steps/fling at enemy- S-LMB        run to pointer collectively for 25 steps/fling at enemy- RMB or C-LMB start aiming at enemy under pointer- S-RMB        open or close or alter at pointer- MMB or C-RMB snap x-hair to floor under pointer- WHEEL-UP     swerve the aiming line- WHEEL-DN     unswerve the aiming line-- exploration    LMB (left mouse button)          RMB (right mouse button)- message line   clear messages and show history  display help- leader on map  grab item(s)                     drop item(s)- party on map   pick new leader on screen        select party member on screen- the map area   go to pointer for 25 steps       set x-hair to enemy- level number   move aiming one level up         move aiming one level down- level caption  open dashboard                   open main menu- percent seen   explore nearest unknown spot     autoexplore 25 times- x-hair info    cycle x-hair among enemies       cycle x-hair among items- party roster   pick new leader on screen        select party member on screen- Calm value     yell/yawn                        yell/yawn- HP gauge       rest (wait 25 times)             heed (lurk 0.1 turns 100 times)- HP Value       wait a turn, bracing for impact  lurk 0.1 of a turn- leader info    auto-fling and keep choice       clear chosen item and x-hair-- aiming mode    LMB (left mouse button)          RMB (right mouse button)- the map area   fling at enemy under pointer     snap x-hair to enemy- level caption  accept target                    cancel aiming- percent seen   set x-hair to nearest upstairs   set x-hair to nearest dnstairs--Assorted commands.-- keys         command- SPACE        clear messages and show history- %            yell/yawn- C-s          start new game- C-x          save and exit to desktop- C-t          toggle autoplay (insert coin)- C-q          quit game and start autoplay- C-c          exit to desktop without saving- ?            display help- F1           display help immediately- F12          open dashboard- v            voice again the recorded commands- V            voice recorded commands 100 times- C-v          voice recorded commands 1000 times- C-V          voice recorded commands 25 times- '            start recording commands- C-S          save game backup- C-P          print screen

− GameDefinition/MainMenu.ascii

@@ -1,24 +0,0 @@-ffjjjjtti,:Lft:                tDEGLLfGEKEDKP                  .iEDEGL.;iiij ...-LLfffjjjti;.fL .              GDDLfGDEDEtf                       ;LDWEGi,;iit ..-WWELfffjjtt;.if.:           .DEGLLGEDLti,                          ,tLKDG ,;itt.-WWW#DLffjjtt;:;j...        tDEGfLDEDGtK.     LambdaHack             itLEG::;itt.-WWWWW Lfffjjti:.t...      tDEGfLDEDL,                                 tDGj.;itt.-WWWKW  GLffjjti: t,      tDEGLGEEDj;    <lambdahack.github.io>        tLDLi,ittj-WWWEWG  GLffjjti: tt   .tDEGGDEDG:                                    ;fEG :iitj-WWWKKK   GLfffjti: tt  tDDLGDEDGf {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ;jGG :iitj-WWWKDWL   DLffjjti: jt.DDLGDEDLD  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG .ittj-EWWWEDKj   DLffjjti: jj.LGDEDLE   {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG  ittj-DKKWKDEKf   GLffjjti::ff.EEDLE    {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGG  ittj- GWKWEDEEt   GLffjjji :fL.ELE     {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ :tGL  ittf- EEWKKDGDEjt..DLfftjji.,fG:K,     {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGj,.tjjf-  EfKGKDLGDDDGDGLffiiti ttf:.     {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ .LG;i,;itt- ..EDKEKEGjiLDDfGLLfijtii;fL:     {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ jLj ,;tjtL-. . KLEEKKDGLLLGLGLfffjji,;LL:,   {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ tfL.fijffL-......jDKEEKKKKKEDGLffffji;;LL:.  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ EfGii tjff-.......KtGDKEDEEDGLGLfffjti,;Lf:  {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{:Df j:jffL.-.......::,E,tjjifL,,LLfffjji.;fL. {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{;iififffL .-....::,;tjLGGGGGLfji;LLfffjjt.,jf.{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{j;i:jfff  .-:::::,;;;,iiiiiiii;;;;LLfffjjt,,;LL:                               ,iiijjfffL ..-::::,,;;;;;;;;;;;;;;;;;GLffffjt;j,jff,::                        ;ifLjjijifffL ..-....::,,,,;;;;,,,,,,,,,:GLffffjjt:::tLiL;::.                .;LLLLGj;i,ffLLL ...-  ..:::::,,,,,,,,,,,,,, Version X.X.X (frontend: xxx, engine: LambdaHack X.X.X).

− GameDefinition/MoveKeys.txt

@@ -1,19 +0,0 @@-Walk throughout a level with mouse or numeric keypad (left diagram below)-or the Vi editor keys (right) or with a compact laptop setup (middle) that-requires enabling in config.ui.ini. Run until disturbed with Shift or Control.-Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift).--               7 8 9          7 8 9          y k u-                \|/            \|/            \|/-               4-5-6          u-i-o          h-.-l-                /|\            /|\            /|\-               1 2 3          j k l          b j n--In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair).-Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any-damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5`-(the same key with Shift or Control) to lurk 0.1 of a turn, without bracing.-Displace enemies by running into them with Shift/Control or S-LMB. Search,-open, descend and attack by bumping into walls, doors, stairs and enemies.-The best melee weapon is automatically chosen from your equipment-and from among your body parts.

GameDefinition/PLAYING.md view

@@ -1,87 +1,214 @@ Playing LambdaHack ================== -The following blurb is a copy of the game intro screen.+The following backstory blurb is a copy of the sample game intro screen: -              LambdaHack is a small dungeon crawler illustrating-              the roguelike game engine of the same name. Playing-              the game involves exploring spooky dungeons, alone-              or in a party of fearless explorers, avoiding-              and setting up ambushes, hiding in shadows from-              the gaze of unspeakable horrors, discovering secret-              passages and gorgeous magical treasure and making-              creative use of it all.+ LambdaHack is a small dungeon crawler+ illustrating the roguelike game engine+ of the same name. Playing the game+ involves exploring spooky dungeons,+ alone or in a party of fearless+ explorers, avoiding and setting up+ ambushes, hiding in shadows from+ the gaze of unspeakable horrors,+ discovering secret passages and+ gorgeous magical treasure and making+ creative use of it all. -              The madness-inspiring abominations that multiply-              in the depths perform the same feats, due to their-              aberrant, abstract hyper-intelligence. They look out-              for any sign of weakness or indecision, ready-              to tirelessly chase the elusive heroes by sight,-              sound and smell.+ The madness-inspiring abominations that+ multiply in the depths perform the same+ feats, due to their aberrant, abstract+ hyper-intelligence. They look out for+ any sign of weakness or indecision,+ ready to tirelessly chase the elusive+ heroes by sight, sound and smell. ++What to expect+--------------+ LambdaHack is a turn-based game. You issue a command.-Then you watch its results unfold on the screen without you being able-to intervene. Then all settles down and you have as much time+Then you watch its results unfold on the screen, without you being able+to intervene. Then the dust settles and you have as much time as you want to inspect the battlefield and think about your next move.  Once the few basic command keys and on-screen symbols are learned, mastery and enjoyment of the game is the matter of tactical skill and literary imagination. To be honest, a lot of imagination is required for this modest sample game, but it has its own distinct quirky mood-and is playable and winnable. Contributions are welcome.-Please offer feedback to mikolaj.konarski@funktory.com or, preferably,-at any of the public forums.+and is playable and winnable. -If the game window is too large for your screen or you experience-other technical issues, please consult+The game differs from classic roguelikes in a few ways:++* player manually controls each member of his squad, though often the best+  tactics is to scout with only one character (a classic roguelike feel)+  and let others guard important areas+* the game is turn-based, but with visibly high granularity --- projectiles+  fly gradually over time with varying speeds and can be sidestepped+  or shot down; less so explosions that are swarms of projectile particles+  (turn-based just the same)+* time passes and factions pursue their goals on a few levels+  simultaneously, while other levels are frozen (but all are persistent)+* the same laws of simulated world apply to all factions and all actors,+  whether player-controlled or AI-controlled; e.g., the same field of view+  calculation, skill checks, equipment limitations, rules for item+  and terrain use+* combat mechanics is deterministic; randomness comes only from AI+  decisions and procedurally generated terrain+* there's (almost) no HP regeneration; attrition ensures all past (silly)+  decisions matter; HP of every actor starts at around half max+* each character has 10 uniform equipment slots, which fill quickly given+  that most melee weapons have cooldowns+* each faction has a single shared inventory of unlimited size,+  which has a physical location on the map and so can be ransacked++If the game window is too large for your screen or the game doesn't start+or you experience other technical issues, please consult [README.md](https://github.com/LambdaHack/LambdaHack/blob/master/README.md)-or describe your problem on gitter or the issue tracker.+or describe your problem on [Discord](https://discord.gg/87Ghnws)+or [Matrix](https://matrix.to/#/!HnbpAHMjOGHlYtrASl:mozilla.org)+or the issue tracker. Contributions of all kinds are welcome.+Please offer feedback to mikolaj.konarski@funktory.com or, preferably,+on any of the public forums.  -Game map---------+Starting your adventure+----------------------- -The map of any particular scenario consists of one or many levels-and each level has a large number of tiles with a particular+Commands for starting a new game, saving and exiting the current game,+configuring convenience settings and toggling AI control of the party+are listed in the main menu, brought up by the Esc key. Of the convenience+settings, the `suspect terrain` choice is of particular interest,+because it determines not only screen display of the level map,+but also whether suspect tiles are considered for mouse go-to, auto-explore+and for the `C-?` command that marks the nearest unexplored position.+Game difficulty, from the game setup menu, determines hitpoints at birth:+difficulty below 5 multiplies hitpoints of player characters, difficulty+over 5 multiplies hitpoints of their enemies. Each of the several named+optional challenges make the game much harder, but usually simpler, as well.++The "cold fish" challenge mode makes it impossible for player+characters to be healed by actors from other factions (this is+a significant restriction in the long crawl adventure).+The "ready goods" challenge mode disables crafting for the player,+which is however not a part of the LambdaHack game, so has no effect.+The "lone wolf" challenge mode reduces player's starting actors+to exactly one, though later on new heroes may join the party.+The "finder keeper" completely disables flinging projectiles+by the player, which affects not only ranged damage dealing,+but also throwing of consumables that buff teammates engaged in melee combat,+weaken and distract enemies, light dark corners, etc.++The game scenarios, as ordered by their number, lead the player along+an optional story arc. The first two adventures double as tutorials+that offer rudimentary preparation for the main game, the long crawl.+They gradually introduce exploration, stealth and melee combat,+helping the player develop his repertoire of squad formations+and move patterns, suitable for different tactical contexts.+When the player loses, a defeat message for the scenario appears+with hints about strategies known to work in the given tactical context.+Alternatively, the player may postpone reading these messages and instead+try to puzzle out the tactics himself --- this is not so hard, as there are+not so many moving parts to figure, at least in the short adventures.++As soon as the player learns to navigate initial levels of the crawl game+and starts employing ranged combat, light sources and other means+of gaining or denying battlefield intel, and dies a lot, it makes sense+to return to the remaining short adventures. They bring forth many extra+game features and tactics and prevent the player from missing half the fun+by trying to play the crawl just like a normal roguelike with spare heroes.+The extra scenarios continue the plotline from the initial tutorial adventures+in the form of flashbacks and eventually lead up to the events that start+the main crawl adventure. The training they provide has narrow focus,+drilling a particular skill set, even as exotic as opportunity fire+management, a frantic race to the exit and big asymmetric melee battle.+The challenge the scenarios offer may be, accordingly, quite extreme,+particularly at higher difficulty levels and when striving for high scores.++The main adventure, the long crawl, is the only one that takes+place in a multi-floor setting, requiring lots of time to beat.+The focus is on resource management and survival,+including terrain transformation using tools, spotting environment+clues and guessing and countering opponents' strategies.+The player has a choice of exploring a single level at a time or portions+of many levels along a single staircase. On some levels he may explore+and loot with a single scout, eluding most opponents. On others he may be+forced to change the pace and perform a complete exterminatory sweep+involving his whole party. On yet others, his best course of action may be+to defend a key location until the first wave of attackers is broken.+The large game arena calls for strategic thinking, including resource+management, frantic races to the exit, big asymmetric melee battles.+Thus, the crawl scenario is the most replayable adventure, but even the small+ones can be refreshed by striving to beat a high score and then+ramping up the difficulty settings.+++Exploring the world+-------------------++The map of any particular adventure consists of one or many+levels and a level consists of a number of tiles with a particular terrain kind on each. The game world is persistent, i.e., every time-the player visits a level during a single game, its layout is the same.+the player visits a level during a single game, its layout is the same+(unless modified by other actors). -Terrain is depicted with non-letter and non-digit (except zero `0`)-characters, the same as items lying on the ground, though blocky-solid symbol are more likely to be non-passable terrain than items.-In case of doubt, one of the aiming commands (keypad `/`, with default-keybinding) cycles through all visible and remembered items on the level-and another (keypad `*`, with default keybinding) through all foes.-Also, pointing at a map position with `MMB` (middle mouse button) displays-a short description of its contents. The basic terrain kinds are as follows.+Letters and digits on the game screen are likely to represent actors.+On the other hand, terrain is depicted with non-letter and non-digit+characters and with zero `0`. Blocky solid symbols are likely to be+non-passable and/or not translucent terrain. White, cyan and green terrain+is usually inert, red is burning or trapped, blue activable or trapped,+magenta activable or searchable. -    terrain type                           on-screen symbol-    wall (horizontal and vertical)         - and |-    tree or rock or man-made column        0-    rubble                                 &-    bush, transparent obstacle             %-    trap, ice obstacle                     ^-    closed door                            +-    open door (horizontal and vertical)    | and --    corridor                               #-    smoke or fog                           ;-    ground                                 .-    water                                  ~-    stairs or exit up                      <-    stairs or exit down                    >-    bedrock                                blank+Items lying on the ground are represented with non-letter and non-digit+characters, just as terrain, though rarely with blocky symbols.+In case of doubt, one of the aiming commands (`/` and `KP_/`,+that is, `/` on the keypad) cycles through all visible and remembered+items on the level and another (`*` and `KP_*`, all with default keybindings)+through all foes. Also, pointing at a map position with MMB+(middle mouse button) displays a short description of its contents. +Pointing with RMB enters aiming mode, in which pointing again+or pressing Space key or MMB decreases detail level of the description.+If a foe or interesting terrain is being pointed at, tilde key `~` shows+the relevant lore details. The basic terrain kinds are as follows.++    terrain type                          on-screen symbol++    bush, transparent obstacle            %+    trap, ice obstacle                    ^++    wall (horizontal and vertical)        - and |+    bedrock                               blank+    tree, rock, man-made column           0+    rubble                                &+    stairs, exit up                       <+    stairs, exit down                     >+    closed door                           +++    open door (horizontal and vertical)   | and -+    corridor                              #+    ground                                .+    water, other fluid                    ~++    smoke, fog, open fire                 ;+    workshop, curtain, foliage            :++The four groups above, in turn, block movement but not view,+block both, block neither, block view but not movement.+Additionally, each tile, regardless if open and if translucent,+may be permanently lit with ambient light or not.+ Actors are marked with lower and upper case letters and with characters `@` and `1` through `9` (but never `0`). Player-controlled-heroes are always bright white and by default they are selected-(e.g., to run together) so they have a blue highlight around their symbol.-If player manages to control animals or other actors, they retain their-letter and color, but gain a highlight as well.+heroes are always bright white and at game start they are selected+(e.g., to run together) so they have a green highlight around their symbol.+If player manages to take control of animals or other actors, they retain+their letter and color, but gain a highlight as well.  So, for example, the following map shows a room with a closed door, full of actors, connected by a corridor with a room with an open door, a pillar, a staircase down and rubble that obscures one of the corners.-The lower row of the larger room is full of items.+The lowest row of the larger room is full of items.      ------       ------     |@19.|       |....&&@@ -90,265 +217,259 @@     ------       ----------  -Heroes-------+Leading your heroes+-------------------  The heroes are displayed on the map with bright white color (red if they are-about to fall down) and symbols `@` and `1` through `9` (never `0`).-The currently chosen party leader is yellow-highlighted on the map-and his attributes are displayed at the bottom-most status line which,+seriously wounded) and symbols `@` and `1` through `9` (never `0`).+The currently chosen party pointman is highlighted on the map with yellow.+The easiest way to control your team is to run a short distance+with your pointman using Shift-direction or LMB, switch the pointman+with the Tab key, repeat. In open terrain, if you keep consistent distance+between teammates, this resembles the leap-frog infantry tactics,+in which the immobile team members cover the movement of the others.+For best effects, try to end each sprint behind cover or concealment+(note that a thin pillar is neither, but a single shadowed spot may be+enough to hide in the dark).++Pointman hero's attributes are displayed at the bottom-most status line which, in its most complex form, looks as follows. -    *@12   2m/s Calm: 20/60 HP: 33/50 Leader: Haskell Alvin   6d1+5% 4d1+    *@12   2m/s Calm: 20/60 HP: 33/50 Pointman: Haskell Alvin   6d1+5% 4d1 -The line starts with the list of party members, with the current leader-highlighted in yellow. Most commands involve only the leader, including-movement with keyboard's keypad or `LMB` (left mouse button). If more-heroes are selected (highlighted in blue), they run together-whenever `:` or `S-LMB` (while holding Shift) over map area is pressed.-Any sleeping hero is highlighted in green and can be woken up-by yelling with `%`, which also taunts or stresses nearby enemies.+The line starts with the list of party members, with the current pointman+highlighted in yellow. Most commands involve only the pointman, including+movement with keyboard or keypad or LMB (left mouse button).+If more heroes are selected (highlighted in green), they run together+whenever `:` or S-LMB (LMB while holding down Shift) over map area+is pressed, though that's usually not a precise enough method+of controlling a team. Any sleeping hero is highlighted in blue+and can be woken up by yelling with `%` key, which also taunts+or stresses up nearby enemies. -Next on the bottom-most status line is the leader's current and maximum+Next on the bottom-most status line is the pointman's current and maximum Calm (morale, composure, focus, attentiveness), then his current and maximum HP (hit points, health). The colon after "Calm" turning-into a dot signifies that the leader is in a position without ambient-illumination, making a stealthy conduct easier. A brace sign instead-of a colon after "HP" means the leader is braced for combat-(see section [Basic Commands](#basic-commands)).+into a dot signifies that the pointman is in a position without ambient+illumination, making stealthy conduct easier. A brace sign instead+of a colon after "HP" means the pointman is braced for combat+(see section [Moving and acting](#Moving-and-acting)). -In the second half of the bottom-most status line, the leader's name-is shown. Then come damage dice of the leader's melee weapons and leader's+In the second half of the bottom-most status line, the pointman's name+is shown. Then come damage dice of the pointman's melee weapons and pointman's appendages, ordered by their power. The dice of the first recharged weapon,-the one that would be used in this moment, is adorned with percentage-damage bonus collected from the whole equipment of the leader.+the one that is going to be used now, is adorned with percentage+damage bonus collected from the whole equipment of the pointman. If the dice are displayed with upper-case `D` instead of lower-case `d`,-the weapon has additional effects apart of the usual kinetic damage.-The nature of the effects can be appraised via the `E`quipment screen.+the weapon has additional effects apart of the usual direct damage.+The nature of the effects can be appraised via the equipment outfit menu.+Only the most common piercing direct damage, denoted by the damage dice,+is affected by the percentage damage bonus. The other direct damage kinds,+such wounding and burning, are represented by extra added integers+and are not scaled by bonuses from melee skill nor maluses from+the opponent's armor.  Weapon damage and other item properties are displayed using the dice notation `xdy`, which denotes `x` rolls of `y`-sided dice. A variant written `xdLy` is additionally scaled by the level depth-in proportion to the maximal level depth (at the first level it's-always one, then it grows up to full rolled value at the last level).-Section [Monsters](#monsters) below describes combat resolution in detail,-including the role of the percentage damage bonus.+in proportion to the maximal level depth (at the first level the result+is always one, then it grows up to the full rolled value at the last level).+Section [Battling monsters](#Battling-monsters) below describes combat+resolution in detail, including the role of the percentage bonuses. -The second, the upper status line describes the current level in relation+The upper status line describes the current level in relation to the party. -    5  Lofty hall    [33% seen] X-hair: dire basilisk    [**__]+    5  Lofty hall    [33% seen] dire basilisk    [__**]  First comes the depth of the current level and its name. Then the percentage of its explorable tiles already seen by the heroes.-The `X-hair` (aiming crosshair) is the common focus of the whole party,+Then the common focus of the whole party, coming from the aiming crosshair marked on the map with a red box and manipulated with mouse or movement keys in aiming mode. In this example, the crosshair points-at a dire basilisk monster, with its hit points drawn as a bar.+at a dire basilisk monster with its hit points drawn as a half-full bar. -Instead of a monster, the `X-hair` area may describe a position on the map,-a recently spotted item on the floor or an item in inventory selected-for further action or, if none are available, a summary of the team status.-For example, this form+Instead of a monster, the aiming crosshair status area may describe+a position on the map, a recently spotted item on the floor or an item+in inventory selected for further action or, if none are available,+a summary of the team composition. For example, this form -    5  Lofty hall    [33% seen] X-hair: exact spot (71,12)    p15 l10+    5  Lofty hall    [33% seen] spot (71,12)    p15 l10  indicates that the party is aiming at an exact spot on the map.-At the end of the status line comes the length of the shortest-path from the leader's position to the spot and the straight-line-distance between the two points, one that a flung projectile would travel.+At the end of this example status line comes the length of the shortest+path from the pointman's position to the spot in crosshair and+the straight-line distance between the two points, one that a flung+projectile would travel if there were no obstacles.  -Basic Commands---------------+Moving and acting+----------------- -This section is a copy of the few basic screens of in-game help. The help-pages are automatically generated based on a game's keybinding content and-on overrides in the player's config file. The remaining in-game help screens,-not shown here, list all game commands grouped by categories in detail.-A text snapshot of the complete in-game help is in+This section is a copy of the few initial bits of in-game help. The in-game+help pages are automatically generated based on a game's keybinding content+definitions and on overrides in the player's config file. The remaining+in-game help screens, not shown here, list all game commands grouped+by categories in detail. A text snapshot of the complete in-game help is in [InGameHelp.txt](InGameHelp.txt). -Walk throughout a level with mouse or numeric keypad (left diagram below)-or the Vi editor keys (right) or with a compact laptop setup (middle) that-requires enabling in config.ui.ini. Run until disturbed with Shift or Control.-Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift).+Walk throughout a level with mouse or numeric keypad (right diagram below)+or the Vi editor keys (middle) or the left-hand movement keys (left). Run until+disturbed with Shift or Control. Go-to a position with LMB (left mouse button). -               7 8 9          7 8 9          y k u-                \|/            \|/            \|/-               4-5-6          u-i-o          h-.-l-                /|\            /|\            /|\-               1 2 3          j k l          b j n+          q w e          y k u          7 8 9+           \|/            \|/            \|/+          a-s-d          h-.-l          4-5-6+           /|\            /|\            /|\+          z x c          b j n          1 2 3 -In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair).+In aiming mode, the same keys (and mouse) move the aiming crosshair. Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5` (the same key with Shift or Control) to lurk 0.1 of a turn, without bracing.+ Displace enemies by running into them with Shift/Control or S-LMB. Search, open, descend and attack by bumping into walls, doors, stairs and enemies.-The best melee weapon is automatically chosen from your equipment-and from among your body parts.+The best, not on cooldown, melee weapon is automatically chosen from your+equipment and from among your body parts. -The following commands, joined with the basic set above,-let you accomplish anything in the game, though-not necessarily with the fewest keystrokes. You can also-play the game exclusively with a mouse, or both mouse-and keyboard. (See the ending help screens for mouse commands.)-Lastly, you can select a command with arrows or mouse directly-from the help screen or the dashboard and execute it on the spot.+The following few commands, joined with the movement and running keys,+let you accomplish almost anything in the game, though not necessarily+with the fewest keystrokes. You can also play the game exclusively+with a mouse, or both mouse and keyboard (e.g., mouse for go-to+and terrain inspection and keyboard for everything else). Lastly,+you can select a command with arrows or mouse directly from the help+screen or the dashboard and execute it on the spot.      keys         command-    E            manage equipment of the leader+    I            manage the shared inventory stash     g or ,       grab item(s)-    ESC          open main menu/finish aiming+    ESC          clear messages/open main menu/finish aiming     RET or INS   open dashboard/accept target-    SPACE        clear messages and show history-    S-TAB        cycle among all party members-    KP_* or !    cycle x-hair among enemies-    KP_/ or /    cycle x-hair among items-    c            close door-    %            yell/yawn+    SPACE        clear messages/show history/cycle detail level+    TAB          cycle among all party members+    *            cycle crosshair among enemies+    /            cycle crosshair among items+    M            modify any admissible terrain+    %            yell or yawn and stop sleeping -Screen area and UI mode (exploration/aiming) determine-mouse click effects. First, we give an overview-of effects of each button over the game map area.-The list includes not only left and right buttons, but also-the optional middle mouse button (MMB) and the mouse wheel,-which is also used over menus, to page-scroll them.-(For mice without RMB, one can use Control key with LMB and for mice-without MMB, one can use C-RMB or C-S-LMB.)+Screen area and UI mode (exploration/aiming) determine mouse click+effects. Here we give an overview of effects of each button over+the game map area. The list includes not only left and right buttons,+but also the optional middle mouse button (MMB) and the mouse wheel,+which is also used over menus, to page-scroll them. For mice without RMB,+one can use Control key with LMB and for mice without MMB, one can use+C-RMB or C-S-LMB. -    keys         command+    keys         command (exploration/aiming)     LMB          go to pointer for 25 steps/fling at enemy     S-LMB        run to pointer collectively for 25 steps/fling at enemy-    RMB or C-LMB start aiming at enemy under pointer-    S-RMB        open or close or alter at pointer-    MMB or C-RMB snap x-hair to floor under pointer+    RMB or C-LMB start aiming at enemy under pointer/cycle detail level+    S-RMB        modify terrain at pointer+    MMB or C-RMB snap crosshair to floor under pointer/cycle detail level     WHEEL-UP     swerve the aiming line     WHEEL-DN     unswerve the aiming line --Advanced Commands--------------------For ranged attacks, setting the aiming crosshair beforehand is not mandatory,-because x-hair is set automatically as soon as a monster comes into view-and can still be adjusted for as long as the missile to fling is not chosen.-However, sometimes you want to examine the level map tile by tile-or assign persistent personal targets to party members.-The latter is essential in the rare cases when your henchmen-(non-leader characters) can move autonomously or fire opportunistically-(via innate skills or rare equipment). Also, if your henchman is adjacent-to more than one enemy, setting his target makes him melee a particular foe.--You can enter the aiming mode with the `*` keypad key that selects-enemies or the `/` key that cycles among items on the floor-and marks a tile underneath an item. You can move x-hair-with direction keys and assign a personal target to the leader-with a `RET` key (Return, Enter). The details of the shared x-hair mark-are displayed in a status line close to the bottom of the screen,-as explained in section [Heroes](#heroes) above.--Commands for saving and exiting the current game, starting a new game,-configuring convenience settings for the current game and challenges-for the next game are listed in the main menu, brought up by the `ESC` key.-Game difficulty, from the challenges menu, determines hitpoints at birth:-difficulty below 5 multiplies hitpoints of player characters, difficulty-over 5 multiplies hitpoints of their enemies. Of the convenience settings,-the `suspect terrain` choice is particularly interesting, because it-determines not only screen display of the level map, but also whether-suspect tiles are considered for auto-explore and for the `C-?` command that-marks the nearest unexplored position.--The "lone wolf" challenge mode reduces player's starting actors to exactly-one (consequently, this does not affect the initial 'raid' scenario).-The "cold fish" challenge mode makes it impossible for player characters-to be healed by actors from other factions (this is a significant-restriction in the final 'crawl' scenario).--For a person new to roguelikes, the 'raid' scenario offers a gentle-introduction. The subsequent game scenarios lead the player along-an optional story arc. They gradually introduce squad combat,-stealth, opportunity fire, asymmetric battles and more.-Starting from the second scenario, the player controls a whole team-of characters and will develop his repertoire of squad formations,-preferred rendezvous locations and the use of light sources.--The last scenario, the crawl, is the only one that takes place-in a multi-floor setting, spanning 10 varied levels, requiring lots-of time and focus to beat and providing considerable replayability.-The player has a choice of exploring a single level at a time-or portions of many levels along a single staircase. The scenario-is the gist and the main challenge of the game, involving strategic-resource management and area denial elements. Compared to that,-the smaller scenarios provide mostly tactical training and additional-entertainment by trying to beat a high-score. They offer variety-and a breather between the deaths^H^H^H^H^H^H the brave attempts-at the long crawl scenario.+Note that mouse is totally optional. Keyboard suffices, occasionally+requiring a lookup for some obscure command key in the help screens.  -Monsters---------+Battling monsters+----------------- -The life of the heroes is full of dangers. Monstrosities, natural+The life of heroes is full of danger. Monstrosities, natural and out of this world, roam the dark corridors and crawl from damp holes day and night. While heroes pay attention to all other party members and take care to move one at a time, monsters don't care about each other-and all move at once, sometimes brutally colliding by accident.+and crowd and stampede all at once, sometimes brutally colliding by accident.  Monsters are depicted on the map with letters. Upper case letters-are unique monsters, often guardians of dungeon levels, and lower case-letters are the rabble. If there are humans not from our team,-they are marked with `@` and `1` through `9` in other colours than white.+are unique monsters, often guardians of special floors, resources+and keys to other areas. Lower case letters are the rabble.+If there are humans not from our team, they are marked+with `@` and `1` through `9` in other colours than white.  When a hero walks and bumps into a monster or a monster attacks the hero, melee combat occurs. Hero *running* into and displacing-a monster (with the `Shift` or `Control` key), or the other way around,-does not inflict damage, but exchanges places. This gives the opponent+a monster (with the `Shift` key and, in case of keypad movement,+alternatively a `Control` key), does not involve inflicting a damage,+but only causes an exchange of places. This gives the opponent a free blow, but can improve the tactical situation or aid escape. In some circumstances actors are immune to the displacing, e.g., when both parties form a continuous front-line. -In melee combat, the best recharged equipped weapon (or the best fighting-organ that is not on cooldown) of each opponent is taken into account-for determining the damage and any extra effects of the blow.-To determine the damage dealt, the outcome of the weapon's damage dice roll-is multiplied by a percentage bonus. The bonus is calculated by taking-the damage bonus (summed from the equipped items of the attacker,-capped at 200%) minus the melee armor modifier of the defender-(capped at 200%, as well), with the outcome bounded between -99% and 99%,-which means that at least 1% of damage always gets through-and the damage is always lower than twice the dice roll.-The current leader's melee bonus, armor modifier and other detailed-skills can be viewed via the `#` command.+In melee combat, the best recharged equipped weapon (including fighting+organs that are not on cooldown) is taken into account for determining+the damage and any extra effects of the blow. To calculate the damage+dealt, the outcome of the weapon's direct piercing damage dice roll+(but not any additional direct damage summands such as wounding or burning)+is multiplied by a percentage bonus. The total bonus is calculated+by taking the damage bonus (summed from the equipped items and organs+and conditions of the attacker, capped at 200%) minus the melee+armor modifier of the defender (capped at 200%, as well). However,+at least 5% of damage always gets through, even if the bonus is nominally+below -95%, so excessively strong armor acts only as a buffer against+high melee skill of opponents. +The current pointman's melee bonus, armor modifier and other detailed+stats can be viewed in the skill menu, accessible via the `#` command,+which summarizes all the stats conferred by organs and conditions listed+in the organ menu, invoked by `@`.+ In ranged combat, the projectile is assumed to be attacking the defender in melee, using itself as the weapon, with the usual dice and damage bonus.-This time, the ranged armor skill of the defender is taken into account+This time, the *ranged* armor skill of the defender is taken into account and, additionally, the speed of the missile (based on shape and weight) figures in the calculation. You may propel any item from your inventory-(by default you are offered only the appropriate items; press `+` to cycle-item menu modes). Only items of a few kinds inflict any damage, but some+(by default you are offered only the appropriate items; press `+` to open+all choices). Only items of a few kinds inflict direct damage, but some have other effects, beneficial, detrimental or mixed.  In-game detailed item descriptions contain melee and ranged damage estimates.-They do not take into account damage from effects and, if bonuses are not-known, guesses are based on averages for the item kind in question.-The displayed figures are rounded, but the game internally keeps track-of minute fractions of HP.+They do not take into account enemy armor nor damage from effects and,+if bonuses are not known, guesses are based on averages for the item kind+in question. The displayed figures are rounded, but the game internally+keeps track of minute fractions of HP for all actors in all calculations. -The stress of combat drains Calm, gradually limiting viewing radius and,+The combat stress drains Calm, gradually limiting viewing radius and, if Calm reaches zero and the actor is sufficiently impressed by his foes,-making him defect and surrender to their domination.-Whenever the monster's or hero's hit points reach zero,-the combatant is incapacitated and promptly dies.-When the last hero dies or is dominated, the scenario ends in defeat.+making him defect and surrender unto their domination. Whenever the monster's+or hero's hit points reach zero, the combatant falls down and quickly+gets permanently incapacitated. When the last hero is disabled or dominated,+the adventure ends in defeat.  -On Winning and Dying---------------------+Attacking from a distance+------------------------- -You win a scenario if you escape the location alive (which may prove+For ranged attacks, setting the aiming crosshair before `f` to attack+is pressed is not mandatory. Crosshair is set automatically as soon+as a monster comes into view and can still be adjusted for as long+as the missile to fling is not chosen. However, sometimes before+flinging you want to examine the level map tile by tile by moving+the crosshair or assign persistent personal targets to party members.+The latter is essential in the rare cases when your henchmen+(non-pointman characters) can move autonomously or fire opportunistically+(via innate skills or rare equipment). Also, if your non-pointman character+is adjacent to more than one enemy, setting his target makes him melee+a particular foe.++You can enter the aiming mode with the `*` and `KP_*` keys that+select enemies or the `/` and `KP_/` keys that cycle among items+on the floor. You can move crosshair with direction keys and assign+a personal target to the pointman with a `RET` key (Return, Enter).+The details about the shared crosshair position are displayed in a status+line close to the bottom of the screen, as explained in section+[Leading your heroes](#Leading-your-heroes) above. You cycle aiming+mode from foe to spot to vector with the ``\`` key, which is useful+when a monster vanishes but you still want to fling at its last+known position.+++Winning and dying+-----------------++You win an adventure if you escape the location alive (which may prove difficult, because your foes tend to gradually build up the ambush squad blocking your escape route) or, in scenarios with no exit locations, if you eliminate all opposition. In the former case, your score@@ -357,10 +478,93 @@ of turns you spent overcoming your foes (the quicker the victory, the better; the slower the demise, the better). Bonus points, affected by the number of heroes lost, are awarded only if you win. The score is heavily-modified by the chosen game difficulty, but not by any other challenges.+modified by the chosen game difficulty, but not by any other challenges+(which are, however, proudly displayed in the high score listing).  When all your heroes fall, you are going to invariably see a new foolhardy-party of adventurers clamoring to be led into the unknown perils. They start-their conquest from a new entrance, with no experience and no equipment,-and new undaunted enemies bar their way. Lead the new hopeful explorers-with wisdom and fortitude!+party of adventurers clamoring to be led into the unknown perils.+They start their conquest afresh, with no experience, no supplies+for survival and no equipment, and new undaunted enemies bar their way.+Lead the new hopeful explorers with wisdom and fortitude!+++FAQ+---++- Q: Why do I summon hostile animals all the time, why do I defect+to the enemy faction every level, why am I constantly sabotaging+my own adventure, what is going on?++A: Whenever anything bad happens, notice it and use it as a learning+experience. Especially if it happens often or periodically.+Check carefully the messages overlaid on the map and in history log,+look at your outfit, organs, stats. Observe coincidences.+Build conjectures. Deduce. Prevent. Adjust. Win. Whomever told you+bumping is enough, lied.++- Q: Why is my hero immobile?++A: Perhaps he's just sleeping (blue box indicates that)? If so,+you can wake him up with the `%` command. If he's not asleep,+his movement skill may be temporarily drained. Switch to another hero+or perform some other productive action that walking or wait+or rest with `R`.++- Q: Is autoexplore safe?++A: Not at all. It doesn't try to guess which hazardous terrain you want+to avoid and which to barge through, so be prepared to abort exploration+if open fire or slippery ground comes into view. Unless you have HP to spare.++- Q: Why does the percentage of explored tiles turn from 100% to 99%?++A: Apparently enemies transformed a tile from unexplorable terrain kind+to explorable. The new tile has never been seen by the player,+so the percentage is no longer at 100%.++- Q: Why when a single hero gets ambushed and is fighting at close quarters,+his distant teammates don't jointly come to his rescue.++A: The teammates wait for him to come back into the formation instead+so that they may assume a front line and then melee their foes together.+The immobile heroes are assumed to be pinned to their positions+by fear and shock, but also by their imperative to hold formation,+so as to defend an important position or avoid running piecemeal+into a trap or into friendly fire or avoid breaking concealment+and revealing their position or leaving a vantage point from which+they can observe and relay enemy movement. For untrained teams,+simultaneous synchronized squad movement is not feasible.+It would be practical, if all squaddies had cameras, with a few drones+overhead for best effect, and if a team of off-site coordinators analyzed+the situation and micromanaged them all. This is not the case here.++- Q: Why is the noise I'm hearing "indistinct"?++A: That's because it's out of direct hearing range of each teammate+on the level, but ponderous enough to be perceived by all as vibrations+and echos from afar. Any other noise adjective indicates that the noise+is heard by at least one teammate and how far it is from the pointman+(who may or may not hear it directly, as signalled by his Calm drop).++- Q: Why are there two 'weakened' conditions in the organ menu of my hero?++A: Each team has a different recipe for their weakness brew.+Consequently, multiple affliction by the concoction from a single team+prolongs a single malady, but affliction by concoctions from many teams+causes concurrent ailments, with compounded effects, but independent+and short durations. The benefit of the mechanism is that+it's possible to tell the perpetrator team of any ailment.+The exceptions are the conditions that activate each turn, e.g., healing+(regeneration, various resistances that effectively cure each turn)+or wounding (poison). These are similar regardless of the team and so+the condition is always only prolonged.++- Q: Why is a harpoon in my shared inventory stash charging for hundreds+of turns?++A: This is an artifact of time running independently on each level.+Any ideas on how to improve this are welcome. A workaround is to drop and then+pick up the item on the level you want to use it. When picked up,+it gets recharged after, randomly, from one to two times the normal+cooldown period of the item and then recharges normally for as long+as it's used on this level.

GameDefinition/config.ui.default view

@@ -14,39 +14,116 @@  [additional_commands] ; Angband compatibility (accept target)-Cmd_2 = ("KP_Insert", ([CmdAim], "", ByAimMode AimModeCmd {exploration = ExecuteIfClear Dashboard, aiming = Accept}))+Cmd_2 = ("KP_Insert", ([CmdAim], "", ByAimMode AimModeCmd {exploration = Dashboard, aiming = Accept}))+; Custom key rebinding example:+;+;   Cmd_3 = ("a", ([CmdItem], "My Happy Cmd", Macro ["t"]))+;+; Explanation: to (t)rigger a consumable item for use, you normally use+;              the key press 't'.+; Suppose you would like to use the key press 'a' instead of 't'.+;   Cmd_3          - can be anything as long as it doesn't conflict or+;                    overlap with a binding already defined+;   "a"            - the new key to use+;   [CmdItem]      - can either be [] or [CmdItem]. If using [CmdItem]+;                    the new keybinding will be displayed in the help menu+;                    in-game alongside other keys related to handling items.+;                    If there is no need to have the new binding displayed+;                    in the help menu, it is recommended to leave this empty []+;   "My Happy Cmd" - Is a name given to your binding, which would be dispayed+;                    in the help page in-game if you use 'CmdItem' from above  [hero_names] HeroName_0 = ("Haskell Alvin", "he") HeroName_1 = ("Alonzo Barkley", "he")-HeroName_2 = ("Ines Galenti", "she")+HeroName_2 = ("Inés Galenti", "she") HeroName_3 = ("Ernst Abraham", "he") HeroName_4 = ("Samuel Saunders", "he") HeroName_5 = ("Roger Robin", "he") HeroName_6 = ("Christopher Flatt", "he")+HeroName_7 = ("Simon Wise", "he")+HeroName_8 = ("Daniel Homer", "he")+HeroName_9 = ("Oleg Cracker", "he")  [ui]-; These two are mutually exclusive:+; Disable these to free up some keys, if you want to rebind commands+; and/or to avoid moving due to accidental key presses. movementViKeys_hjklyubn = True-movementLaptopKeys_uk8o79jl = False-; The font to use for scaling SDL2 display (best by multiples or 0.5):-;sdlFontFile = "16x16xw.woff"-scalableFontSize = 16-sdlScalableSizeAdd = 0-sdlFontFile = "16x16xw.bdf"-sdlBitmapSizeAdd = 0-;sdlFontFile = "8x8xb.fnt"-;sdlFontFile = "8x8x.fnt"-;sdlBitmapSizeAdd = 2+movementLeftHandKeys_axwdqezc = True+; recommended: "binary" or "dejavuBold" or, if not a Debian package, "ubuntu"+chosenFontset = "binary"+; 1.0 means don't scale; 1.5, 2.0, 3.0 give good results, <0.7 very bad+; for scales < 1 try fontsets with bolder auxiliary fonts and/or HintingLight+allFontsScale = 1.0+; NotFullscreen (default), BigBorderlessWindow (preferred), ModeChange+; for 1920×1080 fullscreen, set allFontsScale = 1.5 above+fullscreenMode = NotFullscreen+screenOneMessagePerLine = True+historyOneMessagePerLine = True ; New historyMax takes effect after removal of savefiles.+; Looks best if is divisble by screenful of message (rheight - 4 = 20). historyMax = 5000 maxFps = 24 noAnim = False hpWarningPercent = 20-; Uncomment to make all messages white.-; messageColors = [] overrideCmdline = ""-; Legacy: monospace fonts that have fixed size regardless of boldness (on some OSes at least)-gtkFontFamily = "DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace"-; sdlFonSizeAdd is now ignored-; runStopMsgs is now ignored++[fonts]+; the auxiliary fonts (the format is: kind name size hinting):+binaryRegular = FontProportional "BinarySansProLH-Regular.ttf.woff" 16 HintingHeavy+binaryBold = FontProportional "BinarySansProLH-Semibold.ttf.woff" 16 HintingHeavy+binaryMono = FontMonospace "BinaryCodeProLH-Bold.ttf.woff" 14 HintingHeavy+dejavuRegular = FontProportional "DejaVuLGCSans.ttf.woff" 15 HintingHeavy+dejavuBold = FontProportional "DejaVuLGCSans-Bold.ttf.woff" 13 HintingHeavy+dejavuMono = FontMonospace "Hack-Bold.ttf.woff" 13 HintingHeavy+ubuntuRegular = FontProportional "ubuntu-v14-latin-ext_latin-regular.ttf.woff" 16 HintingLight+ubuntuBold = FontProportional "ubuntu-v14-latin-ext_latin-500.ttf.woff" 16 HintingLight+ubuntuMono = FontMonospace "ubuntu-mono-v9-latin-ext_latin-700.ttf.woff" 16 HintingLight+; the map fonts (the format is: kind name size hinting cellSizeAdd):+; with allFontsScale < 1, try HintingLight for fuzzy, but less distorted shapes:+16x16xwScalable = FontMapScalable "16x16xw.woff" 16 HintingHeavy 0+; the map fonts (the format is: kind name cellSizeAdd):+16x16xwBitmap = FontMapBitmap "16x16xw.bdf" 0+8x8xbBitmap = FontMapBitmap "8x8xb.fnt" 2+8x8xBitmap = FontMapBitmap "8x8x.fnt" 2++[fontsets]+; best proportional:+binary = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "binaryRegular", fontPropBold = "binaryBold", fontMono = "binaryMono"}+dejavuBold = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "dejavuBold", fontPropBold = "dejavuBold", fontMono = "dejavuMono"}++; Warning: the Ubuntu Font Family fonts are considered non-free by Debian+; and so we don't include them in Debian and some other GNU/Linux packages.+; If you use such a package, feel free to download the fonts from our github+; repository or specify absolute paths to their locations in non-free Debian+; package fonts-ubuntu.+ubuntu = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "ubuntuRegular", fontPropBold = "ubuntuBold", fontMono = "ubuntuMono"}++; decent proportional:+binaryBold = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "binaryBold", fontPropBold = "binaryBold", fontMono = "binaryMono"}+dejavu = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "dejavuRegular", fontPropBold = "dejavuBold", fontMono = "dejavuMono"}+ubuntuThin = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "ubuntuRegular", fontPropBold = "ubuntuRegular", fontMono = "ubuntuMono"}++; monospace, for people that don't like proportional or many fonts:+binaryMono = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "binaryMono", fontPropBold = "binaryMono", fontMono = "binaryMono"}+dejavuMono = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "dejavuMono", fontPropBold = "dejavuMono", fontMono = "dejavuMono"}+ubuntuMono = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "ubuntuMono", fontPropBold = "ubuntuMono", fontMono = "ubuntuMono"}++; square:+16x16xw = FontSet {fontMapScalable = "16x16xwScalable", fontMapBitmap = "16x16xwBitmap", fontPropRegular = "", fontPropBold = "", fontMono = ""}+8x8xb = FontSet {fontMapScalable = "", fontMapBitmap = "8x8xbBitmap", fontPropRegular = "", fontPropBold = "", fontMono = ""}+8x8x = FontSet {fontMapScalable = "", fontMapBitmap = "8x8xBitmap", fontPropRegular = "", fontPropBold = "", fontMono = ""}++[message_colors]+; Prefixes of message class constructor names paired with colors.+; The first prefix that matches, wins.+;+; E.g., uncomment to make all messages white:+; Msg = White++[version]+; If an outdated config file mentions fonts that are not bundled with the game+; any more, the game crashes. To prevent that, one of the first three components+; of the game version should be bumped whenever fonts are changed.+; Configs from old versions are rejected, preventing the crash.+version = 0.10.2

+ GameDefinition/fonts/BinaryCodeProLH-Bold.ttf.woff view

binary file changed (absent → 70820 bytes)

+ GameDefinition/fonts/BinarySansProLH-Regular.ttf.woff view

binary file changed (absent → 75896 bytes)

+ GameDefinition/fonts/BinarySansProLH-Semibold.ttf.woff view

binary file changed (absent → 75964 bytes)

+ GameDefinition/fonts/DejaVuLGCSans-Bold.ttf.woff view

binary file changed (absent → 230292 bytes)

+ GameDefinition/fonts/DejaVuLGCSans.ttf.woff view

binary file changed (absent → 244944 bytes)

− GameDefinition/fonts/Fix15Mono-Bold.woff

binary file changed (101756 → absent bytes)

+ GameDefinition/fonts/Hack-Bold.ttf.woff view

binary file changed (absent → 134196 bytes)

− GameDefinition/fonts/LICENSE.16x16x

@@ -1,339 +0,0 @@-                    GNU GENERAL PUBLIC LICENSE-                       Version 2, June 1991-- Copyright (C) 1989, 1991 Free Software Foundation, Inc.,- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.--                            Preamble--  The licenses for most software are designed to take away your-freedom to share and change it.  By contrast, the GNU General Public-License is intended to guarantee your freedom to share and change free-software--to make sure the software is free for all its users.  This-General Public License applies to most of the Free Software-Foundation's software and to any other program whose authors commit to-using it.  (Some other Free Software Foundation software is covered by-the GNU Lesser General Public License instead.)  You can apply it to-your programs, too.--  When we speak of free software, we are referring to freedom, not-price.  Our General Public Licenses are designed to make sure that you-have the freedom to distribute copies of free software (and charge for-this service if you wish), that you receive source code or can get it-if you want it, that you can change the software or use pieces of it-in new free programs; and that you know you can do these things.--  To protect your rights, we need to make restrictions that forbid-anyone to deny you these rights or to ask you to surrender the rights.-These restrictions translate to certain responsibilities for you if you-distribute copies of the software, or if you modify it.--  For example, if you distribute copies of such a program, whether-gratis or for a fee, you must give the recipients all the rights that-you have.  You must make sure that they, too, receive or can get the-source code.  And you must show them these terms so they know their-rights.--  We protect your rights with two steps: (1) copyright the software, and-(2) offer you this license which gives you legal permission to copy,-distribute and/or modify the software.--  Also, for each author's protection and ours, we want to make certain-that everyone understands that there is no warranty for this free-software.  If the software is modified by someone else and passed on, we-want its recipients to know that what they have is not the original, so-that any problems introduced by others will not reflect on the original-authors' reputations.--  Finally, any free program is threatened constantly by software-patents.  We wish to avoid the danger that redistributors of a free-program will individually obtain patent licenses, in effect making the-program proprietary.  To prevent this, we have made it clear that any-patent must be licensed for everyone's free use or not licensed at all.--  The precise terms and conditions for copying, distribution and-modification follow.--                    GNU GENERAL PUBLIC LICENSE-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION--  0. This License applies to any program or other work which contains-a notice placed by the copyright holder saying it may be distributed-under the terms of this General Public License.  The "Program", below,-refers to any such program or work, and a "work based on the Program"-means either the Program or any derivative work under copyright law:-that is to say, a work containing the Program or a portion of it,-either verbatim or with modifications and/or translated into another-language.  (Hereinafter, translation is included without limitation in-the term "modification".)  Each licensee is addressed as "you".--Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope.  The act of-running the Program is not restricted, and the output from the Program-is covered only if its contents constitute a work based on the-Program (independent of having been made by running the Program).-Whether that is true depends on what the Program does.--  1. You may copy and distribute verbatim copies of the Program's-source code as you receive it, in any medium, provided that you-conspicuously and appropriately publish on each copy an appropriate-copyright notice and disclaimer of warranty; keep intact all the-notices that refer to this License and to the absence of any warranty;-and give any other recipients of the Program a copy of this License-along with the Program.--You may charge a fee for the physical act of transferring a copy, and-you may at your option offer warranty protection in exchange for a fee.--  2. You may modify your copy or copies of the Program or any portion-of it, thus forming a work based on the Program, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:--    a) You must cause the modified files to carry prominent notices-    stating that you changed the files and the date of any change.--    b) You must cause any work that you distribute or publish, that in-    whole or in part contains or is derived from the Program or any-    part thereof, to be licensed as a whole at no charge to all third-    parties under the terms of this License.--    c) If the modified program normally reads commands interactively-    when run, you must cause it, when started running for such-    interactive use in the most ordinary way, to print or display an-    announcement including an appropriate copyright notice and a-    notice that there is no warranty (or else, saying that you provide-    a warranty) and that users may redistribute the program under-    these conditions, and telling the user how to view a copy of this-    License.  (Exception: if the Program itself is interactive but-    does not normally print such an announcement, your work based on-    the Program is not required to print an announcement.)--These requirements apply to the modified work as a whole.  If-identifiable sections of that work are not derived from the Program,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works.  But when you-distribute the same sections as part of a whole which is a work based-on the Program, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Program.--In addition, mere aggregation of another work not based on the Program-with the Program (or with a work based on the Program) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.--  3. You may copy and distribute the Program (or a work based on it,-under Section 2) in object code or executable form under the terms of-Sections 1 and 2 above provided that you also do one of the following:--    a) Accompany it with the complete corresponding machine-readable-    source code, which must be distributed under the terms of Sections-    1 and 2 above on a medium customarily used for software interchange; or,--    b) Accompany it with a written offer, valid for at least three-    years, to give any third party, for a charge no more than your-    cost of physically performing source distribution, a complete-    machine-readable copy of the corresponding source code, to be-    distributed under the terms of Sections 1 and 2 above on a medium-    customarily used for software interchange; or,--    c) Accompany it with the information you received as to the offer-    to distribute corresponding source code.  (This alternative is-    allowed only for noncommercial distribution and only if you-    received the program in object code or executable form with such-    an offer, in accord with Subsection b above.)--The source code for a work means the preferred form of the work for-making modifications to it.  For an executable work, complete source-code means all the source code for all modules it contains, plus any-associated interface definition files, plus the scripts used to-control compilation and installation of the executable.  However, as a-special exception, the source code distributed need not include-anything that is normally distributed (in either source or binary-form) with the major components (compiler, kernel, and so on) of the-operating system on which the executable runs, unless that component-itself accompanies the executable.--If distribution of executable or object code is made by offering-access to copy from a designated place, then offering equivalent-access to copy the source code from the same place counts as-distribution of the source code, even though third parties are not-compelled to copy the source along with the object code.--  4. You may not copy, modify, sublicense, or distribute the Program-except as expressly provided under this License.  Any attempt-otherwise to copy, modify, sublicense or distribute the Program is-void, and will automatically terminate your rights under this License.-However, parties who have received copies, or rights, from you under-this License will not have their licenses terminated so long as such-parties remain in full compliance.--  5. You are not required to accept this License, since you have not-signed it.  However, nothing else grants you permission to modify or-distribute the Program or its derivative works.  These actions are-prohibited by law if you do not accept this License.  Therefore, by-modifying or distributing the Program (or any work based on the-Program), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Program or works based on it.--  6. Each time you redistribute the Program (or any work based on the-Program), the recipient automatically receives a license from the-original licensor to copy, distribute or modify the Program subject to-these terms and conditions.  You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties to-this License.--  7. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License.  If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Program at all.  For example, if a patent-license would not permit royalty-free redistribution of the Program by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Program.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system, which is-implemented by public license practices.  Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.--  8. If the distribution and/or use of the Program is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Program under this License-may add an explicit geographical distribution limitation excluding-those countries, so that distribution is permitted only in or among-countries not thus excluded.  In such case, this License incorporates-the limitation as if written in the body of this License.--  9. The Free Software Foundation may publish revised and/or new versions-of the General Public License from time to time.  Such new versions will-be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.--Each version is given a distinguishing version number.  If the Program-specifies a version number of this License which applies to it and "any-later version", you have the option of following the terms and conditions-either of that version or of any later version published by the Free-Software Foundation.  If the Program does not specify a version number of-this License, you may choose any version ever published by the Free Software-Foundation.--  10. If you wish to incorporate parts of the Program into other free-programs whose distribution conditions are different, write to the author-to ask for permission.  For software which is copyrighted by the Free-Software Foundation, write to the Free Software Foundation; we sometimes-make exceptions for this.  Our decision will be guided by the two goals-of preserving the free status of all derivatives of our free software and-of promoting the sharing and reuse of software generally.--                            NO WARRANTY--  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,-REPAIR OR CORRECTION.--  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE-POSSIBILITY OF SUCH DAMAGES.--                     END OF TERMS AND CONDITIONS--            How to Apply These Terms to Your New Programs--  If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these terms.--  To do so, attach the following notices to the program.  It is safest-to attach them to the start of each source file to most effectively-convey the exclusion of warranty; and each file should have at least-the "copyright" line and a pointer to where the full notice is found.--    <one line to give the program's name and a brief idea of what it does.>-    Copyright (C) <year>  <name of author>--    This program is free software; you can redistribute it and/or modify-    it under the terms of the GNU General Public License as published by-    the Free Software Foundation; either version 2 of the License, or-    (at your option) any later version.--    This program is distributed in the hope that it will be useful,-    but WITHOUT ANY WARRANTY; without even the implied warranty of-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-    GNU General Public License for more details.--    You should have received a copy of the GNU General Public License along-    with this program; if not, write to the Free Software Foundation, Inc.,-    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.--Also add information on how to contact you by electronic and paper mail.--If the program is interactive, make it output a short notice like this-when it starts in an interactive mode:--    Gnomovision version 69, Copyright (C) year name of author-    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.-    This is free software, and you are welcome to redistribute it-    under certain conditions; type `show c' for details.--The hypothetical commands `show w' and `show c' should show the appropriate-parts of the General Public License.  Of course, the commands you use may-be called something other than `show w' and `show c'; they could even be-mouse-clicks or menu items--whatever suits your program.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a "copyright disclaimer" for the program, if-necessary.  Here is a sample; alter the names:--  Yoyodyne, Inc., hereby disclaims all copyright interest in the program-  `Gnomovision' (which makes passes at compilers) written by James Hacker.--  <signature of Ty Coon>, 1 April 1989-  Ty Coon, President of Vice--This General Public License does not permit incorporating your program into-proprietary programs.  If your program is a subroutine library, you may-consider it more useful to permit linking proprietary applications with the-library.  If this is what you want to do, use the GNU Lesser General-Public License instead of this License.

− GameDefinition/fonts/LICENSE.Fix15Mono-Bold

@@ -1,94 +0,0 @@-Digitized data copyright (c) 2012-2015, The Mozilla Foundation and Telefonica S.A.
-with Reserved Font Name < Fira >, 
-
-This Font Software is licensed under the SIL Open Font License, Version 1.1.
-This license is copied below, and is also available with a FAQ at:
-http://scripts.sil.org/OFL
-
-
------------------------------------------------------------
-SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
------------------------------------------------------------
-
-PREAMBLE
-The goals of the Open Font License (OFL) are to stimulate worldwide
-development of collaborative font projects, to support the font creation
-efforts of academic and linguistic communities, and to provide a free and
-open framework in which fonts may be shared and improved in partnership
-with others.
-
-The OFL allows the licensed fonts to be used, studied, modified and
-redistributed freely as long as they are not sold by themselves. The
-fonts, including any derivative works, can be bundled, embedded, 
-redistributed and/or sold with any software provided that any reserved
-names are not used by derivative works. The fonts and derivatives,
-however, cannot be released under any other type of license. The
-requirement for fonts to remain under this license does not apply
-to any document created using the fonts or their derivatives.
-
-DEFINITIONS
-"Font Software" refers to the set of files released by the Copyright
-Holder(s) under this license and clearly marked as such. This may
-include source files, build scripts and documentation.
-
-"Reserved Font Name" refers to any names specified as such after the
-copyright statement(s).
-
-"Original Version" refers to the collection of Font Software components as
-distributed by the Copyright Holder(s).
-
-"Modified Version" refers to any derivative made by adding to, deleting,
-or substituting -- in part or in whole -- any of the components of the
-Original Version, by changing formats or by porting the Font Software to a
-new environment.
-
-"Author" refers to any designer, engineer, programmer, technical
-writer or other person who contributed to the Font Software.
-
-PERMISSION & CONDITIONS
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of the Font Software, to use, study, copy, merge, embed, modify,
-redistribute, and sell modified and unmodified copies of the Font
-Software, subject to the following conditions:
-
-1) Neither the Font Software nor any of its individual components,
-in Original or Modified Versions, may be sold by itself.
-
-2) Original or Modified Versions of the Font Software may be bundled,
-redistributed and/or sold with any software, provided that each copy
-contains the above copyright notice and this license. These can be
-included either as stand-alone text files, human-readable headers or
-in the appropriate machine-readable metadata fields within text or
-binary files as long as those fields can be easily viewed by the user.
-
-3) No Modified Version of the Font Software may use the Reserved Font
-Name(s) unless explicit written permission is granted by the corresponding
-Copyright Holder. This restriction only applies to the primary font name as
-presented to the users.
-
-4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
-Software shall not be used to promote, endorse or advertise any
-Modified Version, except to acknowledge the contribution(s) of the
-Copyright Holder(s) and the Author(s) or with their explicit written
-permission.
-
-5) The Font Software, modified or unmodified, in part or in whole,
-must be distributed entirely under this license, and must not be
-distributed under any other license. The requirement for fonts to
-remain under this license does not apply to any document created
-using the Font Software.
-
-TERMINATION
-This license becomes null and void if any of the above conditions are
-not met.
-
-DISCLAIMER
-THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
-OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
-COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
-DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
-OTHER DEALINGS IN THE FONT SOFTWARE.

+ GameDefinition/fonts/ubuntu-mono-v9-latin-ext_latin-700.ttf.woff view

binary file changed (absent → 57416 bytes)

+ GameDefinition/fonts/ubuntu-v14-latin-ext_latin-500.ttf.woff view

binary file changed (absent → 69288 bytes)

+ GameDefinition/fonts/ubuntu-v14-latin-ext_latin-regular.ttf.woff view

binary file changed (absent → 76672 bytes)

GameDefinition/game-src/Client/UI/Content/Input.hs view

@@ -4,7 +4,7 @@   ( standardKeysAndMouse #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , closeDoorTriggers, applyTs+  , applyTs #endif   ) where @@ -12,10 +12,9 @@  import Game.LambdaHack.Core.Prelude -import           Game.LambdaHack.Client.UI.Content.Input-import           Game.LambdaHack.Client.UI.HumanCmd-import qualified Game.LambdaHack.Content.TileKind as TK-import           Game.LambdaHack.Definition.Defs+import Game.LambdaHack.Client.UI.Content.Input+import Game.LambdaHack.Client.UI.HumanCmd+import Game.LambdaHack.Definition.Defs  -- | Description of default key-command bindings. --@@ -31,115 +30,85 @@   -- mode) first.    -- Main menu-  [ ("e", ([CmdMainMenu], "enter challenges menu>", ChallengesMenu))-  , ("s", ([CmdMainMenu], "start new game", GameRestart))+  [ ("s", ([CmdMainMenu], "setup and start new game>", ChallengeMenu))   , ("x", ([CmdMainMenu], "save and exit to desktop", GameExit))-  , ("v", ([CmdMainMenu], "visit settings menu>", SettingsMenu))-  , ("t", ([CmdMainMenu], "toggle autoplay (insert coin)", AutomateToggle))+  , ("v", ([CmdMainMenu], "tweak convenience settings>", SettingsMenu))+  , ("t", ([CmdMainMenu], "toggle autoplay", AutomateToggle))   , ("?", ([CmdMainMenu], "see command help", Help))   , ("F12", ([CmdMainMenu], "switch to dashboard", Dashboard))   , ("Escape", ([CmdMainMenu], "back to playing", AutomateBack))    -- Minimal command set, in the desired presentation order.   -- A lot of these are not necessary, but may be familiar to new players.-  , ("E", ( [CmdMinimal, CmdItem, CmdDashboard]-          , "manage equipment of the leader"+  -- Also a few non-minimal item commands to keep proper order.+  , ("I", ( [CmdMinimal, CmdItem, CmdDashboard]+          , "manage the shared inventory stash"+          , ChooseItemMenu (MStore CStash) ))+  , ("O", ( [CmdItem, CmdDashboard]+          , "manage the equipment outfit of the pointman"           , ChooseItemMenu (MStore CEqp) ))   , ("g", addCmdCategory CmdMinimal $ grabItems "grab item(s)")   , ("Escape", ( [CmdMinimal, CmdAim]-               , "open main menu/finish aiming"-               , ByAimMode AimModeCmd { exploration =-                                          ExecuteIfClear MainMenuAutoOff-                                      , aiming = Cancel } ))-  , ("C-Escape", ([CmdNoHelp], "", MainMenuAutoOn))+               , "clear messages/open main menu/finish aiming"+               , ByAimMode AimModeCmd+                             { exploration = ExecuteIfClear MainMenuAutoOff+                             , aiming = Cancel } ))+  , ("C-Escape", ([], "", MainMenuAutoOn))       -- required by frontends; not shown   , ("Return", ( [CmdMinimal, CmdAim]                , "open dashboard/accept target"-               , ByAimMode AimModeCmd { exploration = ExecuteIfClear Dashboard+               , ByAimMode AimModeCmd { exploration = Dashboard                                       , aiming = Accept } ))-  , ("space", ( [CmdMinimal, CmdMeta]-              , "clear messages and show history"-              , ExecuteIfClear LastHistory ))-  , ("Tab", ( [CmdMove]-            , "cycle among party members on the level"-            , MemberCycle ))-      -- listed here to keep proper order-  , ("BackTab", ( [CmdMinimal, CmdMove]-              , "cycle among all party members"-              , MemberBack ))-  , ("KP_Multiply", ( [CmdMinimal, CmdAim]-                    , "cycle x-hair among enemies"-                    , AimEnemy ))-  , ("KP_Divide", ([CmdMinimal, CmdAim], "cycle x-hair among items", AimItem))-  , ("c", ( [CmdMinimal, CmdMove]-          , descTs closeDoorTriggers-          , AlterDir closeDoorTriggers ))-  , ("%", ([CmdMinimal, CmdMeta], "yell/yawn", Yell))+  , ("space", ( [CmdMinimal, CmdAim]+              , "clear messages/show history/cycle detail level"+              , ByAimMode AimModeCmd { exploration = ExecuteIfClear LastHistory+                                     , aiming = DetailCycle } ))+  , ("Tab", memberCycle Forward [CmdMinimal, CmdMove])+      -- listed here to keep proper order of the minimal cheat sheet+  , ("BackTab", memberCycle Backward [CmdMove])+  , ("A-Tab", memberCycleLevel Forward [])+  , ("A-BackTab", memberCycleLevel Backward [])+  , ("C-Tab", memberCycleLevel Forward [CmdMove])+  , ("C-BackTab", memberCycleLevel Backward [CmdMove])+      -- TODO: the keys are too long to fit in help menu, unless vertically+  , ("*", ( [CmdMinimal, CmdAim]+          , "cycle crosshair among enemies"+          , AimEnemy ))+  , ("/", ([CmdMinimal, CmdAim], "cycle crosshair among items", AimItem))+  , ("m", ([CmdMove], "modify door by closing it", CloseDir))+  , ("M", ([CmdMinimal, CmdMove], "modify any admissible terrain", AlterDir))+  , ("%", ([CmdMinimal, CmdMeta], "yell or yawn and stop sleeping", Yell))    -- Item menu, first part of item use commands-  , ("comma", grabItems "")-  , ("d", dropItems "drop item(s)")-  , ("period", dropItems "")+  , ("comma", grabItems "")  -- only show extra key, not extra entry+  , ("r", dropItems "remove item(s)")   , ("f", addCmdCategory CmdItemMenu $ projectA flingTs)   , ("C-f", addCmdCategory CmdItemMenu             $ replaceDesc "auto-fling and keep choice"             $ projectI flingTs)-  , ("a", addCmdCategory CmdItemMenu $ applyI applyTs)-  , ("C-a", addCmdCategory CmdItemMenu-            $ replaceDesc "apply and keep choice" $ applyIK applyTs)-  , ("p", moveItemTriple [CGround, CEqp, CSha] CInv-                         "item" False)-  , ("i", replaceDesc "" $ moveItemTriple [CGround, CEqp, CSha] CInv-                                          "item" False)-  , ("e", moveItemTriple [CGround, CInv, CSha] CEqp-                         "item" False)-  , ("s", moveItemTriple [CGround, CInv, CEqp] CSha-                         "and share item" False)--  -- Terrain exploration and alteration-  , ("C", ([CmdMove], "open or close or alter", AlterDir []))-  , ("=", ( [CmdMove], "select (or deselect) party member", SelectActor) )-  , ("_", ([CmdMove], "deselect (or select) all on the level", SelectNone))-  , ("semicolon", ( [CmdMove]-                  , "go to x-hair for 25 steps"-                  , Macro ["C-semicolon", "C-quotedbl", "C-V"] ))-  , ("colon", ( [CmdMove]-              , "run to x-hair collectively for 25 steps"-              , Macro ["C-colon", "C-quotedbl", "C-V"] ))-  , ("x", ( [CmdMove]-          , "explore nearest unknown spot"-          , autoexploreCmd ))-  , ("X", ( [CmdMove]-          , "autoexplore 25 times"-          , autoexplore25Cmd ))-  , ("R", ([CmdMove], "rest (wait 25 times)", Macro ["KP_Begin", "C-V"]))-  , ("C-R", ( [CmdMove], "heed (lurk 0.1 turns 100 times)"-            , Macro ["C-KP_Begin", "V"] ))+  , ("t", addCmdCategory CmdItemMenu $ applyI applyTs)+  , ("C-t", addCmdCategory CmdItemMenu+            $ replaceDesc "trigger item and keep choice" $ applyIK applyTs)+  , ("i", replaceDesc "stash item into shared inventory"+          $ moveItemTriple [CGround, CEqp] CStash "item" False)+  , ("o", replaceDesc "equip item into outfit of the pointman"+          $ moveItemTriple [CGround, CStash] CEqp "item" False) -  -- Item use, continued-  , ("P", ( [CmdItem, CmdDashboard]-          , "manage inventory pack of the leader"-          , ChooseItemMenu (MStore CInv) ))-  , ("I", ( [CmdItem, CmdDashboard]-          , ""-          , ChooseItemMenu (MStore CInv) ))-  , ("S", ( [CmdItem, CmdDashboard]-          , "manage the shared party stash"-          , ChooseItemMenu (MStore CSha) ))+  -- Remaining @ChooseItemMenu@ instances   , ("G", ( [CmdItem, CmdDashboard]           , "manage items on the ground"           , ChooseItemMenu (MStore CGround) ))-  , ("A", ( [CmdItem, CmdDashboard]-          , "manage all owned items"+  , ("T", ( [CmdItem, CmdDashboard]+          , "manage our total team belongings"           , ChooseItemMenu MOwned ))-  , ("@", ( [CmdItem, CmdDashboard]-          , "describe organs of the leader"+  , ("@", ( [CmdMeta, CmdDashboard]+          , "describe organs of the pointman"           , ChooseItemMenu MOrgans ))-  , ("#", ( [CmdItem, CmdDashboard]-          , "show skill summary of the leader"+  , ("#", ( [CmdMeta, CmdDashboard]+          , "show skill summary of the pointman"           , ChooseItemMenu MSkills ))-  , ("~", ( [CmdItem]-          , "display known lore"+  , ("~", ( [CmdMeta]+          , "display relevant lore"           , ChooseItemMenu (MLore SItem) ))    -- Dashboard, in addition to commands marked above@@ -152,53 +121,72 @@                         , ChooseItemMenu (MLore slore) )))       (zip [1..] [minBound..maxBound])   ++-  [ ("safeD98", ( [CmdInternal, CmdDashboard]+  [ ("safeD97", ( [CmdInternal, CmdDashboard]                 , "display place lore"                 , ChooseItemMenu MPlaces) )+  , ("safeD98", ( [CmdInternal, CmdDashboard]+                , "display adventure lore"+                , ChooseItemMenu MModes) )   , ("safeD99", ([CmdInternal, CmdDashboard], "", Cancel))  -- blank line +  -- Terrain exploration and modification+  , ("=", ( [CmdMove], "select (or deselect) party member", SelectActor) )+  , ("_", ([CmdMove], "deselect (or select) all on the level", SelectNone))+  , ("semicolon", ( [CmdMove]+                  , "go to crosshair for 25 steps"+                  , Macro ["C-semicolon", "C-quotedbl", "C-v"] ))+  , ("colon", ( [CmdMove]+              , "run to crosshair collectively for 25 steps"+              , Macro ["C-colon", "C-quotedbl", "C-v"] ))+  , ("[", ( [CmdMove]+          , "explore nearest unknown spot"+          , autoexploreCmd ))+  , ("]", ( [CmdMove]+          , "autoexplore 25 times"+          , autoexplore25Cmd ))+  , ("R", ([CmdMove], "rest (wait 25 times)", Macro ["KP_Begin", "C-v"]))+  , ("C-R", ( [CmdMove], "heed (lurk 0.1 turns 100 times)"+            , Macro ["C-KP_Begin", "A-v"] ))+   -- Aiming-  , ("!", ([CmdAim], "", AimEnemy))-  , ("/", ([CmdAim], "", AimItem))-  , ("+", ([CmdAim], "swerve the aiming line", EpsIncr True))-  , ("-", ([CmdAim], "unswerve the aiming line", EpsIncr False))+  , ("+", ([CmdAim], "swerve the aiming line", EpsIncr Forward))+  , ("-", ([CmdAim], "unswerve the aiming line", EpsIncr Backward))   , ("\\", ([CmdAim], "cycle aiming modes", AimFloor))   , ("C-?", ( [CmdAim]-            , "set x-hair to nearest unknown spot"+            , "set crosshair to nearest unknown spot"             , XhairUnknown ))   , ("C-/", ( [CmdAim]-            , "set x-hair to nearest item"+            , "set crosshair to nearest item"             , XhairItem ))   , ("C-{", ( [CmdAim]-            , "set x-hair to nearest upstairs"+            , "aim at nearest upstairs"             , XhairStair True ))   , ("C-}", ( [CmdAim]-            , "set x-hair to nearest dnstairs"+            , "aim at nearest downstairs"             , XhairStair False ))   , ("<", ([CmdAim], "move aiming one level up" , AimAscend 1))-  , ("C-<", ( [CmdNoHelp], "move aiming 10 levels up"-            , AimAscend 10) )+  , ("C-<", ([], "move aiming 10 levels up", AimAscend 10))   , (">", ([CmdAim], "move aiming one level down", AimAscend (-1)))       -- 'lower' would be misleading in some games, just as 'deeper'-  , ("C->", ( [CmdNoHelp], "move aiming 10 levels down"-            , AimAscend (-10)) )+  , ("C->", ([], "move aiming 10 levels down", AimAscend (-10)))   , ("BackSpace" , ( [CmdAim]-                   , "clear chosen item and x-hair"+                   , "clear chosen item and crosshair"                    , ComposeUnlessError ClearTargetIfItemClear ItemClear))    -- Assorted (first few cloned from main menu)-  , ("C-s", ([CmdMeta], "start new game", GameRestart))+  , ("C-g", ([CmdMeta], "start new game", GameRestart))   , ("C-x", ([CmdMeta], "save and exit to desktop", GameExit))-  , ("C-t", ([CmdMeta], "toggle autoplay (insert coin)", Automate))   , ("C-q", ([CmdMeta], "quit game and start autoplay", GameQuit))   , ("C-c", ([CmdMeta], "exit to desktop without saving", GameDrop))   , ("?", ([CmdMeta], "display help", Hint))   , ("F1", ([CmdMeta, CmdDashboard], "display help immediately", Help))   , ("F12", ([CmdMeta], "open dashboard", Dashboard))-  , ("v", ([CmdMeta], "voice again the recorded commands", Repeat 1))-  , ("V", repeatTriple 100)-  , ("C-v", repeatTriple 1000)-  , ("C-V", repeatTriple 25)+  , ("v", repeatLastTriple 1 [CmdMeta])+  , ("C-v", repeatLastTriple 25 [])+  , ("A-v", repeatLastTriple 100 [])+  , ("V", repeatTriple 1 [CmdMeta])+  , ("C-V", repeatTriple 25 [])+  , ("A-V", repeatTriple 100 [])   , ("'", ([CmdMeta], "start recording commands", Record))   , ("C-S", ([CmdMeta], "save game backup", GameSave))   , ("C-P", ([CmdMeta], "print screen", PrintScreen))@@ -216,25 +204,26 @@   , ("RightButtonRelease", mouseRMB)   , ("C-LeftButtonRelease", replaceDesc "" mouseRMB)  -- Mac convention   , ( "S-RightButtonRelease"-    , ([CmdMouse], "open or close or alter at pointer", AlterWithPointer []) )+    , ([CmdMouse], "modify terrain at pointer", AlterWithPointer) )   , ("MiddleButtonRelease", mouseMMB)   , ("C-RightButtonRelease", replaceDesc "" mouseMMB)-  , ( "C-S-LeftButtonRelease",-      addCmdCategory CmdNoHelp $ replaceDesc "" mouseMMB )+  , ( "C-S-LeftButtonRelease", let (_, _, cmd) = mouseMMB+                               in ([], "", cmd) )+  , ("A-MiddleButtonRelease", mouseMMBMute)   , ("WheelNorth", ([CmdMouse], "swerve the aiming line", Macro ["+"]))   , ("WheelSouth", ([CmdMouse], "unswerve the aiming line", Macro ["-"]))    -- Debug and others not to display in help screens-  , ("C-semicolon", ( [CmdNoHelp]-                    , "move one step towards the x-hair"+  , ("C-semicolon", ( []+                    , "move one step towards the crosshair"                     , MoveOnceToXhair ))-  , ("C-colon", ( [CmdNoHelp]-                , "run collectively one step towards the x-hair"+  , ("C-colon", ( []+                , "run collectively one step towards the crosshair"                 , RunOnceToXhair ))-  , ("C-quotedbl", ( [CmdNoHelp]-                   , "continue towards the x-hair"+  , ("C-quotedbl", ( []+                   , "continue towards the crosshair"                    , ContinueToXhair ))-  , ("C-comma", ([CmdNoHelp], "run once ahead", RunOnceAhead))+  , ("C-comma", ([], "run once ahead", RunOnceAhead))   , ("safe1", ( [CmdInternal]               , "go to pointer for 25 steps"               , goToCmd ))@@ -242,13 +231,13 @@               , "run to pointer collectively"               , runToAllCmd ))   , ("safe3", ( [CmdInternal]-              , "pick new leader on screen"+              , "pick new pointman on screen"               , PickLeaderWithPointer ))   , ("safe4", ( [CmdInternal]               , "select party member on screen"               , SelectWithPointer ))   , ("safe5", ( [CmdInternal]-              , "set x-hair to enemy"+              , "set crosshair to enemy"               , AimPointerEnemy ))   , ("safe6", ( [CmdInternal]               , "fling at enemy under pointer"@@ -257,40 +246,30 @@               , "open main menu"               , MainMenuAutoOff ))   , ("safe8", ( [CmdInternal]+              , "clear msgs and open main menu"+              , ExecuteIfClear MainMenuAutoOff ))+  , ("safe9", ( [CmdInternal]               , "cancel aiming"               , Cancel ))-  , ("safe9", ( [CmdInternal]-              , "accept target"-              , Accept ))   , ("safe10", ( [CmdInternal]+               , "accept target"+               , Accept ))+  , ("safe11", ( [CmdInternal]+               , "show history"+               , LastHistory ))+  , ("safe12", ( [CmdInternal]                , "wait a turn, bracing for impact"                , Wait ))-  , ("safe11", ( [CmdInternal]+  , ("safe13", ( [CmdInternal]                , "lurk 0.1 of a turn"                , Wait10 ))-  , ("safe12", ( [CmdInternal]-               , "snap x-hair to enemy"+  , ("safe14", ( [CmdInternal]+               , "snap crosshair to enemy"                , XhairPointerEnemy ))   ]-  ++ map defaultHeroSelect [0..6]--closeDoorTriggers :: [TriggerTile]-closeDoorTriggers =-  [ TriggerTile { ttverb = "close"-                , ttobject = "door"-                , ttfeature = TK.CloseTo "closed vertical door Lit" }-  , TriggerTile { ttverb = "close"-                , ttobject = "door"-                , ttfeature = TK.CloseTo "closed horizontal door Lit" }-  , TriggerTile { ttverb = "close"-                , ttobject = "door"-                , ttfeature = TK.CloseTo "closed vertical door Dark" }-  , TriggerTile { ttverb = "close"-                , ttobject = "door"-                , ttfeature = TK.CloseTo "closed horizontal door Dark" }-  ]+  ++ map defaultHeroSelect [0..9]  applyTs :: [TriggerItem]-applyTs = [TriggerItem { tiverb = "apply"-                       , tiobject = "consumable"+applyTs = [TriggerItem { tiverb = "trigger"+                       , tiobject = "consumable item"                        , tisymbols = "!,?/" }]

GameDefinition/game-src/Client/UI/Content/Screen.hs view

@@ -9,6 +9,7 @@ import Game.LambdaHack.Core.Prelude  import qualified Data.EnumMap.Strict as EM+import           Data.FileEmbed (embedDir) import           Language.Haskell.TH.Syntax import           System.IO @@ -19,24 +20,8 @@ standardLayoutAndFeatures = ScreenContent   { rwidth = 80   , rheight = 24-  -- ASCII art for the main menu. Only pure 7-bit ASCII characters are allowed,-  -- except for character 183 ('·'), which is rendered as very tiny middle dot.-  -- The encoding should be utf-8-unix.-  -- When displayed in the main menu screen, the picture is overwritten-  -- with game and engine version strings and keybindings.-  -- The keybindings overwrite places marked with left curly brace signs.-  -- This sign is forbidden anywhere else in the picture.-  -- The picture and the whole main menu is displayed dull white on black.-  -- The glyphs, or at least the character cells, are perfect squares.-  -- The picture for LambdaHack should be exactly 24 rows by 80 columns.-  , rmainMenuArt = $(do-      let path = "GameDefinition/MainMenu.ascii"-      qAddDependentFile path-      x <- qRunIO $ do-        handle <- openFile path ReadMode-        hSetEncoding handle utf8-        hGetContents handle-      lift x)+  , rwrap = 80  -- not enough height to fit longer messages if wrapped early+  , rwebAddress = "http://lambdahack.github.io"   , rintroScreen = $(do       let path = "GameDefinition/PLAYING.md"       qAddDependentFile path@@ -46,21 +31,28 @@         hGetContents handle       let paragraphs :: [String] -> [String] -> [[String]]           paragraphs [] rows = [reverse rows]-          paragraphs (l : ls) rows = if null l-                                     then reverse rows : paragraphs ls []-                                     else paragraphs ls (l : rows)+          paragraphs (l@"" : ls) rows = case (rows, ls) of+            (('=':'=' : _) : _, _) ->  -- A title. No new paragraph.+              paragraphs ls (l : rows)+            (('-':'-' : _) : _, _) ->  -- A title. No new paragraph.+              paragraphs ls (l : rows)+            ((' ':' ':' ':' ' : _) : _, (' ':' ':' ':' ' : _) : _) ->+              -- At least four spaces before and after; probably a code block.+              paragraphs ls (l : rows)+            _ -> reverse rows : paragraphs ls []+          paragraphs (l : ls) rows = paragraphs ls (l : rows)           intro = case paragraphs (lines x) [] of-            _title : _blurb : par1 : par2 : _rest ->-              ["", ""] ++ par1 ++ [""] ++ par2 ++ ["", ""]+            _titleAndBlurb : par1 : par2 : rest ->+              (par1 ++ [""] ++ par2, rest)             _ -> error "not enough paragraphs in intro screen text"       lift intro)-  , rmoveKeysScreen = $(do-      let path = "GameDefinition/MoveKeys.txt"-      qAddDependentFile path-      x <- qRunIO $ do-        handle <- openFile path ReadMode-        hSetEncoding handle utf8-        hGetContents handle-      lift $ lines x)   , rapplyVerbMap = EM.fromList [('!', "quaff"), (',', "eat"), ('?', "read")]+  , rFontFiles =+-- Checking USE_SDL would be more accurate, but would require complicating+-- .cabal file and slightly larger vty executable is not a problem.+#ifdef USE_JSFILE+      []+#else+      $(embedDir "GameDefinition/fonts")+#endif   }

GameDefinition/game-src/Implementation/MonadClientImplementation.hs view

@@ -27,11 +27,12 @@ import           Game.LambdaHack.Client.State import           Game.LambdaHack.Client.UI import           Game.LambdaHack.Client.UI.SessionUI+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Kind-import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.MonadStateRead import qualified Game.LambdaHack.Common.Save as Save import           Game.LambdaHack.Common.State+import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Server (ChanServer (..))  data CliState = CliState@@ -79,22 +80,6 @@     cli <- gets cliClient     msess <- gets cliSession     IO.liftIO $ Save.saveToChan toSave (cli, msess)-  restartClient = CliImplementation $ state $ \cliS ->-    case cliSession cliS of-      Just sess ->-        let !newSess = (emptySessionUI (sUIOptions sess))-                         { schanF = schanF sess-                         , sccui = sccui sess-                         , shistory = shistory sess-                         , sstart = sstart sess-                         , sgstart = sgstart sess-                         , sallTime = sallTime sess-                         , snframes = snframes sess-                         , sallNframes = sallNframes sess-                         }-            !newCliS = cliS {cliSession = Just newSess}-        in ((), newCliS)-      Nothing -> ((), cliS)  instance MonadClientUI CliImplementation where   {-# INLINE getsSession #-}@@ -141,11 +126,11 @@             -> FactionId             -> ChanServer             -> IO ()-executorCli ccui sUIOptions clientOptions cops isUI fid cliDict =+executorCli ccui sUIOptions clientOptions cops@COps{corule} isUI fid cliDict =   let cliSession | isUI = Just $ emptySessionUI sUIOptions                  | otherwise = Nothing       stateToFileName (cli, _) =-        ssavePrefixCli (soptions cli) <> Save.saveNameCli cops (sside cli)+        ssavePrefixCli (soptions cli) <> Save.saveNameCli corule (sside cli)       totalState cliToSave = CliState         { cliState = updateCOpsAndCachedData (const cops) emptyState             -- state is empty, so the cached data is left empty and untouched

GameDefinition/game-src/Implementation/MonadServerImplementation.hs view

@@ -19,17 +19,14 @@ import           Control.Monad.Trans.State.Strict hiding (State) import qualified Data.EnumMap.Strict as EM import qualified Data.Text.IO as T-import           Options.Applicative (defaultPrefs, execParserPure,-                                      handleParseResult)+import           Options.Applicative+  (defaultPrefs, execParserPure, handleParseResult) import           System.Exit (ExitCode (ExitSuccess))-import           System.FilePath import           System.IO (hFlush, stdout)  import           Game.LambdaHack.Atomic import           Game.LambdaHack.Client-import           Game.LambdaHack.Common.File import           Game.LambdaHack.Common.Kind-import           Game.LambdaHack.Common.Misc import           Game.LambdaHack.Common.MonadStateRead import qualified Game.LambdaHack.Common.Save as Save import           Game.LambdaHack.Common.State@@ -39,7 +36,6 @@ import           Game.LambdaHack.Server.HandleAtomicM import           Game.LambdaHack.Server.MonadServer import           Game.LambdaHack.Server.ProtocolM-import           Game.LambdaHack.Server.ServerOptions import           Game.LambdaHack.Server.State  import Implementation.MonadClientImplementation (executorCli)@@ -140,7 +136,7 @@ -- | Run the main server loop, with the given arguments and empty -- initial states, in the @IO@ monad. executorSer :: COps -> CCUI -> ServerOptions -> UIOptions -> IO ()-executorSer cops ccui soptionsNxtCmdline sUIOptions = do+executorSer cops@COps{corule} ccui soptionsNxtCmdline sUIOptions = do   soptionsNxtRaw <- case uCmdline sUIOptions of     []   -> return soptionsNxtCmdline     args -> handleParseResult $ execParserPure defaultPrefs serverOptionsPI args@@ -153,7 +149,7 @@   -- Wire together game content, the main loop of game clients   -- and the game server loop.   let stateToFileName (_, ser) =-        ssavePrefixSer (soptions ser) <> Save.saveNameSer cops+        ssavePrefixSer (soptions ser) <> Save.saveNameSer corule       totalState serToSave = SerState         { serState = updateCOpsAndCachedData (const cops) emptyState             -- state is empty, so the cached data is left empty and untouched@@ -164,17 +160,6 @@       m = loopSer soptionsNxt executorClient       exe = evalStateT (runSerImplementation m) . totalState       exeWithSaves = Save.wrapInSaves cops stateToFileName exe-      defPrefix = ssavePrefixSer defServerOptions-      bkpOneSave name = do-        dataDir <- appDataDir-        let path bkp = dataDir </> "saves" </> bkp <> name-        b <- doesFileExist (path "")-        when b $ renameFile (path "") (path "bkp.")-      bkpAllSaves = unless (sbenchmark $ sclientOptions soptionsNxt) $ do-        T.hPutStrLn stdout "The game crashed, so savefiles are moved aside."-        bkpOneSave $ defPrefix <> Save.saveNameSer cops-        forM_ [-99..99] $ \n ->-          bkpOneSave $ defPrefix <> Save.saveNameCli cops (toEnum n)   -- Wait for clients to exit even in case of server crash   -- (or server and client crash), which gives them time to save   -- and report their own inconsistencies, if any.@@ -186,7 +171,10 @@                _ -> do                  Ex.uninterruptibleMask_ $ threadDelay 1000000                    -- let clients report their errors and save-                 when (ssavePrefixSer soptionsNxt == defPrefix) bkpAllSaves+                 moveAside <- Save.bkpAllSaves corule clientOptions+                 when moveAside $+                   T.hPutStrLn stdout+                               "The game crashed, so savefiles are moved aside."                  hFlush stdout                  Ex.throwIO ex  -- crash eventually, which kills clients             )

GameDefinition/game-src/TieKnot.hs view

@@ -13,7 +13,7 @@ import qualified Control.Exception as Ex import qualified Data.Primitive.PrimArray as PA import           GHC.Compact-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  import           Game.LambdaHack.Client import qualified Game.LambdaHack.Client.UI.Content.Input as IC@@ -62,33 +62,41 @@   -- This setup ensures the boosting option doesn't affect generating initial   -- RNG for dungeon, etc., and also, that setting dungeon RNG on commandline   -- equal to what was generated last time, ensures the same item boost.-  initialGen <- maybe R.getStdGen return sdungeonRng+  initialGen <- maybe SM.newSMGen return sdungeonRng   let soptionsNxt = options {sdungeonRng = Just initialGen}       boostedItems = IK.boostItemKindList initialGen Content.ItemKind.items-      coitem = IK.makeData $+      itemContent =         if sboostRandomItem         then boostedItems ++ Content.ItemKind.otherItemContent         else Content.ItemKind.content+      coitem = IK.makeData itemContent+                           Content.ItemKind.groupNamesSingleton+                           Content.ItemKind.groupNames       coItemSpeedup = speedupItem coitem-      cotile = TK.makeData coitem Content.TileKind.content+      cotile = TK.makeData Content.TileKind.content+                           Content.TileKind.groupNamesSingleton+                           Content.TileKind.groupNames       coTileSpeedup = Tile.speedupTile sallClear cotile-      coplace = PK.makeData cotile Content.PlaceKind.content-      cocave = CK.makeData coitem coplace cotile Content.CaveKind.content       -- Common content operations, created from content definitions.       -- Evaluated fully to discover errors ASAP and to free memory.       -- Fail here, not inside server code, so that savefiles are not removed,       -- because they are not the source of the failure.       copsRaw = COps-        { cocave+        { cocave = CK.makeData Content.CaveKind.content+                               Content.CaveKind.groupNamesSingleton+                               Content.CaveKind.groupNames         , coitem-        , comode  = MK.makeData cocave coitem Content.ModeKind.content-        , coplace-        , corule  = RK.makeData Content.RuleKind.standardRules+        , comode = MK.makeData Content.ModeKind.content+                               Content.ModeKind.groupNamesSingleton+                               Content.ModeKind.groupNames+        , coplace = PK.makeData Content.PlaceKind.content+                                Content.PlaceKind.groupNamesSingleton+                                Content.PlaceKind.groupNames+        , corule = RK.makeData Content.RuleKind.standardRules         , cotile         , coItemSpeedup         , coTileSpeedup         }-      benchmark = sbenchmark $ sclientOptions soptionsNxt   -- Evaluating for compact regions catches all kinds of errors in content ASAP,   -- even in unused items.   --@@ -103,11 +111,12 @@   -- It is reparsed at each start of the game executable.   -- Fail here, not inside client code, so that savefiles are not removed,   -- because they are not the source of the failure.-  sUIOptions <- mkUIOptions cops benchmark+  sUIOptions <- mkUIOptions (corule cops) (sclientOptions soptionsNxt)   -- Client content operations containing default keypresses   -- and command descriptions.   let !ccui = CCUI-        { coinput = IC.makeData sUIOptions Content.Input.standardKeysAndMouse+        { coinput = IC.makeData (Just sUIOptions)+                                Content.Input.standardKeysAndMouse         , coscreen = SC.makeData Content.Screen.standardLayoutAndFeatures         }   -- Wire together game content, the main loops of game clients@@ -129,11 +138,15 @@   -- Avoid the bound thread that would slow down the communication.   a <- async $ tieKnotForAsync serverOptions                `Ex.finally` fillWorkaround+  -- Exit on an exception without waiting for frontend to spawn.   link a   -- Run a (possibly void) workaround. It's needed for OSes/frontends   -- that need to perform some actions on the main thread   -- (not just any bound thread), e.g., newer OS X drawing with SDL2.-  workaround <- takeMVar workaroundOnMainThreadMVar-  workaround+  join (takeMVar workaroundOnMainThreadMVar)+  -- Wait in case frontend workaround not run on the main thread+  -- and so we'd exit too early and end the game.   wait a+  -- Consume the void workaround if it was spurious to make @tieKnot@ reentrant.+  void $ tryTakeMVar workaroundOnMainThreadMVar #endif

− LICENSE

@@ -1,26 +0,0 @@-BSD 3-Clause License--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright notice, this-   list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright notice,-   this list of conditions and the following disclaimer in the documentation-   and/or other materials provided with the distribution.-3. Neither the name of the copyright holder nor the names of its-   contributors may be used to endorse or promote products derived from-   this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,-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.

LambdaHack.cabal view

@@ -1,77 +1,73 @@ cabal-version: 2.2-name:           LambdaHack+name:          LambdaHack -- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary:+-+------- breaking API changes---             | | +----- minor or non-breaking API additions---             | | | +--- code changes with no API change-version:       0.9.5.0+--             | |  +----- minor or non-breaking API additions+--             | |  | +--- code changes with no API change+version:       0.10.2.0 synopsis:      A game engine library for tactical squad ASCII roguelike dungeon crawlers-description:   LambdaHack is a Haskell game engine library for ASCII roguelike-               games of arbitrary theme, size and complexity, with optional-               tactical squad combat. It's packaged together with a sample-               dungeon crawler in fantasy setting that can be tried out-               in the browser at <http://lambdahack.github.io>.-               (It runs fastest on Chrome. Keyboard commands and savefiles-               are supported only on recent enough versions of browsers.-               Mouse should work everywhere.)-               .-               Please see the changelog file for recent improvements-               and the issue tracker for short-term plans. Long term goals-               include multiplayer tactical squad combat, in-game content-               creation, auto-balancing and persistent content modification-               based on player behaviour. Contributions are welcome.-               .-               Games known to use the LambdaHack library:-               .-               * Allure of the Stars, a near-future Sci-Fi game,-               <http://hackage.haskell.org/package/Allure>-               .-               * Space Privateers, an adventure game set in far future,-               <http://hackage.haskell.org/package/SpacePrivateers>-               .-               Note: All modules in this library are kept visible,-               to let games override and reuse them.-               OTOH, to reflect that some modules are implementation details-               relative to others, the source code adheres to the following-               convention. If a module has the same name as a directory,-               the module is the exclusive interface to the directory.-               No references to the modules in the directory are allowed-               except from the interface module. This policy is only binding-               when developing the library --- library users are free-               to access any modules, since the library authors are in-               no position to guess their particular needs.-               .-               This is a workaround .cabal file, flattened to eliminated-               internal libraries until generating haddocks for them-               is fixed. The original .cabal file is stored in the github repo.+description: LambdaHack is a Haskell game engine library for ASCII roguelike+             games of arbitrary theme, size and complexity, with optional+             tactical squad combat. It's packaged together with a sample+             dungeon crawler in a quirky fantasy setting. The sample game can be+             tried out in the browser at <http://lambdahack.github.io>.+             .+             Please see the changelog file for recent improvements+             and the issue tracker for short-term plans. Long term goals+             include multiplayer tactical squad combat, in-game content+             creation, auto-balancing and persistent content modification+             based on player behaviour. Contributions are welcome.+             .+             Other games known to use the LambdaHack library:+             .+             * Allure of the Stars, a near-future Sci-Fi game,+             <http://hackage.haskell.org/package/Allure>+             .+             Note: All modules in this library are kept visible,+             to let games override and reuse them.+             OTOH, to reflect that some modules are implementation details+             relative to others, the source code adheres to the following+             convention. If a module has the same name as a directory,+             the module is the exclusive interface to the directory.+             No references to the modules in the directory are allowed+             except from the interface module. This policy is only binding+             when developing the library --- library users are free+             to access any modules, since the library authors are in+             no position to guess their particular needs.+             .+             This is a workaround .cabal file, flattened to eliminate+             internal libraries until generating haddocks for them+             is fixed. The original .cabal file is stored in the github repo. homepage:      https://lambdahack.github.io bug-reports:   http://github.com/LambdaHack/LambdaHack/issues license:       BSD-3-Clause license-file:  COPYLEFT-tested-with:   GHC==8.2.2, GHC==8.4.4, GHC==8.6.5-data-files:    GameDefinition/config.ui.default,-               GameDefinition/fonts/16x16xw.woff,-               GameDefinition/fonts/16x16xw.bdf,-               GameDefinition/fonts/16x16x.fnt,-               GameDefinition/fonts/8x8xb.fnt,-               GameDefinition/fonts/8x8x.fnt,-               GameDefinition/fonts/LICENSE.16x16x,-               GameDefinition/fonts/Fix15Mono-Bold.woff,-               GameDefinition/fonts/LICENSE.Fix15Mono-Bold,-               GameDefinition/InGameHelp.txt,-               GameDefinition/PLAYING.md,-               README.md,-               CHANGELOG.md,-               LICENSE,-               COPYLEFT,-               CREDITS+tested-with:   GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.4,+               GHC==9.0.1+-- Enough files is included to build and run CI and manual tests+-- and be presentable on Hackage, but not enough to create+-- a user-friendly binary package, e.g., no InGameHelp.txt. extra-source-files: GameDefinition/config.ui.default,-                    GameDefinition/MainMenu.ascii,-                    GameDefinition/MoveKeys.txt,                     GameDefinition/PLAYING.md,-                    Makefile+                    GameDefinition/fonts/16x16xw.woff,+                    GameDefinition/fonts/16x16xw.bdf,+                    GameDefinition/fonts/16x16x.fnt,+                    GameDefinition/fonts/8x8xb.fnt,+                    GameDefinition/fonts/8x8x.fnt,+                    GameDefinition/fonts/BinarySansProLH-Regular.ttf.woff,+                    GameDefinition/fonts/BinarySansProLH-Semibold.ttf.woff,+                    GameDefinition/fonts/BinaryCodeProLH-Bold.ttf.woff,+                    GameDefinition/fonts/DejaVuLGCSans.ttf.woff,+                    GameDefinition/fonts/DejaVuLGCSans-Bold.ttf.woff,+                    GameDefinition/fonts/Hack-Bold.ttf.woff,+                    GameDefinition/fonts/ubuntu-v14-latin-ext_latin-regular.ttf.woff,+                    GameDefinition/fonts/ubuntu-v14-latin-ext_latin-500.ttf.woff,+                    GameDefinition/fonts/ubuntu-mono-v9-latin-ext_latin-700.ttf.woff,+                    Makefile,+                    CHANGELOG.md,+                    README.md author:        Andres Loeh, Mikolaj Konarski and others maintainer:    Mikolaj Konarski <mikolaj.konarski@funktory.com> category:      Game Engine, Game@@ -96,10 +92,11 @@   default:            False   manual:             True -flag sdl-  description:        switch to the SDL2 frontend-  default:            False-  manual:             True+-- This flag is not used.+-- flag sdl+--   description:        switch to the SDL2 frontend+--   default:            False+--   manual:             True  flag jsaddle   description:        switch to the JSaddle frontend (may be bit-rotted)@@ -126,14 +123,14 @@   default-extensions: MonoLocalBinds, ScopedTypeVariables, OverloadedStrings                       BangPatterns, RecordWildCards, NamedFieldPuns, MultiWayIf,                       LambdaCase, DefaultSignatures, InstanceSigs,-                      MonadFailDesugaring, StrictData, CPP+                      PatternSynonyms, StrictData, CPP   other-extensions:   TemplateHaskell, MultiParamTypeClasses, RankNTypes,                       TypeFamilies, FlexibleContexts, FlexibleInstances,                       DeriveFunctor, FunctionalDependencies,                       GeneralizedNewtypeDeriving, TupleSections,                       DeriveFoldable, DeriveTraversable,                       ExistentialQuantification, GADTs, StandaloneDeriving,-                      DataKinds, KindSignatures, DeriveGeneric+                      DataKinds, KindSignatures, DeriveGeneric, DeriveLift   ghc-options:        -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wimplicit-prelude -Wmissing-home-modules -Widentities -Wredundant-constraints -Wmissing-export-lists -Wpartial-fields   ghc-options:        -Wall-missed-specialisations   ghc-options:        -fno-ignore-asserts -fexpose-all-unfoldings -fspecialise-aggressively -fsimpl-tick-factor=200@@ -202,7 +199,6 @@                       Game.LambdaHack.Client.AI.Strategy                       Game.LambdaHack.Client.Bfs                       Game.LambdaHack.Client.BfsM-                      Game.LambdaHack.Client.ClientOptions                       Game.LambdaHack.Client.CommonM                       Game.LambdaHack.Client.HandleAtomicM                       Game.LambdaHack.Client.HandleResponseM@@ -241,6 +237,7 @@                       Game.LambdaHack.Client.UI.Msg                       Game.LambdaHack.Client.UI.MsgM                       Game.LambdaHack.Client.UI.Overlay+                      Game.LambdaHack.Client.UI.PointUI                       Game.LambdaHack.Client.UI.RunM                       Game.LambdaHack.Client.UI.SessionUI                       Game.LambdaHack.Client.UI.Slideshow@@ -251,6 +248,7 @@                       Game.LambdaHack.Common.Area                       Game.LambdaHack.Common.Actor                       Game.LambdaHack.Common.ActorState+                      Game.LambdaHack.Common.ClientOptions                       Game.LambdaHack.Common.Faction                       Game.LambdaHack.Common.File                       Game.LambdaHack.Common.HighScore@@ -281,7 +279,6 @@                       Game.LambdaHack.Server.DungeonGen.AreaRnd                       Game.LambdaHack.Server.DungeonGen.Cave                       Game.LambdaHack.Server.DungeonGen.Place-                      Game.LambdaHack.Server.EndM                       Game.LambdaHack.Server.Fov                       Game.LambdaHack.Server.FovDigital                       Game.LambdaHack.Server.HandleAtomicM@@ -318,23 +315,26 @@   build-depends:      assert-failure >= 0.1.2 && < 0.2,                       async      >= 2,                       base       >= 4.10 && < 99,-                      base-compat >= 0.8.0,+                      base-compat >= 0.10.0,                       binary     >= 0.8,                       bytestring >= 0.9.2 ,                       containers >= 0.5.3.0,                       deepseq    >= 1.3,                       directory  >= 1.1.0.1,                       enummapset >= 0.5.2.2,+                      file-embed >= 0.0.11,                       filepath   >= 1.2.0.1,                       ghc-prim,                       hashable   >= 1.1.2.5,                       hsini      >= 0.2,+                      int-cast   >= 0.2,                       keys       >= 3,                       miniutter  >= 0.5.0.0,+                      open-browser >= 0.2,                       optparse-applicative >= 0.13,                       pretty-show >= 1.6,                       primitive  >= 0.6.1.0,-                      random     >= 1.1,+                      splitmix   >= 0.0.3,                       stm        >= 2.4,                       time       >= 1.4,                       text       >= 0.11.2.3,@@ -343,21 +343,22 @@                       vector     >= 0.11,                       vector-binary-instances >= 0.2.3.1,                       template-haskell >= 2.6,+                      th-lift-instances,                       ghc-compact    if impl(ghcjs) || flag(jsaddle) {     exposed-modules:    Game.LambdaHack.Client.UI.Frontend.Dom     build-depends:    ghcjs-dom >= 0.9.1.1     cpp-options:      -DUSE_BROWSER-  } else { if flag(vty) {+  } elif flag(vty) {     exposed-modules:    Game.LambdaHack.Client.UI.Frontend.Vty     build-depends:    vty >= 5     cpp-options:      -DUSE_VTY-  } else { if flag(curses) {+  } elif flag(curses) {     exposed-modules:    Game.LambdaHack.Client.UI.Frontend.Curses     build-depends:    hscurses >= 1.4.1     cpp-options:      -DUSE_CURSES-  } else { if flag(gtk) {+  } elif flag(gtk) {     exposed-modules:    Game.LambdaHack.Client.UI.Frontend.Gtk     build-depends:    gtk3 >= 0.12.1     cpp-options:      -DUSE_GTK@@ -365,10 +366,11 @@     exposed-modules:    Game.LambdaHack.Client.UI.Frontend.Sdl     build-depends:    sdl2 >= 2, sdl2-ttf >= 2     cpp-options:      -DUSE_SDL-  } } } }+  }    if impl(ghcjs) {     other-modules:    Game.LambdaHack.Common.JSFile+    build-depends:    ghcjs-base   } else {     other-modules:    Game.LambdaHack.Common.HSFile     build-depends:    zlib >= 0.5.3.1@@ -386,9 +388,16 @@ test-suite test   import: options, exe-options   type:               exitcode-stdio-1.0-  main-is:            test/test.hs+  hs-source-dirs:     test+  main-is:            Spec.hs+  other-modules:      SessionUIMock   build-depends:      ,LambdaHack                       ,async                       ,base+                      ,containers                       ,filepath                       ,optparse-applicative+                      ,tasty >= 1.0+                      ,tasty-hunit+                      ,text+                      ,transformers

Makefile view

@@ -1,26 +1,30 @@+# some of this (not the parts run by CI) needs 'cabal install cabal-plan' play:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix play --dumpInitRngs+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix play --dumpInitRngs  shot:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix play --dumpInitRngs --printEachScreen+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix play --dumpInitRngs --printEachScreen  expose-lore:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode crawl --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode crawl --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000  dig-lore:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode dig --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode dig --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000  see-caves:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode see --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode see --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000 +short-caves:+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode short --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000+ configure-debug: 	cabal configure --enable-profiling --profiling-detail=all-functions -fwith_expensive_assertions --disable-optimization  configure-prof: 	cabal configure --enable-profiling --profiling-detail=exported-functions -ghcjs-new-build:-	cabal new-build -j1 --ghcjs --disable-library-profiling --disable-profiling .+ghcjs-build:+	cabal build --ghcjs .  chrome-log: 	google-chrome --enable-logging --v=1 file:///home/mikolaj/r/lambdahack.github.io/index.html &@@ -29,236 +33,264 @@ 	google-chrome --no-sandbox --js-flags="--logfile=%t.log --prof" ../lambdahack.github.io/index.html  minific:-	npx google-closure-compiler dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js --compilation_level=ADVANCED_OPTIMIZATIONS --isolation_mode=IIFE --assume_function_wrapper --externs=dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js.externs --jscomp_off="*" > ../lambdahack.github.io/lambdahack.all.js+	npx google-closure-compiler dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.10.2.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js --compilation_level=ADVANCED_OPTIMIZATIONS --isolation_mode=IIFE --assume_function_wrapper --externs=dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.10.2.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js.externs --externs=/home/mikolaj/r/lambdahack.github.io/lz-string.extern.js --jscomp_off="*" > ../lambdahack.github.io/lambdahack.all.js  minificForNode:-	npx google-closure-compiler dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js --compilation_level=ADVANCED_OPTIMIZATIONS --isolation_mode=IIFE --assume_function_wrapper --externs=dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js.externs --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/assert.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/child_process.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/crypto.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/dns.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/events.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/globals.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/https.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/os.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/punycode.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/readline.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/stream.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/tls.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/url.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/vm.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/buffer.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/cluster.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/dgram.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/domain.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/fs.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/http.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/net.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/path.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/querystring.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/repl.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/string_decoder.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/tty.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/util.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/zlib.js --jscomp_off="*" > ../lambdahack.github.io/lambdahack.all.js+	npx google-closure-compiler dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.10.2.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js --compilation_level=ADVANCED_OPTIMIZATIONS --isolation_mode=IIFE --assume_function_wrapper --externs=/home/mikolaj/r/lambdahack.github.io/lz-string.extern.js --externs=dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.10.2.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js.externs --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/assert.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/child_process.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/crypto.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/dns.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/events.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/globals.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/https.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/os.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/punycode.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/readline.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/stream.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/tls.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/url.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/vm.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/buffer.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/cluster.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/dgram.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/domain.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/fs.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/http.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/net.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/path.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/querystring.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/repl.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/string_decoder.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/tty.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/util.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/zlib.js --jscomp_off="*" > ../lambdahack.github.io/lambdahack.all.js  # Low delay to display animations swiftly and not bore the public too much. # Delay can't be lower than 2, because browsers sometimes treat delay 1 # specially and add their extra delay. create-gif : 	find ~/.LambdaHack/screenshots/ -name 'prtscn*.bmp' -print0 | xargs -0 -r mogrify -format gif-	gifsicle -O3 --careful -d2 -l ~/.LambdaHack/screenshots/prtscn*.gif -o ~/.LambdaHack/screenshots/screenshot.gif+	../gifsicle/src/gifsicle -O3 --careful -d2 --colors 255 --no-extensions --no-conserve-memory -l ~/.LambdaHack/screenshots/prtscn*.gif -o ~/.LambdaHack/screenshots/screenshot.gif  frontendRaid:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode raid --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode raid --exposeActors  frontendBrawl:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode brawl+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode brawl  frontendShootout:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode shootout+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode shootout  frontendHunt:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode hunt+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode hunt  frontendEscape:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 3 --dumpInitRngs --automateAll --gameMode escape+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 3 --dumpInitRngs --automateAll --gameMode escape  frontendZoo:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 2 --dumpInitRngs --automateAll --gameMode zoo --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 2 --dumpInitRngs --automateAll --gameMode zoo --exposeActors  frontendAmbush:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode ambush+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode ambush  frontendCrawl:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors  frontendCrawlEmpty:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode "crawl empty"+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawlEmpty +frontendCrawlSurvival:+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode crawlSurvival --maxFps 1000+ frontendSafari:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 2 --dumpInitRngs --automateAll --gameMode safari --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode safari --exposeActors  frontendSafariSurvival:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode "safari survival" --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode safariSurvival --exposeActors  frontendBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 4 --dumpInitRngs --automateAll --gameMode battle --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 4 --dumpInitRngs --automateAll --gameMode battle --exposeActors  frontendBattleDefense:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 6 --dumpInitRngs --automateAll --gameMode "battle defense" --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 6 --dumpInitRngs --automateAll --gameMode battleDefense --exposeActors  frontendBattleSurvival:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 6 --dumpInitRngs --automateAll --gameMode "battle survival" --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 6 --dumpInitRngs --automateAll --gameMode battleSurvival --exposeActors  frontendDefense:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode defense --exposeItems --exposeActors+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode defense --exposeItems --exposeActors  frontendDefenseEmpty:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode "defense empty"+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode defenseEmpty  fastCrawl:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors --showItemSamples --noAnim --maxFps 100000+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors --showItemSamples --noAnim --maxFps 100000 --benchmark +slowCrawl:+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors --showItemSamples +# different benchmarks use different arguments+RNGOPTS=--setDungeonRng "SMGen 123 123" --setMainRng "SMGen 123 125"+RNGOPTS1=--setDungeonRng "SMGen 127 123" --setMainRng "SMGen 127 125"+RNGOPTS2=--setDungeonRng "SMGen 129 123" --setMainRng "SMGen 129 125"+ benchMemoryAnim:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --maxFps 100000 --benchmark --stopAfterFrames 33000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 120 --setMainRng 47 --frontendNull --noAnim +RTS -s -A1M -RTS+	$$(cabal-plan list-bin exe:LambdaHack) --dbgMsgSer --logPriority 4 --newGame 1 --maxFps 100000 --benchmark --stopAfterFrames 33000 --automateAll --keepAutomated --gameMode crawl $(RNGOPTS2)  --frontendNull --noAnim +RTS -s -A1M -RTS  benchBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1500 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1500 --automateAll --keepAutomated --gameMode battle $(RNGOPTS1)  benchAnimBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode battle $(RNGOPTS1)  benchFrontendBattle:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode battle $(RNGOPTS1)  benchCrawl:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl $(RNGOPTS)  benchFrontendCrawl:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl $(RNGOPTS)  benchDig:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1 --automateAll --keepAutomated --gameMode dig --setDungeonRng 0 --setMainRng 0+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1 --automateAll --keepAutomated --gameMode dig $(RNGOPTS)  benchNull: benchBattle benchAnimBattle benchCrawl  bench: benchBattle benchAnimBattle benchFrontendBattle benchCrawl benchFrontendCrawl  nativeBenchCrawl:-	dist/build/LambdaHack/LambdaHack		   --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0+	$$(cabal-plan list-bin exe:LambdaHack)		   --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl $(RNGOPTS)  nativeBenchBattle:-	dist/build/LambdaHack/LambdaHack		   --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 0 --setMainRng 0+	$$(cabal-plan list-bin exe:LambdaHack)		   --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle $(RNGOPTS)  nativeBench: nativeBenchBattle nativeBenchCrawl  nodeBenchCrawl:-	node dist/build/LambdaHack/LambdaHack.jsexe/all.js --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0+	node $$(cabal-plan list-bin exe:LambdaHack).jsexe/all.js --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl $(RNGOPTS)  nodeBenchBattle:-	node dist/build/LambdaHack/LambdaHack.jsexe/all.js --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 0 --setMainRng 0+	node $$(cabal-plan list-bin exe:LambdaHack).jsexe/all.js --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle $(RNGOPTS)  nodeBench: nodeBenchBattle nodeBenchCrawl +nodeMinifiedBench:+	node ../lambdahack.github.io/lambdahack.all.js --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle $(RNGOPTS)+	node ../lambdahack.github.io/lambdahack.all.js --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl $(RNGOPTS) -test-travis: test-sniff test-short test-medium benchNull +test-travis: test-short test-medium++test-travis2: test-sniff benchNull+ test: test-sniff test-short test-medium benchNull  test-short: test-short-new test-short-load -test-medium: testRaid-medium testBrawl-medium testShootout-medium testHunt-medium testEscape-medium testZoo-medium testAmbush-medium testCrawl-medium testCrawlEmpty-medium testCrawl-medium-know testSafari-medium testSafariSurvival-medium testBattle-medium testBattleDefense-medium testBattleSurvival-medium testDig-medium testDefenseEmpty-medium+test-medium: testRaid-medium testBrawl-medium testShootout-medium testHunt-medium testEscape-medium testZoo-medium testAmbush-medium testCrawlEmpty-medium testCrawl-medium-know testSafari-medium testSafariSurvival-medium testBattle-medium testBattleDefense-medium testBattleSurvival-medium testDig-medium testDefenseEmpty-medium testMany-teletype  test-sniff:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterFrames 1  --dumpInitRngs --automateAll --keepAutomated --gameMode raid --sniff 2> /tmp/teletypetest.log+	bash -c "./LambdaHack --dbgMsgSer --logPriority 4 --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterFrames 1  --dumpInitRngs --automateAll --keepAutomated --gameMode raid --sniff &> /tmp/teletypetest.log" +testMany-teletype:+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 9 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 50 --dumpInitRngs --automateAll --keepAutomated 2> /tmp/teletypetest.log++testMany-sdlInit:+	./LambdaHack --dbgMsgSer --logPriority 0 --boostRandomItem --newGame 9 --maxFps 100000 --benchmark --stopAfterSeconds 50 --dumpInitRngs --automateAll --keepAutomated 2> /tmp/teletypetest.log+ testRaid-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode raid 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode raid 2> /tmp/teletypetest.log  testBrawl-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode brawl 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode brawl 2> /tmp/teletypetest.log  testShootout-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode shootout 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode shootout 2> /tmp/teletypetest.log  testHunt-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode hunt 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode hunt 2> /tmp/teletypetest.log  testEscape-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 3 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode escape 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 3 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode escape 2> /tmp/teletypetest.log  testZoo-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 2 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode zoo 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 2 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode zoo 2> /tmp/teletypetest.log  testAmbush-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush 2> /tmp/teletypetest.log  testCrawl-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 200 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterGameOver --stopAfterSeconds 200 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --assertExplored 5 2> /tmp/teletypetest.log +testCrawl-medium-double:+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterGameOver --stopAfterSeconds 590 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --assertExplored 4+ testCrawlEmpty-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "crawl empty" 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode crawlEmpty 2> /tmp/teletypetest.log  testCrawl-medium-know:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix know --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix know --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples 2> /tmp/teletypetest.log  testSafari-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 2 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode safari 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode safari 2> /tmp/teletypetest.log  testSafariSurvival-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 8 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode safariSurvival 2> /tmp/teletypetest.log  testBattle-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 3 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode battle 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 3 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode battle 2> /tmp/teletypetest.log  testBattleDefense-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 7 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle defense" 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 7 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode battleDefense 2> /tmp/teletypetest.log  testBattleSurvival-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 7 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 7 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode battleSurvival 2> /tmp/teletypetest.log  testDefense-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 9 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterSeconds 200 --dumpInitRngs --automateAll --keepAutomated --gameMode defense 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 9 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode defense 2> /tmp/teletypetest.log  testDig-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterFrames 100 --dumpInitRngs --automateAll --keepAutomated --gameMode dig 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterFrames 100 --dumpInitRngs --automateAll --keepAutomated --gameMode dig 2> /tmp/teletypetest.log  testDefenseEmpty-medium:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 9 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "defense empty" 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 9 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode defenseEmpty 2> /tmp/teletypetest.log  testCrawl-appveyor:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterSeconds 800 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterGameOver --stopAfterSeconds 300 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --assertExplored 5  testDefense-appveyor:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 9 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterSeconds 800 --dumpInitRngs --automateAll --keepAutomated --gameMode defense+	./LambdaHack --dbgMsgSer --logPriority 4 --newGame 9 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterSeconds 600 --dumpInitRngs --automateAll --keepAutomated --gameMode defense  test-short-new:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix brawl --dumpInitRngs --automateAll --keepAutomated --gameMode brawl --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix shootout --dumpInitRngs --automateAll --keepAutomated --gameMode shootout --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix hunt --dumpInitRngs --automateAll --keepAutomated --gameMode hunt --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix escape --dumpInitRngs --automateAll --keepAutomated --gameMode escape --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix zoo --dumpInitRngs --automateAll --keepAutomated --gameMode zoo --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix crawl --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battle --showItemSamples --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battleDefense --dumpInitRngs --automateAll --keepAutomated --gameMode "battle defense" --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix brawl --dumpInitRngs --automateAll --keepAutomated --gameMode brawl --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix shootout --dumpInitRngs --automateAll --keepAutomated --gameMode shootout --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix hunt --dumpInitRngs --automateAll --keepAutomated --gameMode hunt --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix escape --dumpInitRngs --automateAll --keepAutomated --gameMode escape --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix zoo --dumpInitRngs --automateAll --keepAutomated --gameMode zoo --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix crawl --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode safariSurvival --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battle --showItemSamples --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battleDefense --dumpInitRngs --automateAll --keepAutomated --gameMode battleDefense --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode battleSurvival --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log -# "--setDungeonRng 0 --setMainRng 0" is needed for determinism relative to seed+# $(RNGOPTS) is needed for determinism relative to seed # generated before game save test-short-load:-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix brawl --dumpInitRngs --automateAll --keepAutomated --gameMode brawl --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix shootout --dumpInitRngs --automateAll --keepAutomated --gameMode shootout --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix hunt --dumpInitRngs --automateAll --keepAutomated --gameMode hunt --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix escape --dumpInitRngs --automateAll --keepAutomated --gameMode escape --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix zoo --dumpInitRngs --automateAll --keepAutomated --gameMode zoo --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix crawl --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battle --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battleDefense --dumpInitRngs --automateAll --keepAutomated --gameMode "battle defense" --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log-	dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix brawl --dumpInitRngs --automateAll --keepAutomated --gameMode brawl --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix shootout --dumpInitRngs --automateAll --keepAutomated --gameMode shootout --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix hunt --dumpInitRngs --automateAll --keepAutomated --gameMode hunt --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix escape --dumpInitRngs --automateAll --keepAutomated --gameMode escape --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix zoo --dumpInitRngs --automateAll --keepAutomated --gameMode zoo --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix crawl --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode safariSurvival --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battle --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battleDefense --dumpInitRngs --automateAll --keepAutomated --gameMode battleDefense --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log+	./LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode battleSurvival --frontendTeletype --stopAfterSeconds 2 $(RNGOPTS) 2> /tmp/teletypetest.log  -build-binary-common:-	mkdir -p LambdaHackTheGame/GameDefinition/fonts+build-binary-v1: 	cabal v1-install --force-reinstalls --disable-library-profiling --disable-profiling --disable-documentation --enable-optimization --only-dependencies-	cabal v1-configure --disable-library-profiling --disable-profiling --enable-optimization --prefix=/ --datadir=. --datasubdir=.+	cabal v1-configure --disable-library-profiling --disable-profiling --enable-optimization 	cabal v1-build exe:LambdaHack++copy-binary-v1: 	cabal v1-copy --destdir=LambdaHackTheGameInstall-	([ -f "LambdaHackTheGameInstall/bin/LambdaHack" ] && mv LambdaHackTheGameInstall/bin/LambdaHack LambdaHackTheGame) || exit 0-	([ -f "LambdaHackTheGameInstall/msys64/bin/LambdaHack.exe" ] && mv LambdaHackTheGameInstall/msys64/bin/LambdaHack.exe LambdaHackTheGame) || exit 0-	([ -f "LambdaHackTheGameInstall/msys32/bin/LambdaHack.exe" ] && mv LambdaHackTheGameInstall/msys32/bin/LambdaHack.exe LambdaHackTheGame) || exit 0-#	cabal new-build --disable-library-profiling --disable-profiling --disable-documentation --only-dependencies .-#	cabal new-install --disable-library-profiling --disable-profiling --disable-documentation --datadir=. --datasubdir=. --install-method=copy --installdir=LambdaHackTheGame --enable-executable-stripping exe:LambdaHack-	cp GameDefinition/config.ui.default LambdaHackTheGame/GameDefinition-	cp GameDefinition/fonts/16x16xw.woff LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/16x16xw.bdf LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/16x16x.fnt LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/8x8xb.fnt LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/8x8x.fnt LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/LICENSE.16x16x LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/Fix15Mono-Bold.woff LambdaHackTheGame/GameDefinition/fonts-	cp GameDefinition/fonts/LICENSE.Fix15Mono-Bold LambdaHackTheGame/GameDefinition/fonts++copy-binary:+	cp $$(cabal-plan list-bin exe:LambdaHack) LambdaHackTheGame++configure-binary-v2:+	cabal configure --disable-tests --disable-library-profiling --disable-profiling --enable-optimization++configure-binary-v2-vty:+	cabal configure -fvty --disable-tests --disable-library-profiling --disable-profiling --disable-documentation --enable-optimization++build-binary-v2:+	cabal build --only-dependencies .+	cabal build exe:LambdaHack++copy-directory:+	mkdir -p LambdaHackTheGame/GameDefinition 	cp GameDefinition/InGameHelp.txt LambdaHackTheGame/GameDefinition 	cp GameDefinition/PLAYING.md LambdaHackTheGame/GameDefinition 	cp README.md LambdaHackTheGame@@ -267,16 +299,26 @@ 	cp COPYLEFT LambdaHackTheGame 	cp CREDITS LambdaHackTheGame -build-binary-ubuntu: build-binary-common+build-binary-common: build-binary-v1 copy-directory copy-binary-v1++build-binary-windows: configure-binary-v2 build-binary-v2 copy-directory++build-directory: configure-binary-v2 build-binary-v2 copy-directory copy-binary++build-binary-ubuntu: build-directory 	LambdaHackTheGame/LambdaHack --version > /dev/null; \ 	LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \ 	tar -czf LambdaHack_$${LH_VERSION}_ubuntu-16.04-amd64.tar.gz LambdaHackTheGame -build-binary-macosx: build-binary-common+build-binary-macosx: build-directory 	LambdaHackTheGame/LambdaHack --version > /dev/null; \ 	LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \ 	OS_VERSION=$$(sw_vers -productVersion); \ 	tar -czf LambdaHack_$${LH_VERSION}_macosx-$${OS_VERSION}-amd64.tar.gz LambdaHackTheGame -new-build-dev:-	cabal new-build --datadir=. --disable-optimization -j1+build-directory-vty: configure-binary-v2-vty build-binary-v2 copy-directory copy-binary++build-binary-screen-reader-ubuntu: build-directory-vty+	LambdaHackTheGame/LambdaHack --version > /dev/null; \+	LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \+	tar -czf LambdaHack_$${LH_VERSION}_screen-reader-ubuntu-16.04-amd64.tar.gz LambdaHackTheGame

README.md view

@@ -1,31 +1,40 @@ LambdaHack ========== -[![Build Status](https://travis-ci.org/LambdaHack/LambdaHack.svg?branch=master)](https://travis-ci.org/LambdaHack/LambdaHack)+[![Build Status](https://secure.travis-ci.org/LambdaHack/LambdaHack.svg?master)](https://travis-ci.org/LambdaHack/LambdaHack) [![Hackage](https://img.shields.io/hackage/v/LambdaHack.svg)](https://hackage.haskell.org/package/LambdaHack)-[![Join the chat at https://gitter.im/LambdaHack/LambdaHack](https://badges.gitter.im/LambdaHack/LambdaHack.svg)](https://gitter.im/LambdaHack/LambdaHack?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+[![Join the chat at Discord](https://img.shields.io/discord/688792755564052486.svg?label=chat%20on%20Discord&logo=discord&logoColor=ffffff&color=7389D8&labelColor=6A7EC2)](https://discord.gg/87Ghnws)+[![Join the chat at Matrix](https://img.shields.io/matrix/lambdahack:mozilla.org.svg?label=chat%20on%20Matrix&logo=matrix&server_fqdn=mozilla.modular.im)](https://matrix.to/#/!HnbpAHMjOGHlYtrASl:mozilla.org?via=mozilla.modular.im)  LambdaHack is a Haskell[1] game engine library for ASCII roguelike[2] games of arbitrary theme, size and complexity, with optional tactical squad combat. It's packaged together with a sample-dungeon crawler in wierd fantasy setting that can be tried out-in the browser at http://lambdahack.github.io.-(It runs fastest on Chrome. Keyboard commands and savefiles-are supported only on recent enough versions of browsers.-Mouse should work everywhere.)+dungeon crawler in a quirky fantasy setting. The sample game can be+tried out in the browser at http://lambdahack.github.io. -As an example of the engine's capabilities, here is a showcase of shooting down explosive projectiles. A couple were shot down close enough to enemies to harm them. Others exploded closer to our party members and took out of the air the projectiles that would otherwise harm them.+As an example of the engine's capabilities, here is a showcase+of shooting down explosive projectiles. A couple were shot down close+enough to enemies to harm them. Others exploded closer to our party members+and took out of the air the projectiles that would otherwise harm them.  ![gameplay screenshot](https://raw.githubusercontent.com/LambdaHack/media/master/screenshot/allureofthestars.com.shooting.down.explosives.gif) -This was a semi-automatic stealthy speedrun of the escape scenario of the sample game that comes with the engine. Small bitmap font. The enemy gang has a huge numerical and equipment superiority. Our team loots the area on auto-pilot until the first foe is spotted. Then they scout out enemy positions. Then hero 1 draws enemies and unfortunately enemy fire as well, which is when he valiantly shoots down explosives to avoid the worst damage. Then heroine 2 sneaks behind enemy lines to reach the remaining treasure. That accomplished, the captain signals retreat and leaves for the next area (the zoo).+This was a semi-automatic stealthy speedrun of the escape scenario+of the sample game, native binary, SDL2 frontend, single tiny+bitmap font. The enemy gang has a huge numerical and equipment+superiority. Our team loots the area on auto-pilot until the first foe+is spotted. Then they scout out enemy positions. Then hero 1 draws+enemies and unfortunately enemy fire as well, which is when he valiantly+shoots down explosives to avoid the worst damage. Then heroine 2 sneaks+behind enemy lines to reach the remaining treasure. That accomplished,+the captain signals retreat and leaves for the next area (the zoo).   Using the engine ----------------  To use the engine, you need to specify the content to be-procedurally generated. You specify what the game world+procedurally generated. You declare what the game world is made of (entities, their relations, physics and lore) and the engine builds the world and runs it. The library lets you compile a ready-to-play game binary,@@ -43,41 +52,32 @@ creation, auto-balancing and persistent content modification based on player behaviour. Contributions are welcome. Please offer feedback to mikolaj.konarski@funktory.com or, preferably,-at any of the public forums.+on any of the public forums.  Other games known to use the LambdaHack library:  * Allure of the Stars[6], a near-future Sci-Fi game-* Space Privateers[8], an adventure game set in far future -Note: the engine and the example game are bundled together in a single+Note: the engine and the sample game are bundled together in a single Hackage[3] package released under the permissive `BSD3` license. You are welcome to create your own games by forking and modifying the single package, but please consider eventually splitting your changes-into a separate content-only package that depends on the upstream+into a separate content-heavy package that depends on the upstream engine library. This will help us exchange ideas and share improvements to the common codebase. Alternatively, you can already start the development in separation by cloning and rewriting Allure of the Stars[10]-and mix and merge with the example LambdaHack game rules at will.+and mix and merge with the sample LambdaHack game rules at will. Note that the LambdaHack sample game derives from the Hack/Nethack visual and narrative tradition[9], while Allure of the Stars uses the more free-form-Moria/Angband style (it also uses the `AGPL` license, and `BSD3 + AGPL = AGPL`,+Moria/Angband style (it also uses the AGPL license, and BSD3 + AGPL = AGPL, so make sure you want to liberate your code and content to such an extent). -When creating a new game based on LambdaHack I've found it useful to place-completely new content at the end of the content files to distinguish from-merely modified original LambdaHack content and thus help merging with new-releases. Removals of LambdaHack content merge reasonably well, so there are-no special considerations. When modifying individual content items,-it makes sense to keep their Haskell identifier names and change only-in-game names and possibly frequency group names. - Installation of the sample game from binary archives ---------------------------------------------------- -The game runs rather slowly in the browser (fastest on Chrome)-and you are limited to only one font, though it's scalable.+The game runs rather slowly in the browser (fastest on Chrome) and you are+limited to the square font for all purposes, though it's scalable. Also, savefiles are prone to corruption on the browser, e.g., when it's closed while the game is still saving progress (which takes a long time). Hence, after trying out the game,@@ -90,7 +90,7 @@ if available. On Linux, make sure you have the SDL2 libraries installed on your system (e.g., libsdl2-2.0-0 and libsdl2-ttf-2.0-0 on Ubuntu). For Windows (XP no longer supported), the SDL2 and all other needed libraries-are already contained in the game's binary archive.+are included in the game's binary archive.   Screen and keyboard configuration@@ -98,86 +98,111 @@  The game UI can be configured via a config file. The default settings, the same that are built into the binary,-are in [GameDefinition/config.ui.default](https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/config.ui.default).-When the game is run for the first time, the file is copied to the default-user data folder, which is `~/.LambdaHack/` on Linux,+are on github at [GameDefinition/config.ui.default](https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/config.ui.default).+When the game is run for the first time, or whenever the settings file+is deleted, the file is written to the default user data location,+which is `~/.Allure/` on Linux, `C:\Users\<username>\AppData\Roaming\LambdaHack\` (or `C:\Documents And Settings\user\Application Data\LambdaHack\`-or something else altogether) on Windows, and in RMB menu, under-`Inspect/Application/Local Storage` when run inside the Chrome browser.+or something else altogether) on Windows+and `Inspect/Application/Local Storage` under RMB menu+when run inside the Chrome browser.+If the user config file is outdated or corrupted, it's automatically+moved away together with old savefiles, which guarantees that the new+default config file is ultimately put in its place. -Screen font and consequently window size can be changed by editing+Screen fonts and, consequently, window size can be changed by editing the config file in the user data folder. The default bitmap font-`16x16xw.bdf` covers most national characters in the Latin alphabet-(e.g. to give custom names to player characters) and results-in a game window of exactly 720p (standard HD) dimensions. The `8x8xb.fnt`+`16x16xw.bdf` used for the game map covers most national characters+in the Latin alphabet (e.g. to give custom names to player characters)+and results in a game window of exactly 720p HD dimensions. The `8x8xb.fnt` bitmap font results in a tiny window and covers latin-1 characters only.-The scalable `16x16xw.woff` font results in window sizes dependent-on the `scalableFontSize` parameter in the config file.-With `scalableFontSize = 16` it should look almost the same-as the pixel-perfect `16x16xw.bdf`.+The config file parameter `allFontsScale` permits further window size+adjustments, automatically switching to the scalable `16x16xw.woff`+version of the game map font. Config file option `chosenFontset` governs+not only the main game map font, but also the shape of the rectangular fonts,+if any, in which longer texts are overlaid over the map. -If you don't have a numeric keypad, you can use the Vi editor keys-(aka roguelike keys) or mouse for movement or you can enable the compact-laptop keys (uk8o79jl) in the config file. If numeric keypad doesn't work,-toggling the Num Lock key sometimes helps. If running with the Shift key-and keypad keys doesn't work, try Control key instead.-The game is fully playable with mouse only, as well as with keyboard only,-but the most efficient combination for some players is mouse for go-to,-inspecting, and aiming at distant positions and keyboard for everything else.+For high resolution displays and/or if fullscreen mode is requested+in the configuration file, `allFontsScale` needs to be set.+E.g., scale 3 works for 4K displays. Otherwise, the letters may be+too small or, in fullscreen or on retina displays in OS X,+the screen may be automatically scaled as a whole, not each letter+separately, softening letter edges of the square fonts that should+be pixel-perfect and crisp. +If you don't have a numeric keypad, you can use the left-hand movement+key setup (axwdqezc) or Vi editor keys (aka roguelike keys) or mouse.+If numeric keypad doesn't work, toggling the Num Lock key sometimes helps.+If running with the Shift key and keypad keys doesn't work,+try the Control key instead. The game is fully playable with mouse only,+as well as with keyboard only, but the most efficient combination+may be mouse for menus, go-to, inspecting the map, aiming at distant+positions and keyboard for everything else.+ If you are using a terminal frontend, e.g. the best supported vty frontend,-numeric keypad (e.g., keypad '*' and '/') may not work correctly-depending on versions of the libraries, terminfo and terminal emulators.-Toggling the Num Lock key may help or make issues worse. As a workaround-for the vty frontend, numbers are used for movement, which sadly prevents+then numeric keypad (especially keypad `*` and `/`) may not work correctly,+depending on versions of libraries, terminfo and terminal emulators.+Toggling the Num Lock key may help or make issues worse. As a workaround,+in the vty frontend, numbers are used for movement, which sadly prevents the number keys from selecting heroes. The commands that require pressing Control and Shift together won't work either, but fortunately they are not crucial to gameplay. -Some effort has been put to help using the vty frontend with screen readers,-but without feedback it's hard to say how accesible that setup is.+Some effort went into making the vty frontend usable with screen readers,+but without feedback it's hard to say how accessible that setup is. As a side effect of screen reader support, there is no aiming line-nor path in vty frontend. Screen readers may also work better with animations-turned off using `--noAnim` or the corresponding config file option.-Note that unicode and cursor support are now necessary for correct output.+nor path in vty frontend and some of map position highlighting+is performed using the terminal cursor. Screen readers may also work+better with animations turned off, using `--noAnim` or the corresponding+config file option.   Compilation of the library and sample game from source ------------------------------------------------------ -If you want to compile native binaries from the source code,-use Cabal (already a part of your OS distribution, or available within-The Haskell Platform[7]), which also takes care of all the dependencies.- The recommended frontend is based on SDL2, so you need the SDL2 libraries for your OS. On Linux, remember to install the -dev versions as well, e.g., libsdl2-dev and libsdl2-ttf-dev on Ubuntu Linux 16.04.-(Compilation to JavaScript for the browser is more complicated-and requires the ghcjs[15] compiler and optionally the Google Closure-Compiler[16] as well.)+Other frontends are compiled similarly, but compilation to JavaScript+for the browser is more complicated and requires the ghcjs[15] compiler+and optionally the Google Closure Compiler[16].  The latest official version of the LambdaHack library can be downloaded,-compiled for SDL2 and installed automatically by Cabal from Hackage[3]-as follows+compiled for SDL2 and installed automatically using the Cabal tool,+which is already a part of your OS distribution, or available within+The Haskell Platform[7]. Get the library from Hackage[3] as follows      cabal update-    cabal install LambdaHack+    cabal run LambdaHack  For a newer snapshot, clone the source code from github[5]-and run Cabal from the main directory+and run `cabal run LambdaHack` from the main directory.+Alternatively, if you'd like to develop in this codebase,+the following speeds up the turn-around a lot -    cabal install+    cp cabal.project.local.development cabal.project.local+    cabal install cabal-plan +and then compile with++    cabal build .++and run the game with++    make play+ There is a built-in black and white line terminal frontend, suitable for teletype terminals or a keyboard and a printer (but it's going to use-a lot of paper, unless you disable animations with `--noAnim`). To compile+a lot of paper, unless you disable animations with `--noAnim`). It is used+in CI and for some tests and benchmarks defined in Makefile. To compile with one of the less rudimentary terminal frontends (in which case you are on your own regarding font choice and color setup and you won't have the spiffy colorful squares outlining special positions that exist in SDL2 frontend, but only crude cursor highlights), use Cabal flags, e.g,+to switch to the vty console frontend optimized for screen readers, run -    cabal install -fvty+    cabal run -fvty LambdaHack   Testing and debugging@@ -188,8 +213,8 @@ Numerous tests that use the screensaver game modes (AI vs. AI) and the teletype frontend are gathered in `make test`. Of these, travis runs `test-travis` on each push to github.-Test commands with prefix `frontend` start AI vs. AI games-with the standard, user-friendly frontend.+Test commands with prefix `frontend` start AI vs. AI games with+the standard, user-friendly frontend and auto-locating the game binary.  Run `LambdaHack --help` to see a brief description of all debug options. Of these, the `--sniff` option is very useful (though verbose@@ -202,13 +227,13 @@ to HPC version).      cabal clean-    cabal install --enable-coverage+    cabal build --enable-coverage     make test     hpc report --hpcdir=dist/hpc/dyn/mix/LambdaHack --hpcdir=dist/hpc/dyn/mix/LambdaHack-xxx/ LambdaHack     hpc markup --hpcdir=dist/hpc/dyn/mix/LambdaHack --hpcdir=dist/hpc/dyn/mix/LambdaHack-xxx/ LambdaHack -A quick manual playing session after the automated tests would be in order,-as well, since the tests don't touch the topmost UI layer.+A quick manual playing session, after the automated tests, would be+in order as well, since the tests don't touch the topmost UI layer. Note that a debug option of the form `--stopAfter*` is required to cleanly terminate any automated test. This is needed to gather any HPC info, because HPC requires a clean exit to save data files.@@ -226,14 +251,24 @@ you are editing. Put big formatting changes in separate commits.  Haddocks are provided for all module headers and for all functions and types-from major modules, in particular the modules that are interfaces+from major modules, in particular for the modules that are interfaces for a whole directory of modules. Apart of that, only very important functions and types are distinguished by having a haddock. If minor ones have comments, they should not be haddocks and they are permitted to describe implementation details and be out of date.-Prefer assertions to comments, unless too verbose.+Prefer assertions instead of comments, unless too verbose. +The 'pointman' from game manual and UI is called 'leader' in the source code+and there are a few more mismatches, though the source code naming+and the UI naming should each be consistent in separation.+If the UI names stick, perhaps source code will be renamed at some point. +This codebase is an experiment in extensive use of states without lens.+So far, it works, doesn't result in much larger files or lots+of repetition and has the added benefits that newcomers don't need+to learn any lens library. Record punning, etc., definitely helps.++ Further information ------------------- @@ -253,7 +288,6 @@ [5]: https://github.com/LambdaHack/LambdaHack [6]: http://allureofthestars.com [7]: https://www.haskell.org/platform-[8]: https://github.com/tuturto/space-privateers [9]: https://github.com/LambdaHack/LambdaHack/wiki/Sample-dungeon-crawler [10]: https://github.com/AllureOfTheStars/Allure [11]: https://github.com/LambdaHack/LambdaHack/releases

definition-src/Game/LambdaHack/Content/CaveKind.hs view

@@ -1,9 +1,11 @@--- | The type of cave kinds.+-- | The type of cave kinds. Every level in the game is an instantiated+-- cave kind. module Game.LambdaHack.Content.CaveKind-  ( CaveKind(..), makeData+  ( pattern DEFAULT_RANDOM+  , CaveKind(..), makeData #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , validateSingle, validateAll+  , validateSingle, validateAll, mandatoryGroups #endif   ) where @@ -39,8 +41,6 @@   , cauxConnects    :: Rational         -- ^ a proportion of extra connections   , cmaxVoid        :: Rational       -- ^ at most this proportion of rooms may be void-  , cminStairDist   :: Int              -- ^ minimal distance between stairs-  , cextraStairs    :: Dice.Dice        -- ^ extra stairs on top of from above   , cdoorChance     :: Chance           -- ^ the chance of a door in an opening   , copenChance     :: Chance           -- ^ if there's a door, is it open?   , chidden         :: Int              -- ^ if not open, hidden one in n times@@ -64,10 +64,13 @@   , cfenceApart     :: Bool                -- ^ are places touching fence banned   , clegendDarkTile :: GroupName TileKind  -- ^ the dark place plan legend   , clegendLitTile  :: GroupName TileKind  -- ^ the lit place plan legend+  , cminStairDist   :: Int                 -- ^ minimal distance between stairs+  , cmaxStairsNum   :: Dice.Dice           -- ^ maximum number of stairs   , cescapeFreq     :: Freqs PlaceKind     -- ^ escape groups, if any   , cstairFreq      :: Freqs PlaceKind     -- ^ place groups for created stairs   , cstairAllowed   :: Freqs PlaceKind     -- ^ extra groups for inherited-  , cdesc           :: Text                -- ^ full cave description+  , cskip           :: [Int]  -- ^ which faction starting positions to skip+  , cdesc           :: Text   -- ^ full cave description   }   deriving Show  -- No Eq and Ord to make extending logically sound @@ -84,72 +87,45 @@      ++ [ "cYminSize < 20" | cYminSize < 20 ]      ++ [ "minCellSizeX < 1" | minCellSizeX < 1 ]      ++ [ "minCellSizeY < 1" | minCellSizeY < 1 ]-     ++ [ "minCellSizeX < 6 && stairs"-        | minCellSizeX < 6 && not (null cstairFreq && null cescapeFreq) ]-     ++ [ "minCellSizeY < 4 && stairs"-        | minCellSizeY < 4 && not (null cstairFreq && null cescapeFreq) ]-     ++ [ "minMinSizeX < 5 && stairs"-        | minMinSizeX < 5 && not (null cstairFreq && null cescapeFreq) ]-     ++ [ "minMinSizeY < 3 && stairs"-        | minMinSizeY < 3 && not (null cstairFreq && null cescapeFreq) ]+     -- The following four are heuristics, so not too restrictive:+     ++ [ "minCellSizeX < 6 && non-trivial stairs"+        | minCellSizeX < 6 && not (length cstairFreq <= 1 && null cescapeFreq) ]+     ++ [ "minCellSizeY < 4 && non-trivial stairs"+        | minCellSizeY < 4 && not (length cstairFreq <= 1 && null cescapeFreq) ]+     ++ [ "minMinSizeX < 5 && non-trivial stairs"+        | minMinSizeX < 5 && not (length cstairFreq <= 1 && null cescapeFreq) ]+     ++ [ "minMinSizeY < 3 && non-trivial stairs"+        | minMinSizeY < 3 && not (length cstairFreq <= 1 && null cescapeFreq) ]      ++ [ "minMinSizeX < 1" | minMinSizeX < 1 ]      ++ [ "minMinSizeY < 1" | minMinSizeY < 1 ]      ++ [ "minMaxSizeX < maxMinSizeX" | minMaxSizeX < maxMinSizeX ]      ++ [ "minMaxSizeY < maxMinSizeY" | minMaxSizeY < maxMinSizeY ]-     ++ [ "cextraStairs < 0" | Dice.infDice cextraStairs < 0 ]      ++ [ "chidden < 0" | chidden < 0 ]      ++ [ "cactorCoeff < 0" | cactorCoeff < 0 ]      ++ [ "citemNum < 0" | Dice.infDice citemNum < 0 ]+     ++ [ "cmaxStairsNum < 0" | Dice.infDice cmaxStairsNum < 0 ]      ++ [ "stairs suggested, but not defined"-        | Dice.supDice cextraStairs > 0 && null cstairFreq ]+        | Dice.supDice cmaxStairsNum > 0 && null cstairFreq ]  -- | Validate all cave kinds. -- Note that names don't have to be unique: we can have several variants -- of a cave with a given name.-validateAll :: ContentData ItemKind-            -> ContentData PlaceKind-            -> ContentData TileKind-            -> [CaveKind]-            -> ContentData CaveKind-            -> [Text]-validateAll coitem coplace cotile content cocave =-  let missingActorFreq = filter (not . omemberGroup coitem)-                         $ concatMap (map fst . cactorFreq) content-      missingItemFreq = filter (not . omemberGroup coitem)-                        $ concatMap (map fst . citemFreq) content-      missingPlaceFreq = filter (not . omemberGroup coplace)-                         $ concatMap (map fst . cplaceFreq) content-      missingEscapeGroup = filter (not . omemberGroup coplace . fst)-                           $ concatMap cescapeFreq content-      missingStairFreq = filter (not . omemberGroup coplace)-                         $ concatMap (map fst . cstairFreq) content-      tileGroupFuns = [ cdefTile, cdarkCorTile, clitCorTile, cwallTile-                      , cfenceTileN, cfenceTileE, cfenceTileS, cfenceTileW-                      , clegendDarkTile, clegendLitTile ]-      g kind = map ($ kind) tileGroupFuns-      missingTileFreq = filter (not . omemberGroup cotile)-                        $ concatMap g content-  in [ "cactorFreq item groups not in content:" <+> tshow missingActorFreq-     | not $ null missingActorFreq ]-     ++ [ "citemFreq item groups not in content:" <+> tshow missingItemFreq-        | not $ null missingItemFreq ]-     ++ [ "cplaceFreq place groups not in content:" <+> tshow missingPlaceFreq-        | not $ null missingPlaceFreq ]-     ++ [ "cescapeFreq place groups not in content:"-          <+> tshow missingEscapeGroup-        | not $ null missingEscapeGroup ]-     ++ [ "cstairFreq place groups not in content:" <+> tshow missingStairFreq-        | not $ null missingStairFreq ]-     ++ [ "tile groups not in content:" <+> tshow missingTileFreq-        | not $ null missingTileFreq ]-     ++ [ "no cave defined for \"default random\""-        | not $ omemberGroup cocave "default random" ]+validateAll :: [CaveKind] -> ContentData CaveKind -> [Text]+validateAll _ _ = []  -- so far, always valid -makeData :: ContentData ItemKind-         -> ContentData PlaceKind-         -> ContentData TileKind-         -> [CaveKind]+-- * Mandatory item groups++mandatoryGroups :: [GroupName CaveKind]+mandatoryGroups =+       [DEFAULT_RANDOM]++pattern DEFAULT_RANDOM :: GroupName CaveKind++pattern DEFAULT_RANDOM = GroupName "default random"++makeData :: [CaveKind] -> [GroupName CaveKind] -> [GroupName CaveKind]          -> ContentData CaveKind-makeData coitem coplace cotile =-  makeContentData "CaveKind" cname cfreq validateSingle-                  (validateAll coitem coplace cotile)+makeData content groupNamesSingleton groupNames =+  makeContentData "CaveKind" cname cfreq validateSingle validateAll content+                  groupNamesSingleton+                  (mandatoryGroups ++ groupNames)

definition-src/Game/LambdaHack/Content/ItemKind.hs view

@@ -1,17 +1,23 @@ {-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of weapons, treasure, organs, blasts, etc. module Game.LambdaHack.Content.ItemKind-  ( ItemKind(..), makeData-  , Aspect(..), Effect(..), DetectKind(..), TimerDice, ThrowMod(..)-  , boostItemKindList, forApplyEffect-  , strengthOnSmash, getDropOrgans, getMandatoryHideAsFromKind, isEffEscape-  , isEffEscapeOrAscend, timeoutAspect, onSmashEffect, damageUsefulness-  , verbMsgNoLonger, verbMsgLess, toVelocity, toLinger+  ( pattern CONDITION, pattern COMMON_ITEM, pattern S_BONUS_HP, pattern S_BRACED, pattern S_ASLEEP, pattern S_IMPRESSED, pattern S_CURRENCY, pattern MOBILE+  , pattern CRAWL_ITEM, pattern TREASURE, pattern ANY_SCROLL, pattern ANY_GLASS, pattern ANY_POTION, pattern ANY_FLASK, pattern EXPLOSIVE, pattern ANY_JEWELRY, pattern S_SINGLE_SPARK, pattern S_SPARK, pattern S_FRAGRANCE+  , pattern HORROR, pattern VALUABLE, pattern UNREPORTED_INVENTORY, pattern AQUATIC+  , ItemKind(..), makeData+  , Aspect(..), Effect(..), Condition(..), DetectKind(..)+  , TimerDice, ThrowMod(..)+  , boostItemKindList, forApplyEffect, forDamageEffect, isDamagingKind+  , strengthOnCombine, strengthOnSmash, getDropOrgans+  , getMandatoryPresentAsFromKind, isEffEscape, isEffEscapeOrAscend+  , timeoutAspect, orEffect, onSmashEffect, onCombineEffect, alwaysDudEffect+  , damageUsefulness, verbMsgNoLonger, verbMsgLess, toVelocity, toLinger   , timerNone, isTimerNone, foldTimer, toOrganBad, toOrganGood, toOrganNoTimer #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , boostItemKind, validateSingle, validateAll, validateDups, validateDamage-  , hardwiredItemGroups+  , boostItemKind, onSmashOrCombineEffect+  , validateSingle, validateAll, validateDups, validateDamage+  , mandatoryGroups, mandatoryGroupsSingleton #endif   ) where @@ -23,14 +29,73 @@ import           Data.Hashable (Hashable) import qualified Data.Text as T import           GHC.Generics (Generic)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  import qualified Game.LambdaHack.Core.Dice as Dice+import           Game.LambdaHack.Core.Random (nextRandom) import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.ContentData import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Definition.Flavour +-- * Mandatory item groups++mandatoryGroupsSingleton :: [GroupName ItemKind]+mandatoryGroupsSingleton =+       [S_BONUS_HP, S_BRACED, S_ASLEEP, S_IMPRESSED, S_CURRENCY]++pattern S_BONUS_HP, S_BRACED, S_ASLEEP, S_IMPRESSED, S_CURRENCY :: GroupName ItemKind++mandatoryGroups :: [GroupName ItemKind]+mandatoryGroups =+       [CONDITION, COMMON_ITEM, MOBILE]++pattern CONDITION, COMMON_ITEM, MOBILE :: GroupName ItemKind++-- From Preferences.hs++pattern CONDITION = GroupName "condition"+pattern COMMON_ITEM = GroupName "common item"++-- Assorted++pattern S_BONUS_HP = GroupName "bonus HP"+pattern S_BRACED = GroupName "braced"+pattern S_ASLEEP = GroupName "asleep"+pattern S_IMPRESSED = GroupName "impressed"+pattern S_CURRENCY = GroupName "currency"+pattern MOBILE = GroupName "mobile"++-- * Optional item groups++pattern S_SINGLE_SPARK, S_SPARK, S_FRAGRANCE, CRAWL_ITEM, TREASURE, ANY_SCROLL, ANY_GLASS, ANY_POTION, ANY_FLASK, EXPLOSIVE, ANY_JEWELRY, VALUABLE, UNREPORTED_INVENTORY, AQUATIC, HORROR :: GroupName ItemKind++-- Used in Preferences.hs++pattern S_SINGLE_SPARK = GroupName "single spark"+pattern S_SPARK = GroupName "spark"+pattern S_FRAGRANCE = GroupName "fragrance"++pattern CRAWL_ITEM = GroupName "curious item"+  -- to be used only in long scenarios, such as multi-level dungeon crawl;+  -- may be a powerful or a mundate item, unlike @TREASURE@ item+pattern TREASURE = GroupName "treasure"+  -- particularly powerful items, but may appear in any scenario+pattern ANY_SCROLL = GroupName "scroll"+pattern ANY_GLASS = GroupName "glass"+pattern ANY_POTION = GroupName "potion"+pattern ANY_FLASK = GroupName "flask"+pattern EXPLOSIVE = GroupName "explosive"+pattern ANY_JEWELRY = GroupName "jewelry"++-- * Used elsewhere++pattern VALUABLE = GroupName "valuable"+pattern UNREPORTED_INVENTORY = GroupName "unreported inventory"+pattern AQUATIC = GroupName "aquatic"++pattern HORROR = GroupName "horror"+ -- | Item properties that are fixed for a given kind of items. -- Of these, aspects and effects are jointly called item powers. -- Note that this type is mutually recursive with 'Effect' and `Aspect`.@@ -50,7 +115,7 @@                                 -- ^ accompanying organs and equipment   , idesc    :: Text            -- ^ description   }-  deriving (Show, Generic)  -- No Eq and Ord to make extending logically sound+  deriving Show  -- No Eq and Ord to make extending logically sound  -- | Aspects of items. Aspect @AddSkill@ is additive (starting at 0) -- for all items wielded by an actor and it affects the actor.@@ -73,18 +138,26 @@                        -- ^ item feature   | ELabel Text        -- ^ extra label of the item; it's not pluralized   | ToThrow ThrowMod   -- ^ parameters modifying a throw-  | HideAs (GroupName ItemKind)+  | PresentAs (GroupName ItemKind)                        -- ^ until identified, presents as this unique kind   | EqpSlot Ability.EqpSlot                        -- ^ AI and UI flag that leaks item intended use   | Odds Dice.Dice [Aspect] [Aspect]                        -- ^ if level-scaled dice roll > 50,                        --   pick the former aspects, otherwise the latter-  deriving (Show, Eq, Generic)+  deriving (Show, Eq)  -- | Effects of items. Can be invoked by the item wielder to affect--- another actor or the wielder himself. Many occurences in the same item--- are possible.+-- another actor or the wielder himself.+--+-- Various effects of an item kind are all groupped in one list,+-- at the cost of conditionals, sequences, etc., to ensure brevity+-- and simplicity of content definitions. Most effects fire regardless+-- of activation kind (the only exceptions are @OnSmash@ and @OnCombine@+-- effects) so the deviations, handled via the conditionals, are rare+-- and the definitions remain simple. Whether an item can be activated+-- in any particular way, OTOH, is specified via simple flags elsewhere,+-- again, by default, assuming that most activations are possible for all. data Effect =     Burn Dice.Dice     -- ^ burn with this damage   | Explode (GroupName ItemKind)@@ -104,14 +177,46 @@                           -- ^ paralyze for this many game clips due to water   | InsertMove Dice.Dice  -- ^ give actor this many extra tenths of actor move   | Teleport Dice.Dice    -- ^ teleport actor across rougly this distance-  | CreateItem CStore (GroupName ItemKind) TimerDice+  | CreateItem (Maybe Int) CStore (GroupName ItemKind) TimerDice       -- ^ create an item of the group and insert into the store with the given-      --   random timer+      --   random timer; it cardinality not specified, roll it+  | DestroyItem Int Int CStore (GroupName ItemKind)+      -- ^ destroy some items of the group from the store; see below about Ints+  | ConsumeItems [(Int, GroupName ItemKind)] [(Int, GroupName ItemKind)]+      -- ^ @ConsumeItems toUse toDestroy@ uses items matching @toUse@+      --   (destroys non-durable, without invoking OnSmash effects;+      --   applies normal effects of durable, without destroying them;+      --   the same behaviour as when transforming terrain using items)+      --   and destroys items matching @toDestroy@, invoking no effects,+      --   regardless of durability;+      --   the items are taken from @CGround@ (but not from @CEqp@),+      --   preferring non-durable (since durable can harm when used+      --   and may be more vauable when destroyed); if not all required items+      --   are present, no item are destroyed; if an item belongs to many groups+      --   in the sum of @toUse@ and @toDestroy@, it counts for all+      --   (otherwise, some orders of destroying would succeed,+      --   while others would not); even if item durable, as many copies+      --   are needed as specified, not just one applied many times;+      --   items are first destroyed and then, if any copies left, applied   | DropItem Int Int CStore (GroupName ItemKind)       -- ^ make the actor drop items of the given group from the given store;       --   the first integer says how many item kinds to drop, the second,-      --   how many copies of each kind to drop; for non-organs, beware of-      --   not dropping all, or cluttering store with rubbish becomes beneficial+      --   how many copies of each kind to drop;+      --   for non-organs, beware of not dropping all kinds, or cluttering+      --   store with rubbish becomes beneficial+  | Recharge Int Dice.Dice+      -- ^ reduce the cooldown period of this number of discharged items+      --   in the victim's equipment and organs by this dice of game clips;+      --   if the result is negative, set to 0, instantly recharging the item;+      --   starts with weapons with highest raw damage in equipment,+      --   then among organs, then non-weapons in equipment and among organs;+      --   beware of exploiting for healing periodic items+  | Discharge Int Dice.Dice+      -- ^ increase the cooldown period of this number of fully recharged items+      --   in the victim's equipment and organs by this dice of game clips;+      --   starts with weapons with highest raw damage in equipment,+      --   then among organs, then non-weapons in equipment and among organs;+      --   beware of exploiting for hunger inducing and similar organs   | PolyItem       -- ^ get a suitable (i.e., numerous enough) non-unique common item stack       --   on the floor and polymorph it to a stack of random common items,@@ -129,25 +234,51 @@   | SendFlying ThrowMod   -- ^ send an actor flying (push or pull, depending)   | PushActor ThrowMod    -- ^ push an actor   | PullActor ThrowMod    -- ^ pull an actor-  | DropBestWeapon        -- ^ make the actor drop its best weapon-  | ActivateInv Char-      -- ^ activate all items with this symbol in inventory; space character-      --   means all symbols   | ApplyPerfume          -- ^ remove all smell on the level-  | OneOf [Effect]        -- ^ trigger one of the effects with equal probability+  | AtMostOneOf [Effect]  -- ^ try to trigger a single random effect of the list+  | OneOf [Effect]        -- ^ trigger, with equal probability,+                          --   one of the effects that don't end with @UseDud@   | OnSmash Effect-      -- ^ trigger the effect when item smashed (not when applied nor meleed);-  | Composite [Effect]    -- ^ only fire next effect if previous fully activated-  | VerbNoLonger Text-      -- ^ a sentence with the actor causing the effect as subject and the given-      --   text as verb is emitted when the activation causes item to expire;-      --   no spam is emitted if a projectile-  | VerbMsg Text-      -- ^ a sentence with the actor causing the effect as subject and the given-      --   text as verb is emitted whenever the item is activated;-      --   no spam is emitted if a projectile-  deriving (Show, Eq, Generic)+      -- ^ trigger the effect when item smashed (not when applied nor meleed)+  | OnCombine Effect+      -- ^ trigger the effect only when the actor explicitly desires+      --   to combine items or otherwise subtly tinker with an+      --   item or a tile, e.g., craft items from other items in a workshop;+      --   in particular, don't trigger the effects when entering a tile;+      --   trigger exclusively the effects when activating walkable terrain+  | OnUser Effect  -- ^ apply the effect to the user, not the victim+  | NopEffect                -- ^ nothing happens, @UseDud@, no description+  | AndEffect Effect Effect  -- ^ only fire second effect if first activated+  | OrEffect Effect Effect   -- ^ only fire second effect if first not activated+  | SeqEffect [Effect]       -- ^ fire all effects in order; always suceed+  | When Condition Effect    -- ^ if condition not met, fail without a message;+                             --   better avoided, since AI can't value it well+  | Unless Condition Effect  -- ^ if condition met, fail without a message;+                             --   better avoided, since AI can't value it well+  | IfThenElse Condition Effect Effect+                             -- ^ conditional effect;+                             --   better avoided, since AI can't value it well+  | VerbNoLonger Text Text+      -- ^ a sentence with the actor causing the effect as subject, the given+      --   texts as the verb and the ending of the sentence (that may be+      --   ignored when the message is cited, e.g., as heard by someone)+      --   that is emitted when an activation causes an item to expire;+      --   no spam is emitted if a projectile; the ending is appended+      --   without a space in-between+  | VerbMsg Text Text+      -- ^ as @VerbNoLonger@ but that is emitted whenever the item is activated;+  | VerbMsgFail Text Text+      -- ^ as @VerbMsg@, but a failed effect (returns @UseId@)+  deriving (Show, Eq) +data Condition =+    HpLeq Int+  | HpGeq Int+  | CalmLeq Int+  | CalmGeq Int+  | TriggeredBy Ability.ActivationFlag+  deriving (Show, Eq)+ data DetectKind =     DetectAll   | DetectActor@@ -155,7 +286,8 @@   | DetectExit   | DetectHidden   | DetectEmbed-  deriving (Show, Eq, Generic)+  | DetectStash+  deriving (Show, Eq)  -- | Specification of how to randomly roll a timer at item creation -- to obtain a fixed timer for the item's lifetime.@@ -163,7 +295,7 @@     TimerNone   | TimerGameTurn Dice.Dice   | TimerActorTurn Dice.Dice-  deriving (Eq, Generic)+  deriving Eq  instance Show TimerDice where   show TimerNone = "0"@@ -181,86 +313,156 @@   }   deriving (Show, Eq, Ord, Generic) -instance Binary Effect--instance Binary DetectKind--instance Binary TimerDice- instance Binary ThrowMod  instance Hashable ThrowMod -boostItemKindList :: R.StdGen -> [ItemKind] -> [ItemKind]+boostItemKindList :: SM.SMGen -> [ItemKind] -> [ItemKind] boostItemKindList _ [] = [] boostItemKindList initialGen l =-  let (r, _) = R.randomR (0, length l - 1) initialGen+  let (r, _) = nextRandom (length l - 1) initialGen   in case splitAt r l of     (pre, i : post) -> pre ++ boostItemKind i : post-    _               -> error $  "" `showFailure` l+    _               -> error $ "" `showFailure` l  boostItemKind :: ItemKind -> ItemKind boostItemKind i =   let mainlineLabel (label, _) =-        label `elem` ["common item", "curious item", "treasure"]+        label `elem` [COMMON_ITEM, CRAWL_ITEM, TREASURE]   in if any mainlineLabel (ifreq i)-     then i { ifreq = ("common item", 10000) : filter (not . mainlineLabel) (ifreq i)+     then i { ifreq = (COMMON_ITEM, 10000) : filter (not . mainlineLabel)+                                                    (ifreq i)             , iaspects = delete (SetFlag Ability.Unique) $ iaspects i             }      else i  -- | Whether the effect has a chance of exhibiting any potentially--- noticeable behaviour, except when the item is destroyed.+-- noticeable behaviour, except when the item is destroyed or combined. -- We assume at least one of @OneOf@ effects must be noticeable. forApplyEffect :: Effect -> Bool forApplyEffect eff = case eff of   OnSmash{} -> False-  Composite effs -> any forApplyEffect effs+  OnCombine{} -> False+  OnUser eff1 -> forApplyEffect eff1+  NopEffect -> False+  AndEffect eff1 eff2 -> forApplyEffect eff1 || forApplyEffect eff2+  OrEffect eff1 eff2 -> forApplyEffect eff1 || forApplyEffect eff2+  SeqEffect effs -> or $ map forApplyEffect effs+  When _ eff1 -> forApplyEffect eff1+  Unless _ eff1 -> forApplyEffect eff1+  IfThenElse _ eff1 eff2 -> forApplyEffect eff1 || forApplyEffect eff2   VerbNoLonger{} -> False   VerbMsg{} -> False+  VerbMsgFail{} -> False   ParalyzeInWater{} -> False  -- barely noticeable, spams when resisted   _ -> True +-- | Whether a non-nested effect always applies raw damage.+forDamageEffect :: Effect -> Bool+forDamageEffect eff = case eff of+  Burn{} -> True+  RefillHP n | n < 0 -> True+  _ -> False++-- | Whether an item is damaging. Such items may trigger embedded items+-- and may collide with bursting items mid-air.+isDamagingKind :: ItemKind -> Bool+isDamagingKind itemKind = Dice.infDice (idamage itemKind) > 0+                          || any forDamageEffect (ieffects itemKind)+ isEffEscape :: Effect -> Bool isEffEscape Escape{} = True+isEffEscape (AtMostOneOf l) = any isEffEscape l isEffEscape (OneOf l) = any isEffEscape l-isEffEscape (Composite l) = any isEffEscape l+isEffEscape (OnCombine eff) = isEffEscape eff+isEffEscape (OnUser eff) = isEffEscape eff+isEffEscape (AndEffect eff1 eff2) = isEffEscape eff1 || isEffEscape eff2+isEffEscape (OrEffect eff1 eff2) = isEffEscape eff1 || isEffEscape eff2+isEffEscape (SeqEffect effs) = or $ map isEffEscape effs+isEffEscape (When _ eff) = isEffEscape eff+isEffEscape (Unless _ eff) = isEffEscape eff+isEffEscape (IfThenElse _ eff1 eff2) = isEffEscape eff1 || isEffEscape eff2 isEffEscape _ = False  isEffEscapeOrAscend :: Effect -> Bool isEffEscapeOrAscend Ascend{} = True isEffEscapeOrAscend Escape{} = True+isEffEscapeOrAscend (AtMostOneOf l) = any isEffEscapeOrAscend l isEffEscapeOrAscend (OneOf l) = any isEffEscapeOrAscend l-isEffEscapeOrAscend (Composite l) = any isEffEscapeOrAscend l+isEffEscapeOrAscend (OnCombine eff) = isEffEscapeOrAscend eff+isEffEscapeOrAscend (OnUser eff) = isEffEscapeOrAscend eff+isEffEscapeOrAscend (AndEffect eff1 eff2) =+  isEffEscapeOrAscend eff1 || isEffEscapeOrAscend eff2+isEffEscapeOrAscend (OrEffect eff1 eff2) =+  isEffEscapeOrAscend eff1 || isEffEscapeOrAscend eff2+isEffEscapeOrAscend (SeqEffect effs) =+  or $ map isEffEscapeOrAscend effs+isEffEscapeOrAscend (When _ eff) = isEffEscapeOrAscend eff+isEffEscapeOrAscend (Unless _ eff) = isEffEscapeOrAscend eff+isEffEscapeOrAscend (IfThenElse _ eff1 eff2) =+  isEffEscapeOrAscend eff1 || isEffEscapeOrAscend eff2 isEffEscapeOrAscend _ = False  timeoutAspect :: Aspect -> Bool timeoutAspect Timeout{} = True timeoutAspect _ = False +orEffect :: Effect -> Bool+orEffect OrEffect{} = True+orEffect _ = False+ onSmashEffect :: Effect -> Bool onSmashEffect OnSmash{} = True onSmashEffect _ = False +onCombineEffect :: Effect -> Bool+onCombineEffect OnCombine{} = True+onCombineEffect _ = False++onSmashOrCombineEffect :: Effect -> Bool+onSmashOrCombineEffect OnSmash{} = True+onSmashOrCombineEffect OnCombine{} = True+onSmashOrCombineEffect _ = False++alwaysDudEffect :: Effect -> Bool+alwaysDudEffect OnSmash{} = True+alwaysDudEffect OnCombine{} = True+alwaysDudEffect NopEffect = True+alwaysDudEffect _ = False+ strengthOnSmash :: ItemKind -> [Effect] strengthOnSmash =   let f (OnSmash eff) = [eff]       f _ = []   in concatMap f . ieffects +strengthOnCombine :: ItemKind -> [Effect]+strengthOnCombine =+  let f (OnCombine eff) = [eff]+      f _ = []+  in concatMap f . ieffects+ getDropOrgans :: ItemKind -> [GroupName ItemKind] getDropOrgans =-  let f (DropItem _ _ COrgan grp) = [grp]-      f Impress = ["impressed"]+  let f (DestroyItem _ _ COrgan grp) = [grp]+      f (DropItem _ _ COrgan grp) = [grp]+      f Impress = [S_IMPRESSED]+      f (AtMostOneOf l) = concatMap f l  -- even remote possibility accepted       f (OneOf l) = concatMap f l  -- even remote possibility accepted-      f (Composite l) = concatMap f l  -- not certain, but accepted+      f (OnUser eff) = f eff  -- no OnCombine, because checked for potions, etc.+      f (AndEffect eff1 eff2) = f eff1 ++ f eff2  -- not certain, but accepted+      f (OrEffect eff1 eff2) = f eff1 ++ f eff2  -- not certain, but accepted+      f (SeqEffect effs) = concatMap f effs+      f (When _ eff) = f eff+      f (Unless _ eff) = f eff+      f (IfThenElse _ eff1 eff2) = f eff1 ++ f eff2       f _ = []   in concatMap f . ieffects  -- Anything under @Odds@ is ignored, because it's not mandatory.-getMandatoryHideAsFromKind :: ItemKind -> Maybe (GroupName ItemKind)-getMandatoryHideAsFromKind itemKind =-  let f (HideAs grp) = [grp]+getMandatoryPresentAsFromKind :: ItemKind -> Maybe (GroupName ItemKind)+getMandatoryPresentAsFromKind itemKind =+  let f (PresentAs grp) = [grp]       f _ = []   in listToMaybe $ concatMap f (iaspects itemKind) @@ -270,10 +472,10 @@   in assert (v >= 0) v  verbMsgNoLonger :: Text -> Effect-verbMsgNoLonger name = VerbNoLonger $ "be no longer" <+> name+verbMsgNoLonger name = VerbNoLonger ("be no longer" <+> name) "."  verbMsgLess :: Text -> Effect-verbMsgLess name = VerbMsg $ "look less" <+> name+verbMsgLess name = VerbMsg ("appear less" <+> name) "."  toVelocity :: Int -> Aspect toVelocity n = ToThrow $ ThrowMod n 100 1@@ -294,21 +496,13 @@   TimerActorTurn nDm -> factor nDm  toOrganBad :: GroupName ItemKind -> Dice.Dice -> Effect-toOrganBad grp nDm =-  assert (Dice.infDice nDm > 0-          `blame` "dice at organ creation should always roll above zero"-          `swith` (grp, nDm))-  $ CreateItem COrgan grp (TimerGameTurn nDm)+toOrganBad grp nDm = CreateItem Nothing COrgan grp (TimerGameTurn nDm)  toOrganGood :: GroupName ItemKind -> Dice.Dice -> Effect-toOrganGood grp nDm =-  assert (Dice.infDice nDm > 0-          `blame` "dice at organ creation should always roll above zero"-          `swith` (grp, nDm))-  $ CreateItem COrgan grp (TimerActorTurn nDm)+toOrganGood grp nDm = CreateItem Nothing COrgan grp (TimerActorTurn nDm)  toOrganNoTimer :: GroupName ItemKind -> Effect-toOrganNoTimer grp = CreateItem COrgan grp TimerNone+toOrganNoTimer grp = CreateItem Nothing COrgan grp TimerNone  -- | Catch invalid item kind definitions. validateSingle :: ItemKind -> [Text]@@ -327,9 +521,19 @@           f EqpSlot{} = True           f _ = False           ts = filter f iaspects+          equipable = SetFlag Ability.Equipable `elem` iaspects+          meleeable = SetFlag Ability.Meleeable `elem` iaspects+          likelyTemplate = case ifreq of+            [(grp, 1)] -> "unknown" `T.isSuffixOf` fromGroupName grp+            _ -> False+          likelyException = isymbol `elem` [',', '"', '-'] || likelyTemplate       in [ "EqpSlot specified but not Equipable nor Meleeable"-         | length ts > 0 && SetFlag Ability.Equipable `notElem` iaspects-                         && SetFlag Ability.Meleeable `notElem` iaspects ])+         | length ts == 1 && not equipable && not meleeable ]+         ++ [ "EqpSlot not specified but Equipable or Meleeable and not a likely organ or necklace or template"+            | not likelyException+              && length ts == 0 && (equipable || meleeable) ]+         ++ [ "More than one EqpSlot specified"+            | length ts > 1 ] )   ++ [ "Redundant Equipable or Meleeable"      | SetFlag Ability.Equipable `elem` iaspects        && SetFlag Ability.Meleeable `elem` iaspects ]@@ -353,21 +557,73 @@           ts = filter f iaspects       in ["more than one ToThrow specification" | length ts > 1])   ++ (let f :: Aspect -> Bool-          f HideAs{} = True+          f PresentAs{} = True           f _ = False           ts = filter f iaspects-      in ["more than one HideAs specification" | length ts > 1])+      in ["more than one PresentAs specification" | length ts > 1])   ++ concatMap (validateDups ik) (map SetFlag [minBound .. maxBound])   ++ (let f :: Effect -> Bool+          f VerbNoLonger{} = True+          f _ = False+      in validateOnlyOne ieffects "VerbNoLonger" f)  -- may be duped if nested+  ++ (let f :: Effect -> Bool           f VerbMsg{} = True           f _ = False       in validateOnlyOne ieffects "VerbMsg" f)  -- may be duplicated if nested   ++ (let f :: Effect -> Bool-          f VerbNoLonger{} = True+          f VerbMsgFail{} = True           f _ = False-      in validateOnlyOne ieffects "VerbNoLonger" f)  -- may be duped if nested-  ++ (validateNotNested ieffects "OnSmash" onSmashEffect)-       -- duplicates permitted+      in validateOnlyOne ieffects "VerbMsgFail" f)  -- may be duped if nested+  ++ validateNotNested ieffects "OnSmash or OnCombine" onSmashOrCombineEffect+       -- but duplicates permitted+  ++ let nonPositiveBurn :: Effect -> Bool+         nonPositiveBurn (Burn d) = Dice.infDice d <= 0+         nonPositiveBurn _ = False+         containingNonPositiveBurn =+           filter (checkSubEffectProp nonPositiveBurn) ieffects+     in [ "effects with non-positive Burn:" <+> tshow containingNonPositiveBurn+        | not $ null containingNonPositiveBurn ]+  ++ let emptyOneOf :: Effect -> Bool+         emptyOneOf (AtMostOneOf []) = True+         emptyOneOf (OneOf []) = True+         emptyOneOf _ = False+         containingEmptyOneOf = filter (checkSubEffectProp emptyOneOf) ieffects+     in [ "effects with empty AtMostOneOf or OneOf:"+          <+> tshow containingEmptyOneOf+        | not $ null containingEmptyOneOf ]+  ++ (let nonPositiveEffect :: Effect -> Bool+          nonPositiveEffect (CreateItem (Just n) _ _ _) | n <= 0 = True+          nonPositiveEffect (DestroyItem n k _ _) | n <= 0 || k <= 0 = True+          nonPositiveEffect (ConsumeItems tools raw)+            | any ((<= 0) . fst) (tools ++ raw) = True+          nonPositiveEffect (DropItem n k _ _) | n <= 0 || k <= 0 = True+          nonPositiveEffect (Detect _ n) | n <= 0 = True+          nonPositiveEffect _ = False+          containingNonPositiveEffect =+            filter (checkSubEffectProp nonPositiveEffect) ieffects+      in [ "effects with forbidden non-positive parameters:"+           <+> tshow containingNonPositiveEffect+         | not $ null containingNonPositiveEffect ])+  ++ (let nonPositiveEffect :: Effect -> Bool+          nonPositiveEffect (Summon _ d) | Dice.infDice d <= 0 = True+          nonPositiveEffect (Paralyze d) | Dice.infDice d <= 0 = True+          nonPositiveEffect (ParalyzeInWater d) | Dice.infDice d <= 0 = True+          nonPositiveEffect (InsertMove d) | Dice.infDice d <= 0 = True+          nonPositiveEffect (Teleport d) | Dice.infDice d <= 0 = True+          nonPositiveEffect (CreateItem _ _ _ (TimerGameTurn d))+            | Dice.infDice d <= 0 = True+          nonPositiveEffect (CreateItem _ _ _ (TimerActorTurn d))+            | Dice.infDice d <= 0 = True+          nonPositiveEffect (Recharge n d)+            | n <= 0 || Dice.infDice d <= 0 = True+          nonPositiveEffect (Discharge n d)+            | n <= 0 || Dice.infDice d <= 0 = True+          nonPositiveEffect _ = False+          containingNonPositiveEffect =+            filter (checkSubEffectProp nonPositiveEffect) ieffects+      in [ "effects with forbidden potentially non-positive or negative number or dice:"+           <+> tshow containingNonPositiveEffect+         | not $ null containingNonPositiveEffect ])  -- We only check there are no duplicates at top level. If it may be nested, -- it may presumably be duplicated inside the nesting as well.@@ -379,14 +635,40 @@ -- We check it's not nested one nor more levels. validateNotNested :: [Effect] -> Text -> (Effect -> Bool) -> [Text] validateNotNested effs t f =-  let g (OneOf l) = any f l || any g l-      g (OnSmash effect) = f effect || g effect-      g (Composite l) = any f l || any g l+  let g (AtMostOneOf l) = any h l+      g (OneOf l) = any h l+      g (OnSmash effect) = h effect+      g (OnCombine effect) = h effect+      g (OnUser effect) = h effect+      g (AndEffect eff1 eff2) = h eff1 || h eff2+      g (OrEffect eff1 eff2) = h eff1 || h eff2+      g (SeqEffect effs2) = or $ map h effs2+      g (When _ effect) = h effect+      g (Unless _ effect) = h effect+      g (IfThenElse _ eff1 eff2) = h eff1 || h eff2       g _ = False+      h effect = f effect || g effect       ts = filter g effs   in [ "effect" <+> t <+> "should be specified at top level, not nested"      | length ts > 0 ] +checkSubEffectProp :: (Effect -> Bool) -> Effect -> Bool+checkSubEffectProp f eff =+  let g (AtMostOneOf l) = any h l+      g (OneOf l) = any h l+      g (OnSmash effect) = h effect+      g (OnCombine effect) = h effect+      g (OnUser effect) = h effect+      g (AndEffect eff1 eff2) = h eff1 || h eff2+      g (OrEffect eff1 eff2) = h eff1 || h eff2+      g (SeqEffect effs) = or $ map h effs+      g (When _ effect) = h effect+      g (Unless _ effect) = h effect+      g (IfThenElse _ eff1 eff2) = h eff1 || h eff2+      g _ = False+      h effect = f effect || g effect+  in h eff+ validateDups :: ItemKind -> Aspect -> [Text] validateDups ItemKind{..} feat =   let ts = filter (== feat) iaspects@@ -399,55 +681,29 @@ -- | Validate all item kinds. validateAll :: [ItemKind] -> ContentData ItemKind -> [Text] validateAll content coitem =-  let missingKitGroups = [ cgroup-                      | k <- content-                      , (cgroup, _) <- ikit k-                      , not $ omemberGroup coitem cgroup ]-      f :: Aspect -> Bool-      f HideAs{} = True+  let f :: Aspect -> Bool+      f PresentAs{} = True       f _ = False-      wrongHideAsGroups =+      wrongPresentAsGroups =         [ cgroup         | k <- content         , let (cgroup, notSingleton) = case find f (iaspects k) of-                Just (HideAs grp) | not $ oisSingletonGroup coitem grp ->+                Just (PresentAs grp) | not $ oisSingletonGroup coitem grp ->                   (grp, True)                 _ -> (undefined, False)         , notSingleton         ]-      g :: Effect -> Maybe (GroupName ItemKind)-      g (Explode grp) = Just grp-      g (Summon grp _) = Just grp-      g (CreateItem _ grp _) = Just grp-      g (DropItem _ _ _ grp) = Just grp-      g _ = Nothing-      missingEffectGroups =-        [ (iname k, absGroups)-        | k <- content-        , let grps = mapMaybe g $ ieffects k-              absGroups = filter (not . omemberGroup coitem) grps-        , not $ null absGroups-        ]-      missingHardwiredGroups =-        filter (not . omemberGroup coitem) hardwiredItemGroups-  in [ "no ikit groups in content:" <+> tshow missingKitGroups-     | not $ null missingKitGroups ]-     ++ [ "HideAs groups not singletons:" <+> tshow wrongHideAsGroups-        | not $ null wrongHideAsGroups ]-     ++ [ "mentioned groups not in content:" <+> tshow missingEffectGroups-        | not $ null missingEffectGroups ]-     ++ [ "hardwired groups not in content:" <+> tshow missingHardwiredGroups-        | not $ null missingHardwiredGroups ]--hardwiredItemGroups :: [GroupName ItemKind]-hardwiredItemGroups =-  -- From Preferences.hs:-  ["condition", "common item"]-    -- the others are optional:-    -- "curious item", "treasure", "any scroll", "any vial",-    -- "potion", "explosive", "any jewelry"-  -- Assorted:-  ++ ["bonus HP", "braced", "asleep", "impressed", "currency", "mobile"]+  in [ "PresentAs groups not singletons:" <+> tshow wrongPresentAsGroups+     | not $ null wrongPresentAsGroups ] -makeData :: [ItemKind] -> ContentData ItemKind-makeData = makeContentData "ItemKind" iname ifreq validateSingle validateAll+makeData :: [ItemKind] -> [GroupName ItemKind] -> [GroupName ItemKind]+         -> ContentData ItemKind+makeData content groupNamesSingleton groupNames =+  let allGroupNamesTooLong = filter ((> 23) . T.length . fromGroupName)+                             $ groupNamesSingleton ++ groupNames+  in assert (null allGroupNamesTooLong+             `blame` "ItemKind: some item group names too long"+             `swith` allGroupNamesTooLong) $+     makeContentData "ItemKind" iname ifreq validateSingle validateAll content+                     (mandatoryGroupsSingleton ++ groupNamesSingleton)+                     (mandatoryGroups ++ groupNames)

definition-src/Game/LambdaHack/Content/ModeKind.hs view

@@ -1,15 +1,17 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | The type of kinds of game modes. module Game.LambdaHack.Content.ModeKind-  ( ModeKind(..), makeData-  , Caves, Roster(..), Outcome(..)+  ( pattern CAMPAIGN_SCENARIO, pattern INSERT_COIN, pattern NO_CONFIRMS+  , ModeKind(..), makeData+  , Caves, Roster(..), TeamContinuity(..), Outcome(..)   , HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..)   , Player(..), LeaderMode(..), AutoLeader(..)-  , horrorGroup, genericEndMessages+  , teamExplorer, victoryOutcomes, deafeatOutcomes, nameOutcomePast+  , nameOutcomeVerb, endMessageOutcome, screensave #ifdef EXPOSE_INTERNAL     -- * Internal operations   , validateSingle, validateAll-  , validateSingleRoster, validateSinglePlayer, hardwiredModeGroups+  , validateSingleRoster, validateSinglePlayer, mandatoryGroups #endif   ) where @@ -30,15 +32,19 @@  -- | Game mode specification. data ModeKind = ModeKind-  { msymbol :: Char            -- ^ a symbol-  , mname   :: Text            -- ^ short description-  , mfreq   :: Freqs ModeKind  -- ^ frequency within groups-  , mroster :: Roster          -- ^ players taking part in the game-  , mcaves  :: Caves           -- ^ arena of the game-  , mendMsg :: [(Outcome, Text)]-                               -- ^ messages displayed at particular game ends;-                               --   if no message, the screen is skipped-  , mdesc   :: Text            -- ^ description+  { msymbol   :: Char            -- ^ a symbol+  , mname     :: Text            -- ^ short description+  , mfreq     :: Freqs ModeKind  -- ^ frequency within groups+  , mtutorial :: Bool            -- ^ whether to show tutorial messages, etc.+  , mroster   :: Roster          -- ^ players taking part in the game+  , mcaves    :: Caves           -- ^ arena of the game+  , mendMsg   :: [(Outcome, Text)]+      -- ^ messages displayed at each particular game ends; if message empty,+      --   the screen is skipped+  , mrules    :: Text            -- ^ rules note+  , mdesc     :: Text            -- ^ description+  , mreason   :: Text            -- ^ why/when the mode should be played+  , mhint     :: Text            -- ^ hints in case player faces difficulties   }   deriving Show @@ -47,7 +53,9 @@  -- | The specification of players for the game mode. data Roster = Roster-  { rosterList  :: [(Player, [(Int, Dice.Dice, GroupName ItemKind)])]+  { rosterList  :: [( Player+                    , Maybe TeamContinuity+                    , [(Int, Dice.Dice, GroupName ItemKind)] )]       -- ^ players in the particular team and levels, numbers and groups       --   of their initial members   , rosterEnemy :: [(Text, Text)]  -- ^ the initial enmity matrix@@ -55,14 +63,20 @@   }   deriving Show +-- | Team continuity index. Starting with 1, lower than 100.+newtype TeamContinuity = TeamContinuity Int+  deriving (Show, Eq, Ord, Enum, Generic)++instance Binary TeamContinuity+ -- | Outcome of a game. data Outcome =-    Killed    -- ^ the faction was eliminated+    Escape    -- ^ the player escaped the dungeon alive+  | Conquer   -- ^ the player won by eliminating all rivals   | Defeated  -- ^ the faction lost the game in another way+  | Killed    -- ^ the faction was eliminated+  | Restart   -- ^ game is restarted; the quitter quit   | Camping   -- ^ game is supended-  | Conquer   -- ^ the player won by eliminating all rivals-  | Escape    -- ^ the player escaped the dungeon alive-  | Restart   -- ^ game is restarted   deriving (Show, Eq, Ord, Enum, Bounded, Generic)  instance Binary Outcome@@ -82,7 +96,7 @@   | HiSurvival   | HiKill   | HiLoss-  deriving (Show, Eq, Ord, Generic)+  deriving (Show, Eq, Generic)  instance Binary HiIndeterminant @@ -96,14 +110,14 @@   , fskillsOther :: Ability.Skills                                 -- ^ fixed skill modifiers to the non-leader                                 --   actors; also summed with skills implied-                                --   by ftactic (which is not fixed)+                                --   by @fdoctrine@ (which is not fixed)   , fcanEscape   :: Bool        -- ^ the player can escape the dungeon   , fneverEmpty  :: Bool        -- ^ the faction declared killed if no actors   , fhiCondPoly  :: HiCondPoly  -- ^ score polynomial for the player   , fhasGender   :: Bool        -- ^ whether actors have gender-  , ftactic      :: Ability.Tactic+  , fdoctrine    :: Ability.Doctrine                                 -- ^ non-leaders behave according to this-                                --   tactic; can be changed during the game+                                --   doctrine; can be changed during the game   , fleaderMode  :: LeaderMode  -- ^ the mode of switching the leader   , fhasUI       :: Bool        -- ^ does the faction have a UI client                                 --   (for control or passive observation)@@ -117,7 +131,7 @@     LeaderNull  -- ^ faction can have no leader, is whole under AI control   | LeaderAI AutoLeader -- ^ leader under AI control   | LeaderUI AutoLeader -- ^ leader under UI control, assumes @fhasUI@-  deriving (Show, Eq, Ord, Generic)+  deriving (Show, Eq, Generic)  instance Binary LeaderMode @@ -140,22 +154,55 @@       --   of the automatic switching, but the client is expected to do more,       --   because it's advantageous for that kind of a faction   }-  deriving (Show, Eq, Ord, Generic)+  deriving (Show, Eq, Generic)  instance Binary AutoLeader -horrorGroup :: GroupName ItemKind-horrorGroup = "horror"+teamExplorer :: TeamContinuity+teamExplorer = TeamContinuity 1 -genericEndMessages :: [(Outcome, Text)]-genericEndMessages =-  [ (Killed, "Let's hope a rescue party arrives in time!" )-  , (Defeated, "Let's hope your new overlords let you live." )-  , (Camping, "See you soon, stronger and braver!" )-  , (Conquer, "Can it be done in a better style, though?" )-  , (Escape, "Can it be done more efficiently, though?" )-  , (Restart, "This time for real." ) ]+victoryOutcomes :: [Outcome]+victoryOutcomes = [Escape, Conquer] +deafeatOutcomes :: [Outcome]+deafeatOutcomes = [Defeated, Killed, Restart]++nameOutcomePast :: Outcome -> Text+nameOutcomePast = \case+  Escape   -> "emerged victorious"+  Conquer  -> "vanquished all opposition"+  Defeated -> "got decisively defeated"+  Killed   -> "got eliminated"+  Restart  -> "resigned prematurely"+  Camping  -> "set camp"++nameOutcomeVerb :: Outcome -> Text+nameOutcomeVerb = \case+  Escape   -> "emerge victorious"+  Conquer  -> "vanquish all opposition"+  Defeated -> "be decisively defeated"+  Killed   -> "be eliminated"+  Restart  -> "resign prematurely"+  Camping  -> "set camp"++endMessageOutcome :: Outcome -> Text+endMessageOutcome = \case+  Escape   -> "Can it be done more efficiently, though?"+  Conquer  -> "Can it be done in a better style, though?"+  Defeated -> "Let's hope your new overlords let you live."+  Killed   -> "Let's hope a rescue party arrives in time!"+  Restart  -> "This time for real."+  Camping  -> "See you soon, stronger and braver!"++screensave :: AutoLeader -> ModeKind -> ModeKind+screensave auto mk =+  let f x@(Player{fleaderMode = LeaderAI{}}, _, _) = x+      f (player, teamContinuity, initial) =+          (player {fleaderMode = LeaderAI auto}, teamContinuity, initial)+  in mk { mroster = (mroster mk) {rosterList = map f $ rosterList $ mroster mk}+        , mreason = "This is one of the screensaver scenarios, not available from the main menu, with all factions controlled by AI. Feel free to take over or relinquish control at any moment, but to register a legitimate high score, choose a standard scenario instead.\n" <> mreason mk+        }+ -- | Catch invalid game mode kind definitions. validateSingle :: ModeKind -> [Text] validateSingle ModeKind{..} =@@ -172,13 +219,17 @@ validateSingleRoster :: Caves -> Roster -> [Text] validateSingleRoster caves Roster{..} =   [ "no player keeps the dungeon alive"-  | all (not . fneverEmpty . fst) rosterList ]+  | all (\(pl, _, _) -> not $ fneverEmpty pl) rosterList ]   ++ [ "not exactly one UI client"-     | length (filter (fhasUI . fst) rosterList) /= 1 ]-  ++ concatMap (validateSinglePlayer . fst) rosterList-  ++ let checkPl field pl =-           [ pl <+> "is not a player name in" <+> field-           | all ((/= pl) . fname . fst) rosterList ]+     | length (filter (\(pl, _, _) -> fhasUI pl) rosterList) /= 1 ]+  ++ let tokens = mapMaybe (\(_, tc, _) -> tc) rosterList+         nubTokens = nub $ sort tokens+     in [ "duplicate team continuity token"+        | length tokens /= length nubTokens ]+  ++ concatMap (\(pl, _, _) -> validateSinglePlayer pl) rosterList+  ++ let checkPl field plName =+           [ plName <+> "is not a player name in" <+> field+           | all (\(pl, _, _) -> fname pl /= plName) rosterList ]          checkDipl field (pl1, pl2) =            [ "self-diplomacy in" <+> field | pl1 == pl2 ]            ++ checkPl field pl1@@ -186,7 +237,7 @@      in concatMap (checkDipl "rosterEnemy") rosterEnemy         ++ concatMap (checkDipl "rosterAlly") rosterAlly   ++ let keys = concatMap fst caves-         f (_, l) = concatMap g l+         f (_, _, l) = concatMap g l          g i3@(ln, _, _) =            [ "initial actor levels not among caves:" <+> tshow i3            | ln `notElem` keys ]@@ -203,36 +254,29 @@      | any ((>= 0) . snd) $ Ability.skillsToList fskillsOther ]  -- | Validate game mode kinds together.-validateAll :: ContentData CaveKind-            -> ContentData ItemKind-            -> [ModeKind]-            -> ContentData ModeKind-            -> [Text]-validateAll cocave coitem content comode =-  let caveGroups = concatMap snd . mcaves-      missingCave = filter (not . omemberGroup cocave)-                    $ concatMap caveGroups content-      f Roster{rosterList} =-        concatMap (\(p, l) -> delete horrorGroup (fgroups p)-                              ++ map (\(_, _, grp) -> grp) l)-                  rosterList-      missingRosterItems = filter (not . omemberGroup coitem)-                           $ concatMap (f . mroster) content-      hardwiredAbsent = filter (not . omemberGroup comode) hardwiredModeGroups-  in [ "cave groups not in content:" <+> tshow missingCave-     | not $ null missingCave ]-     ++ [ "roster item groups not in content:" <+> tshow missingRosterItems-        | not $ null missingRosterItems ]-     ++ [ "Hardwired groups not in content:" <+> tshow hardwiredAbsent-        | not $ null hardwiredAbsent ]+validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]+validateAll _ _ = []  -- so far, always valid -hardwiredModeGroups :: [GroupName ModeKind]-hardwiredModeGroups = ["campaign scenario", "insert coin"]+-- * Mandatory item groups -makeData :: ContentData CaveKind-         -> ContentData ItemKind-         -> [ModeKind]+mandatoryGroups :: [GroupName ModeKind]+mandatoryGroups =+       [CAMPAIGN_SCENARIO, INSERT_COIN]++pattern CAMPAIGN_SCENARIO, INSERT_COIN :: GroupName ModeKind++pattern CAMPAIGN_SCENARIO = GroupName "campaign scenario"+pattern INSERT_COIN = GroupName "insert coin"++-- * Optional item groups++pattern NO_CONFIRMS :: GroupName ModeKind++pattern NO_CONFIRMS = GroupName "no confirms"++makeData :: [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind]          -> ContentData ModeKind-makeData cocave coitem =-  makeContentData "ModeKind" mname mfreq validateSingle-                  (validateAll cocave coitem)+makeData content groupNamesSingleton groupNames =+  makeContentData "ModeKind" mname mfreq validateSingle validateAll content+                  groupNamesSingleton+                  (mandatoryGroups ++ groupNames)

definition-src/Game/LambdaHack/Content/PlaceKind.hs view

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-}--- | The type of kinds of rooms, halls and passages.+-- | The type of place kinds. Every room in the game is an instantiated+-- place kind. module Game.LambdaHack.Content.PlaceKind   ( PlaceKind(..), makeData   , Cover(..), Fence(..)@@ -15,7 +16,6 @@ import Game.LambdaHack.Core.Prelude  import           Data.Binary-import           Data.Char (chr) import qualified Data.Text as T import           GHC.Generics (Generic) @@ -59,7 +59,7 @@ data PlaceEntry =     PEntry (ContentId PlaceKind)   | PAround (ContentId PlaceKind)-  | PEnd (ContentId PlaceKind)+  | PExists (ContentId PlaceKind)   deriving (Show, Eq, Generic)  instance Binary PlaceEntry@@ -71,11 +71,10 @@ validateOverride :: [(Char, GroupName TileKind)] -> [Text] validateOverride ov =   let symbols = sort $ map fst ov-      duplicated = filter (uncurry (==)) $ zip symbols (chr 0 : symbols)-  in if null duplicated-     then []-     else [ "duplicated override symbols:"-            <+> T.pack (intersperse ' ' $ map fst duplicated) ]+      duplicated = filter (uncurry (==)) $ zip symbols ('\0' : symbols)+  in [ "duplicated override symbols:"+        <+> T.pack (intersperse ' ' $ map fst duplicated)+     | not (null duplicated) ]  -- | Catch invalid place kind definitions. In particular, verify that -- the top-left corner map is rectangular and not empty.@@ -92,15 +91,9 @@      ++ validateOverride poverrideLit  -- | Validate all place kinds.-validateAll :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind-            -> [Text]-validateAll cotile content _ =-  let overrides place = poverrideDark place ++ poverrideLit place-      missingOverride = filter (not . omemberGroup cotile)-                        $ concatMap (map snd . overrides) content-  in [ "override tile groups not in content:" <+> tshow missingOverride-     | not $ null missingOverride ]+validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]+validateAll _ _ = []  -- so far, always valid -makeData :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind-makeData cotile =-  makeContentData "PlaceKind" pname pfreq validateSingle (validateAll cotile)+makeData :: [PlaceKind] -> [GroupName PlaceKind] -> [GroupName PlaceKind]+         -> ContentData PlaceKind+makeData = makeContentData "PlaceKind" pname pfreq validateSingle validateAll

definition-src/Game/LambdaHack/Content/RuleKind.hs view

@@ -11,21 +11,23 @@  import Game.LambdaHack.Core.Prelude -import Data.Version+import qualified Data.Ini as Ini+import qualified Data.Ini.Types as Ini+import           Data.Version  import Game.LambdaHack.Definition.Defs  -- | The type of game rules and assorted game data. data RuleContent = RuleContent-  { rtitle            :: Text      -- ^ title of the game (not lib)+  { rtitle            :: String    -- ^ title of the game (not lib)   , rXmax             :: X         -- ^ maximum level width; for now,                                    --   keep equal to ScreenContent.rwidth   , rYmax             :: Y         -- ^ maximum level height; for now,                                    --   keep equal to ScreenContent.rheight - 3-  , rfontDir          :: FilePath  -- ^ font directory for the game (not lib)   , rexeVersion       :: Version   -- ^ version of the game   , rcfgUIName        :: FilePath  -- ^ name of the UI config file-  , rcfgUIDefault     :: String    -- ^ the default UI settings config file+  , rcfgUIDefault     :: (String, Ini.Config)+                                   -- ^ the default UI settings config file   , rwriteSaveClips   :: Int       -- ^ game saved that often (not on browser)   , rleadLevelClips   :: Int       -- ^ server switches leader level that often   , rscoresFile       :: FilePath  -- ^ name of the scores file@@ -40,10 +42,9 @@   { rtitle = ""   , rXmax = 0   , rYmax = 0-  , rfontDir = ""   , rexeVersion = makeVersion []   , rcfgUIName = ""-  , rcfgUIDefault = ""+  , rcfgUIDefault = ("", Ini.emptyConfig)   , rwriteSaveClips = 0   , rleadLevelClips = 0   , rscoresFile = ""

definition-src/Game/LambdaHack/Content/TileKind.hs view

@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveGeneric #-}--- | The type of kinds of terrain tiles.+-- | The type of tile kinds. Every terrain tile in the game is+-- an instantiated tile kind. module Game.LambdaHack.Content.TileKind-  ( TileKind(..), Feature(..)+  ( pattern S_UNKNOWN_SPACE, pattern LEGEND_LIT, pattern LEGEND_DARK, pattern S_UNKNOWN_OUTER_FENCE, pattern S_BASIC_OUTER_FENCE, pattern AQUATIC+  , TileKind(..), ProjectileTriggers(..), Feature(..)   , makeData   , isUknownSpace, unknownId   , isSuspectKind, isOpenableKind, isClosableKind@@ -9,7 +10,7 @@ #ifdef EXPOSE_INTERNAL     -- * Internal operations   , validateSingle, validateAll-  , validateDups, hardwiredTileGroups+  , validateDups, mandatoryGroups, mandatoryGroupsSingleton #endif   ) where @@ -17,11 +18,7 @@  import Game.LambdaHack.Core.Prelude -import           Control.DeepSeq-import           Data.Binary-import qualified Data.Char as Char-import           Data.Hashable-import           GHC.Generics (Generic)+import Data.Word (Word8)  import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Definition.Color@@ -43,8 +40,10 @@   , tfreq    :: Freqs TileKind  -- ^ frequency within groups   , tcolor   :: Color        -- ^ map color   , tcolor2  :: Color        -- ^ map color when not in FOV-  , talter   :: Word8        -- ^ minimal skill needed to alter the tile-  , tfeature :: [Feature]    -- ^ properties+  , talter   :: Word8        -- ^ minimal skill needed to activate embeds+                             --   and, in case of big actors not standing on+                             --   the tile, to alter the tile in any way+  , tfeature :: [Feature]    -- ^ properties; order matters   }   deriving Show  -- No Eq and Ord to make extending logically sound @@ -54,11 +53,20 @@       -- ^ initially an item of this group is embedded;       --   we assume the item has effects and is supposed to be triggered   | OpenTo (GroupName TileKind)-      -- ^ goes from a closed to (randomly closed or) open tile when altered+      -- ^ goes from a closed to closed or open tile when altered   | CloseTo (GroupName TileKind)-      -- ^ goes from an open to (randomly opened or) closed tile when altered+      -- ^ goes from an open to open or closed tile when altered   | ChangeTo (GroupName TileKind)       -- ^ alters tile, but does not change walkability+  | OpenWith ProjectileTriggers+             [(Int, GroupName ItemKind)] (GroupName TileKind)+      -- ^ alters tile, as before, using up all listed items from the ground+      --   and equipment; the list never empty; for simplicity, such tiles+      --   are never taken into account when pathfinding+  | CloseWith ProjectileTriggers+              [(Int, GroupName ItemKind)] (GroupName TileKind)+  | ChangeWith ProjectileTriggers+               [(Int, GroupName ItemKind)] (GroupName TileKind)   | HideAs (GroupName TileKind)       -- ^ when hidden, looks as the unique tile of the group   | BuildAs (GroupName TileKind)@@ -86,13 +94,12 @@                          --   is rolled per place and then, once for each                          --   position, one of the two is semi-randomly chosen                          --   (according to their individual frequencies only)-  deriving (Show, Eq, Ord, Generic)--instance Binary Feature--instance Hashable Feature+  deriving (Show, Eq) -instance NFData Feature+-- | Marks whether projectiles are permitted to trigger the tile transformation+-- action.+data ProjectileTriggers = ProjYes | ProjNo+  deriving (Show, Eq)  -- | Validate a single tile kind. validateSingle :: TileKind -> [Text]@@ -103,7 +110,7 @@                                  && isOpenableKind t ]   ++ [ "closable tile is closed" | Walkable `notElem` tfeature                                    && isClosableKind t ]-  ++ [ "walkable tile is considered for triggering by AI"+  ++ [ "walkable tile is considered for activating by AI"      | Walkable `elem` tfeature        && ConsideredByAI `elem` tfeature ]   ++ [ "trail tile not walkable" | Walkable `notElem` tfeature@@ -147,55 +154,58 @@ -- to inspect manually all the tiles with this look to see if any is special. -- This tends to be tedious. Note that tiles may freely differ wrt text blurb, -- dungeon generation rules, AI preferences, etc., whithout causing the tedium.-validateAll :: ContentData ItemKind -> [TileKind] -> ContentData TileKind-            -> [Text]-validateAll coitem content cotile =-  let g :: Feature -> Maybe (GroupName TileKind)-      g (OpenTo grp) = Just grp-      g (CloseTo grp) = Just grp-      g (ChangeTo grp) = Just grp-      g (HideAs grp) = Just grp-      g (BuildAs grp) = Just grp-      g (RevealAs grp) = Just grp-      g (ObscureAs grp) = Just grp-      g _ = Nothing-      missingTileGroups =-        [ (tname k, absGroups)-        | k <- content-        , let grps = mapMaybe g $ tfeature k-              absGroups = filter (not . omemberGroup cotile) grps-        , not $ null absGroups-        ]-      h :: Feature -> Maybe (GroupName ItemKind)-      h (Embed grp) = Just grp-      h _ = Nothing-      missingItemGroups =-        [ (tname k, absGroups)+validateAll :: [TileKind] -> ContentData TileKind -> [Text]+validateAll content cotile =+  let f :: Feature -> Bool+      f HideAs{} = True+      f BuildAs{} = True+      f _ = False+      wrongGrooup k grp = not (oisSingletonGroup cotile grp)+                          || isJust (grp `lookup` tfreq k)+      wrongFooAsGroups =+        [ cgroup         | k <- content-        , let grps = mapMaybe h $ tfeature k-              absGroups = filter (not . omemberGroup coitem) grps-        , not $ null absGroups+        , let (cgroup, notSingleton) = case find f (tfeature k) of+                Just (HideAs grp) | wrongGrooup k grp -> (grp, True)+                Just (BuildAs grp) | wrongGrooup k grp -> (grp, True)+                _ -> (undefined, False)+        , notSingleton         ]-      missingHardwiredGroups =-        filter (not . omemberGroup cotile) hardwiredTileGroups-  in [ "unknown tile (the first) should be the unknown one"-     | talter (head content) /= 1 || tname (head content) /= "unknown space" ]+  in [ "HideAs or BuildAs groups not singletons or point to themselves:"+       <+> tshow wrongFooAsGroups+     | not $ null wrongFooAsGroups ]+     ++ [ "unknown tile (the first) should be the unknown one"+        | talter (head content) /= 1+          || tname (head content) /= "unknown space" ]      ++ [ "no tile other than the unknown (the first) should require skill 1"-        | all (\tk -> talter tk == 1) (tail content) ]-     ++ [ "only unknown tile may have talter 1"-        | any ((== 1) . talter) $ tail content ]-     ++ [ "mentioned tile groups not in content:" <+> tshow missingTileGroups-        | not $ null missingTileGroups ]-     ++ [ "embedded item groups not in content:" <+> tshow missingItemGroups-        | not $ null missingItemGroups ]-     ++ [ "hardwired groups not in content:" <+> tshow missingHardwiredGroups-        | not $ null missingHardwiredGroups ]+        | any (\tk -> talter tk == 1) (tail content) ] -hardwiredTileGroups :: [GroupName TileKind]-hardwiredTileGroups =-  [ "unknown space", "legendLit", "legendDark", "unknown outer fence"-  , "basic outer fence" ]+-- * Mandatory item groups +mandatoryGroupsSingleton :: [GroupName TileKind]+mandatoryGroupsSingleton =+       [S_UNKNOWN_SPACE, S_UNKNOWN_OUTER_FENCE, S_BASIC_OUTER_FENCE]++pattern S_UNKNOWN_SPACE, S_UNKNOWN_OUTER_FENCE, S_BASIC_OUTER_FENCE :: GroupName TileKind++mandatoryGroups :: [GroupName TileKind]+mandatoryGroups =+       [LEGEND_LIT, LEGEND_DARK]++pattern LEGEND_LIT, LEGEND_DARK :: GroupName TileKind++pattern S_UNKNOWN_SPACE = GroupName "unknown space"+pattern S_UNKNOWN_OUTER_FENCE = GroupName "unknown outer fence"+pattern S_BASIC_OUTER_FENCE = GroupName "basic outer fence"+pattern LEGEND_LIT = GroupName "legendLit"+pattern LEGEND_DARK = GroupName "legendDark"++-- * Optional item groups++pattern AQUATIC :: GroupName TileKind++pattern AQUATIC = GroupName "aquatic"+ isUknownSpace :: ContentId TileKind -> Bool {-# INLINE isUknownSpace #-} isUknownSpace tt = toContentId 0 == tt@@ -226,8 +236,8 @@ talterForStairs :: Word8 talterForStairs = 3 -floorSymbol :: Char.Char-floorSymbol = Char.chr 183+floorSymbol :: Char+floorSymbol = '\x00B7'  -- Alter skill schema: -- 0  can be altered by everybody (escape)@@ -241,6 +251,9 @@ -- 100  walls -- maxBound  impenetrable walls, etc., can never be altered -makeData :: ContentData ItemKind -> [TileKind] -> ContentData TileKind-makeData coitem =-  makeContentData "TileKind" tname tfreq validateSingle (validateAll coitem)+makeData :: [TileKind] -> [GroupName TileKind] -> [GroupName TileKind]+         -> ContentData TileKind+makeData content groupNamesAtMostOne groupNames =+  makeContentData "TileKind" tname tfreq validateSingle validateAll content+                  (mandatoryGroupsSingleton ++ groupNamesAtMostOne)+                  (mandatoryGroups ++ groupNames)

definition-src/Game/LambdaHack/Core/Dice.hs view

@@ -1,11 +1,11 @@-{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Representation of dice scaled with current level depth. module Game.LambdaHack.Core.Dice   ( -- * Frequency distribution for casting dice scaled with level depth     Dice, AbsDepth(..), castDice, d, dL, z, zL, intToDice, minDice, maxDice   , infsupDice, supDice, infDice, meanDice, reduceDice     -- * Dice for rolling a pair of integer parameters representing coordinates.-  , DiceXY(..), supDiceXY, infDiceXY, meanDiceXY+  , DiceXY(..), supDiceXY, infDiceXY   ) where  import Prelude ()@@ -13,8 +13,6 @@ import Game.LambdaHack.Core.Prelude  import Data.Binary-import Data.Hashable (Hashable)-import GHC.Generics (Generic)  -- | Multiple dice rolls, some scaled with current level depth, in which case -- the sum of all rolls is scaled in proportion to current depth@@ -36,7 +34,7 @@   | DiceNegate Dice   | DiceMin Dice Dice   | DiceMax Dice Dice-  deriving (Eq, Generic)+  deriving Eq  instance Show Dice where   show = stripOuterParens . showDiceWithParens@@ -71,8 +69,6 @@ wrapInParens "" = "" wrapInParens t = "(" <> t <> ")" -instance Binary Dice- instance Num Dice where   d1 + d2 = DicePlus d1 d2   d1 * d2 = DiceTimes d1 d2@@ -87,13 +83,14 @@ -- e.g., when the dungeon is branched, and it can even be different -- than the length of the longest branch, if levels at some depths are missing. newtype AbsDepth = AbsDepth Int-  deriving (Show, Eq, Ord, Hashable, Binary)+  deriving (Show, Eq, Ord, Binary)  -- | Cast dice scaled with current level depth. When scaling, we round up,--- so that the value of @1 `dL` 1@ is 1 even at the lowest level.+-- so that the value of @1 `dL` 1@ is @1@ even at the lowest level,+-- but so is the value of @1 `dL` depth@. -- -- The implementation calls RNG as many times as there are dice rolls,--- which is costly, so content should prefer to case fewer dice+-- which is costly, so content should prefer to cast fewer dice -- and then multiply them by a constant. If rounded results are not desired -- (often they are, to limit the number of distinct item varieties -- in inventory), another dice may be added to the result.@@ -105,6 +102,7 @@ castDice :: forall m. Monad m          => ((Int, Int) -> m Int)          -> AbsDepth -> AbsDepth -> Dice -> m Int+{-# INLINE castDice #-} castDice randomR (AbsDepth lvlDepth) (AbsDepth maxDepth) dice = do   let !_A = assert (lvlDepth >= 0 && lvlDepth <= maxDepth                     `blame` "invalid depth for dice rolls"@@ -150,19 +148,19 @@ d n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k))         $ DiceD n k --- | A die rolled the given number of times, with the result scaled--- with dungeon level depth.+-- | A die rolled the given number of times,+-- with the result scaled with dungeon level depth. dL :: Int -> Int -> Dice dL n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k))          $ DiceDL n k --- | A die, starting from zero, ending at one less than the bound,+-- | A die, starting from zero, ending at one less than second argument, -- rolled the given number of times. E.g., @1 `z` 1@ always rolls zero. z :: Int -> Int -> Dice z n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k))         $ DiceZ n k --- | A die, starting from zero, ending at one less than the bound,+-- | A die, starting from zero, ending at one less than second argument, -- rolled the given number of times, -- with the result scaled with dungeon level depth. zL :: Int -> Int -> Dice@@ -226,14 +224,17 @@ infDice :: Dice -> Int infDice = fst . infsupDice --- | Mean value of dice. The scaled part taken assuming median level.+-- | Mean value of dice. The scaled part taken assuming median level,+-- but not taking into account rounding up, and so too low, especially+-- for dice small compared to depth. To fix this, depth would need+-- to be taken as argument. meanDice :: Dice -> Double meanDice dice1 = case dice1 of-  DiceI k -> fromIntegral k-  DiceD n k -> fromIntegral (n * (k + 1)) / 2-  DiceDL n k -> fromIntegral (n * (k + 1)) / 4-  DiceZ n k -> fromIntegral (n * k) / 2-  DiceZL n k -> fromIntegral (n * k) / 4+  DiceI k -> intToDouble k+  DiceD n k -> intToDouble (n * (k + 1)) / 2+  DiceDL n k -> intToDouble (n * (k + 1)) / 4+  DiceZ n k -> intToDouble (n * k) / 2+  DiceZL n k -> intToDouble (n * k) / 4   DicePlus d1 d2 -> meanDice d1 + meanDice d2   DiceTimes d1 d2 -> meanDice d1 * meanDice d2  -- I hope this is that simple   DiceNegate d1 -> negate $ meanDice d1@@ -249,9 +250,7 @@ -- | Dice for rolling a pair of integer parameters pertaining to, -- respectively, the X and Y cartesian 2D coordinates. data DiceXY = DiceXY Dice Dice-  deriving (Show, Generic)--instance Binary DiceXY+  deriving Show  -- | Maximal value of DiceXY. supDiceXY :: DiceXY -> (Int, Int)@@ -260,7 +259,3 @@ -- | Minimal value of DiceXY. infDiceXY :: DiceXY -> (Int, Int) infDiceXY (DiceXY x y) = (infDice x, infDice y)---- | Mean value of DiceXY.-meanDiceXY :: DiceXY -> (Double, Double)-meanDiceXY (DiceXY x y) = (meanDice x, meanDice y)

definition-src/Game/LambdaHack/Core/Frequency.hs view

@@ -1,15 +1,14 @@-{-# LANGUAGE DeriveFoldable, DeriveGeneric, DeriveTraversable, TupleSections #-}+{-# LANGUAGE DeriveGeneric, DeriveTraversable, TupleSections #-} -- | A list of entities with relative frequencies of appearance. module Game.LambdaHack.Core.Frequency   ( -- * The @Frequency@ type     Frequency     -- * Construction-  , uniformFreq, toFreq+  , uniformFreq, toFreq, maxBoundInt32     -- * Transformation-  , scaleFreq, renameFreq, setFreq+  , scaleFreq     -- * Consumption   , nullFreq, runFrequency, nameFrequency-  , minFreq, maxFreq, mostFreq   ) where  import Prelude ()@@ -18,9 +17,11 @@  import Control.Applicative import Data.Int (Int32)-import Data.Ord (comparing) import GHC.Generics (Generic) +maxBoundInt32 :: Int+maxBoundInt32 = toIntegralCrash (maxBound :: Int32)+ -- | The frequency distribution type. Not normalized (operations may -- or may not group the same elements and sum their frequencies). -- However, elements with zero frequency are removed upon construction.@@ -34,14 +35,11 @@   }   deriving (Show, Eq, Ord, Foldable, Traversable, Generic) -_maxBound32 :: Integer-_maxBound32 = toInteger (maxBound :: Int32)- instance Monad Frequency where   Frequency xs name >>= f =     Frequency [ #ifdef WITH_EXPENSIVE_ASSERTIONS-                assert (toInteger p * toInteger q <= _maxBound32+                assert (toInteger p * toInteger q <= toInteger maxBoundInt32                         `blame` (name, map fst xs)) #endif                 (p * q, y)@@ -59,7 +57,7 @@   Frequency fs fname <*> Frequency ys yname =     Frequency [ #ifdef WITH_EXPENSIVE_ASSERTIONS-                assert (toInteger p * toInteger q <= _maxBound32+                assert (toInteger p * toInteger q <= toInteger maxBoundInt32                         `blame` (fname, map fst fs, yname, map fst ys)) #endif                 (p * q, f y)@@ -91,7 +89,7 @@ toFreq :: Text -> [(Int, a)] -> Frequency a toFreq name l = #ifdef WITH_EXPENSIVE_ASSERTIONS-  assert (all (\(p, _) -> toInteger p <= _maxBound32) l+  assert (all (\(p, _) -> toInteger p <= toInteger maxBoundInt32) l           `blame` (name, map fst l)) $ #endif   Frequency (filter ((> 0 ) . fst) l) name@@ -103,32 +101,12 @@   assert (n > 0 `blame` "non-positive frequency scale" `swith` (name, n, xs)) $   let multN p = #ifdef WITH_EXPENSIVE_ASSERTIONS-                assert (toInteger p * toInteger n <= _maxBound32+                assert (toInteger p * toInteger n <= toInteger maxBoundInt32                         `blame` (n, Frequency xs name)) $ #endif                 p * n   in Frequency (map (first multN) xs) name --- | Change the description of the frequency.-renameFreq :: Text -> Frequency a -> Frequency a-renameFreq newName fr = fr {nameFrequency = newName}---- | Set frequency of an element.-setFreq :: Eq a => Frequency a -> a -> Int -> Frequency a-setFreq (Frequency xs name) x n =-  let xsNew = [(n, x) | n <= 0] ++ filter ((/= x) . snd) xs-  in Frequency xsNew name- -- | Test if the frequency distribution is empty. nullFreq :: Frequency a -> Bool nullFreq (Frequency fs _) = null fs--minFreq :: Ord a => Frequency a -> Maybe a-minFreq fr = if nullFreq fr then Nothing else Just $ minimum fr--maxFreq :: Ord a => Frequency a -> Maybe a-maxFreq fr = if nullFreq fr then Nothing else Just $ maximum fr--mostFreq :: Frequency a -> Maybe a-mostFreq fr = if nullFreq fr then Nothing-              else Just $ snd $ maximumBy (comparing fst) $ runFrequency fr

definition-src/Game/LambdaHack/Core/Prelude.hs view

@@ -11,38 +11,57 @@    , module Control.Exception.Assert.Sugar -  , Text, (<+>), tshow, divUp, sum, (<$$>), partitionM, length, null+  , Text, (<+>), tshow, divUp, sum, (<$$>), partitionM, length, null, comparing+  , intCast, fromIntegralWrap, toIntegralCrash, intToDouble, int64ToDouble+  , mapM_, forM_    , (***), (&&&), first, second   ) where  import Prelude () -import Prelude.Compat hiding (appendFile, length, null, readFile, sum,-                       writeFile, (<>))+import Prelude.Compat hiding+  ( appendFile+  , foldl+  , foldl1+  , fromIntegral+  , length+  , mapM_+  , null+  , readFile+  , sum+  , writeFile+  , (<>)+  )  import           Control.Applicative import           Control.Arrow (first, second, (&&&), (***)) import           Control.DeepSeq-import           Control.Exception.Assert.Sugar (allB, assert, blame,-                                                 showFailure, swith)-import           Control.Monad.Compat+import           Control.Exception.Assert.Sugar+  (allB, assert, blame, showFailure, swith)+import           Control.Monad.Compat hiding (forM_, mapM_)+import qualified Control.Monad.Compat import           Data.Binary+import qualified Data.Bits as Bits import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Fixed as Fixed import           Data.Hashable import qualified Data.HashMap.Strict as HM+import           Data.Int (Int64)+import           Data.IntCast (intCast) import           Data.Key-import           Data.List.Compat hiding (length, null, sum)+import           Data.List.Compat hiding (foldl, foldl1, length, null, sum) import qualified Data.List.Compat as List import           Data.Maybe+import           Data.Ord (comparing) import           Data.Semigroup.Compat (Semigroup ((<>))) import           Data.Text (Text) import qualified Data.Text as T (pack) import qualified Data.Time as Time import           NLP.Miniutter.English ((<+>)) import qualified NLP.Miniutter.English as MU+import qualified Prelude.Compat  -- | Show and pack the result. tshow :: Show a => a -> Text@@ -149,3 +168,32 @@ instance NFData MU.Person  instance NFData MU.Polarity++-- | Re-exported 'Prelude.fromIntegral', but please give it explicit type+-- to make it obvious if wrapping, etc., may occur. Use `toIntegralCrash`+-- instead, if possible, because it fails instead of wrapping, etc.+-- In general, it may wrap or otherwise lose information.+fromIntegralWrap :: (Integral a, Num b) => a -> b+fromIntegralWrap = Prelude.Compat.fromIntegral++-- | Re-exported 'Data.Bits.toIntegralSized', but please give it explicit type+-- to make it obvious if wrapping, etc., may occur and to trigger optimization.+-- In general, it may crash.+toIntegralCrash :: (Integral a, Integral b, Bits.Bits a, Bits.Bits b)+                => a -> b+{-# INLINE toIntegralCrash #-}+toIntegralCrash = fromMaybe (error "toIntegralCrash") . Bits.toIntegralSized++intToDouble :: Int -> Double+intToDouble = Prelude.Compat.fromIntegral++int64ToDouble :: Int64 -> Double+int64ToDouble = Prelude.Compat.fromIntegral++-- | This has a more specific type (unit result) than normally, to catch errors.+mapM_ :: (Foldable t, Monad m) => (a -> m ()) -> t a -> m ()+mapM_ = Control.Monad.Compat.mapM_++-- | This has a more specific type (unit result) than normally, to catch errors.+forM_ :: (Foldable t, Monad m) => t a -> (a -> m ()) -> m ()+forM_ = Control.Monad.Compat.forM_

definition-src/Game/LambdaHack/Core/Random.hs view

@@ -3,7 +3,8 @@   ( -- * The @Rng@ monad     Rnd     -- * Random operations-  , randomR, random, oneOf, shuffle, frequency+  , randomR, randomR0, nextRandom, randomWord32+  , oneOf, shuffle, shuffleExcept, frequency     -- * Fractional chance   , Chance, chance     -- * Casting dice scaled with level@@ -21,31 +22,65 @@ import Game.LambdaHack.Core.Prelude  import qualified Control.Monad.Trans.State.Strict as St+import           Data.Int (Int32) import           Data.Ratio-import qualified System.Random as R+import qualified Data.Vector.Unboxed as U+import           Data.Word (Word16, Word32)+import qualified System.Random.SplitMix32 as SM  import qualified Game.LambdaHack.Core.Dice as Dice import           Game.LambdaHack.Core.Frequency  -- | The monad of computations with random generator state.-type Rnd a = St.State R.StdGen a+type Rnd a = St.State SM.SMGen a --- | Get a random object within a range with a uniform distribution.-randomR :: (R.Random a) => (a, a) -> Rnd a+-- | Get a random object within a (inclusive) range with a uniform distribution.+randomR :: (Integral a) => (a, a) -> Rnd a {-# INLINE randomR #-}-randomR = St.state . R.randomR+randomR (0, h) = St.state $ nextRandom h+randomR (l, h) | l > h = error "randomR: empty range"+randomR (l, h) = St.state $ \g ->+  let (x, g') = nextRandom (h - l) g+  in (x + l, g') --- | Get a random object of a given type with a uniform distribution.-random :: (R.Random a) => Rnd a-{-# INLINE random #-}-random = St.state R.random+-- | Generate random 'Integral' in @[0, x]@ range.+randomR0 :: (Integral a) => a -> Rnd a+{-# INLINE randomR0 #-}+randomR0 h = St.state $ nextRandom h +-- | Generate a random integral value in @[0, x]@ range, where @x@ is within+-- @Int32@.+--+-- The limitation to @Int32@ values is needed to keep it working on signed+-- types. In package @random@, a much more complex scheme is used+-- to keep it working for arbitrary fixed number of bits.+nextRandom :: forall a. (Integral a) => a -> SM.SMGen -> (a, SM.SMGen)+{-# INLINE nextRandom #-}+nextRandom h g = assert ((intCast :: a -> Integer) h+                         <= (intCast :: Int32 -> Integer) maxBound) $+  let (w32, g') = SM.bitmaskWithRejection32'+                    ((fromIntegralWrap :: a -> Word32) h) g+      -- `fromIntegralWrap` is fine here, because wrapping is OK.+      x = (fromIntegralWrap :: Word32 -> a) w32+  in if x > h+     then error $ "nextRandom internal error"+                  `showFailure`+                    ( (intCast :: a -> Integer) x+                    , (intCast :: a -> Integer) h+                    , w32 )+     else (x, g')++-- | Get a random 'Word32' using full range.+randomWord32 :: Rnd Word32+{-# INLINE randomWord32 #-}+randomWord32 = St.state SM.nextWord32+ -- | Get any element of a list with equal probability. oneOf :: [a] -> Rnd a oneOf [] = error $ "oneOf []" `showFailure` () oneOf [x] = return x oneOf xs = do-  r <- randomR (0, length xs - 1)+  r <- randomR0 (length xs - 1)   return $! xs !! r  -- | Generates a random permutation. Naive, but good enough for small inputs.@@ -55,13 +90,28 @@   x <- oneOf l   (x :) <$> shuffle (delete x l) +-- | Generates a random permutation, except for the existing mapping.+shuffleExcept :: U.Vector Word16 -> Int -> [Word16] -> Rnd [Word16]+shuffleExcept v len l0 = assert (len == length l0) $+  shuffleE 0 (l0 \\ filter (/= maxBound) (U.toList v))+ where+  shuffleE :: Int -> [Word16] -> Rnd [Word16]+  shuffleE i _ | i == len = return []+  shuffleE i l = do+    let a0 = v U.! i+    if a0 == maxBound then do+      a <- oneOf l+      (a :) <$> shuffleE (succ i) (delete a l)+    else+      (a0 :) <$> shuffleE (succ i) l+ -- | Gen an element according to a frequency distribution. frequency :: Show a => Frequency a -> Rnd a {-# INLINE frequency #-} frequency = St.state . rollFreq  -- | Randomly choose an item according to the distribution.-rollFreq :: Show a => Frequency a -> R.StdGen -> (a, R.StdGen)+rollFreq :: Show a => Frequency a -> SM.SMGen -> (a, SM.SMGen) rollFreq fr g = case runFrequency fr of   [] -> error $ "choice from an empty frequency"                 `showFailure` nameFrequency fr@@ -69,11 +119,11 @@                                `showFailure` (nameFrequency fr, n, x)   [(_, x)] -> (x, g)  -- speedup   fs -> let sumf = foldl' (\ !acc (!n, _) -> acc + n) 0 fs-            (r, ng) = R.randomR (1, sumf) g+            (r, ng) = nextRandom (pred sumf) g             frec :: Int -> [(Int, a)] -> a             frec !m [] = error $ "impossible roll"                                  `showFailure` (nameFrequency fr, fs, m)-            frec m ((n, x) : _) | m <= n = x+            frec m ((n, x) : _) | m < n = x             frec m ((n, _) : xs) = frec (m - n) xs         in assert (sumf > 0 `blame` "frequency with nothing to pick"                             `swith` (nameFrequency fr, fs))@@ -91,7 +141,6 @@   return (k <= n)  -- | Cast dice scaled with current level depth.--- Note that at the first level, the scaled dice are always ignored. castDice :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.Dice -> Rnd Int castDice = Dice.castDice randomR

definition-src/Game/LambdaHack/Definition/Ability.hs view

@@ -1,14 +1,15 @@ {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Abilities of items, actors and factions. module Game.LambdaHack.Definition.Ability-  ( Skill(..), Skills, Flag(..), Flags(..), Tactic(..), EqpSlot(..)+  ( Skill(..), Skills, Flag(..), ActivationFlag(..), Flags(..)+  , Doctrine(..), EqpSlot(..)   , getSk, addSk, checkFl, skillsToList   , zeroSkills, addSkills, sumScaledSkills-  , nameTactic, describeTactic, tacticSkills+  , nameDoctrine, describeDoctrine, doctrineSkills   , blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , compactSkills, scaleSkills+  , scaleSkills #endif   ) where @@ -44,14 +45,18 @@   | SkMaxHP   | SkMaxCalm   | SkSpeed-  | SkSight  -- ^ FOV radius, where 1 means a single tile FOV+  | SkSight  -- ^ FOV radius, where 1 means a single tile FOV area   | SkSmell   | SkShine   | SkNocto   | SkHearing   | SkAggression   | SkOdor-  deriving (Show, Eq, Ord, Generic, Enum, Bounded)+  | SkDeflectRanged  -- ^ intended to reflect how many items granting complete+                     --   invulnerability are among organs and equipment;+                     --   this is not strength of deflection nor duration, etc.+  | SkDeflectMelee   -- ^ see above+  deriving (Show, Eq, Enum, Bounded, Generic)  -- | Strength of particular skills. This is cumulative from actor -- organs and equipment and so pertain to an actor as well as to items.@@ -63,7 +68,7 @@ -- -- The tree is by construction sparse, so the derived equality is semantical. newtype Skills = Skills {skills :: EM.EnumMap Skill Int}-  deriving (Show, Eq, Ord, Generic, Hashable, Binary)+  deriving (Show, Eq, Ord, Hashable, Binary)  -- | Item flag aspects. data Flag =@@ -74,36 +79,70 @@   | Durable       -- ^ don't break even when hitting or applying   | Equipable     -- ^ AI and UI flag: consider equipping (may or may not                   --   have 'EqpSlot', e.g., if the benefit is periodic)-  | Meleeable     -- ^ AI and UI flag: consider meleeing with+  | Benign        -- ^ AI and UI flag: the item is not meant to harm   | Precious      -- ^ AI and UI flag: don't risk identifying by use;                   --   also, can't throw or apply if not calm enough;                   --   also may be used for UI flavour or AI hints   | Blast         -- ^ the item is an explosion blast particle   | Condition     -- ^ item is a condition (buff or de-buff) of an actor-                  --   and is displayed as such;-                  --   this differs from belonging to the @condition@ group,-                  --   which doesn't guarantee display as a condition,-                  --   but governs removal by items that drop @condition@+                  --   and is displayed as such, not activated at death;+                  --   this differs from belonging to the @CONDITION@ group,+                  --   which doesn't guarantee any behaviour or display,+                  --   but governs removal by items that drop @CONDITION@   | Unique        -- ^ at most one copy can ever be generated+  | MetaGame      -- ^ once identified, the item is known until savefile deleted+  | MinorEffects  -- ^ override: the effects on this item are considered+                  --   minor and so possibly not causing identification on use,+                  --   and so this item will identify on pick-up+  | MinorAspects  -- ^ override: don't show question marks by weapons in HUD+                  --   even when unidentified item with this flag equipped+  | -- The flags below specify all conditions under which the item activates,+    -- charges permitting, in addition to universal conditions, which are+    -- hitting an actor as projectiles and being explicitly triggered+    -- by an actor (item destruction and combining only pertain+    -- to explicitly listed effects).+    Meleeable     -- ^ meleeing with the item is permitted and so the item+                  --   activates when meleed with   | Periodic      -- ^ at most one of any copies without cooldown (timeout)                   --   activates each turn; the cooldown required after                   --   activation is specified in @Timeout@ (or is zero);                   --   the initial cooldown can also be specified                   --   as @TimerDice@ in @CreateItem@ effect; uniquely, this                   --   activation never destroys a copy, unless item is fragile;-                  --   all this happens only for items in equipment or organs-  | MinorEffects  -- ^ override: the effects on this item are considered-                  --   minor and so not causing identification on use,-                  --   and so this item will identify on pick-up-  deriving (Show, Eq, Ord, Generic, Enum, Bounded)+                  --   all this happens only for items in equipment or organs;+                  --   kinetic damage is not applied+  | UnderRanged   -- ^ activates when non-projectile actor with this item+                  --   as equipment or organ is under ranged attack;+                  --   kinetic damage is not applied+  | UnderMelee    -- ^ activates when non-projectile actor with this item+                  --   as equipment or organ is under melee attack;+                  --   kinetic damage is not applied+  deriving (Show, Eq, Enum, Bounded, Generic) +-- | These flags correspond to the last cases of @Flag@ and addtionally+-- to all the universal circumstances of item activation,+-- under which every item activates (even if vacuusly).+data ActivationFlag =+    ActivationMeleeable+  | ActivationPeriodic+  | ActivationUnderRanged+  | ActivationUnderMelee+  | -- | From here on, all items affected regardless of their `Flag` content.+    ActivationProjectile+  | ActivationTrigger+  | ActivationOnSmash+  | ActivationOnCombine+  | ActivationEmbed+  | ActivationConsume+  deriving (Show, Eq)+ newtype Flags = Flags {flags :: ES.EnumSet Flag}-  deriving (Show, Eq, Ord, Generic, Hashable, Binary)+  deriving (Show, Eq, Ord, Hashable, Binary) --- | Tactic of non-leader actors. Apart of determining AI operation,--- each tactic implies a skill modifier, that is added to the non-leader skills--- defined in @fskillsOther@ field of @Player@.-data Tactic =+-- | Doctrine of non-leader actors. Apart of determining AI operation,+-- each doctrine implies a skill modifier, that is added to the non-leader+-- skills defined in @fskillsOther@ field of @Player@.+data Doctrine =     TExplore  -- ^ if enemy nearby, attack, if no items, etc., explore unknown   | TFollow   -- ^ always follow leader's target or his position if no target   | TFollowNoItems   -- ^ follow but don't do any item management nor use@@ -115,11 +154,11 @@               --   to sight radius and fallback temporarily to @TRoam@               --   when enemy is seen by the faction and is within               --   the actor's sight radius-  deriving (Show, Eq, Ord, Enum, Bounded, Generic)+  deriving (Show, Eq, Enum, Bounded, Generic) -instance Binary Tactic+instance Binary Doctrine -instance Hashable Tactic+instance Hashable Doctrine  -- | AI and UI hints about the role of the item. data EqpSlot =@@ -180,51 +219,53 @@ zeroSkills :: Skills zeroSkills = Skills EM.empty -compactSkills :: EM.EnumMap Skill Int -> EM.EnumMap Skill Int-compactSkills = EM.filter (/= 0)-+-- This avoids costly compaction (required for Eq) even in case of adding+-- empty skills, etc. This function is used a lot. addSkills :: Skills -> Skills -> Skills addSkills (Skills sk1) (Skills sk2) =-  Skills $ compactSkills $ EM.unionWith (+) sk1 sk2+  let combine _ s1 s2 = case s1 + s2 of+        0 -> Nothing+        s -> Just s+  in Skills $ EM.mergeWithKey combine id id sk1 sk2 -scaleSkills :: Int -> EM.EnumMap Skill Int -> EM.EnumMap Skill Int-scaleSkills n = EM.map (n *)+scaleSkills :: Skills -> Int -> Skills+scaleSkills _ 0 = zeroSkills+scaleSkills (Skills sk) n = Skills $ EM.map (n *) sk  sumScaledSkills :: [(Skills, Int)] -> Skills-sumScaledSkills l = Skills $ compactSkills $ EM.unionsWith (+)-                           $ map (\(Skills sk, k) -> scaleSkills k sk) l+sumScaledSkills = foldr addSkills zeroSkills . map (uncurry scaleSkills) -nameTactic :: Tactic -> Text-nameTactic TExplore        = "explore"-nameTactic TFollow         = "follow freely"-nameTactic TFollowNoItems  = "follow only"-nameTactic TMeleeAndRanged = "fight only"-nameTactic TMeleeAdjacent  = "melee only"-nameTactic TBlock          = "block only"-nameTactic TRoam           = "roam freely"-nameTactic TPatrol         = "patrol area"+nameDoctrine :: Doctrine -> Text+nameDoctrine TExplore        = "explore"+nameDoctrine TFollow         = "follow freely"+nameDoctrine TFollowNoItems  = "follow only"+nameDoctrine TMeleeAndRanged = "fight only"+nameDoctrine TMeleeAdjacent  = "melee only"+nameDoctrine TBlock          = "block only"+nameDoctrine TRoam           = "roam freely"+nameDoctrine TPatrol         = "patrol area" -describeTactic :: Tactic -> Text-describeTactic TExplore = "investigate unknown positions, chase targets"-describeTactic TFollow = "follow leader's target or position, grab items"-describeTactic TFollowNoItems =-  "follow leader's target or position, ignore items"-describeTactic TMeleeAndRanged =+describeDoctrine :: Doctrine -> Text+describeDoctrine TExplore = "investigate unknown positions, chase targets"+describeDoctrine TFollow = "follow pointman's target or position, grab items"+describeDoctrine TFollowNoItems =+  "follow pointman's target or position, ignore items"+describeDoctrine TMeleeAndRanged =   "engage in both melee and ranged combat, don't move"-describeTactic TMeleeAdjacent = "engage exclusively in melee, don't move"-describeTactic TBlock = "block and wait, don't move"-describeTactic TRoam = "move freely, chase targets"-describeTactic TPatrol = "find and patrol an area (WIP)"+describeDoctrine TMeleeAdjacent = "engage exclusively in melee, don't move"+describeDoctrine TBlock = "block and wait, don't move"+describeDoctrine TRoam = "move freely, chase targets"+describeDoctrine TPatrol = "find and patrol an area (WIP)" -tacticSkills :: Tactic -> Skills-tacticSkills TExplore = zeroSkills-tacticSkills TFollow = zeroSkills-tacticSkills TFollowNoItems = ignoreItems-tacticSkills TMeleeAndRanged = meleeAndRanged-tacticSkills TMeleeAdjacent = meleeAdjacent-tacticSkills TBlock = blockOnly-tacticSkills TRoam = zeroSkills-tacticSkills TPatrol = zeroSkills+doctrineSkills :: Doctrine -> Skills+doctrineSkills TExplore = zeroSkills+doctrineSkills TFollow = zeroSkills+doctrineSkills TFollowNoItems = ignoreItems+doctrineSkills TMeleeAndRanged = meleeAndRanged+doctrineSkills TMeleeAdjacent = meleeAdjacent+doctrineSkills TBlock = blockOnly+doctrineSkills TRoam = zeroSkills+doctrineSkills TPatrol = zeroSkills  minusTen, blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems :: Skills

definition-src/Game/LambdaHack/Definition/Color.hs view

@@ -1,18 +1,22 @@-{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, MagicHash,-             TypeFamilies #-}+{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, MagicHash #-} -- | Colours and text attributes. module Game.LambdaHack.Definition.Color   ( -- * Colours     Color(..)-  , defFG, isBright, darkCol, brightCol, stdCol, legalFgCol, colorToRGB+  , defFG, isBright, darkCol, brightCol, stdCol, legalFgCol+  , cVeryBadEvent, cBadEvent, cRisk, cGraveRisk, cVeryGoodEvent, cGoodEvent+  , cVista, cSleep, cWakeUp, cGreed, cNeutralEvent, cRareNeutralEvent+  , cIdentification, cMeta, cBoring, cGameOver, cTutorialHint+  , colorToRGB     -- * Complete text attributes   , Highlight (..), Attr(..)   , highlightToColor, defAttr     -- * Characters with attributes   , AttrChar(..), AttrCharW32(..)   , attrCharToW32, attrCharFromW32-  , fgFromW32, bgFromW32, charFromW32, attrFromW32, attrEnumFromW32-  , spaceAttrW32, retAttrW32, attrChar2ToW32, attrChar1ToW32+  , fgFromW32, bgFromW32, charFromW32, attrFromW32+  , spaceAttrW32, nbspAttrW32, spaceCursorAttrW32, trimmedLineAttrW32+  , attrChar2ToW32, attrChar1ToW32   ) where  import Prelude ()@@ -23,8 +27,6 @@ import           Data.Binary import           Data.Bits (unsafeShiftL, unsafeShiftR, (.&.)) import qualified Data.Char as Char-import           Data.Hashable (Hashable)-import           Data.Word (Word32) import           GHC.Exts (Int (I#)) import           GHC.Generics (Generic) import           GHC.Prim (int2Word#)@@ -55,8 +57,6 @@   put = putWord8 . toEnum . fromEnum   get = fmap (toEnum . fromEnum) getWord8 -instance Hashable Color- instance NFData Color  -- | The default colours, to optimize attribute setting.@@ -67,13 +67,36 @@ isBright :: Color -> Bool isBright c = c > BrBlack --- | Colour sets.+-- | Colour sets. Sorted. darkCol, brightCol, stdCol, legalFgCol :: [Color] darkCol = [Red .. Cyan] brightCol = [BrRed .. BrCyan]  -- BrBlack is not really that bright stdCol = darkCol ++ brightCol-legalFgCol = White : BrWhite : BrBlack : stdCol+legalFgCol = darkCol ++ [White, BrBlack] ++ brightCol ++ [BrWhite] +-- See the discussion of colours and the table of colours at+-- https://github.com/LambdaHack/LambdaHack/wiki/Display#colours+-- Another mention of colours, concerning terrain, is in PLAYING.md manual.+-- The manual and this code should follow the wiki.+cVeryBadEvent, cBadEvent, cRisk, cGraveRisk, cVeryGoodEvent, cGoodEvent, cVista, cSleep, cWakeUp, cGreed, cNeutralEvent, cRareNeutralEvent, cIdentification, cMeta, cBoring, cGameOver, cTutorialHint :: Color+cVeryBadEvent = Red+cBadEvent = BrRed+cRisk = Magenta+cGraveRisk = BrMagenta+cVeryGoodEvent = Green+cGoodEvent = BrGreen+cVista = BrGreen+cSleep = Blue+cWakeUp = BrBlue+cGreed = BrBlue+cNeutralEvent = Cyan+cRareNeutralEvent = BrCyan+cIdentification = Brown+cMeta = BrYellow+cBoring = White+cGameOver = BrWhite+cTutorialHint = BrMagenta+ -- | Translationg to heavily modified Linux console color RGB values. -- -- Warning: SDL frontend sadly duplicates this code.@@ -96,26 +119,26 @@ colorToRGB BrCyan    = "#52F4E5" colorToRGB BrWhite   = "#FFFFFF" --- | For reference, the original Linux console colors.--- Good old retro feel and more useful than xterm (e.g. brown).-_olorToRGB :: Color -> Text-_olorToRGB Black     = "#000000"-_olorToRGB Red       = "#AA0000"-_olorToRGB Green     = "#00AA00"-_olorToRGB Brown     = "#AA5500"-_olorToRGB Blue      = "#0000AA"-_olorToRGB Magenta   = "#AA00AA"-_olorToRGB Cyan      = "#00AAAA"-_olorToRGB White     = "#AAAAAA"-_olorToRGB AltWhite  = "#AAAAAA"-_olorToRGB BrBlack   = "#555555"-_olorToRGB BrRed     = "#FF5555"-_olorToRGB BrGreen   = "#55FF55"-_olorToRGB BrYellow  = "#FFFF55"-_olorToRGB BrBlue    = "#5555FF"-_olorToRGB BrMagenta = "#FF55FF"-_olorToRGB BrCyan    = "#55FFFF"-_olorToRGB BrWhite   = "#FFFFFF"+-- -- | For reference, the original Linux console colors.+-- -- Good old retro feel and more useful than xterm (e.g. brown).+-- colorToRGB :: Color -> Text+-- colorToRGB Black     = "#000000"+-- colorToRGB Red       = "#AA0000"+-- colorToRGB Green     = "#00AA00"+-- colorToRGB Brown     = "#AA5500"+-- colorToRGB Blue      = "#0000AA"+-- colorToRGB Magenta   = "#AA00AA"+-- colorToRGB Cyan      = "#00AAAA"+-- colorToRGB White     = "#AAAAAA"+-- colorToRGB AltWhite  = "#AAAAAA"+-- colorToRGB BrBlack   = "#555555"+-- colorToRGB BrRed     = "#FF5555"+-- colorToRGB BrGreen   = "#55FF55"+-- colorToRGB BrYellow  = "#FFFF55"+-- colorToRGB BrBlue    = "#5555FF"+-- colorToRGB BrMagenta = "#FF55FF"+-- colorToRGB BrCyan    = "#55FFFF"+-- colorToRGB BrWhite   = "#FFFFFF"  -- | Additional map cell highlight, e.g., a colorful square around the cell -- or a colorful background.@@ -126,6 +149,8 @@     HighlightNone   | HighlightGreen   | HighlightBlue+  | HighlightBrown+  | HighlightCyan   | HighlightGrey   | HighlightWhite   | HighlightMagenta@@ -134,28 +159,30 @@   | HighlightYellowAim   | HighlightRedAim   | HighlightNoneCursor-  deriving (Show, Eq, Ord, Enum, Bounded, Generic)+  deriving (Show, Eq, Ord, Enum, Bounded)  highlightToColor :: Highlight -> Color highlightToColor hi = case hi of   HighlightNone -> Black  -- should be transparent, but is OK in web frontend   HighlightGreen -> Green   HighlightBlue -> Blue+  HighlightBrown -> Brown+  HighlightCyan -> Cyan   HighlightGrey -> BrBlack-  HighlightWhite -> White  -- bright, but no saturation, so doesn't obscure-  HighlightMagenta -> BrMagenta  -- usually around white, so bright is fine+  HighlightWhite -> White  -- bright, but no saturation, so doesn't obscure much+  HighlightMagenta -> BrMagenta  -- very rare, so bright is fine   HighlightRed -> Red   HighlightYellow -> BrYellow  -- obscures, but mostly used around bright white   HighlightYellowAim -> BrYellow   HighlightRedAim -> Red-  HighlightNoneCursor -> Black+  HighlightNoneCursor -> Black  -- used in vty for cursor via @maxIndexByA@  -- | Text attributes: foreground color and highlight. data Attr = Attr   { fg :: Color      -- ^ foreground colour   , bg :: Highlight  -- ^ highlight   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq)  -- | The default attribute, to optimize attribute setting. defAttr :: Attr@@ -166,7 +193,7 @@   { acAttr :: Attr   , acChar :: Char   }-  deriving (Show, Eq, Ord)+  deriving (Show, Eq)  -- This implementation is faster than @Int@, because some vector updates -- can be done without going to and from @Int@.@@ -200,15 +227,18 @@ {-# INLINE attrFromW32 #-} attrFromW32 w = Attr (fgFromW32 w) (bgFromW32 w) -attrEnumFromW32 :: AttrCharW32 -> Int-{-# INLINE attrEnumFromW32 #-}-attrEnumFromW32 !w = fromEnum $ attrCharW32 w .&. (2 ^ (16 :: Int) - 1)- spaceAttrW32 :: AttrCharW32 spaceAttrW32 = attrCharToW32 $ AttrChar defAttr ' ' -retAttrW32 :: AttrCharW32-retAttrW32 = attrCharToW32 $ AttrChar defAttr '\n'+nbspAttrW32 :: AttrCharW32+nbspAttrW32 = attrCharToW32 $ AttrChar defAttr '\x00a0'++spaceCursorAttrW32 :: AttrCharW32+spaceCursorAttrW32 =+  attrCharToW32 $ AttrChar (defAttr {bg = HighlightNoneCursor}) ' '++trimmedLineAttrW32 :: AttrCharW32+trimmedLineAttrW32 = attrChar2ToW32 BrBlack '$'  attrChar2ToW32 :: Color -> Char -> AttrCharW32 {-# INLINE attrChar2ToW32 #-}

definition-src/Game/LambdaHack/Definition/ContentData.hs view

@@ -21,6 +21,7 @@  import           Data.Function import qualified Data.Map.Strict as M+import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Vector as V @@ -39,21 +40,24 @@  validateRarity :: Rarity -> [Text] validateRarity rarity =-  let sortedRarity = sortOn fst rarity+  -- @SortOn@ less efficient here, because function cheap.+  let sortedRarity = sortBy (comparing fst) rarity   in [ "rarity not sorted" | sortedRarity /= rarity ]      ++ [ "rarity depth thresholds not unique"         | map head (groupBy ((==) `on` fst) sortedRarity) /= sortedRarity ]-     ++ [ "rarity depth not between 0 and 10"-        | case (sortedRarity, reverse sortedRarity) of-            ((lowest, _) : _, (highest, _) : _) ->-              lowest <= 0 || highest > 10+     ++ [ "rarity depth not positive"+        | case sortedRarity of+            ((lowest, _) : _) -> lowest <= 0             _ -> False ]  validFreqs :: Freqs a -> Bool-validFreqs freqs = all ((> 0) . snd) freqs-                   && let groups = sort $ map fst freqs-                      in all (uncurry (/=)) $ zip groups ("" : groups)-                           -- this also catches empty group names+validFreqs freqs =+  -- Greater or equal to 0 permitted, e.g., to cover embedded template UNKNOWN+  -- items not yet identified by the client, but triggerable nevertheless.+  all ((>= 0) . snd) freqs+  && let groups = sort $ map fst freqs+         tailOfGroups = if null groups then groups else tail groups+     in all (uncurry (/=)) $ zip groups tailOfGroups  emptyContentData :: ContentData a emptyContentData = ContentData V.empty M.empty@@ -70,9 +74,12 @@                      -- ^ validate the whole defined content of this type                      -- and list all offence                 -> [c]  -- ^ all content of this type+                -> [GroupName c]  -- ^ singleton group names for this content+                -> [GroupName c]  -- ^ remaining group names for this content                 -> ContentData c {-# INLINE makeContentData #-}-makeContentData contentName getName getFreq validateSingle validateAll content =+makeContentData contentName getName getFreq validateSingle validateAll+                content groupNamesSingleton groupNames =   -- The @force@ is needed for @GHC.Compact@.   let contentVector = V.force $ V.fromList content       groupFreq =@@ -90,7 +97,39 @@                         , not (null offences) ]       allOffences = validateAll content contentData       freqsOffenders = filter (not . validFreqs . getFreq) content-  in assert (null freqsOffenders+      allGroupNamesEmpty = filter (T.null . fromGroupName)+                           $ groupNamesSingleton ++ groupNames+      allGroupNamesTooLong = filter ((> 30) . T.length . fromGroupName)+                             $ groupNamesSingleton ++ groupNames+      allGroupNamesSorted = sort $ groupNamesSingleton ++ groupNames+      allGroupNamesUnique = nub allGroupNamesSorted+      allGroupNamesNonUnique = allGroupNamesSorted \\ allGroupNamesUnique+      missingGroups = filter (not . omemberGroup contentData)+                             (groupNamesSingleton ++ groupNames)+      groupsMoreThanOne = filter (oisMoreThanOneGroup contentData)+                                 groupNamesSingleton+      groupsDeclaredSet = S.fromAscList allGroupNamesUnique+      groupsNotDeclared = filter (`S.notMember` groupsDeclaredSet)+                          $ M.keys groupFreq+  in assert (null allGroupNamesEmpty+             `blame` contentName ++ ": some group names empty"+             `swith` allGroupNamesEmpty) $+     assert (null allGroupNamesTooLong+             `blame` contentName ++ ": some group names too long"+             `swith` allGroupNamesTooLong) $+     assert (null allGroupNamesNonUnique+             `blame` contentName ++ ": some group names duplicated"+             `swith` allGroupNamesNonUnique) $+     assert (null missingGroups+             `blame` contentName ++ ": some group names pertain to no content"+             `swith` missingGroups) $+     assert (null groupsMoreThanOne+             `blame` contentName ++ ": some group names refer to more than one content, while they shouldn't"+             `swith` groupsMoreThanOne) $+     assert (null groupsNotDeclared+             `blame` contentName ++ ": some group names are not included in group name lists, neither singleton nor duplicable"+             `swith` groupsNotDeclared) $+     assert (null freqsOffenders              `blame` contentName ++ ": some Freqs values not valid"              `swith` freqsOffenders) $      assert (null singleOffenders@@ -117,6 +156,12 @@     Just [_] -> True     _ -> False +oisMoreThanOneGroup :: ContentData a -> GroupName a -> Bool+oisMoreThanOneGroup ContentData{groupFreq} cgroup =+  case M.lookup cgroup groupFreq of+    Just (_:_:_) -> True+    _ -> False+ -- | The id of the unique member of a singleton content group. ouniqGroup :: Show a => ContentData a -> GroupName a -> ContentId a ouniqGroup ContentData{groupFreq} !cgroup =@@ -161,7 +206,8 @@ omapVector d f = V.map f $ contentVector d  oimapVector :: ContentData a -> (ContentId a -> a -> b) -> V.Vector b-oimapVector d f = V.imap (\i a -> f (toContentId $ toEnum i) a) $ contentVector d+oimapVector d f = V.imap (\i a -> f (toContentId $ toEnum i) a)+                         (contentVector d)  -- | Size of content @a@. olength :: ContentData a -> Int

definition-src/Game/LambdaHack/Definition/Defs.hs view

@@ -1,25 +1,23 @@-{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TypeFamilies #-}+{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Basic types for content definitions. module Game.LambdaHack.Definition.Defs-  ( X, Y-  , GroupName, toGroupName, fromGroupName+  ( X, Y, GroupName(..)   , Freqs, Rarity, linearInterpolation   , ContentId, toContentId, fromContentId, contentIdIndex   , CStore(..), ppCStore, ppCStoreIn, verbCStore   , SLore(..), ItemDialogMode(..), ppSLore, headingSLore   , ppItemDialogMode, ppItemDialogModeIn, ppItemDialogModeFrom+  , Direction(..)   ) where  import Prelude ()  import Game.LambdaHack.Core.Prelude -import           Control.DeepSeq-import           Data.Binary-import           Data.Hashable-import           Data.String (IsString (..))-import qualified Data.Text as T-import           GHC.Generics (Generic)+import Control.DeepSeq+import Data.Binary+import Data.Hashable+import GHC.Generics (Generic)  -- | X spacial dimension for points and vectors. type X = Int@@ -31,46 +29,68 @@ -- is never serialized. But we'd need to cover the few cases -- (e.g., @litemFreq@) where @GroupName@ goes into savegame. newtype GroupName a = GroupName {fromGroupName :: Text}-  deriving (Show, Eq, Ord, Hashable, Binary, Generic)--instance IsString (GroupName a) where-  fromString = GroupName . T.pack--instance NFData (GroupName a)--toGroupName :: Text -> GroupName a-{-# INLINE toGroupName #-}-toGroupName = GroupName+  deriving (Show, Eq, Ord, Hashable, Binary, NFData)  -- | For each group that the kind belongs to, denoted by a @GroupName@ -- in the first component of a pair, the second component of a pair shows -- how common the kind is within the group. type Freqs a = [(GroupName a, Int)] --- | Rarity on given depths.+-- | Rarity on given depths. The first element of the pair is normally+-- in (0, 10] interval and, e.g., if there are 20 levels, 0.5 represents+-- the first level and 10 the last. Exceptionally, it may be larger than 10,+-- meaning appearance in the dungeon is not possible under normal circumstances+-- and the value remains constant above the interval bound. type Rarity = [(Double, Int)] --- We assume @dataset@ is sorted and between 0 and 10.+-- We assume depths are greater or equal to one and the rarity @dataset@+-- is non-empty, sorted and the first elements of the pairs are positive.+-- The convention for adding implicit outer intervals is that+-- the value increases linearly, starting from 0 at 0. Similarly,+-- if the last interval ends before 10, the value drops linearly,+-- in a way that would reach 0 a step after 10, but staying constant+-- from 10 onward. If the last interval ends after 10, the value stays constant+-- after the interval's upper bound.+--+-- Note that rarity [(1, 1)] means constant value 1 only thanks to @ceiling@.+-- OTOH, [(1, 10)] is not equivalent to [(10/150, 10)] in a 150-deep dungeon,+-- since its value at the first level is drastically lower. This only+-- matters if content creators mix the two notations, so care must be taken+-- in such cases. Otherwise, for any given level, all kinds scale consistently+-- and the simpler notation just paintes the dungeon in larger strokes. linearInterpolation :: Int -> Int -> Rarity -> Int-linearInterpolation !levelDepth !totalDepth !dataset =-  let findInterval :: (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))-      findInterval x1y1 [] = (x1y1, (11, 0))+linearInterpolation !levelDepthInt !totalDepthInt !dataset =+  let levelDepth10 = intToDouble $ levelDepthInt * 10+      totalDepth = intToDouble totalDepthInt+      findInterval :: (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))+      findInterval x1y1@(x1Last, y1Last) [] =  -- we are past the last interval+        let stepLevel = 10 / totalDepth+              -- this is the distance representing one level, the same+              -- as the distance from 0 to the representation of level 1+            yConstant = if x1Last >= 10+                        then y1Last+                        else ceiling (intToDouble y1Last * stepLevel+                                      / (10 + stepLevel - x1Last))+              -- this is the value of the interpolation formula at the end+              -- with y2 == 0, levelDepth10 == totalDepth * 10,+              -- and x2 == 10 + stepLevel+        in if levelDepthInt > totalDepthInt  -- value stays constant+           then ((x1Last, yConstant), (x1Last + 1, yConstant))+                  -- this artificial interval is enough to emulate+                  -- the value staying constant indefinitely+           else (x1y1, (10 + stepLevel, 0))       findInterval !x1y1 ((!x, !y) : rest) =-        if fromIntegral levelDepth * 10 <= x * fromIntegral totalDepth+        if levelDepth10 <= x * totalDepth         then (x1y1, (x, y))         else findInterval (x, y) rest       ((x1, y1), (x2, y2)) = findInterval (0, 0) dataset-  in ceiling-     $ fromIntegral y1-       + fromIntegral (y2 - y1)-         * (fromIntegral levelDepth * 10 - x1 * fromIntegral totalDepth)-         / ((x2 - x1) * fromIntegral totalDepth)+  in y1 + ceiling+            (intToDouble (y2 - y1) * (levelDepth10 - x1 * totalDepth)+             / ((x2 - x1) * totalDepth))  -- | Content identifiers for the content type @c@. newtype ContentId c = ContentId Word16-  deriving (Show, Eq, Ord, Enum, Binary, Generic)--instance Hashable (ContentId c)+  deriving (Show, Eq, Ord, Enum, Hashable, Binary)  toContentId :: Word16 -> ContentId c {-# INLINE toContentId #-}@@ -89,8 +109,7 @@     CGround   | COrgan   | CEqp-  | CInv-  | CSha+  | CStash   deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)  instance Binary CStore@@ -100,19 +119,17 @@ ppCStore :: CStore -> (Text, Text) ppCStore CGround = ("on", "the ground") ppCStore COrgan = ("in", "body")-ppCStore CEqp = ("in", "equipment")-ppCStore CInv = ("in", "pack")  -- "inventory pack" overflows text too easily-ppCStore CSha = ("in", "shared stash")+ppCStore CEqp = ("in", "equipment outfit")+ppCStore CStash = ("in", "shared inventory stash")  ppCStoreIn :: CStore -> Text ppCStoreIn c = let (tIn, t) = ppCStore c in tIn <+> t  verbCStore :: CStore -> Text-verbCStore CGround = "drop"+verbCStore CGround = "remove" verbCStore COrgan = "implant" verbCStore CEqp = "equip"-verbCStore CInv = "pack"-verbCStore CSha = "stash"+verbCStore CStash = "stash"  -- | Item slot and lore categories. data SLore =@@ -134,7 +151,8 @@   | MOwned         -- ^ all party's items   | MSkills        -- ^ not items, but determined by leader's items   | MLore SLore    -- ^ not party's items, but all known generalized items-  | MPlaces        -- ^ not items at all, but definitely a lore+  | MPlaces        -- ^ places; not items at all, but definitely a lore+  | MModes         -- ^ scenarios; not items at all, but definitely a lore   deriving (Show, Read, Eq, Ord, Generic)  instance NFData ItemDialogMode@@ -152,7 +170,7 @@ headingSLore :: SLore -> Text headingSLore SItem = "miscellaneous item" headingSLore SOrgan = "vital anatomic organ"-headingSLore STrunk = "living creature"+headingSLore STrunk = "autonomous entity" headingSLore SCondition = "momentary bodily condition" headingSLore SBlast = "explosion blast particle" headingSLore SEmbed = "landmark feature"@@ -160,13 +178,21 @@ ppItemDialogMode :: ItemDialogMode -> (Text, Text) ppItemDialogMode (MStore cstore) = ppCStore cstore ppItemDialogMode MOrgans = ("in", "body")-ppItemDialogMode MOwned = ("in", "our possession")+ppItemDialogMode MOwned = ("among", "our total team belongings") ppItemDialogMode MSkills = ("among", "skills") ppItemDialogMode (MLore slore) = ("among", ppSLore slore <+> "lore") ppItemDialogMode MPlaces = ("among", "place lore")+ppItemDialogMode MModes = ("among", "adventure lore")  ppItemDialogModeIn :: ItemDialogMode -> Text ppItemDialogModeIn c = let (tIn, t) = ppItemDialogMode c in tIn <+> t  ppItemDialogModeFrom :: ItemDialogMode -> Text ppItemDialogModeFrom c = let (_tIn, t) = ppItemDialogMode c in "from" <+> t++data Direction = Forward | Backward+  deriving (Show, Read, Eq, Ord, Generic)++instance NFData Direction++instance Binary Direction

definition-src/Game/LambdaHack/Definition/Flavour.hs view

@@ -4,7 +4,7 @@   ( -- * The @Flavour@ type     Flavour(Flavour)   , -- * Constructors-    zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy+    zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory   , -- * Accessors     flavourToColor, flavourToName     -- * Assorted@@ -21,12 +21,11 @@  import Data.Binary import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.))-import Data.Hashable (Hashable (hashWithSalt), hashUsing) import GHC.Generics (Generic)  import Game.LambdaHack.Definition.Color -data FancyName = Plain | Fancy | Liquid | GlassPlain | GlassFancy+data FancyName = Plain | Fancy | Liquid | GlassPlain | GlassFancy | Story   deriving (Show, Eq, Ord, Enum, Bounded, Generic)  -- | The type of item flavours.@@ -42,20 +41,18 @@   toEnum n = Flavour (toEnum $ unsafeShiftR n 8)                      (toEnum $ n .&. (2 ^ (8 :: Int) - 1)) -instance Hashable Flavour where-  hashWithSalt = hashUsing fromEnum- instance Binary Flavour where-  put = put . (fromIntegral :: Int -> Word16) . fromEnum-  get = fmap (toEnum . (fromIntegral :: Word16 -> Int)) get+  put = put . (toIntegralCrash :: Int -> Word16) . fromEnum+  get = fmap (toEnum . (intCast :: Word16 -> Int)) get  -- | Turn a colour set into a flavour set.-zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy :: [Color] -> [Flavour]+zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory :: [Color] -> [Flavour] zipPlain = map (Flavour Plain) zipFancy = map (Flavour Fancy) zipLiquid = map (Flavour Liquid) zipGlassPlain = map (Flavour GlassPlain) zipGlassFancy = map (Flavour GlassFancy)+zipStory = map (Flavour Story)  -- | Get the underlying base colour of a flavour. flavourToColor :: Flavour -> Color@@ -70,6 +67,8 @@   colorToGlassPlainName baseColor flavourToName Flavour{fancyName=GlassFancy, ..} =   colorToGlassFancyName baseColor+flavourToName Flavour{fancyName=Story, ..} =+  colorToStoryName baseColor  -- | Human-readable names for item colors. The plain set. colorToPlainName :: Color -> Text@@ -138,6 +137,26 @@ -- | Human-readable names for item colors. The fancy glass set. colorToGlassFancyName :: Color -> Text colorToGlassFancyName color = colorToFancyName color <+> "crystal"++-- | Human-readable names for story item colors.+colorToStoryName :: Color -> Text+colorToStoryName Black     = "unfathomable"+colorToStoryName Red       = "depressing"+colorToStoryName Green     = "confidence-boosting"+colorToStoryName Brown     = "mundane"+colorToStoryName Blue      = "fleeting"+colorToStoryName Magenta   = "complex"+colorToStoryName Cyan      = "wierd"+colorToStoryName White     = "obvious"+colorToStoryName AltWhite  = error "colorToStoryName: illegal color"+colorToStoryName BrBlack   = "inconclusive"+colorToStoryName BrRed     = "troubling"+colorToStoryName BrGreen   = "cherished"+colorToStoryName BrYellow  = "glaring"+colorToStoryName BrBlue    = "profound"+colorToStoryName BrMagenta = "torturous"+colorToStoryName BrCyan    = "peculiar"+colorToStoryName BrWhite   = "explosive"  -- | Simple names for team colors (bright colours preferred). colorToTeamName :: Color -> Text

engine-src/Game/LambdaHack/Atomic.hs view

@@ -8,8 +8,8 @@     -- * Re-exported from "Game.LambdaHack.Atomic.HandleAtomicWrite"   , handleUpdAtomic     -- * Re-exported from "Game.LambdaHack.Atomic.PosAtomicRead"-  , PosAtomic(..), posUpdAtomic, posSfxAtomic, breakUpdAtomic-  , seenAtomicCli, seenAtomicSer+  , PosAtomic(..), posUpdAtomic, posSfxAtomic, iidUpdAtomic, iidSfxAtomic+  , breakUpdAtomic, lidOfPos, seenAtomicCli, seenAtomicSer     -- * Re-exported from "Game.LambdaHack.Atomic.MonadStateWrite"   , MonadStateWrite(..), AtomicFail(..)   ) where

engine-src/Game/LambdaHack/Atomic/CmdAtomic.hs view

@@ -4,8 +4,8 @@ -- -- 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+-- For example item removal from equipment, in isolation, is not an atomic+-- command, but item dropped from equipment 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'). --@@ -20,16 +20,17 @@  import Game.LambdaHack.Core.Prelude +import qualified Data.EnumSet as ES import           Data.Int (Int64)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  -- 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           Game.LambdaHack.Common.Analytics+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA@@ -55,6 +56,8 @@   | SfxAtomic SfxAtomic  -- ^ atomic special effects   deriving Show +-- TODO: needed in the future, if efect, to save undo information:+-- --  deriving (Show, Eq, Generic) -- -- instance Binary CmdAtomic@@ -65,16 +68,17 @@ -- that help clients determine whether and how to communicate it to players. data UpdAtomic =   -- Create/destroy actors and items.-    UpdCreateActor ActorId Actor [(ItemId, Item)]+    UpdRegisterItems [(ItemId, Item)]+  | 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)]+  | UpdCreateItem Bool ItemId Item ItemQuant Container+  | UpdDestroyItem Bool ItemId Item ItemQuant Container+  | UpdSpotActor ActorId Actor+  | UpdLoseActor ActorId Actor+  | UpdSpotItem Bool ItemId ItemQuant Container+  | UpdLoseItem Bool ItemId ItemQuant Container+  | UpdSpotItemBag Bool Container ItemBag+  | UpdLoseItemBag Bool Container ItemBag   -- Move actors and items.   | UpdMoveActor ActorId Point Point   | UpdWaitActor ActorId Watchfulness Watchfulness@@ -87,9 +91,11 @@   -- Change faction attributes.   | UpdQuitFaction FactionId (Maybe Status) (Maybe Status)                    (Maybe (FactionAnalytics, GenerationAnalytics))+  | UpdSpotStashFaction Bool FactionId LevelId Point+  | UpdLoseStashFaction Bool FactionId LevelId Point   | UpdLeadFaction FactionId (Maybe ActorId) (Maybe ActorId)   | UpdDiplFaction FactionId FactionId Diplomacy Diplomacy-  | UpdTacticFaction FactionId Ability.Tactic Ability.Tactic+  | UpdDoctrineFaction FactionId Ability.Doctrine Ability.Doctrine   | UpdAutoFaction FactionId Bool   | UpdRecordKill ActorId (ContentId ItemKind) Int   -- Alter map.@@ -106,10 +112,13 @@   | UpdSpotSmell LevelId [(Point, Time)]   | UpdLoseSmell LevelId [(Point, Time)]   -- Assorted.-  | UpdTimeItem ItemId Container ItemTimer ItemTimer-  | UpdAgeGame [LevelId]-  | UpdUnAgeGame [LevelId]+  | UpdTimeItem ItemId Container ItemTimers ItemTimers+  | UpdAgeGame (ES.EnumSet LevelId)+  | UpdUnAgeGame (ES.EnumSet LevelId)   | UpdDiscover Container ItemId (ContentId ItemKind) IA.AspectRecord+      -- Here and below @Container@ is only used for presentation+      -- and when @CStash@ is not visible, but the item is, it won't+      -- break anything, because item identification is not registered globally.   | UpdCover Container ItemId (ContentId ItemKind) IA.AspectRecord   | UpdDiscoverKind Container ItemKindIx (ContentId ItemKind)   | UpdCoverKind Container ItemKindIx (ContentId ItemKind)@@ -118,38 +127,41 @@   | UpdDiscoverServer ItemId IA.AspectRecord   | UpdCoverServer ItemId IA.AspectRecord   | UpdPerception LevelId Perception Perception-  | UpdRestart FactionId PerLid State Challenge ClientOptions R.StdGen+  | UpdRestart FactionId PerLid State Challenge ClientOptions SM.SMGen   | UpdRestartServer State   | UpdResume FactionId PerLid   | UpdResumeServer State   | UpdKillExit FactionId   | UpdWriteSave-  | UpdHearFid FactionId HearMsg  -- in @UpdAtomic@ to let AI analyze and count+  | UpdHearFid FactionId (Maybe Int) HearMsg+      -- in @UpdAtomic@ to let AI analyze and count   deriving Show  -- | Symbolic representation of text messages about heard noises, -- sent by server to clients and shown to players and used by AI. data HearMsg =-    HearUpd Bool UpdAtomic+    HearUpd UpdAtomic   | HearStrike (ContentId ItemKind)   | HearSummon Bool (GroupName ItemKind) Dice.Dice+  | HearCollideTile   | HearTaunt Text   deriving Show  -- | Abstract syntax of atomic special effects, that is, atomic commands -- that only display special effects and don't change 'State' nor client 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+    SfxStrike ActorId ActorId ItemId+  | SfxRecoil ActorId ActorId ItemId+  | SfxSteal ActorId ActorId ItemId+  | SfxRelease ActorId ActorId ItemId+  | SfxProject ActorId ItemId+  | SfxReceive ActorId ItemId+  | SfxApply ActorId ItemId+  | SfxCheck ActorId ItemId+  | SfxTrigger ActorId LevelId Point (ContentId TileKind)+  | SfxShun ActorId LevelId Point (ContentId TileKind)+  | SfxEffect FactionId ActorId ItemId IK.Effect Int64+  | SfxItemApplied ItemId Container   | SfxMsgFid FactionId SfxMsg   | SfxRestart   | SfxCollideTile ActorId Point@@ -161,8 +173,10 @@ data SfxMsg =     SfxUnexpected ReqFailure   | SfxExpected Text ReqFailure-  | SfxFizzles-  | SfxNothingHappens+  | SfxExpectedEmbed ItemId LevelId ReqFailure+  | SfxFizzles ItemId Container+  | SfxNothingHappens ItemId Container+  | SfxNoItemsForTile [[(Int, GroupName ItemKind)]]   | SfxVoidDetection IK.DetectKind   | SfxUnimpressed ActorId   | SfxSummonLackCalm ActorId@@ -187,35 +201,46 @@   | SfxDupUnique   | SfxDupValuable   | SfxColdFish-  | SfxTimerExtended LevelId ActorId ItemId CStore (Delta Time)-  | SfxCollideActor LevelId ActorId ActorId+  | SfxReadyGoods+  | SfxTimerExtended ActorId ItemId CStore (Delta Time)+      -- This @CStore@ is only printed, so even @CStash@ is safe.+  | SfxCollideActor ActorId ActorId+  | SfxItemYield ItemId Int LevelId   deriving Show  undoUpdAtomic :: UpdAtomic -> Maybe UpdAtomic undoUpdAtomic cmd = case cmd of+  UpdRegisterItems{} -> Nothing  -- harmless and never forgotten   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+  UpdCreateItem verbose iid item k c ->+    Just $ UpdDestroyItem verbose iid item k c+  UpdDestroyItem verbose iid item k c ->+    Just $ UpdCreateItem verbose iid item k c+  UpdSpotActor aid body -> Just $ UpdLoseActor aid body+  UpdLoseActor aid body -> Just $ UpdSpotActor aid body+  UpdSpotItem verbose iid k c -> Just $ UpdLoseItem verbose iid k c+  UpdLoseItem verbose iid k c -> Just $ UpdSpotItem verbose iid k c+  UpdSpotItemBag verbose c bag -> Just $ UpdLoseItemBag verbose c bag+  UpdLoseItemBag verbose c bag -> Just $ UpdSpotItemBag verbose c bag   UpdMoveActor aid fromP toP -> Just $ UpdMoveActor aid toP fromP   UpdWaitActor aid fromWS toWS -> Just $ UpdWaitActor aid toWS fromWS   UpdDisplaceActor source target -> Just $ UpdDisplaceActor target source-  UpdMoveItem iid k aid c1 c2 -> Just $ UpdMoveItem iid k aid c2 c1+  UpdMoveItem iid k aid store1 store2 ->+    Just $ UpdMoveItem iid k aid store2 store1   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 manalytics ->     Just $ UpdQuitFaction fid toSt fromSt manalytics+  UpdSpotStashFaction verbose fid lid pos ->+    Just $ UpdLoseStashFaction verbose fid lid pos+  UpdLoseStashFaction verbose fid lid pos ->+    Just $ UpdSpotStashFaction verbose fid lid pos   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+  UpdDoctrineFaction fid toT fromT -> Just $ UpdDoctrineFaction 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 ->@@ -253,17 +278,18 @@  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+  SfxStrike source target iid -> SfxRecoil source target iid+  SfxRecoil source target iid -> SfxStrike source target iid+  SfxSteal source target iid -> SfxRelease source target iid+  SfxRelease source target iid -> SfxSteal source target iid+  SfxProject aid iid -> SfxReceive aid iid+  SfxReceive aid iid -> SfxProject aid iid+  SfxApply aid iid -> SfxCheck aid iid+  SfxCheck aid iid -> SfxApply aid iid+  SfxTrigger aid lid p tile -> SfxShun aid lid p tile+  SfxShun aid lid p tile -> SfxTrigger aid lid p tile   SfxEffect{} -> cmd  -- not ideal?+  SfxItemApplied{} -> cmd   SfxMsgFid{} -> cmd   SfxRestart -> cmd   SfxCollideTile{} -> cmd

engine-src/Game/LambdaHack/Atomic/HandleAtomicWrite.hs view

@@ -7,15 +7,15 @@   ( handleUpdAtomic #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , updCreateActor, updDestroyActor, updCreateItem, updDestroyItem-  , updSpotItemBag, updLoseItemBag+  , updRegisterItems, 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+  , updTrajectory, updQuitFaction, updSpotStashFaction, updLoseStashFaction+  , updLeadFaction, updDiplFaction, updDoctrineFaction, updAutoFaction+  , updRecordKill, updAlterTile, updAlterExplorable, updSearchTile+  , updSpotTile, updLoseTile, updAlterSmell, updSpotSmell, updLoseSmell+  , updTimeItem, updAgeGame, updUnAgeGame, ageLevel, updDiscover, updCover   , updDiscoverKind, discoverKind, updCoverKind   , updDiscoverAspect, discoverAspect, updCoverAspect   , updDiscoverServer, updCoverServer@@ -28,6 +28,7 @@ import Game.LambdaHack.Core.Prelude  import qualified Data.EnumMap.Strict as EM+import qualified Data.EnumSet as ES import           Data.Int (Int64)  import           Game.LambdaHack.Atomic.CmdAtomic@@ -41,6 +42,8 @@ import           Game.LambdaHack.Common.Level 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@@ -50,8 +53,6 @@ import           Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Content.PlaceKind as PK import           Game.LambdaHack.Content.TileKind (TileKind, unknownId)-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs @@ -72,16 +73,17 @@ -- that can see it, even though not all are able to process it. handleUpdAtomic :: MonadStateWrite m => UpdAtomic -> m () handleUpdAtomic cmd = case cmd of+  UpdRegisterItems ais -> updRegisterItems ais   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+  UpdCreateItem _ iid item kit c -> updCreateItem iid item kit c+  UpdDestroyItem _ iid item kit c -> updDestroyItem iid item kit c+  UpdSpotActor aid body -> updSpotActor aid body+  UpdLoseActor aid body -> updLoseActor aid body+  UpdSpotItem _ iid kit c -> updSpotItem iid kit c+  UpdLoseItem _ iid kit c -> updLoseItem iid kit c+  UpdSpotItemBag _ c bag -> updSpotItemBag c bag+  UpdLoseItemBag _ c bag -> updLoseItemBag c bag   UpdMoveActor aid fromP toP -> updMoveActor aid fromP toP   UpdWaitActor aid fromWS toWS -> updWaitActor aid fromWS toWS   UpdDisplaceActor source target -> updDisplaceActor source target@@ -90,10 +92,12 @@   UpdRefillCalm aid n -> updRefillCalm aid n   UpdTrajectory aid fromT toT -> updTrajectory aid fromT toT   UpdQuitFaction fid fromSt toSt _ -> updQuitFaction fid fromSt toSt+  UpdSpotStashFaction _ fid lid pos -> updSpotStashFaction fid lid pos+  UpdLoseStashFaction _ fid lid pos -> updLoseStashFaction fid lid pos   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+  UpdDoctrineFaction fid toT fromT -> updDoctrineFaction 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@@ -129,11 +133,76 @@   UpdWriteSave -> return ()   UpdHearFid{} -> return () +-- 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.+updRegisterItems :: MonadStateWrite m => [(ItemId, Item)] -> m ()+updRegisterItems 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)+ -- 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+  updRegisterItems ais+  updSpotActor aid body++-- 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)) ()+  updLoseActor aid body++-- Create a few copies of an item that is already registered for the dungeon+-- (in @sitemRev@ field of @StateServer@).+--+-- Number of copies may be zero, when the item is only created as a sample+-- to let the player know what can potentially be genereated in the dungeon.+updCreateItem :: MonadStateWrite m+              => ItemId -> Item -> ItemQuant -> Container -> m ()+updCreateItem iid item kit c = do+  updRegisterItems [(iid, item)]+  updSpotItem iid kit c++-- 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+  -- 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)) ()+  updLoseItem iid kit c++updSpotActor :: MonadStateWrite m => ActorId -> Actor -> m ()+updSpotActor aid body = do   -- 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.@@ -155,21 +224,11 @@   updateLevel (blid body) $ if bproj body                             then updateProjMap (EM.alter g (bpos body))                             else updateBigMap (EM.alter h (bpos body))-  addAis ais   actorMaxSk <- getsState $ maxSkillsFromActor body   modifyState $ updateActorMaxSkills $ EM.insert aid actorMaxSk --- 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)) ()+updLoseActor :: MonadStateWrite m => ActorId -> Actor ->  m ()+updLoseActor aid body = do   -- 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"@@ -197,15 +256,9 @@                             else updateBigMap (EM.alter h (bpos body))   modifyState $ updateActorMaxSkills $ EM.delete aid --- Create a few copies of an item that is already registered for the dungeon--- (in @sitemRev@ field of @StateServer@).------ Number of copies may be zero, when the item is only created as a sample--- to let the player know what can potentially be genereated in the dungeon.-updCreateItem :: MonadStateWrite m-              => ItemId -> Item -> ItemQuant -> Container -> m ()-updCreateItem iid item kit@(k, _) c = do-  addAis [(iid, item)]+updSpotItem :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m ()+updSpotItem iid kit@(k, _) c = do+  item <- getsState $ getItemBody iid   when (k > 0) $ do     insertItemContainer iid kit c     case c of@@ -213,58 +266,40 @@                           $ addItemToActorMaxSkills 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+updLoseItem :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m ()+updLoseItem iid kit@(k, _) c = assert (k > 0) $ do+  item <- getsState $ getItemBody iid   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])                         $ addItemToActorMaxSkills iid item (-k) aid     _ -> return () -updSpotItemBag :: MonadStateWrite m-               => Container -> ItemBag -> [(ItemId, Item)] -> m ()-updSpotItemBag c bag ais = do-  addAis ais+updSpotItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()+updSpotItemBag c bag =   -- The case of empty bag is for a hack to help identifying sample items.   when (not $ EM.null bag) $ do-    let !_A = assert (EM.size bag == length ais) ()     insertBagContainer bag c     case c of       CActor aid store ->-        when (store `elem` [CEqp, COrgan]) $+        when (store `elem` [CEqp, COrgan]) $ do+          itemD <- getsState sitemD+          let ais = map (\iid -> (iid, itemD EM.! iid)) $ EM.keys bag           forM_ ais $ \(iid, item) ->             addItemToActorMaxSkills 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+updLoseItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()+updLoseItemBag c bag = assert (EM.size bag > 0) $ 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]) $+      when (store `elem` [CEqp, COrgan]) $ do+        itemD <- getsState sitemD+        let ais = map (\iid -> (iid, itemD EM.! iid)) $ EM.keys bag         forM_ ais $ \(iid, item) ->           addItemToActorMaxSkills iid item (- (fst $ bag EM.! iid)) aid     _ -> return ()@@ -387,6 +422,28 @@   let adj fa = fa {gquit = toSt}   updateFaction fid adj +updSpotStashFaction :: MonadStateWrite m+                    => FactionId -> LevelId -> Point -> m ()+updSpotStashFaction fid lid pos = do+  let adj fa = fa {gstash = Just (lid, pos)}+    -- the stash may be outdated, but not empty and it's correct,+    -- because we know stash may be only one, so here it's added,+    -- the old one is removed, despite us not seeing its location;+    -- warning: in this form, this is not reversible, no undo,+    -- so we'd need to add the required @UpdLoseStashFaction@+    -- elsehwere, similarly as @LoseTile@ is added when FOV+    -- reveals that tile is different than expected+  updateFaction fid adj++updLoseStashFaction :: MonadStateWrite m+                    => FactionId -> LevelId -> Point -> m ()+updLoseStashFaction fid lid pos = do+  let adj fa = assert (gstash fa == Just (lid, pos)+                       `blame` "unexpected lack of gstash"+                       `swith` (fid, lid, pos, fa))+               $ fa {gstash = Nothing}+  updateFaction fid adj+ -- The previous leader is assumed to be alive. updLeadFaction :: MonadStateWrite m                => FactionId@@ -412,21 +469,22 @@   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 !_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 -> Ability.Tactic -> Ability.Tactic -> m ()-updTacticFaction fid toT fromT = do+updDoctrineFaction :: MonadStateWrite m+                   => FactionId -> Ability.Doctrine -> Ability.Doctrine -> m ()+updDoctrineFaction fid toT fromT = do   let adj fact =         let player = gplayer fact-        in assert (ftactic player == fromT)-           $ fact {gplayer = player {ftactic = toT}}+        in assert (fdoctrine player == fromT)+           $ fact {gplayer = player {fdoctrine = toT}}   updateFaction fid adj  updAutoFaction :: MonadStateWrite m => FactionId -> Bool -> m ()@@ -466,14 +524,14 @@   lvl <- getLevel lid   let t = lvl `at` p   if t /= fromTile-  then atomicFail "tile to alter is different than assumed"+  then atomicFail "terrain to modify 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}+      (False, True) -> updateLevel lid $ \lvl2 -> lvl2 {lseen = lseen lvl2 + 1}+      (True, False) -> updateLevel lid $ \lvl2 -> lvl2 {lseen = lseen lvl2 - 1}       _ -> return ()  updAlterExplorable :: MonadStateWrite m => LevelId -> Int -> m ()@@ -507,7 +565,8 @@ 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+      adj tileMap = assert (allB (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}@@ -521,7 +580,8 @@   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+      adj tileMap = assert (allB (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}@@ -576,26 +636,27 @@   updateLevel lid $ updateSmell upd  updTimeItem :: MonadStateWrite m-            => ItemId -> Container -> ItemTimer -> ItemTimer+            => ItemId -> Container -> ItemTimers -> ItemTimers             -> 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)) ()+      let !_A1 = assert (fromIt == it `blame` (k, it, iid, c, fromIt, toIt)) ()+          !_A2 = assert (length toIt <= k `blame` (k, toIt, iid, c, fromIt)) ()       deleteItemContainer iid (k, fromIt) c       insertItemContainer iid (k, toIt) c     Nothing -> error $ "" `showFailure` (bag, iid, c, fromIt, toIt) -updAgeGame :: MonadStateWrite m => [LevelId] -> m ()+updAgeGame :: MonadStateWrite m => ES.EnumSet LevelId -> m () updAgeGame lids = do   modifyState $ updateTime $ flip timeShift (Delta timeClip)-  mapM_ (ageLevel (Delta timeClip)) lids+  mapM_ (ageLevel (Delta timeClip)) $ ES.elems lids -updUnAgeGame :: MonadStateWrite m => [LevelId] -> m ()+updUnAgeGame :: MonadStateWrite m => ES.EnumSet LevelId -> m () updUnAgeGame lids = do   modifyState $ updateTime $ flip timeShift (timeDeltaReverse $ Delta timeClip)-  mapM_ (ageLevel (timeDeltaReverse $ Delta timeClip)) lids+  mapM_ (ageLevel (timeDeltaReverse $ Delta timeClip)) $ ES.elems lids  ageLevel :: MonadStateWrite m => Delta Time -> LevelId -> m () ageLevel delta lid =@@ -688,11 +749,14 @@     assert (discoAspect1 EM.! iid == arItem)     $ EM.delete iid discoAspect1 +-- This is ever run only on clients. updRestart :: MonadStateWrite m => State -> m () updRestart = putState +-- This is ever run only on the server. updRestartServer :: MonadStateWrite m => State -> m () updRestartServer = putState +-- This is ever run only on the server. updResumeServer :: MonadStateWrite m => State -> m () updResumeServer = putState

engine-src/Game/LambdaHack/Atomic/MonadStateWrite.hs view

@@ -5,13 +5,13 @@   , moveActorMap, swapActorMap   , insertBagContainer, insertItemContainer, insertItemActor   , deleteBagContainer, deleteItemContainer, deleteItemActor-  , addAis, itemsMatch, addItemToActorMaxSkills, resetActorMaxSkills+  , itemsMatch, addItemToActorMaxSkills, resetActorMaxSkills #ifdef EXPOSE_INTERNAL     -- * Internal operations   , insertItemFloor, insertItemEmbed-  , insertItemOrgan, insertItemEqp, insertItemInv, insertItemSha+  , insertItemOrgan, insertItemEqp, insertItemStash   , deleteItemFloor, deleteItemEmbed-  , deleteItemOrgan, deleteItemEqp, deleteItemInv, deleteItemSha+  , deleteItemOrgan, deleteItemEqp, deleteItemStash   , rmFromBag #endif   ) where@@ -22,7 +22,6 @@  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@@ -32,9 +31,9 @@ import qualified Game.LambdaHack.Common.ItemAspect as IA import           Game.LambdaHack.Common.Level import           Game.LambdaHack.Common.MonadStateRead+import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.State import           Game.LambdaHack.Common.Types-import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs @@ -67,7 +66,7 @@ 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.+-- perhaps it's applied automatically. updateActor :: MonadStateWrite m => ActorId -> (Actor -> Actor) -> m () updateActor aid f = do   let alt Nothing = error $ "no body to update" `showFailure` aid@@ -181,48 +180,51 @@     insertItemFloor iid kit (blid b) (bpos b)   COrgan -> insertItemOrgan iid kit aid   CEqp -> insertItemEqp iid kit aid-  CInv -> insertItemInv iid kit aid-  CSha -> do+  CStash -> do     b <- getsState $ getActorBody aid-    insertItemSha iid kit (bfid b)+    insertItemStash iid kit (bfid b) -insertItemOrgan :: MonadStateWrite m-                => ItemId -> ItemQuant -> ActorId -> m ()-insertItemOrgan iid kit aid = do+-- We assume @Meleeable@ and @Benign@ are never secret and so we don't need+-- to fix the weapon counts when the item is identified later on.+insertItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()+insertItemOrgan iid kit@(k, _) aid = do   arItem <- getsState $ aspectRecordFromIid iid   let bag = EM.singleton iid kit       upd = EM.unionWith mergeItemQuant bag   updateActor aid $ \b ->     b { borgan = upd (borgan b)       , bweapon = if IA.checkFlag Ability.Meleeable arItem-                  then bweapon b + 1-                  else bweapon b }+                  then bweapon b + k+                  else bweapon b+      , bweapBenign = if IA.checkFlag Ability.Meleeable arItem+                         && IA.checkFlag Ability.Benign arItem+                      then bweapBenign b + k+                      else bweapBenign b } -insertItemEqp :: MonadStateWrite m-              => ItemId -> ItemQuant -> ActorId -> m ()-insertItemEqp iid kit aid = do+insertItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()+insertItemEqp iid kit@(k, _) aid = do   arItem <- getsState $ aspectRecordFromIid iid   let bag = EM.singleton iid kit       upd = EM.unionWith mergeItemQuant bag   updateActor aid $ \b ->     b { beqp = upd (beqp b)       , bweapon = if IA.checkFlag Ability.Meleeable arItem-                  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)}+                  then bweapon b + k+                  else bweapon b+      , bweapBenign = if IA.checkFlag Ability.Meleeable arItem+                         && IA.checkFlag Ability.Benign arItem+                      then bweapBenign b + k+                      else bweapBenign 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)}+insertItemStash :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()+insertItemStash iid kit fid = do+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! fid+  case mstash of+    Just (lid, pos) -> insertItemFloor iid kit lid pos+      -- can't be inserted into outdated or unseen stash position,+      -- because such commands are visible only when the stash position is+      -- and so @gstash@ points at the correct one, thanks to @atomicRemember@+    Nothing -> error $ "" `showFailure` (iid, kit, fid)  deleteBagContainer :: MonadStateWrite m                    => ItemBag -> Container -> m ()@@ -278,36 +280,45 @@     deleteItemFloor iid kit (blid b) (bpos b)   COrgan -> deleteItemOrgan iid kit aid   CEqp -> deleteItemEqp iid kit aid-  CInv -> deleteItemInv iid kit aid-  CSha -> do+  CStash -> do     b <- getsState $ getActorBody aid-    deleteItemSha iid kit (bfid b)+    deleteItemStash iid kit (bfid b)  deleteItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()-deleteItemOrgan iid kit aid = do+deleteItemOrgan iid kit@(k, _) aid = do   arItem <- getsState $ aspectRecordFromIid iid   updateActor aid $ \b ->     b { borgan = rmFromBag kit iid (borgan b)       , bweapon = if IA.checkFlag Ability.Meleeable arItem-                  then bweapon b - 1-                  else bweapon b }+                  then bweapon b - k+                  else bweapon b+      , bweapBenign = if IA.checkFlag Ability.Meleeable arItem+                         && IA.checkFlag Ability.Benign arItem+                      then bweapBenign b - k+                      else bweapBenign b }  deleteItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m ()-deleteItemEqp iid kit aid = do+deleteItemEqp iid kit@(k, _) aid = do   arItem <- getsState $ aspectRecordFromIid iid   updateActor aid $ \b ->     b { beqp = rmFromBag kit iid (beqp b)       , bweapon = if IA.checkFlag Ability.Meleeable arItem-                  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)}+                  then bweapon b - k+                  else bweapon b+      , bweapBenign = if IA.checkFlag Ability.Meleeable arItem+                         && IA.checkFlag Ability.Benign arItem+                      then bweapBenign b - k+                      else bweapBenign b } -deleteItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()-deleteItemSha iid kit fid =-  updateFaction fid $ \fact -> fact {gsha = rmFromBag kit iid (gsha fact)}+deleteItemStash :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m ()+deleteItemStash iid kit fid = do+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! fid+  case mstash of+    Just (lid, pos) -> deleteItemFloor iid kit lid pos+      -- can't be deleted from an outdated or unseen stash position,+      -- because such commands are visible only when the stash position is+      -- and so @gstash@ points at the correct one, thanks to @atomicRemember@+    Nothing -> error $ "" `showFailure` (iid, kit, fid)  -- Removing the part of the kit from the back of the list, -- so that @DestroyItem kit (CreateItem kit x) == x@.@@ -323,24 +334,6 @@                         `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 =

engine-src/Game/LambdaHack/Atomic/PosAtomicRead.hs view

@@ -4,11 +4,12 @@ -- See -- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>. module Game.LambdaHack.Atomic.PosAtomicRead-  ( PosAtomic(..), posUpdAtomic, posSfxAtomic-  , breakUpdAtomic, seenAtomicCli, seenAtomicSer+  ( PosAtomic(..), posUpdAtomic, posSfxAtomic, iidUpdAtomic, iidSfxAtomic+  , breakUpdAtomic, lidOfPos, seenAtomicCli, seenAtomicSer #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , posProjBody, singleAid, doubleAid, singleContainer+  , pointsProjBody, posProjBody, singleAid, doubleAid+  , singleContainerStash, singleContainerActor #endif   ) where @@ -40,12 +41,13 @@ -- seeing (and we assume smelling actors get lots of data from smells). data PosAtomic =     PosSight LevelId [Point]    -- ^ whomever sees all the positions, notices-  | PosFidAndSight [FactionId] LevelId [Point]+  | PosFidAndSight FactionId LevelId [Point]                                 -- ^ observers and the faction notice   | PosSmell LevelId [Point]    -- ^ whomever smells all the positions, notices+  | PosSightLevels [(LevelId, Point)]+                                -- ^ whomever sees all the positions, notices   | PosFid FactionId            -- ^ only the faction notices, server doesn't-  | PosFidAndSer (Maybe LevelId) FactionId-                                -- ^ faction and server notices+  | PosFidAndSer FactionId      -- ^ faction and server notices   | PosSer                      -- ^ only the server notices   | PosAll                      -- ^ everybody notices   | PosNone                     -- ^ never broadcasted, but sent manually@@ -77,36 +79,41 @@ -- contradict state) if the visibility is lower. posUpdAtomic :: MonadStateRead m => UpdAtomic -> m PosAtomic posUpdAtomic cmd = case cmd of+  UpdRegisterItems{} -> return PosNone   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+  UpdCreateItem _ _ _ _ c -> singleContainerStash c+  UpdDestroyItem _ _ _ _ c -> singleContainerStash c+  UpdSpotActor _ body -> return $! posProjBody body+  UpdLoseActor _ body -> return $! posProjBody body+  UpdSpotItem _ _ _ c -> singleContainerStash c+  UpdLoseItem _ _ _ c -> singleContainerStash c+  UpdSpotItemBag _ c _ -> singleContainerStash c+  UpdLoseItemBag _ c _ -> singleContainerStash c   UpdMoveActor aid fromP toP -> do     b <- getsState $ getActorBody aid-    -- Non-projectile actors are never totally isolated from envirnoment;+    -- Non-projectile actors are never totally isolated from environment;     -- they hear, feel air movement, etc.-    return $! if bproj b-              then PosSight (blid b) [fromP, toP]-              else PosFidAndSight [bfid b] (blid b) [fromP, toP]+    return $! pointsProjBody 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+  UpdMoveItem _ _ aid cstore1 cstore2 -> do+    b <- getsState $ getActorBody aid+    mlidPos1 <- lidPosOfStash b cstore1+    mlidPos2 <- lidPosOfStash b cstore2+    let mlidPos = mlidPos1 `mplus` mlidPos2+    return $! maybe (posProjBody b)+                    (\lidPos -> PosSightLevels [lidPos, (blid b, bpos b)])+                    mlidPos   UpdRefillHP aid _ -> singleAid aid   UpdRefillCalm aid _ -> singleAid aid   UpdTrajectory aid _ _ -> singleAid aid   UpdQuitFaction{} -> return PosAll-  UpdLeadFaction fid _ _ -> return $ PosFidAndSer Nothing fid+  UpdSpotStashFaction _ fid lid pos -> return $! PosFidAndSight fid lid [pos]+  UpdLoseStashFaction _ fid lid pos -> return $! PosFidAndSight fid lid [pos]+  UpdLeadFaction fid _ _ -> return $! PosFidAndSer fid   UpdDiplFaction{} -> return PosAll-  UpdTacticFaction fid _ _ -> return $! PosFidAndSer Nothing fid+  UpdDoctrineFaction fid _ _ -> return $! PosFidAndSer fid   UpdAutoFaction{} -> return PosAll   UpdRecordKill aid _ _ -> singleAid aid   UpdAlterTile lid p _ _ -> return $! PosSight lid [p]@@ -116,10 +123,10 @@   UpdAlterGold{} -> return PosAll   UpdSearchTile aid p _ -> do     b <- getsState $ getActorBody aid-    return $! PosFidAndSight [bfid b] (blid b) [bpos b, p]+    return $! pointsProjBody b [bpos b, p]   UpdHideTile aid p _ -> do     b <- getsState $ getActorBody aid-    return $! PosFidAndSight [bfid b] (blid b) [bpos b, p]+    return $! pointsProjBody b [bpos b, p]   UpdSpotTile lid ts -> do     let ps = map fst ts     return $! PosSight lid ps@@ -139,15 +146,19 @@   UpdLoseSmell lid sms -> do     let ps = map fst sms     return $! PosSmell lid ps-  UpdTimeItem _ c _ _ -> singleContainer c+  UpdTimeItem _ c _ _ -> singleContainerStash 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+  UpdDiscover c _ _ _ -> singleContainerActor c+    -- This implies other factions applying items from their inventory,+    -- when we can't see the position of the stash, won't Id the item+    -- for us, even when notice item usage. Thrown items will Id, though,+    -- just as triggering items from the floor or embedded items.+  UpdCover c _ _ _ -> singleContainerActor c+  UpdDiscoverKind c _ _ -> singleContainerActor c+  UpdCoverKind c _ _ -> singleContainerActor c+  UpdDiscoverAspect c _ _ -> singleContainerActor c+  UpdCoverAspect c _ _ -> singleContainerActor c   UpdDiscoverServer{} -> return PosSer   UpdCoverServer{} -> return PosSer   UpdPerception{} -> return PosNone@@ -157,45 +168,123 @@   UpdResumeServer _ -> return PosSer   UpdKillExit fid -> return $! PosFid fid   UpdWriteSave -> return PosAll-  UpdHearFid fid _ -> return $! PosFid fid+  UpdHearFid fid _ _ -> return $! PosFid fid  -- | 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+  SfxStrike _ target _ -> singleAid target+  SfxRecoil _ target _ -> singleAid target+  SfxSteal _ target _ -> singleAid target+  SfxRelease _ target _ -> singleAid target+  SfxProject aid _ -> singleAid aid+  SfxReceive aid _ -> singleAid aid+  SfxApply aid _ -> singleAid aid+  SfxCheck aid _ -> singleAid aid+  SfxTrigger aid lid 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+    return $! PosSightLevels [(lid, p), (blid body, bpos body)]+      -- @PosFidAndSightLevels@ would be better, but no big deal+  SfxShun aid lid 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+    return $! PosSightLevels [(lid, p), (blid body, bpos body)]+  SfxEffect _ aid _ _ _ -> singleAid aid  -- sometimes we don't see source, OK+  SfxItemApplied _ c -> singleContainerActor c   SfxMsgFid fid _ -> return $! PosFid fid   SfxRestart -> return PosAll   SfxCollideTile aid _ -> singleAid aid   SfxTaunt _ aid -> singleAid aid -posProjBody :: Actor -> PosAtomic-posProjBody body =+-- | All items introduced by the atomic command, to be used in it.+iidUpdAtomic :: UpdAtomic -> [ItemId]+iidUpdAtomic cmd = case cmd of+  UpdRegisterItems{} -> []+  UpdCreateActor{} -> []  -- iids and items needed even on server+  UpdDestroyActor{} -> []+  UpdCreateItem{} -> []+  UpdDestroyItem{} -> []+  UpdSpotActor _ body -> getCarriedIidsAndTrunk body+  UpdLoseActor{} -> []  -- already seen, so items known+  UpdSpotItem _ iid _ _ -> [iid]+  UpdLoseItem{} -> []+  UpdSpotItemBag _ _ bag -> EM.keys bag+  UpdLoseItemBag{} -> []+  UpdMoveActor{} -> []+  UpdWaitActor{} -> []+  UpdDisplaceActor{} -> []+  UpdMoveItem{} -> []+  UpdRefillHP{} -> []+  UpdRefillCalm{} -> []+  UpdTrajectory{} -> []+  UpdQuitFaction{} -> []+  UpdSpotStashFaction{} -> []+  UpdLoseStashFaction{} -> []+  UpdLeadFaction{} -> []+  UpdDiplFaction{} -> []+  UpdDoctrineFaction{} -> []+  UpdAutoFaction{} -> []+  UpdRecordKill{} -> []+  UpdAlterTile{} -> []+  UpdAlterExplorable{} -> []+  UpdAlterGold{} -> []+  UpdSearchTile{} -> []+  UpdHideTile{} -> []+  UpdSpotTile{} -> []+  UpdLoseTile{} -> []+  UpdSpotEntry{} -> []+  UpdLoseEntry{} -> []+  UpdAlterSmell{} -> []+  UpdSpotSmell{} -> []+  UpdLoseSmell{} -> []+  UpdTimeItem iid _ _ _ -> [iid]+  UpdAgeGame{} -> []+  UpdUnAgeGame{} -> []+  UpdDiscover _ iid _ _ -> [iid]+  UpdCover _ iid _ _ -> [iid]+  UpdDiscoverKind{} -> []+  UpdCoverKind{} -> []+  UpdDiscoverAspect _ iid _ -> [iid]+  UpdCoverAspect _ iid _ -> [iid]+  UpdDiscoverServer{} -> []  -- never sent to clients+  UpdCoverServer{} -> []+  UpdPerception{} -> []+  UpdRestart{} -> []+  UpdRestartServer{} -> []+  UpdResume{} -> []+  UpdResumeServer{} -> []+  UpdKillExit{} -> []+  UpdWriteSave -> []+  UpdHearFid{} -> []++-- | All items introduced by the atomic special effect, to be used in it.+iidSfxAtomic :: SfxAtomic -> [ItemId]+iidSfxAtomic cmd = case cmd of+  SfxStrike _ _ iid -> [iid]+  SfxRecoil _ _ iid -> [iid]+  SfxSteal _ _ iid -> [iid]+  SfxRelease _ _ iid -> [iid]+  SfxProject _ iid -> [iid]+  SfxReceive _ iid -> [iid]+  SfxApply _ iid -> [iid]+  SfxCheck _ iid -> [iid]+  SfxTrigger{} -> []+  SfxShun{} -> []+  SfxEffect{} -> []+  SfxItemApplied iid _ -> [iid]+  SfxMsgFid{} -> []+  SfxRestart{} -> []+  SfxCollideTile{} -> []+  SfxTaunt{} -> []++pointsProjBody :: Actor -> [Point] -> PosAtomic+pointsProjBody body ps =   if bproj body-  then PosSight (blid body) [bpos body]-  else PosFidAndSight [bfid body] (blid body) [bpos body]+  then PosSight (blid body) ps+  else PosFidAndSight (bfid body) (blid body) ps +posProjBody :: Actor -> PosAtomic+posProjBody body = pointsProjBody body [bpos body]+ singleAid :: MonadStateRead m => ActorId -> m PosAtomic singleAid aid = do   body <- getsState $ getActorBody aid@@ -209,16 +298,42 @@   -- 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+singleContainerStash :: MonadStateRead m => Container -> m PosAtomic+singleContainerStash (CFloor lid p) = return $! PosSight lid [p]+singleContainerStash (CEmbed lid p) = return $! PosSight lid [p]+singleContainerStash (CActor aid cstore) = do   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]+  mlidPos <- lidPosOfStash b cstore+  return $! maybe (posProjBody b)+                  (\lidPos -> PosSightLevels [lidPos, (blid b, bpos b)])+                    -- the actor's position is needed so that a message+                    -- about the actor is not sent to a client that doesn't+                    -- know the actor; actor's faction is ignored, because+                    -- for these operations actor doesn't vanish+                  mlidPos+singleContainerStash (CTrunk fid lid p) = return $! PosFidAndSight fid lid [p] +singleContainerActor :: MonadStateRead m => Container -> m PosAtomic+singleContainerActor (CFloor lid p) = return $! PosSight lid [p]+singleContainerActor (CEmbed lid p) = return $! PosSight lid [p]+singleContainerActor (CActor aid _) = do+  b <- getsState $ getActorBody aid+  return $! posProjBody b+    -- stash position is ignored, because for these operations, nothing+    -- is added to that position; the store name is only used for flavour text+singleContainerActor (CTrunk fid lid p) = return $! PosFidAndSight fid lid [p]++lidPosOfStash :: MonadStateRead m+              => Actor -> CStore -> m (Maybe (LevelId, Point))+lidPosOfStash b cstore =+  case cstore of+    CStash -> do+      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+      case mstash of+        Just{} -> return mstash+        Nothing -> error $ "manipulating void stash" `showFailure` b+    _ -> return Nothing+ -- | 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.@@ -230,20 +345,75 @@ -- This is computed in server's @State@ from before performing the command. breakUpdAtomic :: MonadStateRead m => UpdAtomic -> m [UpdAtomic] breakUpdAtomic cmd = case cmd of+  UpdCreateItem verbose iid item kit (CActor aid CStash) -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) ->+        return [UpdCreateItem verbose iid item kit (CFloor lid pos)]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, item)+  UpdDestroyItem verbose iid item kit (CActor aid CStash) -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) ->+        return [UpdDestroyItem verbose iid item kit (CFloor lid pos)]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, item)+  UpdSpotItem verbose iid kit (CActor aid CStash) -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [UpdSpotItem verbose iid kit (CFloor lid pos)]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)+  UpdLoseItem verbose iid kit (CActor aid CStash) -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [UpdLoseItem verbose iid kit (CFloor lid pos)]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)+  UpdSpotItemBag verbose (CActor aid CStash) bag -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [UpdSpotItemBag verbose (CFloor lid pos) bag]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, bag)+  UpdLoseItemBag verbose (CActor aid CStash) bag -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [UpdLoseItemBag verbose (CFloor lid pos) bag]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, bag)+  UpdMoveItem iid k aid CStash store2 -> do+    b <- getsState $ getActorBody aid+    bag <- getsState $ getBodyStoreBag b CStash+    let (k1, it1) = bag EM.! iid+        kit = assert (k <= k1) (k, take k it1)+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [ UpdLoseItem True iid kit (CFloor lid pos)+                                , UpdSpotItem True iid kit (CActor aid store2) ]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)+  UpdMoveItem iid k aid store1 CStash -> do+    b <- getsState $ getActorBody aid+    bag <- getsState $ getBodyStoreBag b store1+    let (k1, it1) = bag EM.! iid+        kit = assert (k <= k1) (k, take k it1)+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [ UpdLoseItem True iid kit (CActor aid store1)+                                , UpdSpotItem True iid kit (CFloor lid pos) ]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)   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 and no other commands     -- may be inserted between the two below, so the leader doesn't     -- need to be updated, even when aid is the leader.     b <- getsState $ getActorBody aid-    ais <- getsState $ getCarriedAssocsAndTrunk b-    return [ UpdLoseActor aid b ais-           , UpdSpotActor aid b {bpos = toP, boldpos = Just fromP} ais ]+    return [ UpdLoseActor aid b+           , UpdSpotActor aid b {bpos = toP, boldpos = Just fromP} ]   UpdDisplaceActor source target -> do     sb <- getsState $ getActorBody source-    sais <- getsState $ getCarriedAssocsAndTrunk sb     tb <- getsState $ getActorBody target-    tais <- getsState $ getCarriedAssocsAndTrunk tb     -- The order ensures the invariant that no two big actors occupy the same     -- position is maintained. The actions about leadership are required     -- to keep faction data (identify of the leader) consistent with actor@@ -258,33 +428,57 @@              | Just source == msleader ]              ++ [ UpdLeadFaction (bfid tb) mtleader Nothing                 | Just target == mtleader ]-             ++ [ UpdLoseActor source sb sais-                , UpdLoseActor target tb tais+             ++ [ UpdLoseActor source sb+                , UpdLoseActor target tb                 , UpdSpotActor source sb { bpos = bpos tb-                                         , boldpos = Just $ bpos sb } sais+                                         , boldpos = Just $ bpos sb }                 , UpdSpotActor target tb { bpos = bpos sb-                                         , boldpos = Just $ bpos tb } tais-                ]+                                         , boldpos = Just $ bpos tb } ]              ++ [ UpdLeadFaction (bfid sb) Nothing msleader                 | Just source == msleader ]              ++ [ UpdLeadFaction (bfid tb) Nothing mtleader                 | Just target == mtleader ]+  UpdTimeItem iid (CActor aid CStash) fromIt toIt -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> return [UpdTimeItem iid (CFloor lid pos) fromIt toIt]+      Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)   _ -> return [] +-- | What is the main map level the @PosAtomic@ refers to, if any.+lidOfPos :: PosAtomic -> Maybe LevelId+lidOfPos posAtomic =+  case posAtomic of+    PosSight lid _ -> Just lid+    PosFidAndSight _ lid _ -> Just lid+    PosSmell lid _ -> Just lid+    PosSightLevels [] -> Nothing+    PosSightLevels ((lid, _) : _) -> Just lid+    PosFid{} -> Nothing+    PosFidAndSer{} -> Nothing+    PosSer -> Nothing+    PosAll -> Nothing+    PosNone -> Nothing+ -- | 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+seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool+seenAtomicCli knowEvents fid perLid posAtomic =+  let per = (perLid EM.!)+  in case posAtomic of+    PosSight lid ps -> all (`ES.member` totalVisible (per lid)) ps || knowEvents+    PosFidAndSight fid2 lid ps ->+      fid == fid2 || all (`ES.member` totalVisible (per lid)) ps || knowEvents+    PosSmell lid ps -> all (`ES.member` totalSmelled (per lid)) ps || knowEvents+    PosSightLevels l ->+      let visible (lid, pos) = pos `ES.member` totalVisible (per lid)+      in all visible l || knowEvents     PosFid fid2 -> fid == fid2-    PosFidAndSer _ fid2 -> fid == fid2+    PosFidAndSer fid2 -> fid == fid2     PosSer -> False     PosAll -> True-    PosNone -> error $ "no position possible" `showFailure` fid+    PosNone -> False  -- | Determine whether the server would see a command that has -- the given visibilty conditions.

engine-src/Game/LambdaHack/Client.hs view

@@ -12,8 +12,6 @@   , 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"   , CCUI   , UIOptions, applyUIOptions, uCmdline, mkUIOptions@@ -21,7 +19,6 @@  import Prelude () -import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.LoopM import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.Response

engine-src/Game/LambdaHack/Client/AI.hs view

@@ -19,11 +19,14 @@ import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State+import Game.LambdaHack.Common.Actor+import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead+import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State+import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types-import Game.LambdaHack.Common.Point  -- | Handle the move of an actor under AI control (regardless if the whole -- faction is under human or computer control).@@ -31,26 +34,32 @@ queryAI aid = do   -- @sleader@ may be different from @gleader@ due to @stopPlayBack@,   -- but only leaders may change faction leader, so we fix that beforehand:-  side <- getsClient sside-  mleader <- getsState $ gleader . (EM.! side) . sfactionD+  body <- getsState $ getActorBody aid+  foeAssocs <- getsState $ foeRegularAssocs (bfid body) (blid body)+  friendAssocs <- getsState $ friendRegularAssocs (bfid body) (blid body)+  mleader <- getsState $ gleader . (EM.! bfid body) . sfactionD   mleaderCli <- getsClient sleader   unless (Just aid == mleader || mleader == mleaderCli) $     -- @aid@ is not the leader, so he can't change leader later on,     -- so we match the leaders here     modifyClient $ \cli -> cli {_sleader = mleader}-  (aidToMove, treq, oldFlee) <- pickActorAndAction Nothing aid-  (aidToMove2, treq2) <--    case treq of-      ReqWait | mleader == Just aid -> do+  (aidToMove, treq, oldFlee) <- pickActorAndAction foeAssocs friendAssocs+                                                   Nothing aid+  let tryAgain = do         -- Leader waits; a waste; try once to pick a yet different leader         -- or at least a non-waiting action. 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) aid+          , sfleeD = EM.alter (const oldFlee) aidToMove $ sfleeD cli }+        (a, t, _) <- pickActorAndAction foeAssocs friendAssocs+                                        (Just aidToMove) aid         return (a, t)+  (aidToMove2, treq2) <-+    if mleader /= Just aid+    then return (aidToMove, treq)+    else case treq of+      ReqWait -> tryAgain+      ReqYell -> tryAgain       _ -> return (aidToMove, treq)   return ( ReqAITimed treq2          , if aidToMove2 /= aid then Just aidToMove2 else Nothing )@@ -58,18 +67,16 @@ -- | 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 -> ActorId-                   -> m (ActorId, RequestTimed, Maybe Point)--- This inline would speeds up execution by 15% and decreases allocation by 15%,--- but it'd bloat JS code without speeding it up.--- {-# INLINE pickActorAndAction #-}-pickActorAndAction maid aid = do+                   => [(ActorId, Actor)] -> [(ActorId, Actor)]+                   -> Maybe ActorId -> ActorId+                   -> m (ActorId, RequestTimed, Maybe (Point, Time))+pickActorAndAction foeAssocs friendAssocs maid aid = do   mleader <- getsClient sleader   aidToMove <-     if mleader == Just aid-    then pickActorToMove maid+    then pickActorToMove foeAssocs friendAssocs maid     else do-      setTargetFromTactics aid+      setTargetFromDoctrines foeAssocs friendAssocs aid       return aid   oldFlee <- getsClient $ EM.lookup aidToMove . sfleeD   -- Trying harder (@retry@) whenever no better leader found and so at least@@ -77,5 +84,5 @@   -- If a new leader found, there is hope (but we don't check)   -- that he gets a non-waiting action without any desperate measures.   let retry = maybe False (aidToMove ==) maid-  treq <- pickAction aidToMove retry+  treq <- pickAction foeAssocs friendAssocs aidToMove retry   return (aidToMove, treq, oldFlee)

engine-src/Game/LambdaHack/Client/AI/ConditionM.hs view

@@ -1,13 +1,11 @@ -- | Assorted conditions used later on in AI logic. module Game.LambdaHack.Client.AI.ConditionM-  ( condAimEnemyPresentM-  , condAimEnemyRememberedM+  ( condAimEnemyTargetedM+  , condAimEnemyOrStashM+  , condAimEnemyOrRememberedM   , condAimNonEnemyPresentM-  , condAimEnemyNoMeleeM-  , condInMeleeM   , condAimCrucialM   , condTgtNonmovingEnemyM-  , condAnyFoeAdjM   , condAdjTriggerableM   , meleeThreatDistList   , condBlocksFriendsM@@ -21,7 +19,7 @@   , benGroundItems   , desirableItem   , condSupport-  , condSoloM+  , condAloneM   , condShineWouldBetrayM   , fleeList   ) where@@ -31,10 +29,8 @@ import Game.LambdaHack.Core.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           Game.LambdaHack.Common.Actor@@ -45,6 +41,7 @@ import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level 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@@ -55,31 +52,41 @@ import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs  -- 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+-- | Require that a target enemy is visible by the party.+condAimEnemyTargetedM :: MonadClient m => ActorId -> m Bool+condAimEnemyTargetedM aid = do   btarget <- getsClient $ getTarget aid   return $ case btarget of     Just (TEnemy _) -> True     _ -> False --- | Require that the target enemy is remembered on the actor's level.-condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool-condAimEnemyRememberedM aid = do+-- | Require that a target enemy or enemy stash is visible by the party.+condAimEnemyOrStashM :: MonadClient m => ActorId -> m Bool+condAimEnemyOrStashM aid = do+  btarget <- getsClient $ getTarget aid+  return $ case btarget of+    Just (TEnemy _) -> True+    Just (TPoint (TStash _) _ _) -> True  -- speedup from: lid == blid b+    _ -> False++-- | Require that a target enemy is remembered on the actor's level.+condAimEnemyOrRememberedM :: MonadClient m => ActorId -> m Bool+condAimEnemyOrRememberedM aid = do   b <- getsState $ getActorBody aid   btarget <- getsClient $ getTarget aid   return $ case btarget of+    Just (TEnemy _) -> True     Just (TPoint (TEnemyPos _) lid _) -> lid == blid b+    Just (TPoint (TStash _) lid _) -> lid == blid b     _ -> False --- | Require that the target non-enemy is visible by the party.+-- | Require that a target non-enemy is visible by the party. condAimNonEnemyPresentM :: MonadClient m => ActorId -> m Bool condAimNonEnemyPresentM aid = do   btarget <- getsClient $ getTarget aid@@ -87,29 +94,6 @@     Just (TNonEnemy _) -> True     _ -> False --- | Require that the target enemy is visible by the party and doesn't melee.-condAimEnemyNoMeleeM :: MonadClient m => ActorId -> m Bool-condAimEnemyNoMeleeM aid = do-  btarget <- getsClient $ getTarget aid-  case btarget of-    Just (TEnemy aid2) -> do-      b2 <- getsState $ getActorBody aid2-      actorMaxSkills <- getsState sactorMaxSkills-      return $ actorCanMelee actorMaxSkills aid2 b2-    _ -> return False--condInMeleeM :: MonadClient m => LevelId -> m Bool-condInMeleeM lid = do-  condInMelee <- getsClient scondInMelee-  case EM.lookup lid condInMelee of-    Just inM -> return inM-    Nothing -> do-      side <- getsClient sside-      inM <- getsState $ inMelee side lid-      modifyClient $ \cli ->-        cli {scondInMelee = EM.insert lid inM condInMelee}-      return inM- -- | Require that the target is crucial to success, e.g., an item, -- or that it's not too far away and so the changes to get it are high. condAimCrucialM :: MonadClient m => ActorId -> m Bool@@ -123,9 +107,10 @@       && (pathLen < 10  -- close enough to get there first           || tgoal `notElem` [TUnknown, TKnown])     Just TgtAndPath{tapTgt=TVector{}, tapPath=Just AndPath{pathLen}} ->-      pathLen < 7  -- the constant in @vToTgt@, where only-                   -- non-crucial targets are produced; this will also-                   -- prevent animals from sleep close to cave edges+      pathLen < 7  -- can't say if the target important, but the constants+                   -- from @take6@ and @traSlack7@ ensure target is+                   -- already approached or close to level edge+                   -- or not a random @traSlack7@ wandering     _ -> False  -- includes the case of target with no path  -- | Check if the target is a nonmoving enemy.@@ -138,19 +123,13 @@       return $ Ability.getSk Ability.SkMove 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 on or adjacent to a triggerable tile -- (e.g., stairs).-condAdjTriggerableM :: MonadClient m => ActorId -> m Bool-condAdjTriggerableM aid = do+condAdjTriggerableM :: MonadClient m => Ability.Skills -> ActorId -> m Bool+condAdjTriggerableM actorSk aid = do   COps{coTileSpeedup} <- getsState scops   b <- getsState $ getActorBody aid   lvl <- getLevel $ blid b-  actorSk <- currentSkillsClient aid   let alterSkill = Ability.getSk Ability.SkAlter actorSk       alterMinSkill p = Tile.alterMinSkill coTileSpeedup $ lvl `at` p       underFeet p = p == bpos b  -- if enter and alter, be more permissive@@ -169,17 +148,18 @@ -- 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 =+meleeThreatDistList :: [(ActorId, Actor)] -> ActorId -> State+                    -> [(Int, (ActorId, Actor))]+meleeThreatDistList foeAssocs aid s =   let actorMaxSkills = sactorMaxSkills s       b = getActorBody aid s-      allAtWar = foeRegularAssocs (bfid b) (blid b) s+       strongActor (aid2, b2) =         let actorMaxSk = actorMaxSkills EM.! aid2             nonmoving = Ability.getSk Ability.SkMove actorMaxSk <= 0         in not (hpTooLow b2 actorMaxSk || nonmoving)-           && actorCanMelee actorMaxSkills aid2 b2-      allThreats = filter strongActor allAtWar+           && actorCanMeleeToHarm actorMaxSkills aid2 b2+      allThreats = filter strongActor foeAssocs       addDist (aid2, b2) = (chessDist (bpos b) (bpos b2), (aid2, b2))   in sortBy (comparing fst) $ map addDist allThreats @@ -195,7 +175,8 @@           _ -> False   any blocked <$> getsState (fidActorRegularIds (bfid b) (blid b)) --- | Require the actor stands over a weapon that would be auto-equipped.+-- | Require the actor stands over a weapon that would be auto-equipped,+-- if only it was a desirable item (checked elsewhere). condFloorWeaponM :: MonadStateRead m => ActorId -> m Bool condFloorWeaponM aid =   any (IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) <$>@@ -209,8 +190,14 @@  -- | Require that the actor can project any items. condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool-condCanProjectM skill aid =-  if skill < 1 then return False else  -- shortcut+condCanProjectM skill aid = do+  side <- getsClient sside+  curChal <- getsClient $ scurChal+  fact <- getsState $ (EM.! side) . sfactionD+  if skill < 1+     || ckeeper curChal && fhasUI (gplayer fact)+  then return False+  else  -- shortcut     -- Compared to conditions in @projectItem@, range and charge are ignored,     -- because they may change by the time the position for the fling     -- is reached.@@ -218,37 +205,48 @@  condProjectListM :: MonadClient m                  => Int -> ActorId-                 -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]+                 -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)] condProjectListM skill aid = do   condShineWouldBetray <- condShineWouldBetrayM aid-  condAimEnemyPresent <- condAimEnemyPresentM aid+  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid   discoBenefit <- getsClient sdiscoBenefit   getsState $ projectList discoBenefit skill aid-                          condShineWouldBetray condAimEnemyPresent+                          condShineWouldBetray condAimEnemyOrRemembered  projectList :: DiscoveryBenefit -> Int -> ActorId -> Bool -> Bool -> State-            -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]+            -> [(Double, CStore, ItemId, ItemFull, ItemQuant)] projectList discoBenefit skill aid-            condShineWouldBetray condAimEnemyPresent s =+            condShineWouldBetray condAimEnemyOrRemembered s =   let b = getActorBody aid s       actorMaxSk = getActorMaxSkills aid s       calmE = calmEnough b actorMaxSk-      condNotCalmEnough = not calmE       heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.         deltasSerious (bcalmDelta b)+      uneasy = condAimEnemyOrRemembered+               || not calmE+               || heavilyDistressed+        -- don't take recent fleeing into account when item can be lost+      coeff CGround = 2  -- pickup turn saved+      coeff COrgan = error $ "" `showFailure` benList+      coeff CEqp = 1000  -- must hinder currently (or be very potent);+                         -- note: not larger, to avoid Int32 overflow+      coeff CStash = 1       -- This detects if the value of keeping the item in eqp is in fact < 0.-      hind = hinders condShineWouldBetray condAimEnemyPresent-                     heavilyDistressed condNotCalmEnough actorMaxSk-      q (Benefit{benInEqp, benFling}, _, _, itemFull, _) =+      hind = hinders condShineWouldBetray uneasy actorMaxSk+      goodMissile (Benefit{benInEqp, benFling}, cstore, iid, itemFull, kit) =         let arItem = aspectRecordFull itemFull-        in benFling < 0-           && (not benInEqp  -- can't wear, so OK to risk losing or breaking-               || not (IA.checkFlag Ability.Meleeable arItem)-                    -- 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+            benR = coeff cstore * benFling+        in if benR < -1  -- ignore very weak projectiles+              && (not benInEqp  -- can't wear, so OK to risk losing or breaking+                  || not (IA.checkFlag Ability.Meleeable arItem)+                       -- anything else expendable+                     && hind itemFull)  -- hinders now, so possibly often+              && permittedProjectAI skill calmE itemFull+           then Just (benR, cstore, iid, itemFull, kit)+           else Nothing+      stores = [CStash, CGround] ++ [CEqp | calmE]+      benList = benAvailableItems discoBenefit aid stores s+  in mapMaybe goodMissile benList  -- | Produce the list of items from the given stores available to the actor -- and the items' values.@@ -256,27 +254,24 @@                   -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] benAvailableItems discoBenefit aid cstores s =   let b = getActorBody aid s-      ben cstore bag =+      mstash = gstash $ sfactionD s EM.! bfid b+      ben _ CGround | mstash == Just (blid b, bpos b) = []+      ben bag cstore =         [ (discoBenefit EM.! iid, cstore, iid, itemToFull iid s, kit)         | (iid, kit) <- EM.assocs bag]-      benCStore cs = ben cs $ getBodyStoreBag b cs s+      benCStore cs = ben (getBodyStoreBag b cs s) cs   in concatMap benCStore cstores -hinders :: Bool -> Bool -> Bool -> Bool -> Ability.Skills -> ItemFull-        -> Bool-hinders condShineWouldBetray condAimEnemyPresent-        heavilyDistressed condNotCalmEnough-          -- guess that enemies have projectiles and used them now or recently-        actorMaxSk itemFull =+hinders :: Bool -> Bool -> Ability.Skills -> ItemFull -> Bool+hinders condShineWouldBetray uneasy actorMaxSk itemFull =   let arItem = aspectRecordFull itemFull       itemShine = 0 < IA.getSkill Ability.SkShine arItem       -- @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)+  in -- In the presence of enemies (seen, remembered or unseen but distressing)      -- actors want to hide in the dark.-     (condAimEnemyPresent || condNotCalmEnough || heavilyDistressed)-     && itemShineBad  -- even if it's a weapon, take it off+     uneasy && 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 actorMaxSk > speedWalk@@ -302,7 +297,7 @@       isDesirable (ben, _, _, itemFull, _) =         desirableItem cops canEsc (benPickup ben)                       (aspectRecordFull itemFull) (itemKind itemFull)-                      99  -- fake, becuase no time is wasted walking to item+                      99  -- fake, because no time is wasted walking to item   filter isDesirable     <$> getsState (benAvailableItems discoBenefit aid [CGround]) @@ -323,42 +318,44 @@                  in benPickup > 0 && not preciousNotUseful   in useful && not loneProjectile -condSupport :: MonadClient m => Int -> ActorId -> m Bool+condSupport :: MonadClient m => [(ActorId, Actor)] -> 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+condSupport friendAssocs param aid = do+  mtgtMPath <- getsClient $ EM.lookup aid . stargetD+  getsState $ strongSupport friendAssocs param aid mtgtMPath -strongSupport :: Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool-strongSupport param aid btarget condAimEnemyPresent condAimEnemyRemembered s =+strongSupport :: [(ActorId, Actor)]+              -> Int -> ActorId -> Maybe TgtAndPath -> State+              -> Bool+strongSupport friendAssocs param aid mtgtMPath s =   -- The smaller the area scanned for friends, the lower number required.   let actorMaxSkills = sactorMaxSkills s       actorMaxSk = actorMaxSkills EM.! aid       n = min 2 param - Ability.getSk Ability.SkAggression actorMaxSk       b = getActorBody aid s-      mtgtPos = aidTgtToPos aid (blid b) btarget s-      approaching b2 = case mtgtPos of-        Just tgtPos | condAimEnemyPresent || condAimEnemyRemembered ->-          chessDist (bpos b2) tgtPos <= 1 + param+      approaching b2 = case mtgtMPath of+        Just TgtAndPath{tapTgt=TEnemy{},tapPath=Just AndPath{pathGoal}} ->+            chessDist (bpos b2) pathGoal <= 1 + param  -- will soon melee anyway         _ -> False       closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)-                       in dist > 0 && (dist <= param || approaching b2)+                       in dist > 0 && (dist <= max 2 param || approaching b2)       closeAndStrong (aid2, b2) = closeEnough b2-                                  && actorCanMelee actorMaxSkills aid2 b2-      friends = friendRegularAssocs (bfid b) (blid b) s-      closeAndStrongFriends = filter closeAndStrong friends+                                  && actorCanMeleeToHarm actorMaxSkills aid2 b2+      closeAndStrongFriends = filter closeAndStrong friendAssocs   in n <= 0 || not (null (drop (n - 1) closeAndStrongFriends))        -- optimized: length closeAndStrongFriends >= n -condSoloM :: MonadClient m => ActorId -> m Bool-condSoloM aid = do+-- The numbers reflect fleeing AI conditions for non-aggresive actors+-- so that actors don't wait for support that is not possible due to not+-- enough friends on the level, even counting sleeping ones.+condAloneM :: MonadClient m => [(ActorId, Actor)] -> ActorId -> m Bool+condAloneM friendAssocs aid = do   b <- getsState $ getActorBody aid-  let isSingleton [_] = True-      isSingleton _ = False-  isSingleton <$> getsState (friendRegularList (bfid b) (blid b))+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+  let onStashLevel = case mstash of+        Nothing -> False+        Just (lid, _) -> lid == blid b+  return $! length friendAssocs <= if onStashLevel then 3 else 2  -- | Require that the actor stands in the dark and so would be betrayed -- by his own equipped light,@@ -369,8 +366,9 @@   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+fleeList :: MonadClient m+         => [(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])+fleeList foeAssocs 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,@@ -380,19 +378,21 @@                        , tapTgt } -> case tapTgt of           TEnemy{} -> Left pathGoal           TPoint TEnemyPos{} _ _ -> Left pathGoal+            -- this is too weak, because only one is recorded and sometimes+            -- many are needed to decide to flee next turn as well           _ -> Right pathList         _ -> Right []-  fleeD <- getsClient sfleeD-  -- But if fled previous turn, prefer even more fleeing further this turn.-  let eOldFleeOrTgt = case EM.lookup aid fleeD of-        Nothing -> etgtPath-        Just p -> Left p   b <- getsState $ getActorBody aid   lvl <- getLevel $ blid b-  posFoes <- getsState $ map bpos . foeRegularList (bfid b) (blid b)-  let myVic = vicinityUnsafe $ bpos b-      dist p | null posFoes = 100-             | otherwise = minimum $ map (chessDist p) posFoes+  localTime <- getsState $ getLocalTime (blid b)+  fleeD <- getsClient sfleeD+  -- But if fled recently, prefer even more fleeing further this turn.+  let eOldFleeOrTgt = case EM.lookup aid fleeD of+        Just (fleeStart, time) | timeRecent5 localTime time -> Left fleeStart+        _ -> etgtPath+      myVic = vicinityUnsafe $ bpos b+      dist p | null foeAssocs = 100+             | otherwise = minimum $ map (chessDist p . bpos . snd) foeAssocs       dVic = map (dist &&& id) myVic       -- Flee, if possible. Direct access required; not enough time to open.       -- Can't be occupied.

engine-src/Game/LambdaHack/Client/AI/PickActionM.hs view

@@ -56,1017 +56,1231 @@ import           Game.LambdaHack.Definition.Defs  -- | 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 (not (bproj body)-                    `blame` "AI gets to manually move its projectiles"-                    `swith` (aid, bfid body, side)) ()-  -- Reset fleeing flag. May then be set in @flee@.-  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-  mleader <- getsClient sleader-  body <- getsState $ getActorBody aid-  condInMelee <- condInMeleeM $ blid body-  condAimEnemyPresent <- condAimEnemyPresentM aid-  condAimEnemyNoMelee <- condAimEnemyNoMeleeM aid-  condAimEnemyRemembered <- condAimEnemyRememberedM aid-  condAimNonEnemyPresent <- condAimNonEnemyPresentM aid-  condAimCrucial <- condAimCrucialM aid-  condAnyFoeAdj <- condAnyFoeAdjM aid-  threatDistL <- getsState $ meleeThreatDistList aid-  (fleeL, badVic) <- fleeList aid-  modifyClient $ \cli -> cli {sfleeD = EM.delete aid (sfleeD cli)}-  condSupport1 <- condSupport 1 aid-  condSupport3 <- condSupport 3 aid-  condSolo <- condSoloM aid  -- solo fighters aggresive-  canDeAmbientL <- getsState $ canDeAmbientList body-  actorSk <- currentSkillsClient aid-  condCanProject <- condCanProjectM (getSk SkProject actorSk) aid-  condAdjTriggerable <- condAdjTriggerableM aid-  condBlocksFriends <- condBlocksFriendsM aid-  condNoEqpWeapon <- condNoEqpWeaponM aid-  condEnoughGear <- condEnoughGearM aid-  condFloorWeapon <- condFloorWeaponM aid-  condDesirableFloorItem <- condDesirableFloorItemM aid-  condTgtNonmovingEnemy <- condTgtNonmovingEnemyM aid-  explored <- getsClient sexplored-  actorMaxSkills <- getsState sactorMaxSkills-  friends <- getsState $ friendRegularList (bfid body) (blid body)-  let anyFriendOnLevelAwake = any (\b ->-        bwatch b /= WSleep && bpos b /= bpos body) friends-      actorMaxSk = actorMaxSkills EM.! aid-      prefersSleepWhenAwake = case bwatch body of-        WSleep -> Ability.getSk Ability.SkMoveItem actorMaxSk <= -10-        _ -> prefersSleep actorMaxSk  -- nm @WWake@-      mayFallAsleep = not condAimEnemyRemembered-                      && mayContinueSleep-                      && canSleep actorSk-      mayContinueSleep = not condAimEnemyPresent-                         && not (hpFull body actorSk)-                         && not uneasy-                         && not condAnyFoeAdj-                         && (anyFriendOnLevelAwake  -- friend guards the sleeper-                             || prefersSleepWhenAwake)  -- or he doesn't care-      dozes = case bwatch body of-                WWait n -> n > 0-                _ -> False-              && mayFallAsleep-              && Just aid /= mleader  -- best teammate for a task so stop dozing-      lidExplored = ES.member (blid body) explored-      panicFleeL = fleeL ++ badVic-      condHpTooLow = hpTooLow body actorMaxSk-      heavilyDistressed =  -- actor hit by a proj or similarly distressed-        deltasSerious (bcalmDelta body)-      condNotCalmEnough = not (calmEnough body actorMaxSk)-      uneasy = heavilyDistressed || condNotCalmEnough-      speed1_5 = speedScale (3%2) (gearSpeed actorMaxSk)-      -- Max skills used, because we need to know if can melee as leader.-      condCanMelee = actorCanMelee actorMaxSkills 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 = actorMaxSkills EM.! aid2-              in gearSpeed ar2 > speed1_5)-        threatAdj-      actorShines = Ability.getSk SkShine actorMaxSk > 0-      aCanDeLightL | actorShines = []-                   | otherwise = canDeAmbientL-      aCanDeLight = not $ null aCanDeLightL-      canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL-      abInMaxSkill sk = getSk sk actorMaxSk > 0-      runSkills = [SkMove, SkDisplace]  -- not @SkAlter@, to ground sleepers-      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:: [([Skill], m (Strategy RequestTimed), Bool)]-      prefix =-        [ ( [SkApply]-          , applyItem aid ApplyFirstAid-          , not condAnyFoeAdj && condHpTooLow)-        , ( [SkAlter]-          , 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) )-        , ( [SkDisplace]-          , displaceFoe aid  -- only swap with an enemy to expose him-                             -- and only if a friend is blocked by us-          , condAnyFoeAdj && condBlocksFriends)  -- later checks foe eligible-        , ( [SkMoveItem]-          , pickup aid True-          , condNoEqpWeapon  -- we assume organ weapons usually inferior-            && condFloorWeapon && not condHpTooLow-            && abInMaxSkill SkMelee )-        , ( [SkAlter]-          , 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 ->-                    -- Here we don't check @condInMelee@ because regardless-                    -- of whether our team melees (including the fleeing ones),-                    -- endangered actors should flee from very close foes.-                    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-                    || not condInMelee && condAimEnemyNoMelee && condCanMelee ->-                    -- Too far to flee from melee, too close from ranged,-                    -- not in ambient, so no point fleeing into dark; advance.-                    -- Or the target enemy doesn't melee and melee enemies-                    -- far away, so chase him.-                    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) )-        , ( [SkMelee]-          , meleeBlocker aid  -- only melee blocker-          , condAnyFoeAdj  -- if foes, don't displace, otherwise friends:-            || not (abInMaxSkill SkDisplace)  -- 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.-        , ( [SkAlter]-          , trigger aid ViaNothing-          , not condInMelee  -- don't incur overhead-            && condAdjTriggerable && not condAimEnemyPresent )-        , ( [SkDisplace]  -- prevents some looping movement-          , displaceBlocker aid retry  -- fires up only when path blocked-          , retry || not condDesirableFloorItem )-        , ( [SkMelee]-          , meleeAny aid-          , condAnyFoeAdj )  -- won't flee nor displace, so let it melee-        , ( runSkills-          , flee aid panicFleeL  -- ultimate panic mode; open tiles, if needed-          , condAnyFoeAdj )-        ]-      -- Order doesn't matter, scaling does.-      -- These are flattened in @stratToFreq@ (taking only the best variant)-      -- and then summed, so if any of these can fire, it will.-      -- If none can, @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.-      -- The scaling values for @stratToFreq@ need to be so low-resolution-      -- or we get 32bit @Freqency@ overflows, which would bite us in JS.-      distant :: [([Skill], m (Frequency RequestTimed), Bool)]-      distant =-        [ ( [SkMoveItem]-          , stratToFreq (if condInMelee then 2 else 20000)-            $ yieldUnneeded aid  -- 20000 to unequip ASAP, unless is thrown-          , True )-        , ( [SkMoveItem]-          , stratToFreq 1-            $ equipItems aid  -- doesn't take long, very useful if safe-          , not (condInMelee-                 || condDesirableFloorItem-                 || uneasy) )-        , ( [SkProject]-          , stratToFreq (if condTgtNonmovingEnemy then 20 else 3)-              -- not too common, to leave missiles for pre-melee dance-            $ projectItem aid  -- equivalent of @condCanProject@ called inside-          , condAimEnemyPresent && not condInMelee )-        , ( [SkApply]-          , 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-                      || condAimNonEnemyPresent)-                     && (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) )-        ]-      suffix =-        [ ( [SkMoveItem]-          , pickup aid False  -- e.g., to give to other party members-          , not condInMelee && not dozes )-        , ( [SkMoveItem]-          , unEquipItems aid  -- late, because these items not bad-          , not condInMelee && not dozes )-        , ( [SkWait]-          , waitBlockNow  -- try to fall asleep, rarely-          , bwatch body `notElem` [WSleep, WWake]-            && mayFallAsleep-            && prefersSleep actorMaxSk-            && not condAimCrucial)-        , ( runSkills-          , chase aid (not condInMelee-                       && heavilyDistressed-                       && aCanDeLight) retry-          , not dozes-            && if condInMelee-               then condCanMelee && condAimEnemyPresent-               else not (condThreat 2) || not condMeleeBad )-        ]-      fallback =  -- Wait until friends sidestep; ensures strategy never empty.-                  -- Also, this is what non-leader heroes do, unless they melee.-        [ ( [SkWait]-          , case bwatch body of-              WSleep -> yellNow  -- we know actor doesn't want to sleep,-                                 -- so celebrate wake up with a bang-              _ -> waitBlockNow  -- block, etc.-          , True )-        , ( runSkills  -- if can't block, at least change something-          , chase aid (not condInMelee-                       && heavilyDistressed-                       && aCanDeLight) True-          , not condInMelee || condCanMelee && condAimEnemyPresent )-        , ( [SkDisplace]  -- if can't brace, at least change something-          , displaceBlocker aid True-          , True )-        , ( []-          , yellNow  -- desperate fallback-          , True )-       ]-  -- Check current, not maximal skills, since this can be a leader as well-  -- as non-leader action.-  let abInSkill sk = getSk sk actorSk > 0-      checkAction :: ([Skill], m a, Bool) -> Bool-      checkAction (abts, _, cond) = (null abts || 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-      combineWeighted as = liftFrequency <$> sumF as-  sumPrefix <- sumS prefix-  comDistant <- combineWeighted distant-  sumSuffix <- sumS suffix-  sumFallback <- sumS fallback-  return $! if bwatch body == WSleep-               && abInSkill SkWait-               && mayContinueSleep-                 -- no check of @canSleep@, because sight lowered by sleeping-            then returN "sleep" ReqWait-            else sumPrefix .| comDistant .| sumSuffix .| sumFallback--waitBlockNow :: MonadClient m => m (Strategy RequestTimed)-waitBlockNow = return $! returN "wait" ReqWait--yellNow :: MonadClient m => m (Strategy RequestTimed)-yellNow = return $! returN "yell" ReqYell--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)-  actorMaxSk <- getsState $ getActorMaxSkills aid-  let calmE = calmEnough b actorMaxSk-      isWeapon (_, _, _, itemFull, _) =-        IA.checkFlag Ability.Meleeable $ aspectRecordFull itemFull-      filterWeapon | onlyWeapon = filter isWeapon-                   | otherwise = id-      prepareOne (oldN, l4)-                 (Benefit{benInEqp}, _, iid, itemFull, (itemK, _)) =-        let prep newN toCStore = (newN, (iid, itemK, CGround, toCStore) : l4)-            n = oldN + itemK-            arItem = aspectRecordFull itemFull-        in if | calmE && IA.goesIntoSha arItem && 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-  actorMaxSk <- getsState $ getActorMaxSkills aid-  let calmE = calmEnough body actorMaxSk-  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)])-              -> ( [(Int, (ItemId, ItemFullKit))]-                 , [(Int, (ItemId, ItemFullKit))] )-              -> (Int, [(ItemId, Int, CStore, CStore)])-      improve fromCStore (oldN, l4) (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) ->-                (n, (iidInv, 1, fromCStore, CEqp) : l4)-          _ -> (oldN, l4)-      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltasSerious (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) actorMaxSk itemFull-      bestThree = bestByEqpSlot discoBenefit-                                (filter filterNeeded eqpAssocs)-                                (filter filterNeeded invAssocs)-                                (filter filterNeeded shaAssocs)-      bEqpInv = foldl' (improve CInv) (0, [])-                $ map (\(eqp, inv, _) -> (inv, eqp)) bestThree-      bEqpBoth | calmE =-                   foldl' (improve CSha) bEqpInv-                   $ map (\(eqp, _, sha) -> (sha, eqp)) bestThree-               | otherwise = bEqpInv-      (_, prepared) = bEqpBoth-  return $! if null prepared-            then reject-            else returN "equipItems" $ ReqMoveItems prepared--yieldUnneeded :: MonadClient m => ActorId -> m (Strategy RequestTimed)-yieldUnneeded aid = do-  body <- getsState $ getActorBody aid-  actorMaxSk <- getsState $ getActorMaxSkills aid-  let calmE = calmEnough body actorMaxSk-  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.-        deltasSerious (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) actorMaxSk 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-  actorMaxSk <- getsState $ getActorMaxSkills aid-  let calmE = calmEnough body actorMaxSk-  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, ItemFullKit))]-                           , [(Int, (ItemId, ItemFullKit))] )-              -> [(ItemId, Int, CStore, CStore)]-      improve fromCStore (bestSha, bestEOrI) =-        case bestEOrI of-          ((vEOrI, (iidEOrI, bei)) : _) | 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)) : _) | 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.-        deltasSerious (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) actorMaxSk itemFull-      bestThree = bestByEqpSlot discoBenefit eqpAssocs invAssocs-                                (filter filterNeeded shaAssocs)-      bInvSha = concatMap-                  (improve CInv . (\(_, inv, sha) -> (sha, inv))) bestThree-      bEqpSha = concatMap-                  (improve CEqp . (\(eqp, _, sha) -> (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 EqpSlot [(ItemId, ItemFullKit)]-groupByEqpSlot is =-  let f (iid, itemFullKit) =-        let arItem = aspectRecordFull $ fst itemFullKit-        in case IA.aEqpSlot arItem 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)]-              -> [( [(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.elems $ 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-  actorMaxSk <- getsState $ getActorMaxSkills aid-  fact <- getsState $ (EM.! bfid b) . sfactionD-  actorSk <- currentSkillsClient aid-  mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  case mtgtMPath of-    Just TgtAndPath{ tapTgt=TEnemy{}-                   , tapPath=Just AndPath{pathList=q : _, pathGoal} }-      | q == pathGoal -> return reject  -- not a real blocker, but goal enemy-    Just TgtAndPath{tapPath=Just 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.-      lvl <- getLevel (blid b)-      let maim | adjacent (bpos b) pathGoal = Just pathGoal-               | adjacent (bpos b) q = Just q-               | otherwise = Nothing  -- MeleeDistant-          lBlocker = case maim of-            Nothing -> []-            Just aim -> posToAidsLvl aim lvl-      case lBlocker of-        aid2 : _ -> do-          body2 <- getsState $ getActorBody aid2-          actorMaxSk2 <- getsState $ getActorMaxSkills 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-                  && getSk SkDisplace 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-                  && getSk SkDisplace actorSk <= 0-                       -- can't displace-                  && getSk SkMove actorSk > 0  -- blocked move-                  && 3 * bhp body2 < bhp b  -- only get rid of weak friends-                  && gearSpeed actorMaxSk2 <= gearSpeed actorMaxSk -> 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-  adjBigAssocs <- getsState $ adjacentBigAssocs b-  let foe (_, b2) = isFoe (bfid b) fact (bfid b2) && bhp b2 > 0-      adjFoes = map fst $ filter foe adjBigAssocs-  btarget <- getsClient $ getTarget aid-  mtargets <- case btarget of-    Just (TEnemy aid2) -> do-      b2 <- getsState $ getActorBody aid2-      return $! if adjacent (bpos b2) (bpos b) && foe (aid2, b2)-                then Just [aid2]-                else Nothing-    _ -> return Nothing-  let adjTargets = fromMaybe adjFoes mtargets-  mels <- mapM (pickWeaponClient aid) 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.--- TODO: In @actionStrategy@ we require minimal @SkAlter@ even for the case--- of triggerable tile underfoot. A quirk; a specialization of AI actors.-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 $ bpos b : 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 <- getsState $ aidTgtToPos aid (blid b) btarget-  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 = getSk SkProject 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 = 1000  -- must hinder currently (or be very potent);-                                 -- note: not larger, to avoid Int32 overflow-              coeff CInv = 1-              coeff CSha = 1-              fRanged (Benefit{benFling}, cstore, iid, itemFull, kit) =-                -- If the item is discharged, neither the kinetic hit nor-                -- any effects activate, so no point projecting.-                -- This changes in time, so recharging is not included-                -- in @condProjectListM@, but checked here, just before fling.-                let recharged = hasCharge localTime itemFull kit-                    arItem = aspectRecordFull itemFull-                    trange = IA.totalRange arItem $ 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)-  actorMaxSk <- getsState $ getActorMaxSkills aid-  let calmE = calmEnough b actorMaxSk-      condNotCalmEnough = not calmE-      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.-        deltasSerious (bcalmDelta b)-      skill = getSk SkApply actorSk-      -- This detects if the value of keeping the item in eqp is in fact < 0.-      hind = hinders condShineWouldBetray condAimEnemyPresent-                     heavilyDistressed condNotCalmEnough actorMaxSk-      permittedActor itemFull kit =-        either (const False) id-        $ permittedApply localTime skill calmE itemFull kit-      disqualify :: Bool -> IK.Effect -> Bool-      -- These effects tweak items, which is only situationally beneficial-      -- and not really the best idea while in combat.-      disqualify _ IK.PolyItem = True-      disqualify _ IK.RerollItem = True-      disqualify _ IK.DupItem = True-      disqualify _ IK.Identify = True-      -- This is usually the main effect of item and it's useless without Calm.-      disqualify durable IK.Summon{} =-        durable && (bcalm b < xM 30 || condNotCalmEnough)-      disqualify durable (IK.OneOf l) = any (disqualify durable) l-      disqualify durable (IK.Composite l) = any (disqualify durable) l-      disqualify _ _ = False-      q (Benefit{benInEqp}, _, _, itemFull@ItemFull{itemKind}, kit) =-        let arItem = aspectRecordFull itemFull-            durable = IA.checkFlag Durable arItem-        in (not benInEqp  -- can't wear, so OK to break-            || durable  -- can wear, but can't break, even better-            || not (IA.checkFlag Ability.Meleeable arItem)-                 -- anything else expendable-               && hind itemFull)  -- hinders now, so possibly often, so away!-           && permittedActor itemFull kit-           && not (any (disqualify durable) $ IK.ieffects itemKind)-           && not (IA.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 isJust $ lookup "condition" $ IK.ifreq 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@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.Composite l) = any getHP l-            getHP _ = False-            heals = any getHP $ IK.ieffects itemKind-            dropsGrps = IK.getDropOrgans itemKind  -- @Impress@ effect included-            dropsBadOrgans =-              not (null myBadGrps)-              && ("condition" `elem` dropsGrps-                  || not (null (dropsGrps `intersect` myBadGrps)))-            dropsImpressed =-              "impressed" `elem` myBadGrps-              && ("condition" `elem` dropsGrps-                  || "impressed" `elem` dropsGrps)-            dropsGoodOrgans =-              not (null myGoodGrps)-              && ("condition" `elem` dropsGrps-                  || not (null (dropsGrps `intersect` myGoodGrps)))-            wastesDrop = not dropsBadOrgans && not (null dropsGrps)-            wastesHP = hpEnough b actorMaxSk && heals-            durable = IA.checkFlag Durable $ aspectRecordFull itemFull-            situationalBenApply =-              if | dropsBadOrgans -> if dropsImpressed-                                     then benApply + 1000  -- crucial-                                     else benApply + 20-                 | wastesDrop || wastesHP -> benApply - 10-                 | otherwise -> benApply-            benR = ceiling situationalBenApply-                   * if cstore == CEqp && not durable-                     then 1000  -- must hinder currently (or be very potent)-                     else coeff cstore-            canApply = situationalBenApply > 0 && case applyGroup of-              ApplyFirstAid -> q benAv && (heals || dropsImpressed)-                -- when low HP, Calm easy to deplete, so impressed crucial-              ApplyAll -> q benAv-                          && not dropsGoodOrgans-                          && (dropsImpressed || not wastesHP)-                               -- waste healing only if it drops impressed;-                               -- otherwise apply anything beneficial at will-        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)-  adjBigAssocs <- getsState $ adjacentBigAssocs b-  let foe (_, b2) = isFoe (bfid b) fact (bfid b2)-      adjFoes = filter foe adjBigAssocs-      walkable p =  -- DisplaceAccess-        Tile.isWalkable coTileSpeedup (lvl `at` p)-      notLooping body p =  -- avoid displace loops-        boldpos body /= Just p || actorWaits body-      nFriends body = length $ filter (adjacent (bpos body) . bpos) friends-      nFrNew = nFriends b + 1-      qualifyActor (aid2, body2) = do-        let tpos = bpos body2-        case posToAidsLvl tpos lvl of-          [_] -> do-            actorMaxSk <- getsState $ getActorMaxSkills aid2-            dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk-              -- DisplaceDying, DisplaceBraced, DisplaceImmobile,-              -- DisplaceSupported-            let nFrOld = nFriends body2-            return $! if walkable (bpos body2)  -- DisplaceAccess-                         && dEnemy && nFrOld < nFrNew-                         && notLooping b (bpos body2)-                      then Just (nFrOld * nFrOld, ReqDisplace aid2)-                      else Nothing-          _ -> return Nothing  -- DisplaceProjectiles-  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-  actorMaxSkills <- getsState sactorMaxSkills-  let condCanMelee = actorCanMelee actorMaxSkills aid b-  mtgtMPath <- getsClient $ EM.lookup aid . stargetD-  case mtgtMPath of-    Just TgtAndPath{ tapTgt=TEnemy{}-                   , tapPath=Just AndPath{pathList=q : _, pathGoal} }-      | q == pathGoal  -- not a real blocker but goal; only displace if can't-                       -- melee (e.g., followed leader) and desperate-        && not (retry && condCanMelee) ->-        return reject-    Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}}-      | adjacent (bpos b) q ->  -- not veered off target too much-        displaceTgt aid q retry-    _ -> return reject  -- goal reached--displaceTgt :: MonadClient m-            => ActorId -> Point -> Bool -> m (Strategy RequestTimed)-displaceTgt source tpos retry = do-  COps{coTileSpeedup} <- getsState scops-  b <- getsState $ getActorBody source-  let !_A = assert (adjacent (bpos b) tpos) ()-  lvl <- getLevel $ blid b-  let walkable p =  -- DisplaceAccess-        Tile.isWalkable coTileSpeedup (lvl `at` p)-      notLooping body p =  -- avoid displace loops-        boldpos body /= Just p || actorWaits body-  if walkable tpos && notLooping b tpos then do-    mleader <- getsClient sleader-    case posToAidsLvl tpos lvl of-      [] -> return reject-      [aid2] | Just aid2 /= mleader -> do-        b2 <- getsState $ getActorBody aid2-        mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD-        enemyTgt <- condAimEnemyPresentM source-        enemyPos <- condAimEnemyRememberedM source-        enemyTgt2 <- condAimEnemyPresentM aid2-        enemyPos2 <- condAimEnemyRememberedM aid2-        case mtgtMPath of-          Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}}-            | q == bpos b  -- friend wants to swap-              || bwatch b2 `elem` [WSleep, WWake]  -- friend sleeps, not cares-              || retry  -- desperate-                 && not (boldpos b == Just tpos  -- and no displace loop-                         && not (actorWaits 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 _ | bwatch b2 `notElem` [WSleep, WWake] -> return reject-          _ -> do  -- an enemy or ally or dozing or disoriented friend --- swap-            tfact <- getsState $ (EM.! bfid b2) . sfactionD-            actorMaxSk <- getsState $ getActorMaxSkills aid2-            dEnemy <- getsState $ dispEnemy source 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=Just AndPath{pathList=q : _, ..}}-      | pathGoal == bpos body -> return reject  -- done; picking up items, etc.-      | 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 = getSk SkAlter actorSk-      !_A = 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)-        (posToAidAssocs p (blid b) s)  -- don't kill own projectiles-  let lalter = salter EM.! blid b-      -- Only actors with SkAlter can search for hidden doors, etc.-      enterableHere p = alterSkill >= fromEnum (lalter PointArray.! p)-  if noFriends target && enterableHere target then-    return $! returN "moveTowards target" $ target `vectorToFrom` source-  else do-    -- This lets animals mill around, even when blocked,-    -- because they have nothing to lose (unless other animals melee).-    -- Blocked heroes instead don't become leaders and don't move-    -- until friends sidestep to let them reach their goal.-    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 = sortOn 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 || actorWaits 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).-  case posToAidsLvl tpos lvl of-    [target] | walkable-               && getSk SkDisplace actorSk > 0-               && notLooping sb tpos -> do-      -- @target@ can be a foe, as well as a friend.-      tb <- getsState $ getActorBody target-      tfact <- getsState $ (EM.! bfid tb) . sfactionD-      actorMaxSk <- getsState $ getActorMaxSkills target-      dEnemy <- getsState $ dispEnemy source target actorMaxSk-        -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported-      if isFoe (bfid tb) tfact (bfid sb) && not dEnemy-      then return Nothing-      else return $ Just $ ReqDisplace target-    [] | walkable && getSk SkMove actorSk > 0 ->-      -- Movement requires full access. The potential invisible actor is hit.-      return $ Just $ ReqMove dir-    [] | not walkable-         && getSk SkAlter 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).+pickAction :: MonadClient m+           => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> Bool+           -> m RequestTimed+pickAction foeAssocs friendAssocs 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 (not (bproj body)+                    `blame` "AI gets to manually move its projectiles"+                    `swith` (aid, bfid body, side)) ()+  stratAction <- actionStrategy foeAssocs friendAssocs 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, Actor)] -> [(ActorId, Actor)] -> ActorId -> Bool+               -> m (Strategy RequestTimed)+actionStrategy foeAssocs friendAssocs aid retry = do+  COps{coTileSpeedup} <- getsState scops+  mleader <- getsClient sleader+  body <- getsState $ getActorBody aid+  lvl <- getLevel (blid body)+  localTime <- getsState $ getLocalTime (blid body)+  condInMelee <- condInMeleeM $ blid body+  condAimEnemyTargeted <- condAimEnemyTargetedM aid+  condAimEnemyOrStash <- condAimEnemyOrStashM aid+  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid+  condAimNonEnemyPresent <- condAimNonEnemyPresentM aid+  condAimCrucial <- condAimCrucialM aid+  actorMaxSkills <- getsState sactorMaxSkills+  condAnyFoeAdj <- getsState $ anyFoeAdj aid+  fact <- getsState $ (EM.! bfid body) . sfactionD+  condOurAdj <- getsState $ any (\(_, b) -> isFriend (bfid body) fact (bfid b))+                            . adjacentBigAssocs body+  oursExploring <- getsState $ oursExploringAssocs (bfid body)+  condAnyHarmfulFoeAdj <- getsState $ anyHarmfulFoeAdj actorMaxSkills aid+  threatDistL <- getsState $ meleeThreatDistList foeAssocs aid+  (fleeL, badVic) <- fleeList foeAssocs aid+  oldFleeD <- getsClient sfleeD+  condSupport1 <- condSupport friendAssocs 1 aid+  condSupport3 <- condSupport friendAssocs 3 aid+  condSolo <- condAloneM friendAssocs aid  -- solo fighters aggresive+  actorSk <- currentSkillsClient aid+  condCanProject <- condCanProjectM (getSk SkProject actorSk) aid+  condAdjTriggerable <- condAdjTriggerableM actorSk aid+  condBlocksFriends <- condBlocksFriendsM aid+  condNoEqpWeapon <- condNoEqpWeaponM aid+  condEnoughGear <- condEnoughGearM aid+  condFloorWeapon <- condFloorWeaponM aid+  condDesirableFloorItem <- condDesirableFloorItemM aid+  condTgtNonmovingEnemy <- condTgtNonmovingEnemyM aid+  randomAggressionThreshold <- rndToAction $ randomR0 10+  explored <- getsClient sexplored+  -- This doesn't treat actors guarding stash specially, so on such levels+  -- man sleeping actors may reside for a long time. Variety, OK.+  let awakeAndNotGuarding (_, b) =+        bpos b /= bpos body+        && bwatch b /= WSleep+        && Just (blid b, bpos b) /= gstash fact+      anyFriendOnLevelAwake = any awakeAndNotGuarding friendAssocs+      actorMaxSk = actorMaxSkills EM.! aid+      recentlyFled = maybe False (\(_, time) -> timeRecent5 localTime time)+                           (aid `EM.lookup` oldFleeD)+      prefersSleepWhenAwake = case bwatch body of+        WSleep -> Ability.getSk Ability.SkMoveItem actorMaxSk <= -10+        _ -> prefersSleep actorMaxSk  -- nm @WWake@+      mayFallAsleep = not condAimEnemyOrRemembered+                      && calmFull body actorMaxSk  -- only when fully relaxed+                      && mayContinueSleep+                      && canSleep actorSk+      mayContinueSleep = not condAimEnemyOrStash+                         && not (hpFull body actorSk)+                         && not uneasy+                         && not condAnyFoeAdj+                         && (anyFriendOnLevelAwake  -- friend guards the sleeper+                             || prefersSleepWhenAwake)  -- or he doesn't care+      dozes = case bwatch body of+                WWait n -> n > 0+                _ -> False+              && mayFallAsleep+              && Just aid /= mleader  -- best teammate for a task so stop dozing+      lidExplored = ES.member (blid body) explored+      panicFleeL = fleeL ++ badVic+      condHpTooLow = hpTooLow body actorMaxSk+      heavilyDistressed =  -- actor hit by a proj or similarly distressed+        deltasSerious (bcalmDelta body)+      heavilyDistressedThisTurn =  -- if far from melee, almost sure hit by proj+        deltasSeriousThisTurn (bcalmDelta body)+      condNotCalmEnough = not (calmEnough body actorMaxSk)+      uneasy = heavilyDistressed || condNotCalmEnough || recentlyFled+      speed = gearSpeed actorMaxSk+      speed1_5 = speedScale (3%2) speed+      -- Max skills used, because we need to know if can melee as leader.+      condCanMelee = actorCanMelee actorMaxSkills aid body+      condMeleeBad = not ((condSolo || condSupport1) && condCanMelee)+      -- These are only melee threats.+      condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL+      threatAdj = takeWhile ((== 1) . fst) threatDistL+      condManyThreatsAdj = length threatAdj >= 2+      condFastThreatAdj =+        any (\(_, (aid2, _)) ->+              let ar2 = actorMaxSkills EM.! aid2+              in gearSpeed ar2 > speed1_5)+            threatAdj+      condNonStealthyThreatAdj =+        any (\(_, (aid2, b2)) ->+              let ar2 = actorMaxSkills EM.! aid2+              in Ability.getSk Ability.SkShine ar2 > 0+                 || isLit (bpos b2))+            threatAdj+      actorShines = Ability.getSk Ability.SkShine actorMaxSk > 0+      isLit pos = Tile.isLit coTileSpeedup (lvl `at` pos)+        -- solid tiles ignored, because not obvious if dark after removed+      canFleeIntoDark = not $ actorShines || all (isLit . snd) fleeL+      avoidAmbient = not condInMelee && uneasy && not actorShines+  mtgtMPath <- getsClient $ EM.lookup aid . stargetD+  let condGoalIsLit = case mtgtMPath of+        Just TgtAndPath{tapPath=Just AndPath{pathGoal}} -> isLit pathGoal+        _ -> False+      -- Fleeing makes sense, because either actor can't melee,+      -- or at least won't flee without scoring a hit and return next turn,+      -- due to threat no longer seen (due to blindness or dark).+      fleeingMakesSense =+        not condCanMelee+        || (Ability.getSk Ability.SkSight actorMaxSk > 2+            || Ability.getSk Ability.SkNocto actorMaxSk > 2)+           && (Ability.getSk Ability.SkShine actorMaxSk > 2+               || condNonStealthyThreatAdj || null threatAdj)+      abInSkill sk = getSk sk actorSk > 0+      abInMaxSkill sk = getSk sk actorMaxSk > 0+      runSkills = [SkMove, SkDisplace]  -- not @SkAlter@, to ground sleepers+      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:: [([Skill], m (Strategy RequestTimed), Bool)]+      prefix =+        [ ( [SkApply]+          , applyItem actorSk aid ApplyFirstAid+          , not condAnyHarmfulFoeAdj && condHpTooLow)+        , ( [SkAlter]+          , 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 condAimEnemyOrStash+            && ((condNotCalmEnough || condHpTooLow)  -- flee+                && condMeleeBad && condAnyHarmfulFoeAdj+                || (lidExplored || condEnoughGear)  -- explore+                   && not condDesirableFloorItem) )+        , ( [SkDisplace]+          , displaceFoe aid  -- only swap with an enemy to expose him+                             -- and only if a friend is blocked by us+          , condAnyFoeAdj && condBlocksFriends)  -- later checks foe eligible+        , ( [SkMoveItem]+          , pickup aid True+          , condNoEqpWeapon  -- we assume organ weapons usually inferior+            && condDesirableFloorItem && condFloorWeapon && not condHpTooLow+            && abInMaxSkill SkMelee )+        , ( [SkAlter]+          , trigger aid ViaEscape+          , condAdjTriggerable && not condAimEnemyTargeted+            && not condDesirableFloorItem )  -- collect the last loot+        , ( runSkills+          , flee actorSk aid (not actorShines) fleeL+          , -- Flee either from melee, if our melee is bad and enemy close,+            -- or from missiles, if we can hide in the dark in one step.+            -- Note that we don't know how far ranged threats are or if,+            -- in fact, they hit from all sides or are hidden. Hence we can't+            -- do much except hide in darkness or take off light (elsewhere).+            -- We tend to flee even when over stash (on lit terrain at least),+            -- but only if we can't fling at enemy (e.g., not visible).+            -- This is OK, since otherwise we'd be killed for free+            -- and the stash would be taken just a little later on.+            -- Note: a part of this condition appears in @actorVulnerable@.+            not condFastThreatAdj+            && fleeingMakesSense+            && if | condAnyHarmfulFoeAdj ->+                    -- Here we don't check @condInMelee@ because regardless+                    -- of whether our team melees (including the fleeing ones),+                    -- endangered actors should flee from very close foes.+                    not condCanMelee+                    || condManyThreatsAdj && not condSupport1 && not condSolo+                  | case gstash fact of+                      Nothing -> False+                      Just (lid, pos) ->+                        lid == blid body+                        && chessDist pos (bpos body) <= 2 -> False+                  | condInMelee -> False+                      -- No fleeing when others melee and no critical threat+                      -- (otherwise no target nor action would be possible).+                  | heavilyDistressedThisTurn  -- and no adj melee+                    || (heavilyDistressed && not (condThreat 2)) ->+                    not condCanMelee || canFleeIntoDark+                      -- Almost surely hit by projectile. So, if can melee,+                      -- don't escape except into the dark.+                      -- Note that even when in dark now, the projectile hit+                      -- might have been enabled by dynamic light+                      -- or light from lying items, so fleeing still needed.+                      -- If heroes stay in the light when under fire,+                      -- they are pummeled by fast ranged foes and can neither+                      -- flee (too slow) nor force them to flee nor kill them.+                      -- Also AI monsters need predictable behaviour to avoid+                      -- having to chase them forever. Ranged aggravating helps+                      -- and melee-less ranged always fleeing when hit helps+                      -- and makes them evading ambushers, perfect for swarms.+                  | condThreat 2  -- melee enemies near+                    || condThreat 5 && heavilyDistressed ->+                         -- enemies not near but maintain fleeing hysteresis,+                         -- but not if due to lack of support, which changes,+                         -- hence @heavilyDistressed@ and not @recentlyFled@+                    not condCanMelee  -- can't melee, flee+                    || -- No support, not alone, either not aggressive+                       -- or can safely project from afar instead. Flee.+                       not condSupport3+                       && not condSolo+                       -- Don't flee if can spend time productively, killing+                       -- an enemy that blocks projecting or walking.+                       && not condAnyFoeAdj+                       -- Extra random aggressiveness if can't project+                       -- and didn't flee recently and so undecided.+                       -- This is hacky; the randomness is outside @Strategy@.+                       && (condCanProject+                           || recentlyFled  -- still no support, keep fleeing+                           || Ability.getSk Ability.SkAggression actorMaxSk+                              < randomAggressionThreshold)+                  | otherwise -> False )  -- melee threats too far+        , ( runSkills  -- no blockers if can't move right now+          , meleeBlocker actorSk aid  -- only melee blocker+          , abInSkill SkMelee+            && (condAnyFoeAdj  -- if foes, don't displace, otherwise friends:+                || not (abInSkill SkDisplace)  -- displace friends, if can+                   && condAimEnemyOrStash) )  -- excited+                        -- So that animals block each other until hero comes+                        -- and then the stronger makes a show for him+                        -- and kills the weaker.+        , ( [SkAlter]+          , trigger aid ViaNothing+          , not condInMelee  -- don't incur overhead+            && condAdjTriggerable+            && not condAimEnemyTargeted )  -- targeting stash is OK, to unblock+                                           -- dungeons if party has only one key+        , ( [SkDisplace]  -- prevents some looping movement+          , displaceBlocker aid retry  -- fires up only when path blocked+          , retry || not condDesirableFloorItem )+        , ( [SkMelee]+          , meleeAny aid+          , condAnyFoeAdj )  -- won't flee nor displace, so let it melee+        , ( runSkills+          , flee actorSk+                 aid  -- rattlesnakes and hornets flee and return when charging+                 ((heavilyDistressedThisTurn && not condAnyHarmfulFoeAdj+                   || (heavilyDistressed && not (condThreat 2)))+                     -- prefer bad but dark spots if under fire+                  && not actorShines)+                 panicFleeL  -- ultimate panic mode; open tiles, if needed+          , condAnyHarmfulFoeAdj )+        ]+      -- Order doesn't matter, scaling does.+      -- These are flattened in @stratToFreq@ (taking only the best variant)+      -- and then summed, so if any of these can fire, it will.+      -- If none can, @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.+      -- The scaling values for @stratToFreq@ need to be so low-resolution+      -- or we get 32bit @Freqency@ overflows, which would bite us in JS.+      --+      -- Note that all monadic actions here are performed when the strategy+      -- is being chosen so, e.g., none of them can be @flee@ or the actor+      -- would be marked in state as fleeing even when the strategy is+      -- not chosen. TODO: introduce @MonadClientRead@ and so ensure with types+      -- that none of these actions modifie state.+      distant :: [([Skill], m (Frequency RequestTimed), Bool)]+      distant =+        [ ( [SkMoveItem]+          , stratToFreq (if condInMelee then 20 else 20000)+            $ yieldUnneeded aid  -- 20000 to unequip ASAP, unless is thrown+          , True )+        , ( [SkMoveItem]+          , stratToFreq 10+            $ equipItems aid  -- doesn't take long, very useful if safe+          , not (condInMelee+                 || condDesirableFloorItem+                 || uneasy) )+        , ( [SkProject]+          , stratToFreq (if condTgtNonmovingEnemy then 100 else 30)+              -- not too common, to leave missiles for pre-melee dance+            $ projectItem actorSk aid+          , condAimEnemyTargeted && not condInMelee && condCanProject )+        , ( [SkApply]  -- common, because animals have that+          , stratToFreq 10+            $ applyItem actorSk aid ApplyAll  -- use any potion or scroll+          , condAimEnemyTargeted || condThreat 9 )  -- can buff against enemies+        , ( runSkills+          , stratToFreq (if | condInMelee ->+                              4000  -- friends pummeled by target, go to help+                            | not condAimEnemyOrStash ->+                              20  -- if enemy only remembered investigate anyway+                            | not (isLit (bpos body))  -- would need to leave+                              && not actorShines       -- dark, most probably+                              && condGoalIsLit -> 1+                            | otherwise ->+                              200)+            $ chase actorSk aid avoidAmbient retry+          , condCanMelee+            && Just (blid body, bpos body) /= gstash fact+            && (if condInMelee then condAimEnemyOrStash+                else (condAimEnemyOrRemembered+                      || condAimNonEnemyPresent)+                     && (not (condThreat 2)+                         || heavilyDistressed  -- if under fire, do something!+                         || speed >= speedAdd speedWalk speedWalk+                              -- low risk of getting hit first+                         || 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) )+        ]+      suffix =+        [ ( [SkMoveItem]+          , pickup aid False  -- e.g., to give to other party members+          , not condInMelee && condDesirableFloorItem && not dozes )+        , ( [SkMoveItem]+          , unEquipItems aid  -- late, because these items not bad+          , not condInMelee && not dozes )+        , ( [SkWait]+          , waitBlockNow  -- try to fall asleep, rarely+          , bwatch body `notElem` [WSleep, WWake]+            && mayFallAsleep+            && prefersSleep actorMaxSk+            && not condAimCrucial)+        , ( runSkills+          , chase actorSk aid avoidAmbient retry+          , not dozes+            && if condInMelee+               then condCanMelee && condAimEnemyOrStash+               else (not (condThreat 2) || not condMeleeBad)+                    && (Just (blid body, bpos body) /= gstash fact+                        || heavilyDistressed  -- guard strictly, until harmed+                        || length oursExploring <= 1+                        || condOurAdj  -- or if teammates adjacent+                        || bcalm body < 10) )  -- break loop, avoid domination+        ]+      fallback =  -- Wait until friends sidestep; ensures strategy never empty.+                  -- Also, this is what non-leader heroes do, unless they melee.+        [ ( [SkWait]+          , case bwatch body of+              WSleep -> yellNow  -- we know actor doesn't want to sleep,+                                 -- so celebrate wake up with a bang+              _ -> waitBlockNow  -- block, etc.+          , True )+        , ( runSkills  -- if can't block, at least change something+          , chase actorSk aid avoidAmbient True+          , not condInMelee || condCanMelee && condAimEnemyTargeted )+        , ( [SkDisplace]  -- if can't brace, at least change something+          , displaceBlocker aid True+          , True )+        , ( []+          , yellNow  -- desperate fallback+          , True )+       ]+  -- Check current, not maximal skills, since this can be a leader as well+  -- as non-leader action.+  let checkAction :: ([Skill], m a, Bool) -> Bool+      checkAction (abts, _, cond) = (null abts || any abInSkill abts) && cond+      sumS :: [([Skill], m a, Bool)] -> [m a]+      sumS abAction =+        let as = filter checkAction abAction+        in map (\(_, m, _) -> m) as+      sumF :: [([Skill], m (Frequency RequestTimed), Bool)]+           -> m (Frequency RequestTimed)+      sumF abFreq = do+        let as = filter checkAction abFreq+        -- This is costly: the monadic side-effects are evaluated.+        -- If we roll an unevaluated one until we find one that is permitted,+        -- keeping track of those aready checked might outweigh the savings.+        -- Even worse, without evaluating per-item frequencies,+        -- applying an amazing item may be disregarded in favour of throwing+        -- a mediocre one.+        strats <- mapM (\(_, m, _) -> m) as+        return $! msum strats+      combineWeighted as = liftFrequency <$> sumF as+      sumPrefix = sumS prefix+      comDistant = combineWeighted distant+      sumSuffix = sumS suffix+      sumFallback = sumS fallback+      -- TODO: should be: sumPrefix .| comDistant .| sumSuffix .| sumFallback+      -- but then all side-effects have to be computed beforehand,+      -- breaking the state, e.g., marking actor as fleeing, always.+      sums = sumPrefix ++ [comDistant] ++ sumSuffix ++ sumFallback+      tryStrategies :: [m (Strategy RequestTimed)] -> m (Strategy RequestTimed)+      tryStrategies [] = return mzero+      tryStrategies (m : rest) = do+        str <- m+        if nullStrategy str+        then tryStrategies rest+        else return str  -- don't perform the remaining monadic actions+  if bwatch body == WSleep+     && abInSkill SkWait+     && mayContinueSleep+       -- no check of @canSleep@, because sight lowered by sleeping+  then return $! returN "sleep" ReqWait+  else tryStrategies sums++waitBlockNow :: MonadClient m => m (Strategy RequestTimed)+waitBlockNow = return $! returN "wait" ReqWait++yellNow :: MonadClient m => m (Strategy RequestTimed)+yellNow = return $! returN "yell" ReqYell++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)+  actorMaxSk <- getsState $ getActorMaxSkills aid+  let calmE = calmEnough b actorMaxSk+      isWeapon (_, _, _, itemFull, _) =+        IA.checkFlag Ability.Meleeable $ aspectRecordFull itemFull+      filterWeapon | onlyWeapon = filter isWeapon+                   | otherwise = id+      prepareOne (oldN, l4)+                 (Benefit{benInEqp}, _, iid, _, (itemK, _)) =+        let prep newN toCStore = (newN, (iid, itemK, CGround, toCStore) : l4)+            n = oldN + itemK+        in if | benInEqp && calmE && not (eqpOverfull b n) -> prep n CEqp+              | onlyWeapon -> (oldN, l4)+              | otherwise -> prep n CStash+      (_, 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 @benInEqp@ (which implies @goesIntoEqp@).+-- Such items are moved between any stores, as needed. In this case,+-- from stash to eqp.+equipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed)+equipItems aid = do+  body <- getsState $ getActorBody aid+  actorMaxSk <- getsState $ getActorMaxSkills aid+  let calmE = calmEnough body actorMaxSk+  fact <- getsState $ (EM.! bfid body) . sfactionD+  eqpAssocs <- getsState $ kitAssocs aid [CEqp]+  stashAssocs <- getsState $ kitAssocs aid [CStash]+  condShineWouldBetray <- condShineWouldBetrayM aid+  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid+  discoBenefit <- getsClient sdiscoBenefit+  localTime <- getsState $ getLocalTime (blid body)+  fleeD <- getsClient sfleeD+  -- In general, AI always equips the best item in stash if it's better+  -- than the best in equipment. Additionally, if there is space left+  -- in equipment for a future good item, an item from stash may be+  -- equipped if it's not much worse than in equipment.+  -- If the item in question is the best item in stash.+  -- at least one copy must remain in stash.+  let improve :: (Int, [(ItemId, Int, CStore, CStore)])+              -> ( [(Int, (ItemId, ItemFullKit))]+                 , [(Int, (ItemId, ItemFullKit))] )+              -> (Int, [(ItemId, Int, CStore, CStore)])+      improve (oldN, l4) (bestStash, bestEqp) =+        let n = 1 + oldN+        in if eqpOverfull body n then (oldN, l4)+           else case (bestStash, bestEqp) of+             ((_, (iidStash, _)) : _, []) ->+               (n, (iidStash, 1, CStash, CEqp) : l4)+             ((vStash, (iidStash, _)) : _, (vEqp, _) : _) | vStash > vEqp ->+               (n, (iidStash, 1, CStash, CEqp) : l4)+             _ -> case (pluralCopiesOfBest bestStash, bestEqp) of+               ((vStash, (iidStash, _)) : _, (vEqp, _) : _)+                 | not (eqpOverfull body (n + 1))  -- 9 items in equipment+                   && vStash >= vEqp - 20 && vStash > 20 ->+                     -- within 2 damage of the best and not too bad absolutely+                     (n, (iidStash, 1, CStash, CEqp) : l4)+               _ -> (oldN, l4)+      getK (_, (itemK, _)) = itemK+      pluralCopiesOfBest bestStash@((_, (_, itemFullKit)) : rest) =+        if getK itemFullKit > 1 then bestStash else rest+      pluralCopiesOfBest [] = []+      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.+        deltasSerious (bcalmDelta body)+      recentlyFled = maybe False (\(_, time) -> timeRecent5 localTime time)+                           (aid `EM.lookup` fleeD)+      uneasy = condAimEnemyOrRemembered+               || not calmE+               || heavilyDistressed+               || recentlyFled+      canEsc = fcanEscape (gplayer fact)+      -- 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 uneasy actorMaxSk itemFull+             || not canEsc && IA.isHumanTrinket (itemKind itemFull))+                  -- don't equip items that block progress, e.g., blowtorch+      bestTwo = bestByEqpSlot discoBenefit+                              (filter filterNeeded stashAssocs)+                              (filter filterNeeded eqpAssocs)+      bEqpStash = foldl' improve (0, []) bestTwo+      (_, prepared) = bEqpStash+  return $! if not calmE || null prepared+            then reject+            else returN "equipItems" $ ReqMoveItems prepared++yieldUnneeded :: MonadClient m => ActorId -> m (Strategy RequestTimed)+yieldUnneeded aid = do+  body <- getsState $ getActorBody aid+  actorMaxSk <- getsState $ getActorMaxSkills aid+  let calmE = calmEnough body actorMaxSk+  eqpAssocs <- getsState $ kitAssocs aid [CEqp]+  condShineWouldBetray <- condShineWouldBetrayM aid+  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid+  discoBenefit <- getsClient sdiscoBenefit+  localTime <- getsState $ getLocalTime (blid body)+  fleeD <- getsClient sfleeD+  -- 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.+        deltasSerious (bcalmDelta body)+      recentlyFled = maybe False (\(_, time) -> timeRecent5 localTime time)+                           (aid `EM.lookup` fleeD)+      uneasy = condAimEnemyOrRemembered+               || not calmE+               || heavilyDistressed+               || recentlyFled+      yieldSingleUnneeded (iidEqp, (itemEqp, (itemK, _))) =+        [ (iidEqp, itemK, CEqp, CStash)+        | harmful discoBenefit iidEqp  -- harmful not shared+          || hinders condShineWouldBetray uneasy actorMaxSk itemEqp ]+      yieldAllUnneeded = concatMap yieldSingleUnneeded eqpAssocs+  return $! if not calmE || null yieldAllUnneeded+            then reject+            else returN "yieldUnneeded" $ ReqMoveItems yieldAllUnneeded++-- This only concerns items that @equipItems@ handles, that is+-- with a slot and with @benInEqp@ (which implies @goesIntoEqp@).+unEquipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed)+unEquipItems aid = do+  body <- getsState $ getActorBody aid+  actorMaxSk <- getsState $ getActorMaxSkills aid+  let calmE = calmEnough body actorMaxSk+  eqpAssocs <- getsState $ kitAssocs aid [CEqp]+  stashAssocs <- getsState $ kitAssocs aid [CStash]+  condShineWouldBetray <- condShineWouldBetrayM aid+  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid+  discoBenefit <- getsClient sdiscoBenefit+  localTime <- getsState $ getLocalTime (blid body)+  fleeD <- getsClient sfleeD+  -- In general, AI unequips only if equipment is full and better stash item+  -- for another slot is likely to come or if the best (or second best)+  -- item in stash is worse than in equipment and at least one better+  -- item remains in equipment.+  let improve :: ( [(Int, (ItemId, ItemFullKit))]+                 , [(Int, (ItemId, ItemFullKit))] )+              -> [(ItemId, Int, CStore, CStore)]+      improve (bestStash, bestEqp) =+        case bestEqp of+          ((_, (iidEqp, itemEqp)) : _) | getK itemEqp > 1+                                         && bestStash `worseThanEqp` bestEqp ->+            -- To share the best items with others, if they care+            -- and if a better or equal item is not already in stash.+            -- The effect is that after each party member has a copy,+            -- a single copy is permanently kept in stash, to quickly+            -- equip a new-joiner.+            [(iidEqp, 1, CEqp, CStash)]+          _ : bestEqp2@((_, (iidEqp, itemEqp)) : _)+            | getK itemEqp > 1+              && bestStash `worseThanEqp` bestEqp2 ->+            -- To share the second best items with others, if they care+            -- and if a better or equal item is not already in stash.+            -- The effect is the same as with the rule above, but only as long+            -- as the best item is scarce. Then this rule doesn't fire and+            -- every second best item copy is eventually equipped by someone.+            [(iidEqp, getK itemEqp, CEqp, CStash)]+          _ -> case reverse bestEqp of+            bestEqpR@((vEqp, (iidEqp, itemEqp)) : _)+              | eqpOverfull body 1  -- 10 items in equipment+                && (bestStash `betterThanEqp` bestEqpR+                    || getK itemEqp > 1 && vEqp < 20) ->+              -- To make place in eqp for an item better than any ours.+              -- Even a minor boost is removed only if stash has a better one.+              -- Also remove extra copies if the item weak, ih hopes+              -- of a prompt better pickup.+              [(iidEqp, 1, CEqp, CStash)]+            _ -> []+      getK (_, (itemK, _)) = itemK+      worseThanEqp ((vStash, _) : _) ((vEqp, _) : _) = vStash < vEqp+      worseThanEqp [] _ = True+      worseThanEqp _ [] = error "unEquipItems: worseThanEqp: []"+      -- Not @>=@ or we could remove a useful item, without replacing it+      -- with a better or even equal one. We only remove it so if the item+      -- is weak and duplicated in equipment.+      betterThanEqp ((vStash, _) : _) ((vEqp, _) : _) = vStash > vEqp+      betterThanEqp [] _ = False+      betterThanEqp _ [] = error "unEquipItems: betterThanEqp: []"+      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.+        deltasSerious (bcalmDelta body)+      recentlyFled = maybe False (\(_, time) -> timeRecent5 localTime time)+                           (aid `EM.lookup` fleeD)+      uneasy = condAimEnemyOrRemembered+               || not calmE+               || heavilyDistressed+               || recentlyFled+      -- Here we don't need to filter out items that hinder (except in stash)+      -- because they are moved to stash 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 stash to consider only eligible items in @betterThanEqp@.+      filterNeeded (_, (itemFull, _)) =+        not $ hinders condShineWouldBetray uneasy actorMaxSk itemFull+      bestTwo = bestByEqpSlot discoBenefit+                              (filter filterNeeded stashAssocs)+                              eqpAssocs+      bEqpStash = concatMap improve bestTwo+  return $! if not calmE || null bEqpStash+            then reject+            else returN "unEquipItems" $ ReqMoveItems bEqpStash++groupByEqpSlot :: [(ItemId, ItemFullKit)]+               -> EM.EnumMap EqpSlot [(ItemId, ItemFullKit)]+groupByEqpSlot is =+  let f (iid, itemFullKit) =+        let arItem = aspectRecordFull $ fst itemFullKit+        in case IA.aEqpSlot arItem of+          Nothing -> Nothing+          Just es -> Just (es, [(iid, itemFullKit)])+      withES = mapMaybe f is+  in EM.fromListWith (++) withES++bestByEqpSlot :: DiscoveryBenefit+              -> [(ItemId, ItemFullKit)]+              -> [(ItemId, ItemFullKit)]+              -> [( [(Int, (ItemId, ItemFullKit))]+                  , [(Int, (ItemId, ItemFullKit))] )]+bestByEqpSlot discoBenefit eqpAssocs stashAssocs =+  let eqpMap = EM.map (\g -> (g, [])) $ groupByEqpSlot eqpAssocs+      stashMap = EM.map (\g -> ([], g)) $ groupByEqpSlot stashAssocs+      appendTwo (g1, g2) (h1, h2) = (g1 ++ h1, g2 ++ h2)+      eqpStashMap = EM.unionsWith appendTwo [eqpMap, stashMap]+      bestSingle = strongestSlot discoBenefit+      bestTwo eqpSlot (g1, g2) = (bestSingle eqpSlot g1, bestSingle eqpSlot g2)+  in EM.elems $ EM.mapWithKey bestTwo eqpStashMap++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++-- If enemy (or even a friend) blocks the way, sometimes melee him+-- even though normally you wouldn't.+meleeBlocker :: MonadClient m+             => Ability.Skills -> ActorId -> m (Strategy RequestTimed)+meleeBlocker actorSk aid = do+  b <- getsState $ getActorBody aid+  actorMaxSk <- getsState $ getActorMaxSkills aid+  fact <- getsState $ (EM.! bfid b) . sfactionD+  mtgtMPath <- getsClient $ EM.lookup aid . stargetD+  case mtgtMPath of+    Just TgtAndPath{ tapTgt=TEnemy{}+                   , tapPath=Just AndPath{pathList=q : _, pathGoal} }+      | q == pathGoal -> return reject+        -- not a real blocker, but goal enemy, so defer deciding whether+        -- to melee him to the code that deals with goal enemies+    Just TgtAndPath{tapPath=Just 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.+      lvl <- getLevel (blid b)+      let maim | adjacent (bpos b) pathGoal = Just pathGoal+               | adjacent (bpos b) q = Just q+               | otherwise = Nothing  -- MeleeDistant+          lBlocker = case maim of+            Nothing -> []+            Just aim -> posToAidsLvl aim lvl+      case lBlocker of+        aid2 : _ -> do+          body2 <- getsState $ getActorBody aid2+          actorMaxSk2 <- getsState $ getActorMaxSkills aid2+          -- No problem if there are many projectiles at the spot. We just+          -- attack the first one.+          if | bproj body2  -- displacing saves a move, so don't melee+               && getSk SkDisplace 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+                  && getSk SkDisplace actorSk <= 0+                       -- can't displace+                  && getSk SkMove actorSk > 0  -- blocked move+                  && 3 * bhp body2 < bhp b  -- only get rid of weak friends+                  && gearSpeed actorMaxSk2 <= gearSpeed actorMaxSk -> 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. However only potentially harmful+-- enemies or those having loot or moving (can follow and spy) are meleed+-- (or those that are in the way, see elsewhere).+-- Projectiles are rather displaced or sidestepped, because it's cheaper+-- and also the projectile may be explosive and so harm anyway+-- and also if ignored it may hit enemies --- AI can't tell.+meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed)+meleeAny aid = do+  b <- getsState $ getActorBody aid+  fact <- getsState $ (EM.! bfid b) . sfactionD+  adjBigAssocs <- getsState $ adjacentBigAssocs b+  actorMaxSkills <- getsState sactorMaxSkills+  let foe b2 = isFoe (bfid b) fact (bfid b2)+      adjFoes = filter (uncurry $ actorWorthKilling actorMaxSkills)+                $ filter (foe . snd) adjBigAssocs+  btarget <- getsClient $ getTarget aid+  mtargets <- case btarget of+    Just (TEnemy aid2) -> do+      b2 <- getsState $ getActorBody aid2+      return $! if adjacent (bpos b2) (bpos b)+                   && actorWorthKilling actorMaxSkills aid2 b2+                then Just [(aid2, b2)]+                else Nothing+    _ -> return Nothing+  let adjTargets = fromMaybe adjFoes mtargets+  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, hence triggering terrain.+-- 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.+-- TODO: In @actionStrategy@ we require minimal @SkAlter@ even for the case+-- of triggerable tile underfoot. Let's say this quirk is a specialization+-- of AI actors, because there are usually many, so not all need to trigger.+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 $ bpos b : vicinityUnsafe (bpos b)+  efeat <- embedBenefit fleeVia aid pbags+  return $! liftFrequency $ toFreq "trigger"+    [ (ceiling benefit, ReqAlter pos)+    | (benefit, (pos, _)) <- efeat+    , let underFeet = pos == bpos b+    , underFeet+      || not (occupiedBigLvl pos lvl)+         && not (occupiedProjLvl pos lvl) -- AlterBlockActor+         && EM.notMember pos (lfloor lvl) ]  -- AlterBlockItem++projectItem :: MonadClient m+            => Ability.Skills -> ActorId -> m (Strategy RequestTimed)+projectItem actorSk aid = do+  btarget <- getsClient $ getTarget aid+  b <- getsState $ getActorBody aid+  -- We query target, not path, because path is not needed for flinging.+  -- Even if unknown tiles exist between us and the target, we assume+  -- they are walkable and not just transparent and we happily try to shoot.+  mfpos <- getsState $ aidTgtToPos aid (blid b) btarget+  case (btarget, mfpos) of+    (_, Just fpos) | adjacent (bpos b) fpos -> return reject+    (Just (TEnemy aidE), Just fpos) -> do+      actorMaxSkills <- getsState sactorMaxSkills+      body <- getsState $ getActorBody aidE+      if actorWorthChasing actorMaxSkills aidE body then do+        cops <- getsState scops+        lvl <- getLevel (blid b)+        seps <- getsClient seps+        case makeLine False b fpos seps cops lvl of+          Just newEps -> do+            let skill = getSk SkProject actorSk+            -- ProjectAimOnself, ProjectBlockActor, ProjectBlockTerrain+            -- and no actors or obstacles along the path.+            benList <- condProjectListM skill aid+            localTime <- getsState $ getLocalTime (blid b)+            let fRanged (benR, cstore, iid, itemFull, kit) =+                  -- If the item is discharged, neither the kinetic hit nor+                  -- any effects activate, so no point projecting.+                  -- This changes in time, so recharging is not included+                  -- in @condProjectListM@, but checked here, just before fling.+                  let recharged = hasCharge localTime kit+                      arItem = aspectRecordFull itemFull+                      trange = IA.totalRange arItem $ 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))+                  in if trange >= chessDist (bpos b) fpos && recharged+                     then Just ( - ceiling (benR * intToDouble rangeMult / 10)+                               , ReqProject fpos newEps iid cstore )+                     else Nothing+                benRanged = mapMaybe fRanged benList+            return $! liftFrequency $ toFreq "projectItem" benRanged+          _ -> return reject+      else return reject+    _ -> return reject++data ApplyItemGroup = ApplyAll | ApplyFirstAid+  deriving Eq++applyItem :: MonadClient m+          => Ability.Skills -> ActorId -> ApplyItemGroup+          -> m (Strategy RequestTimed)+applyItem actorSk aid applyGroup = do+  b <- getsState $ getActorBody aid+  fact <- getsState $ (EM.! bfid b) . sfactionD+  condShineWouldBetray <- condShineWouldBetrayM aid+  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid+  localTime <- getsState $ getLocalTime (blid b)+  let calmE = calmEnough b actorSk+      heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.+        deltasSerious (bcalmDelta b)+      uneasy = condAimEnemyOrRemembered+               || not calmE+               || heavilyDistressed+        -- don't take recent fleeing into account when item can be lost+      skill = getSk SkApply actorSk+      -- This detects if the value of keeping the item in eqp is in fact < 0.+      hind = hinders condShineWouldBetray uneasy actorSk+      canEsc = fcanEscape (gplayer fact)+      permittedActor cstore itemFull kit =+        fromRight False+        $ permittedApply localTime skill calmE cstore itemFull kit+      disqualify :: Bool -> IK.Effect -> Bool+      -- These effects tweak items, which is only situationally beneficial+      -- and not really the best idea while in combat.+      disqualify _ IK.PolyItem = True+      disqualify _ IK.RerollItem = True+      disqualify _ IK.DupItem = True+      disqualify _ IK.Identify = True+      -- This is hard to use and would be wasted recharging stomach.+      disqualify _ IK.Recharge{} = True+      -- This is usually the main effect of item and it's useless without Calm.+      disqualify durable IK.Summon{} =+        durable && (bcalm b < xM 30 || not calmE)+      disqualify durable (IK.AtMostOneOf l) = any (disqualify durable) l+      disqualify durable (IK.OneOf l) = any (disqualify durable) l+      disqualify durable (IK.OnUser eff) = disqualify durable eff+      disqualify durable (IK.AndEffect eff1 eff2) =+        disqualify durable eff1 || disqualify durable eff2+      disqualify durable (IK.OrEffect eff1 eff2) =+        disqualify durable eff1 || disqualify durable eff2+      disqualify durable (IK.SeqEffect effs) = any (disqualify durable) effs+      disqualify durable (IK.When _ eff) = disqualify durable eff+      disqualify durable (IK.Unless _ eff) = disqualify durable eff+      disqualify durable (IK.IfThenElse _ eff1 eff2) =+        disqualify durable eff1 || disqualify durable eff2+      disqualify _ _ = False+      q (Benefit{benInEqp}, cstore, _, itemFull@ItemFull{itemKind}, kit) =+        let arItem = aspectRecordFull itemFull+            durable = IA.checkFlag Durable arItem+        in (not benInEqp  -- can't wear, so OK to break+            || durable  -- can wear, but can't break, even better+            || not (IA.checkFlag Ability.Meleeable arItem)+                 -- anything else expendable+               && hind itemFull)  -- hinders now, so possibly often, so away!+           && permittedActor (Just cstore) itemFull kit+           && not (any (disqualify durable) $ IK.ieffects itemKind)+           && (canEsc || not (IA.isHumanTrinket itemKind))+                -- A hack to prevent monsters from using up treasure+                -- meant for heroes.+      stores = [CStash, CGround, COrgan] ++ [CEqp | 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 maybe False (> 0) $ lookup IK.CONDITION $ IK.ifreq itemKind+           then Just $ if benInEqp (discoBenefit EM.! iid)+                       then Right $ GroupName $ IK.iname itemKind+                         -- conveniently, @iname@ matches @ifreq@+                       else Left $ GroupName $ IK.iname itemKind+           else Nothing) (EM.keys $ borgan b)+      fTool benAv@( Benefit{benApply}, cstore, iid+                  , itemFull@ItemFull{itemKind}, _ ) =+        let dropsGrps = IK.getDropOrgans itemKind  -- @Impress@ effect included+            dropsBadOrgans =+              not (null myBadGrps)+              && (IK.CONDITION `elem` dropsGrps+                  || not (null (dropsGrps `intersect` myBadGrps)))+            dropsImpressed =+              IK.S_IMPRESSED `elem` myBadGrps+              && (IK.CONDITION `elem` dropsGrps+                  || IK.S_IMPRESSED `elem` dropsGrps)+            dropsGoodOrgans =+              not (null myGoodGrps)+              && (IK.CONDITION `elem` dropsGrps+                  || not (null (dropsGrps `intersect` myGoodGrps)))+            wastesDrop = not dropsBadOrgans && not (null dropsGrps)+            -- Don't include @Ascend@ nor @Teleport@, because maybe no foe near.+            -- Don't include @AtMostOneOf@ nor @OneOf@ because+            -- other effects may kill you.+            getHP (IK.RefillHP p) = max 0 p+            getHP (IK.OnUser eff) = getHP eff+            getHP (IK.AndEffect eff1 eff2) = getHP eff1 + getHP eff2+            getHP (IK.OrEffect eff1 _) = getHP eff1+            getHP (IK.SeqEffect effs) = sum $ map getHP effs+            getHP (IK.When _ eff) = getHP eff+            getHP (IK.Unless _ eff) = getHP eff+            getHP (IK.IfThenElse _ eff1 eff2) = getHP eff1 + getHP eff2+            getHP _ = 0+            healPower = sum $ map getHP $ IK.ieffects itemKind+            wastesHP = xM healPower+                       > xM (Ability.getSk Ability.SkMaxHP actorSk) - bhp b+            durable = IA.checkFlag Durable $ aspectRecordFull itemFull+            situationalBenApply =+              if | dropsBadOrgans -> if dropsImpressed+                                     then benApply + 1000  -- crucial+                                     else benApply + 20+                 | wastesDrop || wastesHP -> benApply - 10+                 | otherwise -> benApply+            coeff CGround = 2  -- pickup turn saved+            coeff COrgan = if durable then 1 else 1000+              -- if not durable, must hinder currently or be very potent+            coeff CEqp = if durable then 1 else 1000+            coeff CStash = 1+            benR = ceiling situationalBenApply * coeff cstore+            canApply =+              situationalBenApply > 0+              && (dropsImpressed || not wastesHP)+                -- waste healing only if it drops impressed;+                -- otherwise apply anything beneficial at will+              && case applyGroup of+                ApplyFirstAid -> q benAv && (healPower > 0 || dropsImpressed)+                  -- when low HP, Calm easy to deplete, so impressed crucial+                ApplyAll -> q benAv && not dropsGoodOrgans+                  -- not an emergency, so don't sacrifice own good conditions+        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+     => Ability.Skills -> ActorId -> Bool -> [(Int, Point)]+     -> m (Strategy RequestTimed)+flee actorSk aid avoidAmbient fleeL = do+  COps{coTileSpeedup} <- getsState scops+  b <- getsState $ getActorBody aid+  localTime <- getsState $ getLocalTime (blid b)+  fleeD <- getsClient sfleeD+  let recentlyFled = maybe False (\(_, time) -> timeRecent5 localTime time)+                           (aid `EM.lookup` fleeD)+  -- Regardless if fleeing accomplished, mark the need, but don't forget+  -- the location of initial danger, in case enemies not seen any more,+  -- if not too old.+  unless recentlyFled $+    modifyClient $ \cli ->+      cli {sfleeD = EM.insert aid (bpos b, localTime) (sfleeD cli)}+  lvl <- getLevel $ blid b+  let isAmbient pos = Tile.isLit coTileSpeedup (lvl `at` pos)+                      && Tile.isWalkable coTileSpeedup (lvl `at` pos)+                        -- if solid, will be altered and perhaps darkened+      fleeAmbientAvoided = filter (not . isAmbient . snd) fleeL+      fleeAmbient = if avoidAmbient && not (null fleeAmbientAvoided)+                    then fleeAmbientAvoided+                    else fleeL+  let vVic = map (second (`vectorToFrom` bpos b)) fleeAmbient+      str = liftFrequency $ toFreq "flee" vVic+  mapStrategyM (moveOrRunAid actorSk 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)+  adjBigAssocs <- getsState $ adjacentBigAssocs b+  let foe (_, b2) = isFoe (bfid b) fact (bfid b2)+      adjFoes = filter foe adjBigAssocs+      walkable p =  -- DisplaceAccess+        Tile.isWalkable coTileSpeedup (lvl `at` p)+      nFriends body = length $ filter (adjacent (bpos body) . bpos) friends+      nFrNew = nFriends b + 1+      qualifyActor (aid2, b2) = do+        case posToAidsLvl (bpos b2) lvl of+          _ | not (walkable (bpos b2))  -- DisplaceAccess+              || boldpos b == Just (bpos b2)+                 && boldpos b2 == Just (bpos b) ->  -- avoid short loops+              return Nothing+          [_] -> do+            actorMaxSk <- getsState $ getActorMaxSkills aid2+            dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk+              -- DisplaceDying, DisplaceBraced, DisplaceImmobile,+              -- DisplaceSupported+            let nFrOld = nFriends b2+            return $! if dEnemy && nFrOld < nFrNew+                      then Just ( (nFrNew - nFrOld) ^ (2 :: Int)+                                , ReqDisplace aid2 )+                      else Nothing+          _ -> return Nothing  -- DisplaceProjectiles+  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=Just AndPath{pathList=q : _, pathGoal} }+      | q == pathGoal  -- not a real blocker but goal; only try to displace+                       -- if desperate (that is, already tried to melee it)+        && not retry ->+        return reject+    Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}}+      | adjacent (bpos b) q ->  -- not veered off target too much+        displaceTgt aid q retry+    _ -> return reject  -- goal reached++displaceTgt :: MonadClient m+            => ActorId -> Point -> Bool -> m (Strategy RequestTimed)+displaceTgt source tpos retry = do+  COps{coTileSpeedup} <- getsState scops+  b <- getsState $ getActorBody source+  actorMaxSkills <- getsState sactorMaxSkills+  let !_A = assert (adjacent (bpos b) tpos) ()+  lvl <- getLevel $ blid b+  let walkable p =  -- DisplaceAccess+        Tile.isWalkable coTileSpeedup (lvl `at` p)+  case posToAidsLvl tpos lvl of+    _ | not (walkable tpos) -> return reject  -- DisplaceAccess+    [aid2] -> do+      b2 <- getsState $ getActorBody aid2+      mleader <- getsClient sleader+      if | bwatch b2 `elem` [WSleep, WWake] ->+             return $! returN "displace sleeping" $ ReqDisplace aid2+         | Just aid2 == mleader -> return reject+         | boldpos b == Just tpos+           && boldpos b2 == Just (bpos b) ->+             return reject  -- avoid short loops+         | otherwise -> do+           tfact <- getsState $ (EM.! bfid b2) . sfactionD+           mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD+           enemyTgt <- condAimEnemyOrRememberedM source+           enemyTgt2 <- condAimEnemyOrRememberedM aid2+           case mtgtMPath of+             -- I can see targets of only own team, so no check of @bfid@.+             Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}}+               | q == bpos b ->  -- teammate wants to swap+                 return $! returN "displace mutual" $ ReqDisplace aid2+             Just _ -> return $!+               -- Teammate, possibly without path, for whatever reason.+               if retry  -- me desperate+                  || Just (blid b2, bpos b2) == gstash tfact  -- guarding; lazy+                  || getSk SkDisplace (actorMaxSkills EM.! aid2) <= 0+                       -- can't displace back+                  || enemyTgt && not enemyTgt2+                       -- 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+               then returN "displace teammate" $ ReqDisplace aid2+               else reject+             _ -> do  -- an enemy or ally or disoriented teammate+               actorMaxSk <- getsState $ getActorMaxSkills aid2+               dEnemy <- getsState $ dispEnemy source aid2 actorMaxSk+                 -- DisplaceDying, DisplaceBraced, DisplaceImmobile,+                 -- DisplaceSupported+               return $!+                 if bfid b == bfid b2  -- disoriented teammate; doesn't care+                    || isFoe (bfid b2) tfact (bfid b) && dEnemy  -- foe+                    || retry  -- ally, I need to be desperate, as above+                 then returN "displace other" $ ReqDisplace aid2+                 else reject+    _ -> return reject  -- DisplaceProjectiles and no blocker at all++chase :: MonadClient m+      => Ability.Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)+chase actorSk aid avoidAmbient retry = do+  body <- getsState $ getActorBody aid+  fact <- getsState $ (EM.! bfid body) . sfactionD+  mtgtMPath <- getsClient $ EM.lookup aid . stargetD+  let -- With no leader, the goal is vague, so permit arbitrary detours.+      relaxed = fleaderMode (gplayer fact) == LeaderNull+      strAmbient avoid = case mtgtMPath of+        Just TgtAndPath{tapPath=Just AndPath{pathList=q : _, ..}} ->+          if pathGoal == bpos body+          then return reject  -- done; picking up items, etc.+          else moveTowards actorSk aid avoid q pathGoal (relaxed || retry)+        _ -> return reject  -- goal reached or banned ambient lit tile+  strAvoided <- strAmbient avoidAmbient+  str <- if avoidAmbient && nullStrategy strAvoided+         then strAmbient False+         else return strAvoided+  mapStrategyM (moveOrRunAid actorSk aid) str++moveTowards :: MonadClient m+            => Ability.Skills -> ActorId -> Bool -> Point -> Point -> Bool+            -> m (Strategy Vector)+moveTowards actorSk aid avoidAmbient target goal relaxed = do+  COps{coTileSpeedup} <- getsState scops+  b <- getsState $ getActorBody aid+  lvl <- getLevel $ blid b+  let source = bpos b+      alterSkill = getSk SkAlter actorSk+      !_A = 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)+        (posToAidAssocs p (blid b) s)  -- don't kill own projectiles+  let lalter = salter EM.! blid b+      isAmbient pos = Tile.isLit coTileSpeedup (lvl `at` pos)+                      && Tile.isWalkable coTileSpeedup (lvl `at` pos)+                        -- if solid, will be altered and perhaps darkened+      -- Only actors with SkAlter can search for hidden doors, etc.+      enterableHere p = alterSkill >= fromEnum (lalter PointArray.! p)+      permittedHere p | avoidAmbient = enterableHere p && not (isAmbient p)+                      | otherwise = enterableHere p+  -- If target is the final goal, is not occupied and is lit, permit+  -- movement into lit position, regardless.+  if noFriends target && (target == goal && enterableHere target+                          || permittedHere target) then+    return $! returN "moveTowards target" $ target `vectorToFrom` source+  else do+    -- This lets animals mill around, even when blocked,+    -- because they have nothing to lose (unless other animals melee).+    -- Blocked heroes instead don't become leaders and don't move+    -- until friends sidestep to let them reach their goal.+    let goesBack p = Just p == boldpos b+        nonincreasing p = chessDist source goal >= chessDist p goal+        isSensible | relaxed = \p -> noFriends p+                                     && permittedHere p+                   | otherwise = \p -> nonincreasing p+                                       && not (goesBack p)+                                       && noFriends p+                                       && permittedHere p+        sensible = [ ((goesBack p, chessDist p goal), v)+                   | v <- moves+                   , let p = source `shift` v+                   , isSensible p ]+        -- @SortOn@ less efficient here, because function cheap.+        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+             => Ability.Skills -> ActorId -> Vector -> m (Maybe RequestTimed)+moveOrRunAid actorSk source dir = do+  COps{coTileSpeedup} <- getsState scops+  sb <- getsState $ getActorBody 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 || actorWaits 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).+  case posToAidsLvl tpos lvl of+    [target] | walkable+               && getSk SkDisplace actorSk > 0+               && notLooping sb tpos -> do+      -- @target@ can be a foe, as well as a friend.+      tb <- getsState $ getActorBody target+      tfact <- getsState $ (EM.! bfid tb) . sfactionD+      actorMaxSk <- getsState $ getActorMaxSkills target+      dEnemy <- getsState $ dispEnemy source target actorMaxSk+        -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported+      if isFoe (bfid tb) tfact (bfid sb) && not dEnemy+      then return Nothing+      else return $ Just $ ReqDisplace target+    [] | walkable && getSk SkMove actorSk > 0 ->+      -- Movement requires full access. The potential invisible actor is hit.+      return $ Just $ ReqMove dir+    [] | not walkable+         && getSk SkAlter 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., to close doors).       return $ Just $ ReqAlter tpos     _ -> return Nothing  -- can't displace, move nor alter

engine-src/Game/LambdaHack/Client/AI/PickActorM.hs view

@@ -1,6 +1,6 @@ -- | Picking the AI actor to move and refreshing leader and non-leader targets. module Game.LambdaHack.Client.AI.PickActorM-  ( pickActorToMove, setTargetFromTactics+  ( pickActorToMove, setTargetFromDoctrines   ) where  import Prelude ()@@ -19,10 +19,13 @@ import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Faction+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.State+import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Content.ModeKind@@ -32,20 +35,25 @@  -- | 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+pickActorToMove :: MonadClient m+                => [(ActorId, Actor)] -> [(ActorId, Actor)] -> Maybe ActorId+                -> m ActorId+pickActorToMove foeAssocs friendAssocs maidToAvoid = do+  COps{coTileSpeedup} <- getsState scops   actorMaxSkills <- getsState sactorMaxSkills   mleader <- getsClient sleader   let oldAid = fromMaybe (error $ "" `showFailure` maidToAvoid) mleader   oldBody <- getsState $ getActorBody oldAid   let side = bfid oldBody       arena = blid oldBody+  lvl <- getLevel arena+  localTime <- getsState $ getLocalTime arena+  condInMelee <- condInMeleeM arena   fact <- getsState $ (EM.! side) . sfactionD   -- Find our actors on the current level only.   ours <- getsState $ fidActorRegularAssocs side arena   let pickOld = do-        void $ refreshTarget (oldAid, oldBody)+        void $ refreshTarget foeAssocs friendAssocs (oldAid, oldBody)         return oldAid       oursNotSleeping = filter (\(_, b) -> bwatch b /= WSleep) ours   case oursNotSleeping of@@ -63,20 +71,23 @@     [(aidNotSleeping, bNotSleeping)] -> do       -- Target of asleep actors won't change unless foe adjacent,       -- which is caught without recourse to targeting.-      void $ refreshTarget (aidNotSleeping, bNotSleeping)+      void $ refreshTarget foeAssocs friendAssocs (aidNotSleeping, bNotSleeping)       return aidNotSleeping     _ -> 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+      -- until we can't distinguish them any more, at which point we slightly+      -- 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+            mtgt <- refreshTarget foeAssocs friendAssocs aidBody             return (aidBody, mtgt)       oursTgtRaw <- mapM refresh oursNotSleeping-      fleeD <- getsClient sfleeD-      let goodGeneric (_, Nothing) = Nothing+      oldFleeD <- getsClient sfleeD+      let recentlyFled aid = maybe False+                                   (\(_, time) -> timeRecent5 localTime time)+                                   (aid `EM.lookup` oldFleeD)+          goodGeneric (_, Nothing) = Nothing           goodGeneric (_, Just TgtAndPath{tapPath=Nothing}) = Nothing             -- this case means melee-less heroes adjacent to foes, etc.             -- will never flee if melee is happening; but this is rare;@@ -94,70 +105,66 @@             -- 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 && actorWaits 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+            _ | aid == oldAid && actorWaits b -> Nothing+                  -- Not the old leader that was stuck last turn+                  -- because he is likely to be still stuck.+            Nothing -> Just ((aid, b), tgt)+            Just aidToAvoid ->+              if aid == aidToAvoid+              then Nothing  -- not an attempted leader stuck this turn+              else Just ((aid, b), tgt)           oursTgt = mapMaybe goodGeneric oursTgtRaw-          -- This should be kept in sync with @actionStrategy@.+          -- This should be kept in sync with @actionStrategy@,+          -- because it's a part of the condition for @flee@ in @PickActionM@.+          -- Comments are in the full copy.           actorVulnerable ((aid, body), _) = do-            condInMelee <- condInMeleeM $ blid body             let actorMaxSk = actorMaxSkills EM.! aid-            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+            condAnyHarmfulFoeAdj <-+              getsState $ anyHarmfulFoeAdj actorMaxSkills aid+            threatDistL <- getsState $ meleeThreatDistList foeAssocs aid+            (fleeL, _) <- fleeList foeAssocs aid+            condSupport1 <- condSupport friendAssocs 1 aid+            condSolo <- condAloneM friendAssocs aid             let condCanFlee = not (null fleeL)+                heavilyDistressed =+                  deltasSerious (bcalmDelta body)                 speed1_5 = speedScale (3%2) (gearSpeed actorMaxSk)                 condCanMelee = actorCanMelee actorMaxSkills aid body-                condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL                 threatAdj = takeWhile ((== 1) . fst) threatDistL                 condManyThreatAdj = length threatAdj >= 2                 condFastThreatAdj =                   any (\(_, (aid2, _)) ->-                    let actorMaxSk2 = actorMaxSkills EM.! aid2-                    in gearSpeed actorMaxSk2 > speed1_5)-                  threatAdj-                heavilyDistressed =-                  -- Actor hit by a projectile or similarly distressed.-                  deltasSerious (bcalmDelta body)-                actorShines = Ability.getSk Ability.SkShine actorMaxSk > 0-                aCanDeLightL | actorShines = []-                             | otherwise = canDeAmbientL-                canFleeFromLight =-                  not $ null $ aCanDeLightL `intersect` map snd fleeL+                        let ar2 = actorMaxSkills EM.! aid2+                        in gearSpeed ar2 > speed1_5)+                      threatAdj+                condNonStealthyThreatAdj =+                  any (\(_, (aid2, b2)) ->+                        let ar2 = actorMaxSkills EM.! aid2+                        in Ability.getSk Ability.SkShine ar2 > 0+                           || isLit (bpos b2))+                      threatAdj+                isLit pos = Tile.isLit coTileSpeedup (lvl `at` pos)+                fleeingMakesSense =+                  not condCanMelee+                  || (Ability.getSk Ability.SkSight actorMaxSk > 2+                      || Ability.getSk Ability.SkNocto actorMaxSk > 2)+                     && (Ability.getSk Ability.SkShine actorMaxSk > 2+                         || condNonStealthyThreatAdj || null threatAdj)             return $!-              -- This is a part of the condition for @flee@ in @PickActionM@.               not condFastThreatAdj-              && if | condThreat 1 ->+              && fleeingMakesSense+              && if | condAnyHarmfulFoeAdj ->                       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 ...-                    -- because actor should be picked anyway, to try to melee.-                    | otherwise ->-                      not condInMelee-                      && heavilyDistressed-                      -- Different from @PickActionM@:-                      && 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)+                    | condInMelee -> False+                    | heavilyDistressed -> True+                        -- Different from @PickActionM@:+                        -- If under fire, do something quickly, always,+                        -- because the actor clearly vulnerable,+                        -- but don't make a leader only because threats close.+                    | otherwise -> False               && condCanFlee-          actorFled ((aid, _), _) = EM.member aid fleeD+          actorFled ((aid, _), _) = recentlyFled aid           actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _                                       , tapPath=Nothing }) =             return False@@ -166,29 +173,50 @@             | 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+            let closeFoes = filter ((<= 3) . chessDist (bpos b) . bpos . snd)+                                   foeAssocs                 actorHears = deltasHears (bcalmDelta b)             return $! actorHears  -- 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+          -- AI has to be prudent and not lightly waste leader for meleeing.+          actorMeleeing ((aid, _), _) =+            getsState $ anyHarmfulFoeAdj actorMaxSkills aid       (oursVulnerable, oursSafe) <- partitionM actorVulnerable oursTgt       let (oursFled, oursNotFled) = partition actorFled oursSafe-      (oursMeleeing, oursNotMeleeing) <- partitionM actorMeleeing oursNotFled+      (oursMeleeingRaw, oursNotMeleeingRaw) <-+         partitionM actorMeleeing oursNotFled+      let actorMeleeingCanDisplace ( (aid, sb)+                                   , TgtAndPath{tapTgt=TEnemy target} ) = do+            tb <- getsState $ getActorBody target+            let actorMaxSk = actorMaxSkills EM.! target+            dEnemy <- getsState $ dispEnemy aid target actorMaxSk+            -- Some usual conditions ignored, because transient or rare.+            return $! checkAdjacent sb tb && dEnemy+          actorMeleeingCanDisplace _ = return False+      (oursMeleeingCanDisplace, oursMeleeing) <-+         partitionM actorMeleeingCanDisplace oursMeleeingRaw+      let adjStash+            ( (_, b)+            , TgtAndPath{tapTgt=TPoint TStash{} lid pos} ) =+                lid == arena+                && adjacent pos (bpos b)+                && isNothing (posToBigLvl pos lvl)+          adjStash _ = False+          (oursAdjStash, oursNotMeleeing) =+            partition adjStash oursNotMeleeingRaw       (oursHearing, oursNotHearing) <- partitionM actorHearning oursNotMeleeing       let actorRanged ((aid, body), _) =             not $ actorCanMelee actorMaxSkills aid body           targetTEnemy (_, TgtAndPath{tapTgt=TEnemy _}) = True-          targetTEnemy-            ( (_, b)-            , TgtAndPath{tapTgt=TPoint (TEnemyPos _) lid _} ) =-              lid == blid b+          targetTEnemy (_, TgtAndPath{tapTgt=TPoint TEnemyPos{} lid _}) =+            lid == arena+          targetTEnemy ((_, b), TgtAndPath{tapTgt=TPoint TStash{} lid pos}) =+            lid == arena && pos /= bpos b+              -- stashes as crucial as enemies. except when guarding them           targetTEnemy _ = False           actorNoSupport ((aid, _), _) = do-            threatDistL <- getsState $ meleeThreatDistList aid-            condSupport2 <- condSupport 2 aid+            threatDistL <- getsState $ meleeThreatDistList foeAssocs aid+            condSupport2 <- condSupport friendAssocs 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@@ -196,6 +224,9 @@             return $! condThreat 5 && not condSupport2           (oursRanged, oursNotRanged) = partition actorRanged oursNotHearing           (oursTEnemyAll, oursOther) = partition targetTEnemy oursNotRanged+          notSwapReady ((_, b), TgtAndPath{tapTgt=TPoint TStash{} lid pos}) _ =+            lid == arena && pos == bpos b+              -- not ready to follow goal if already guarding the stash           notSwapReady abt@((_, b), _)                        (ab2, Just t2@TgtAndPath{tapPath=                                        Just AndPath{pathList=q : _}}) =@@ -230,23 +261,30 @@             else (oursNoSupportRaw, oursSupportRaw)           (oursBlocked, oursPos) =             partition targetBlocked $ oursRanged ++ oursOther+          guarding ((_, b), Just TgtAndPath{tapTgt=TPoint TStash{} lid pos}) =+            lid == arena && pos == bpos b+          guarding _ = False+          -- Don't try to include a stash guard in formation, even if attacking+          -- or being attacked. Attackers would be targetted anyway.+          oursNotSleepingNorGuarding = filter (not . guarding) oursTgtRaw           -- Lower overhead is better.           overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int-          overheadOurs ((aid, _), TgtAndPath{tapPath=Nothing}) =-            100 + if aid == oldAid then 1 else 0-          overheadOurs-            abt@( (aid, b)-                , TgtAndPath{tapPath=Just AndPath{pathLen=d,pathGoal}} ) =+          overheadOurs (_, TgtAndPath{tapPath=Nothing}) = 100+          overheadOurs ((_, b), TgtAndPath{tapTgt=TPoint TStash{} lid pos})+            | lid == arena && pos == bpos b = 200  -- guarding, poor choice+          overheadOurs abt@( (aid, b)+                           , TgtAndPath{tapPath=Just AndPath{pathLen=d, ..}} ) =             -- 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 oursNotSleeping+            let maxSpread = 3 + length oursNotSleepingNorGuarding                 lDist p = [ chessDist (bpos b2) p-                          | (aid2, b2) <- oursNotSleeping, aid2 /= aid]+                          | ((aid2, b2), _) <- oursNotSleepingNorGuarding+                          , aid2 /= aid ]                 pDist p = let ld = lDist p-                          in assert (not $ null ld) $ minimum ld+                          in if null ld then 0 else minimum ld                 aidDist = pDist (bpos b)                 -- Negative, if the goal gets us closer to the party.                 diffDist = pDist pathGoal - aidDist@@ -255,27 +293,51 @@                 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)+                targetsEnemy = targetTEnemy abt+                fightValue = if targetsEnemy+                             then - fromEnum (bhp b `div` (10 * oneM))+                             else 0+                isLit pos = Tile.isLit coTileSpeedup (lvl `at` pos)+                  -- solid tiles ignored, because not obvious if dark+                  -- after removed+                actorMaxSk = actorMaxSkills EM.! aid+                actorShines = Ability.getSk Ability.SkShine actorMaxSk > 0+                stepsIntoLight =+                  not actorShines+                  && not (isLit $ bpos b)+                  && case pathList of+                    [] -> False+                    q : _ -> isLit q+                      -- shortest path is through light even though may+                      -- sidestep through dark in @chase@ or @flee@+            in formationValue `div` 3+               + fightValue                + (case d of-                    0 -> -400 -- do your thing ASAP and retarget-                    1 -> -200 -- prevent others from occupying the tile+                    0 -> -400  -- do your thing ASAP and retarget+                    1 | not targetsEnemy -> -200+                      -- prevent others from trying to occupy the tile;+                      -- TStash that obscures a foe correctly handled here                     _ -> if d < 8 then d `div` 4 else 2 + d `div` 10)-               + (if aid == oldAid then 1 else 0)-          positiveOverhead sk =-            let ov = 200 - overheadOurs sk-            in if ov <= 0 then 1 else ov-          candidates = [ oursVulnerable+               + (if aid == oldAid then 0 else 10)+               + (if stepsIntoLight then 30 else 0)+          -- Overheads above @maxBoundInt32@ are unlikely (and unsuppored in JS)+          -- and also capping the value does not distort the choice too much.+          positiveOverhead abt =+            min maxBoundInt32 $ max 1 $ 200 - overheadOurs abt+          candidates = [ oursAdjStash+                       , 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+                       , oursFled  -- if just fled, but not vulnerable,+                                   -- keep him passive and safe, out of action+                       , oursMeleeingCanDisplace+                           -- prefer melee actors displacing than blocked+                           -- actors trying to walk around them+                       , oursTEnemyBlocked+                           -- prefer blocked actors trying to walk around+                           -- even if that causes overhead for the meleeing+                       , oursMeleeing                        , oursHearing                        , oursBlocked                        ]@@ -288,34 +350,33 @@           modifyClient $ updateLeader aid s           -- When you become a leader, stop following old leader, but follow           -- his target, if still valid, to avoid distraction.-          condInMelee <- condInMeleeM $ blid b-          when (ftactic (gplayer fact)+          when (fdoctrine (gplayer fact)                 `elem` [Ability.TFollow, Ability.TFollowNoItems]                 && not condInMelee) $-            void $ refreshTarget (aid, b)+            void $ refreshTarget foeAssocs friendAssocs (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+-- | Inspect the doctrines of the actor and set his target according to it.+setTargetFromDoctrines :: MonadClient m+                        => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId+                        -> m ()+setTargetFromDoctrines foeAssocs friendAssocs oldAid = do   mleader <- getsClient sleader   let !_A = assert (mleader /= Just oldAid) ()   oldBody <- getsState $ getActorBody oldAid   moldTgt <- getsClient $ EM.lookup oldAid . stargetD-  condInMelee <- condInMeleeM $ blid oldBody   let side = bfid oldBody       arena = blid oldBody   fact <- getsState $ (EM.! side) . sfactionD-  let explore = void $ refreshTarget (oldAid, oldBody)+  let explore = void $ refreshTarget foeAssocs friendAssocs (oldAid, oldBody)       setPath mtgt = case (mtgt, moldTgt) of         (Nothing, _) -> return False         ( Just TgtAndPath{tapTgt=leaderTapTgt},           Just TgtAndPath{tapTgt=oldTapTgt,tapPath=Just oldTapPath} )           | leaderTapTgt == oldTapTgt  -- targets agree             && bpos oldBody == pathSource oldTapPath -> do  -- nominal path-            void $ refreshTarget (oldAid, oldBody)+            void $ refreshTarget foeAssocs friendAssocs (oldAid, oldBody)             return True  -- already on target         (Just TgtAndPath{tapTgt=leaderTapTgt}, _) -> do             tap <- createPath oldAid leaderTapTgt@@ -326,7 +387,7 @@                   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+        -- If no leader at all (forced @TFollow@ doctrine on an actor         -- from a leaderless faction), fall back to @TExplore@.         Nothing -> explore         _ | bwatch oldBody == WSleep ->@@ -334,7 +395,9 @@           explore         Just leader -> do           onLevel <- getsState $ memActor leader arena-          -- If leader not on this level, fall back to @TExplore@.+          condInMelee <- condInMeleeM arena+          -- If leader not on this level or if we are meleeing,+          -- and so following is not important, fall back to @TExplore@.           if not onLevel || condInMelee then explore           else do             -- Copy over the leader's target, if any, or follow his position.@@ -347,7 +410,7 @@               unless nonEnemyPathSet                 -- If no path even to the leader himself, explore.                 explore-  case ftactic $ gplayer fact of+  case fdoctrine $ gplayer fact of     Ability.TExplore -> explore     Ability.TFollow -> follow     Ability.TFollowNoItems -> follow

engine-src/Game/LambdaHack/Client/AI/PickTargetM.hs view

@@ -35,6 +35,7 @@ import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector+import qualified Game.LambdaHack.Content.CaveKind as CK import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.RuleKind import           Game.LambdaHack.Content.TileKind (isUknownSpace)@@ -44,11 +45,10 @@  -- | Verify and possibly change the target of an actor. This function both -- updates the target in the client state and returns the new target explicitly.-refreshTarget :: MonadClient m => (ActorId, Actor) -> m (Maybe TgtAndPath)--- This inline would speeds up execution by 5% and decreases allocation by 10%,--- but it'd bloat JS code without speeding it up.--- {-# INLINE refreshTarget #-}-refreshTarget (aid, body) = do+refreshTarget :: MonadClient m+              => [(ActorId, Actor)] -> [(ActorId, Actor)] -> (ActorId, Actor)+              -> m (Maybe TgtAndPath)+refreshTarget foeAssocs friendAssocs (aid, body) = do   side <- getsClient sside   let !_A = assert (bfid body == side                     `blame` "AI tries to move an enemy actor"@@ -56,7 +56,7 @@   let !_A = assert (not (bproj body)                     `blame` "AI gets to manually move its projectiles"                     `swith` (aid, body, side)) ()-  mtarget <- computeTarget aid+  mtarget <- computeTarget foeAssocs friendAssocs aid   case mtarget of     Nothing -> do       -- Melee in progress and the actor can't contribute@@ -66,7 +66,6 @@       return Nothing     Just tgtMPath -> do       -- _debugoldTgt <- getsClient $ EM.lookup aid . stargetD-      -- Choose a target from those proposed by AI for the actor.       modifyClient $ \cli ->         cli {stargetD = EM.insert aid tgtMPath (stargetD cli)}       return mtarget@@ -79,10 +78,11 @@       --       <> "\nHandleAI target:"   <+> tshow tgtMPath       -- trace _debug $ return $ Just tgtMPath -computeTarget :: forall m. MonadClient m => ActorId -> m (Maybe TgtAndPath)-{-# INLINE computeTarget #-}-computeTarget aid = do-  cops@COps{corule=RuleContent{rXmax, rYmax, rnearby}, coTileSpeedup}+computeTarget :: forall m. MonadClient m+              => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId+              -> m (Maybe TgtAndPath)+computeTarget foeAssocs friendAssocs aid = do+  cops@COps{cocave, corule=RuleContent{rXmax, rYmax, rnearby}, coTileSpeedup}     <- getsState scops   b <- getsState $ getActorBody aid   mleader <- getsClient sleader@@ -95,6 +95,7 @@       actorMaxSk = actorMaxSkills EM.! aid       alterSkill = Ability.getSk Ability.SkAlter actorMaxSk   lvl <- getLevel $ blid b+  localTime <- getsState $ getLocalTime (blid b)   let stepAccesible :: [Point] -> Bool       stepAccesible (q : _) =         -- Effectively, only @alterMinWalk@ is checked, because real altering@@ -111,8 +112,9 @@       mvalidPos <- getsState $ aidTgtToPos aid (blid b) (Just tapTgt)       return $!         if | isNothing mvalidPos -> Nothing  -- wrong level-           | bpos b == pathGoal->+           | bpos b == pathGoal ->                mtgtMPath  -- goal reached; stay there picking up items+                          -- or hiding in ambush or in panic            | pathSource == bpos b ->  -- no move                -- If next step not accessible, something serious happened,                -- so reconsider the target, not only path.@@ -134,44 +136,56 @@                                    -- by enemy or congestion, so serious,                                    -- so reconsider target, not only path     Nothing -> return Nothing  -- no target assigned yet-  fact <- getsState $ (EM.! bfid b) . sfactionD-  allFoes <- getsState $ foeRegularAssocs (bfid b) (blid b)-  let canMove = Ability.getSk Ability.SkMove actorMaxSk > 0-                || Ability.getSk Ability.SkDisplace actorMaxSk > 0-                -- Needed for now, because AI targets and shoots enemies-                -- based on the path to them, not LOS to them:-                || Ability.getSk Ability.SkProject actorMaxSk > 0-      canAlter = Ability.getSk Ability.SkAlter actorMaxSk >= 4+  factionD <- getsState sfactionD+  seps <- getsClient seps+  let fact = factionD EM.! bfid b+      slackDoctrine =+        fdoctrine (gplayer fact)+          `elem` [ Ability.TMeleeAndRanged, Ability.TMeleeAdjacent+                 , Ability.TBlock, Ability.TRoam, Ability.TPatrol ]+      canMove = Ability.getSk Ability.SkMove actorMaxSk > 0+      canReach = canMove+                 || Ability.getSk Ability.SkDisplace actorMaxSk > 0+                 -- Needed for now, because AI targets and shoots enemies+                 -- based on the path to them, not LOS to them:+                 || Ability.getSk Ability.SkProject actorMaxSk > 0+      canAlter = Ability.getSk Ability.SkAlter actorMaxSk+                 >= if slackDoctrine then 2 else 4+      canMoveItem = Ability.getSk Ability.SkMoveItem actorMaxSk > 0+      calmE = calmEnough b actorMaxSk+      heavilyDistressed =  -- actor hit by a proj or similarly distressed+        deltasSerious (bcalmDelta b)+  -- Speedup compared to @currentSkillsClient@.   actorMinSk <- getsState $ actorCurrentSkills Nothing aid   condCanProject <-     condCanProjectM (Ability.getSk Ability.SkProject actorMaxSk) aid+  fleeD <- getsClient sfleeD   let condCanMelee = actorCanMelee actorMaxSkills aid b       condHpTooLow = hpTooLow b actorMaxSk-  friends <- getsState $ friendRegularList (bfid b) (blid b)+      mfled = aid `EM.lookup` fleeD+      recentlyFled =+        maybe False (\(_, time) -> timeRecent5 localTime time) mfled+      recentlyFled20 =+        maybe False (\(_, time) -> timeRecent5 localTime time) mfled+      actorTurn = ticksPerMeter $ gearSpeed actorMaxSk   let canEscape = fcanEscape (gplayer fact)       canSmell = Ability.getSk Ability.SkSmell actorMaxSk > 0       meleeNearby | canEscape = rnearby `div` 2                   | otherwise = rnearby       rangedNearby = 2 * meleeNearby-      -- Don't target nonmoving actors, including sleeping, unless-      -- they have loot or attack ours or at heroes, because nonmoving-      -- can't be lured nor ambushed nor can chase us.-      ---      -- This is KISS, but not ideal, because AI doesn't fling at nonmoving-      -- actors but only at moving ones and so probably doesn't use-      -- ranged combat as much as would be optimal.-      worthTargetting aidE body = do-        actorMaxSkE <- getsState $ getActorMaxSkills aidE-        factE <- getsState $ (EM.! bfid body) . sfactionD-        let attacksFriends = any (adjacent (bpos body) . bpos) friends-            nonmoving = Ability.getSk Ability.SkMove actorMaxSkE <= 0-                        && bwatch body /= WWake  -- will start moving very soon-            hasLoot = not (EM.null (beqp body)) || not (EM.null (binv body))-              -- even consider "unreported inventory", for speed and KISS-            isHero = fhasGender (gplayer factE)-        return $! not nonmoving || hasLoot || attacksFriends || isHero+      -- We do target foes that already attack ours or have benign weapons.+      -- We assume benign weapons run out if they are the sole cause+      -- of targeting, to avoid stalemate.+      worthTargeting aidE body =+        let attacksFriends =+              any (adjacent (bpos body) . bpos . snd) friendAssocs+              && actorCanMeleeToHarm actorMaxSkills aidE body+        in attacksFriends+           || bweapBenign body > 0+           || actorWorthChasing actorMaxSkills aidE body       targetableMelee body =-        let attacksFriends = any (adjacent (bpos body) . bpos) friends+        let attacksFriends =+              any (adjacent (bpos body) . bpos . snd) friendAssocs             -- 3 is             -- 1 from condSupport1             -- + 2 from foe being 2 away from friend before he closed in@@ -180,14 +194,16 @@             n | Ability.getSk Ability.SkAggression actorMaxSk >= 2               = rangedNearby                   -- boss never waits-              | condInMelee = if attacksFriends then 4 else 2+              | condInMelee = if attacksFriends then 8 else 4                   -- attack even if foe not in melee, to create another                   -- skirmish and perhaps overwhelm them in this one;                   -- also, this looks more natural; also sometimes the foe                   -- would attack our friend in a couple of turns anyway,                   -- but we may be too far from him at that time               | otherwise = meleeNearby-        in condCanMelee && chessDist (bpos body) (bpos b) <= n+        in canMove+           && condCanMelee+           && chessDist (bpos body) (bpos b) <= n       -- Even when missiles run out, the non-moving foe will still be       -- targeted, which is fine, since he is weakened by ranged, so should be       -- meleed ASAP, even if without friends.@@ -196,17 +212,30 @@           -- boss fires at will         && chessDist (bpos body) (bpos b) < rangedNearby         && condCanProject-      targetableEnemy (aidE, body) =-        if adjacent (bpos body) (bpos b)-        then return True  -- target regardless of anything, e.g., to flee-        else do-          worth <- worthTargetting aidE body-          return $! worth && (targetableRanged body || targetableMelee body)-  nearbyFoes <- filterM targetableEnemy allFoes+        && (canMove || targetableLine body)+              -- prevent the exploit of using cover against non-moving shooters+              -- causing them to ignore any other distant foes+      targetableLine body = isJust $ makeLine False b (bpos body) seps cops lvl+      targetableEnemy (aidE, body) = worthTargeting aidE body+                                     && (adjacent (bpos body) (bpos b)+                                            -- target regardless of anything,+                                            -- e.g., to flee if helpless+                                         || targetableMelee body+                                         || targetableRanged body)+      targetableFoes = filter targetableEnemy foeAssocs+      canMeleeEnemy (aidE, body) = actorCanMeleeToHarm actorMaxSkills aidE body+      nearbyFoes = if recentlyFled && not condInMelee+                   then filter (not . canMeleeEnemy) targetableFoes+                   else targetableFoes   discoBenefit <- getsClient sdiscoBenefit-  fleeD <- getsClient sfleeD   getKind <- getsState $ flip getIidKind   getArItem <- getsState $ flip aspectRecordFromIid+  cstashes <- if canMove+                 && (calmE || null nearbyFoes) -- danger or risk of defecting+                 && not heavilyDistressed+                 && isAIFact fact  -- humans target any stashes explicitly+              then closestStashes aid+              else return []   let desirableIid (iid, (k, _)) =         let Benefit{benPickup} = discoBenefit EM.! iid         in desirableItem cops canEscape benPickup@@ -218,118 +247,145 @@         let actorSk = if mleader == Just aid then actorMaxSk else actorMinSk         in Ability.getSk Ability.SkMove actorSk > 0       isStuck = actorWaits b && couldMoveLastTurn-      slackTactic =-        ftactic (gplayer fact)-          `elem` [ Ability.TMeleeAndRanged, Ability.TMeleeAdjacent-                 , Ability.TBlock, Ability.TRoam, Ability.TPatrol ]       setPath :: Target -> m (Maybe TgtAndPath)       setPath tgt = do-        let take7 tap@TgtAndPath{tapTgt=TEnemy{}} =-              tap  -- @TEnemy@ needed for projecting, even by roaming actors-            take7 tap@TgtAndPath{tapPath=Just AndPath{..}} =-              -- Best path only followed 7 moves; then straight on. Cheaper.-              let path7 = take 7 pathList-                  vOld = towards (bpos b) pathGoal-                  pNew = shiftBounded rXmax rYmax (bpos b) vOld-                  walkable = Tile.isWalkable coTileSpeedup $ lvl `at` pNew+        let take6 tap@TgtAndPath{tapTgt=TEnemy{}} = tap+              -- @TEnemy@ needed for projecting, even by roaming actors;+              -- however, CStash not as binding, so excursions possible+            take6 TgtAndPath{tapPath=Just AndPath{..}} =+              -- Path followed for up to 6 moves regardless if the target valid+              -- and then target forgot and a new one picked.+              let path6 = take 6 pathList+                  vOld = if bpos b /= pathGoal+                         then towards (bpos b) pathGoal+                         else Vector 0 0                   tapTgt = TVector vOld-              in if bpos b == pathGoal  -- goal reached, so better know the tgt-                    || not walkable  -- can't walk, so don't chase a vector-                 then tap-                 else TgtAndPath{ tapTgt-                                , tapPath=Just AndPath{pathList=path7, ..} }-            take7 tap = tap+                  tapPath = Just AndPath{pathList=path6, ..}+              in TgtAndPath{..}+            take6 tap = tap         tgtpath <- createPath aid tgt-        return $ Just $ if slackTactic then take7 tgtpath else tgtpath+        return $ Just $ if slackDoctrine then take6 tgtpath else tgtpath       pickNewTarget = pickNewTargetIgnore Nothing       pickNewTargetIgnore :: Maybe ActorId -> m (Maybe TgtAndPath)-      pickNewTargetIgnore maidToIgnore = do-        let f aidToIgnore = filter ((/= aidToIgnore) . fst) nearbyFoes-            notIgnoredFoes = maybe nearbyFoes f maidToIgnore-        cfoes <- closestFoes notIgnoredFoes aid-        case cfoes of-          (_, (aid2, _)) : _ -> setPath $ TEnemy aid2-          [] | condInMelee -> return Nothing  -- don't slow down fighters-            -- this looks a bit strange, because teammates stop in their tracks-            -- all around the map (unless very close to the combatant),-            -- but the intuition is, not being able to help immediately,-            -- and not being too friendly to each other, they just wait and see-            -- and also shout to the teammate to flee and lure foes into ambush+      pickNewTargetIgnore maidToIgnore =+        case cstashes of+          (_, (fid2, pos2)) : _ -> setPath $ TPoint (TStash fid2) (blid b) pos2           [] -> do-            citemsRaw <- closestItems aid-            let citems = toFreq "closestItems"-                         $ filter desirableFloor citemsRaw-            if nullFreq citems then do-              ctriggersRaw <- closestTriggers ViaAnything aid-              let ctriggers = toFreq "ctriggers" ctriggersRaw-              if nullFreq ctriggers then do-                -- Tracking enemies is more important than exploring, but smell-                -- is unreliable and may lead to allies, not foes, so avoid it.-                smpos <- if canSmell-                         then closestSmell aid-                         else return []-                case smpos of-                  [] -> do-                    let vToTgt v0 = do+            let f aidToIgnore = filter ((/= aidToIgnore) . fst) nearbyFoes+                notIgnoredFoes = maybe nearbyFoes f maidToIgnore+            cfoes <- closestFoes notIgnoredFoes aid+            case cfoes of+             (_, (aid2, _)) : _ -> setPath $ TEnemy aid2+             [] | condInMelee -> return Nothing  -- don't slow down fighters+               -- this looks a bit strange, because teammates stop+               -- in their tracks all around the map (unless very close+               -- to the combatant), but the intuition is, not being able+               -- to help immediately, and not being too friendly+               -- to each other, they just wait and see and also shout+               -- to the teammate to flee and lure foes into ambush+             [] -> do+              mhideout <- if recentlyFled20+                          then closestHideout aid+                          else return Nothing+              case (mhideout, mfled) of+               (Just (p, dist), Just (_, time))+                 | timeDeltaToFrom localTime time+                   <= timeDeltaScale actorTurn (20 - dist) ->+                -- Only target if can reach the hideout 20 turns from fleeing+                -- start, given the actor speed as a leader.+                setPath $ TPoint THideout (blid b) p+               _ -> do+                citemsRaw <- if canMoveItem && canMove+                             then closestItems aid+                             else return []+                let citems = toFreq "closestItems"+                             $ filter desirableFloor citemsRaw+                if nullFreq citems then do+                  -- Tracking enemies is more important than exploring,+                  -- but smell is unreliable and may lead to allies,+                  -- not foes, so avoid it. However, let's keep smell+                  -- more imporant than getting to stairs, to let smelling+                  -- monsters follow cues even on explored levels.+                  smpos <- if canSmell+                           then closestSmell aid+                           else return []+                  case smpos of+                    [] -> do+                      ctriggersRaw <- closestTriggers ViaAnything aid+                      let ctriggers = toFreq "ctriggers" ctriggersRaw+                      if nullFreq ctriggers then do+                        let oldpos = fromMaybe (bpos b) (boldpos b)+                            vOld = bpos b `vectorToFrom` oldpos+                            pNew = shiftBounded rXmax rYmax (bpos b) vOld+                        if slackDoctrine && not isStuck && calmE && not focused+                           && isUnit vOld && bpos b /= pNew+                                -- both are needed, e.g., when just teleported+                                -- or when the shift bounded by level borders+                        then do                           let vFreq = toFreq "vFreq"-                                      $ (20, v0) : map (1,) moves+                                      $ (20, vOld) : map (1,) moves                           v <- rndToAction $ frequency vFreq-                          -- Items and smells, etc. considered every 7 moves.+                          -- Once the most pressing targets exhaused,+                          -- wander around for 7 steps and only then,+                          -- or if blocked or derailed, consider again+                          -- the old and new targets.+                          --+                          -- Together with depending on heroes or aliens+                          -- to keep arean, sleepiness, inability to displace+                          -- and chasing random smells, this makes it very hard+                          -- to fully explore and change levels for, e.g.,+                          -- animals. Heroes idling on the level help a lot.                           let pathSource = bpos b-                              tra = trajectoryToPathBounded-                                      rXmax rYmax pathSource (replicate 7 v)-                              pathList = map head $ group tra+                              traSlack7 = trajectoryToPathBounded+                                            rXmax rYmax pathSource+                                            (replicate 7 v)  -- > 6 from take6+                              pathList = map head $ group traSlack7                               pathGoal = last pathList                               pathLen = length pathList-                          return $ Just $-                            TgtAndPath-                              { tapTgt = TVector v-                              , tapPath = if pathLen == 0-                                          then Nothing-                                          else Just AndPath{..} }-                        oldpos = fromMaybe (bpos b) (boldpos b)-                        vOld = bpos b `vectorToFrom` oldpos-                        pNew = shiftBounded rXmax rYmax (bpos b) vOld-                    if slackTactic && not isStuck-                       && isUnit vOld && bpos b /= pNew-                            -- both are needed, e.g., when just teleported-                            -- or when the shift bounded by level borders-                       && Tile.isWalkable coTileSpeedup (lvl `at` pNew)-                    then vToTgt vOld-                    else do-                      upos <- closestUnknown aid-                      case upos of-                        Nothing -> do-                          -- If can't move (and so no BFS data), no info gained.-                          -- Or if can't alter and possibly stuck among rubble.-                          when (canMove && canAlter) $-                            modifyClient $ \cli -> cli {sexplored =-                              ES.insert (blid b) (sexplored cli)}-                          ctriggersRaw2 <- closestTriggers ViaExit aid-                          let ctriggers2 = toFreq "ctriggers2" ctriggersRaw2-                          if nullFreq ctriggers2 then do-                            afoes <- closestFoes allFoes aid-                            case afoes of-                              (_, (aid2, _)) : _ ->-                                -- All stones turned, time to win or die.-                                setPath $ TEnemy aid2-                              [] -> do-                                furthest <- furthestKnown aid-                                setPath $ TPoint TKnown (blid b) furthest-                          else do-                            (p, (p0, bag)) <- rndToAction $ frequency ctriggers2-                            setPath $ TPoint (TEmbed bag p0) (blid b) p-                        Just p -> setPath $ TPoint TUnknown (blid b) p-                  (_, (p, _)) : _ -> setPath $ TPoint TSmell (blid b) p-              else do-                (p, (p0, bag)) <- rndToAction $ frequency ctriggers-                setPath $ TPoint (TEmbed bag p0) (blid b) p-            else do-              (p, bag) <- rndToAction $ frequency citems-              setPath $ TPoint (TItem bag) (blid b) p-      tellOthersNothingHere pos = do+                              tapTgt = TVector v+                              tapPath = Just AndPath{..}+                          return $ Just TgtAndPath {..}+                        else do+                          upos <- if canMove+                                  then closestUnknown aid+                                  else return Nothing+                          case upos of+                            Nothing -> do+                              -- If can't move (and so no BFS data),+                              -- no info gained. Or if can't open doors.+                              -- If stuck among ice pillars, we can't help it.+                              when (canMove && canAlter) $+                                modifyClient $ \cli -> cli {sexplored =+                                  ES.insert (blid b) (sexplored cli)}+                              ctriggersRaw2 <- closestTriggers ViaExit aid+                              let ctriggers2 = toFreq "ctriggers2" ctriggersRaw2+                              if nullFreq ctriggers2 then do+                                let toKill = actorWorthKilling actorMaxSkills+                                    worthyFoes = filter (uncurry toKill)+                                                        foeAssocs+                                afoes <- closestFoes worthyFoes aid+                                case afoes of+                                  (_, (aid2, _)) : _ ->+                                    -- All stones turned, time to win or die.+                                    setPath $ TEnemy aid2+                                  [] -> do+                                    furthest <- furthestKnown aid+                                    setPath $ TPoint TKnown (blid b) furthest+                              else do+                                (p, (p0, bag)) <-+                                  rndToAction $ frequency ctriggers2+                                setPath $ TPoint (TEmbed bag p0) (blid b) p+                            Just p -> setPath $ TPoint TUnknown (blid b) p+                      else do+                        (p, (p0, bag)) <- rndToAction $ frequency ctriggers+                        setPath $ TPoint (TEmbed bag p0) (blid b) p+                    (_, (p, _)) : _ -> setPath $ TPoint TSmell (blid b) p+                else do+                  (p, bag) <- rndToAction $ frequency citems+                  setPath $ TPoint (TItem bag) (blid b) p+      tellOthersNothingHere = do         let f TgtAndPath{tapTgt} = case tapTgt of-              TPoint _ lid p -> p /= pos || lid /= blid b+              TPoint _ lid p -> p /= bpos b || lid /= blid b               _ -> True         modifyClient $ \cli -> cli {stargetD = EM.filter f (stargetD cli)}         pickNewTarget@@ -339,13 +395,16 @@         TEnemy a -> do           body <- getsState $ getActorBody a           if | (condInMelee  -- fight close foes or nobody at all+                || bweapon body <= 0  -- not dangerous                 || not focused && not (null nearbyFoes))  -- prefers closer foes                && a `notElem` map fst nearbyFoes  -- old one not close enough                || blid body /= blid b  -- wrong level-               || actorDying body -> -- foe already dying+               || actorDying body  -- foe already dying+               || not (worthTargeting a body)+               || recentlyFled ->+                    -- forget enemy positions to prevent attacking them+                    -- again soon after flight                pickNewTarget-             | EM.member aid fleeD -> pickNewTarget-                 -- forget enemy positions to prevent attacking them again soon              | otherwise -> do                -- If there are no unwalkable tiles on the path to enemy,                -- he gets target @TEnemy@ and then, even if such tiles emerge,@@ -356,32 +415,58 @@                case mpath of                  Nothing -> pickNewTargetIgnore (Just a)                    -- enemy became unreachable-                 Just AndPath{pathList=[]} -> pickNewTargetIgnore (Just a)+                 Just AndPath{pathList=[]} -> pickNewTarget                    -- he is his own enemy                  Just AndPath{pathList= q : _} ->                    -- If in melee and path blocked by actors (even proj.)                    -- change target for this turn due to urgency.-                   -- Because of @condInMelee@ new target will be enemy,-                   -- if any other is left, or empty target.+                   -- Because of @condInMelee@ new target will be stash+                   -- or enemy if any other is left, or empty target.                    -- If not in melee, keep target and consider your options-                   -- (wait until blocking actors move or displace or melee).-                   -- We don't want to wander away in search of loot, only to-                   -- turn around next turn when the enemy is again considered.-                   if not condInMelee || not (occupiedBigLvl q lvl)-                                         && not (occupiedProjLvl q lvl)+                   -- (wait until blocking actors move or displace or melee+                   -- or sidestep). We don't want to wander away+                   -- in search of loot, only to turn around next turn+                   -- when the enemy is again considered.+                   if not condInMelee+                      || q == bpos body  -- blocked by the enemy, great!+                      || not (occupiedBigLvl q lvl)+                         && not (occupiedProjLvl q lvl)                    then return $ Just tap{tapPath=mpath}                    else pickNewTargetIgnore (Just a)-        -- In this case, need to retarget, to focus on foes that melee ours-        -- and not, e.g., on remembered foes or items.-        _ | condInMelee -> pickNewTarget         TPoint _ lid _ | lid /= blid b -> pickNewTarget  -- wrong level         TPoint tgoal lid pos -> case tgoal of+          TStash fid2 -> do+            oursExploring <- getsState $ oursExploringAssocs (bfid b)+            let oursExploringLid =+                  filter (\(_, body) -> blid body == lid) oursExploring+                spawnFreqs = CK.cactorFreq $ okind cocave $ lkind lvl+                hasGroup grp = fromMaybe 0 (lookup grp spawnFreqs) > 0+                lvlSpawnsUs = any hasGroup $ fgroups (gplayer fact)+           -- Even if made peace with the faction, loot stash one last time.+            if (calmE || null nearbyFoes)  -- no risk or can't defend anyway+               && not heavilyDistressed  -- not under heavy fire+               && gstash (factionD EM.! fid2) == Just (lid, pos)+               -- The condition below is more lenient than in @closestStashes@+               -- to avoid wasting time on guard's movement.+               && (fid2 == bfid b+                   && (pos == bpos b  -- guarded by me, so keep guarding+                       && (null nearbyFoes  -- if no foes nearby+                           || length oursExploringLid > 1) -- or buddies nearby+                       || isNothing (posToBigLvl pos lvl))  -- or unguarded+                   && (length oursExploring > 1  -- other actors able to explore+                       || lvlSpawnsUs)  -- or future spawned will be able+                   || isFoe (bfid b) fact fid2)+            then return $ Just tap+            else pickNewTarget+          -- In this case, need to retarget, to focus on foes that melee ours+          -- and not, e.g., on remembered foes or items.+          _ | condInMelee || not (null cstashes) -> pickNewTarget           TEnemyPos _  -- chase last position even if foe hides-            | bpos b == pos -> tellOthersNothingHere pos-            | EM.member aid fleeD -> pickNewTarget+            | bpos b == pos -> tellOthersNothingHere+            | recentlyFled -> pickNewTarget                 -- forget enemy positions to prevent attacking them again soon             | otherwise -> do-              -- Here pick the closer enemy, remembered or seen, to avoid+              -- Here pick the closer enemy, the remembered or seen, to avoid               -- loops when approaching new enemy obscures him behind obstacle               -- but reveals the previously remembered one, etc.               let remainingDist = chessDist (bpos b) pos@@ -389,8 +474,14 @@                      nearbyFoes               then pickNewTarget               else return $ Just tap-          _ | not $ null nearbyFoes ->-            pickNewTarget  -- prefer close foes to anything else+          -- Don't stop fleeing into hideout after 5 turns even if foes appear.+          THideout ->+            -- Approach or stay in the hideout until 20 turns pass.+            if not recentlyFled20+            then pickNewTarget+            else return $ Just tap+          -- Prefer close foes to anything else below.+          _ | not (null nearbyFoes) -> pickNewTarget           -- Below we check the target could not be picked again in           -- pickNewTarget (e.g., an item got picked up by our teammate)           -- and only in this case it is invalidated.@@ -453,8 +544,8 @@                     -- tile was searched or altered or skill lowered             then pickNewTarget  -- others unconcerned             else return $ Just tap-        _ | not $ null nearbyFoes ->-          pickNewTarget  -- prefer close foes to any vector+        _ | condInMelee || not (null nearbyFoes && null cstashes) ->+            pickNewTarget         TNonEnemy _ | mleader == Just aid ->  -- a leader, never follow           pickNewTarget         TNonEnemy a -> do@@ -468,11 +559,9 @@               Nothing -> pickNewTarget               Just AndPath{pathList=[]} -> pickNewTarget               _ -> return $ Just tap{tapPath=mpath}-        TVector{} -> if pathLen > 1+        TVector{} -> if bpos b /= pathGoal                      then return $ Just tap                      else pickNewTarget-  if canMove-  then case oldTgtUpdatedPath of-    Nothing -> pickNewTarget-    Just tap -> updateTgt tap+  if canReach+  then maybe pickNewTarget updateTgt oldTgtUpdatedPath   else return Nothing

engine-src/Game/LambdaHack/Client/AI/Strategy.hs view

@@ -1,10 +1,10 @@-{-# LANGUAGE DeriveFoldable, DeriveTraversable, TupleSections #-}+{-# LANGUAGE DeriveTraversable, TupleSections #-} -- | AI strategies to direct actors not controlled directly by human players. -- No operation in this module involves the @State@ type or any of our -- client/server monads types. module Game.LambdaHack.Client.AI.Strategy   ( Strategy, nullStrategy, liftFrequency-  , (.|), reject, (.=>), only, bestVariant, renameStrategy, returN, mapStrategyM+  , (.|), reject, (.=>), only, bestVariant, returN, mapStrategyM   ) where  import Prelude ()@@ -12,7 +12,6 @@ import Game.LambdaHack.Core.Prelude  import Control.Applicative-import Data.Int (Int32)  import Game.LambdaHack.Core.Frequency @@ -27,14 +26,12 @@ newtype Strategy a = Strategy { runStrategy :: [Frequency a] }   deriving (Show, Foldable, Traversable) -_maxBound32 :: Integer-_maxBound32 = toInteger (maxBound :: Int32)- instance Monad Strategy where   m >>= f  = normalizeStrategy $ Strategy     [ toFreq name [ #ifdef WITH_EXPENSIVE_ASSERTIONS-                    assert (toInteger p * toInteger q <= _maxBound32)+                    assert (toInteger p * toInteger q+                            <= toInteger maxBoundInt32) #endif                     (p * q, b)                   | (p, a) <- runFrequency x@@ -101,10 +98,6 @@ bestVariant :: Strategy a -> Frequency a bestVariant (Strategy []) = mzero bestVariant (Strategy (f : _)) = f---- | Overwrite the description of all frequencies within the strategy.-renameStrategy :: Text -> Strategy a -> Strategy a-renameStrategy newName (Strategy fs) = Strategy $ map (renameFreq newName) fs  -- | Like 'return', but pick a name of the single frequency. returN :: Text -> a -> Strategy a

engine-src/Game/LambdaHack/Client/Bfs.hs view

@@ -4,11 +4,10 @@ module Game.LambdaHack.Client.Bfs   ( BfsDistance, MoveLegal(..)   , subtractBfsDistance, minKnownBfs, apartBfs, maxBfsDistance, fillBfs-  , AndPath(..), actorsAvoidedDist, findPathBfs-  , accessBfs+  , AndPath(..), findPathBfs, accessBfs #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , succBfsDistance, predBfsDistance, abortedUnknownBfs+  , succBfsDistance, predBfsDistance, abortedUnknownBfs, maskBfs, distanceBfs #endif   ) where @@ -19,26 +18,33 @@ import           Control.Monad.ST.Strict (ST, runST) import           Data.Binary import           Data.Bits (Bits, complement, (.&.), (.|.))-import qualified Data.EnumMap.Strict as EM-import qualified Data.IntMap.Strict as IM+import qualified Data.EnumSet as ES+import qualified Data.IntSet as IS import qualified Data.Primitive.PrimArray as PA import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM import           GHC.Exts (inline) import           GHC.Generics (Generic) -import           Game.LambdaHack.Common.Level-import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray+import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Definition.Defs +-- @Word8@ is much faster, but in some very rare cases leads to AI loops,+-- e.g., when a move through uknown terrain towards enemy stash+-- goes beyond the @apartBfs@ range and makes AI abandon the stash target,+-- only to pick it up after a step in the opposite direction.+-- In normal LH maps, path length can get to around 200,+-- in contrived mazes it could perhaps reach a few thousand.+type DistanceWord = Word16+ -- | Weighted distance between points along shortest paths.-newtype BfsDistance = BfsDistance {bfsDistance :: Word8}+newtype BfsDistance = BfsDistance {bfsDistance :: DistanceWord}   deriving (Show, Eq, Ord, Bits)  instance PointArray.UnboxRepClass BfsDistance where-  type UnboxRep BfsDistance = Word8+  type UnboxRep BfsDistance = DistanceWord   toUnboxRepUnsafe = bfsDistance   fromUnboxRep = BfsDistance @@ -58,7 +64,7 @@ -- | The minimal distance value assigned to paths that don't enter -- any unknown tiles. minKnownBfs :: BfsDistance-minKnownBfs = BfsDistance 128+minKnownBfs = BfsDistance $ 1 + maxBound `div` 2  -- | The distance value that denotes no legal path between points, -- either due to blocked tiles or pathfinding aborted at earlier tiles,@@ -68,7 +74,7 @@  -- | Maximum value of the type. maxBfsDistance :: BfsDistance-maxBfsDistance = BfsDistance (maxBound :: Word8)+maxBfsDistance = BfsDistance (maxBound :: DistanceWord)  -- | The distance value that denotes that path search was aborted -- at this tile due to too large actual distance@@ -77,6 +83,10 @@ abortedUnknownBfs :: BfsDistance abortedUnknownBfs = predBfsDistance apartBfs +maskBfs :: BfsDistance -> BfsDistance+{-# INLINE maskBfs #-}+maskBfs distance = distance .&. complement minKnownBfs+ -- | Create and fill a BFS array for the given level. -- Unsafe array operations are OK here, because the intermediate -- values of the vector don't leak anywhere outside nor are kept unevaluated@@ -116,7 +126,7 @@               -> Word8               -> PointI               -> (PA.MutablePrimArray s PointI, PA.MutablePrimArray s PointI)-              -> U.MVector s Word8+              -> U.MVector s DistanceWord               -> ST s () fillBfsThawed !lalter !alterSkill !sourceI               (!tabAThawed, !tabBThawed) !vThawed = do@@ -161,7 +171,7 @@                             !alter = lalter `PointArray.accessI` p                         if | alterSkill < alter -> return acc2                            | alter == 1 -> do-                             let distCompl = distance .&. complement minKnownBfs+                             let distCompl = maskBfs distance                              unsafeWriteI p distCompl                              return acc2                            | otherwise -> do@@ -199,9 +209,6 @@  instance Binary AndPath -actorsAvoidedDist :: Int-actorsAvoidedDist = 5- -- | Find a path, without the source position, with the smallest length. -- The @eps@ coefficient determines which direction (of the closest -- directions available) that path should prefer, where 0 means north-west@@ -214,15 +221,15 @@ -- -- An unwelcome side effect of avoiding actors is that friends will sometimes -- avoid displacing and instead perform two separate moves, wasting 1 turn--- in total. But in corridors they will still displace and elsewhere--- this scenario was quite rare already.-findPathBfs :: BigActorMap -> PointArray.Array Word8 -> (PointI -> Bool)+-- in total (only if they had opposed direction of their goals; unlikely).+-- But in corridors they will still displace and elsewhere this scenario+-- was quite rare already.+findPathBfs :: ES.EnumSet Point -> PointArray.Array Word8 -> (PointI -> Bool)             -> Point -> Point -> Int             -> PointArray.Array BfsDistance             -> Maybe AndPath {-# INLINE findPathBfs #-}-findPathBfs lbig lalter fovLit pathSource pathGoal sepsRaw-            arr@PointArray.Array{..} =+findPathBfs lbig lalter fovLit pathSource pathGoal sepsRaw arr =   let !pathGoalI = fromEnum pathGoal       !pathSourceI = fromEnum pathSource       eps = sepsRaw `mod` 4@@ -247,8 +254,7 @@                     BfsDistance (arr `PointArray.accessI` p) /= dist               in if backtrackingMove                  then minChild minP maxDark minAlter mvs-                 else let free = fromEnum (bfsDistance dist) < actorsAvoidedDist-                                 || p `IM.notMember` EM.enumMapToIntMap lbig+                 else let free = p `IS.notMember` ES.enumSetToIntSet lbig                           alter | free = lalter `PointArray.accessI` p                                 | otherwise = maxBound-1  -- occupied; disaster                           dark = not $ fovLit p@@ -269,7 +275,7 @@             !posP = toEnum pos         in track newPos dist (posP : suffix)       !goalDist = BfsDistance $ arr `PointArray.accessI` pathGoalI-      pathLen = fromEnum $ bfsDistance $ goalDist .&. complement minKnownBfs+      pathLen = fromEnum $ bfsDistance $ maskBfs goalDist       pathList = track pathGoalI (goalDist .|. minKnownBfs) []       andPath = AndPath{..}   in assert (BfsDistance (arr `PointArray.accessI` pathSourceI)@@ -281,8 +287,7 @@               f acc@(pAcc, dAcc, chessAcc, sumAcc) p d =                 if d <= abortedUnknownBfs  -- works in visible secrets mode only                    || d /= apartBfs && adjacent p pathGoal  -- works for stairs-                then let dist = fromEnum $ bfsDistance-                                $ d .&. complement minKnownBfs+                then let dist = fromEnum $ bfsDistance $ maskBfs d                          chessNew = chessDist p pathGoal                          sumNew = dist + 2 * chessNew                          resNew = (p, dist, chessNew, sumNew)@@ -310,8 +315,12 @@  -- | Access a BFS array and interpret the looked up distance value. accessBfs :: PointArray.Array BfsDistance -> Point -> Maybe Int-accessBfs bfs p =-  let dist = bfs PointArray.! p-  in if PointArray.axsize bfs == 0 || dist == apartBfs-     then Nothing-     else Just $ fromEnum $ bfsDistance $ dist .&. complement minKnownBfs+accessBfs bfs p = if PointArray.axsize bfs == 0+                  then Nothing+                  else distanceBfs $ bfs PointArray.! p++distanceBfs :: BfsDistance -> Maybe Int+{-# INLINE distanceBfs #-}+distanceBfs dist = if dist == apartBfs+                   then Nothing+                   else Just $ fromEnum $ bfsDistance $ maskBfs dist

engine-src/Game/LambdaHack/Client/BfsM.hs view

@@ -9,6 +9,7 @@   , furthestKnown, closestUnknown, closestSmell   , FleeViaStairsOrEscape(..)   , embedBenefit, closestTriggers, condEnoughGearM, closestItems, closestFoes+  , closestStashes, oursExploringAssocs, closestHideout #ifdef EXPOSE_INTERNAL   , unexploredDepth, updatePathFromBfs #endif@@ -20,7 +21,6 @@  import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES-import           Data.Ord import           Data.Word  import           Game.LambdaHack.Client.Bfs@@ -35,24 +35,27 @@ import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level 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.Types import           Game.LambdaHack.Common.Vector+import qualified Game.LambdaHack.Content.CaveKind as CK import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.RuleKind import           Game.LambdaHack.Content.TileKind (isUknownSpace)-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs  invalidateBfsAid :: MonadClient m => ActorId -> m () invalidateBfsAid aid =-  modifyClient $ \cli -> cli {sbfsD = EM.insert aid BfsInvalid (sbfsD cli)}+  modifyClient $ \cli ->+    cli {sbfsD = EM.adjust (const BfsInvalid) aid (sbfsD cli)}  invalidateBfsPathAid :: MonadClient m => ActorId -> m () invalidateBfsPathAid aid = do@@ -60,21 +63,27 @@       f (BfsAndPath bfsArr _) = BfsAndPath bfsArr EM.empty   modifyClient $ \cli -> cli {sbfsD = EM.adjust f aid (sbfsD cli)} +-- Even very distant actors affected, e.g., when a hidden door found in a wall. invalidateBfsLid :: MonadClient m => LevelId -> m () invalidateBfsLid lid = do-  side <- getsClient sside-  let f (_, b) = blid b == lid && bfid b == side && not (bproj b)-  as <- getsState $ filter f . EM.assocs . sactorD-  mapM_ (invalidateBfsAid . fst) as+  lvl <- getLevel lid+  -- No need to filter, because foes won't be in our BFS map and looking up+  -- in our BFS map is faster than in all actors map.+  mapM_ invalidateBfsAid $ EM.elems $ lbig lvl -invalidateBfsPathLid :: MonadClient m => LevelId -> Point -> m ()-invalidateBfsPathLid lid pos = do-  side <- getsClient sside-  let f (_, b) = blid b == lid && bfid b == side && not (bproj b)-                 && chessDist pos (bpos b) < actorsAvoidedDist-                      -- rough approximation, but kicks in well before blockage-  as <- getsState $ filter f . EM.assocs . sactorD-  mapM_ (invalidateBfsPathAid . fst) as+-- We invalidate, but not when actors move, since they are likely to move+-- out of the way in time. We only do, when they appear or disappear,+-- because they may be immobile or too close to move away before we get there.+-- We also don't consider far actors, since they are likely to disappear+-- again or to be far from our path. If they close enough to be lit+-- by our light, or one step further, that's worth taking seriously.+invalidateBfsPathLid :: MonadClient m => Actor -> m ()+invalidateBfsPathLid body = do+  lvl <- getLevel $ blid body+  let close (p, _) = chessDist p (bpos body) <= 3  -- heuristic+  -- No need to filter more, because foes won't be in our BFS map and looking up+  -- in our BFS map is faster than in all actors map.+  mapM_ (invalidateBfsPathAid . snd) $ filter close $ EM.assocs $ lbig lvl  invalidateBfsAll :: MonadClient m => m () invalidateBfsAll =@@ -113,18 +122,24 @@   if not canMove   then return (bfsArr, Nothing)   else do-    b <- getsState $ getActorBody aid-    let lid = blid b+    getActorB <- getsState $ flip getActorBody+    let b = getActorB aid+    fact <- getsState $ (EM.! bfid b) . sfactionD     seps <- getsClient seps     salter <- getsClient salter-    lvl <- getLevel lid-    let !lalter = salter EM.! lid+    lvl <- getLevel (blid b)+    let !lalter = salter EM.! blid b         fovLit p = Tile.isLit coTileSpeedup $ PointArray.fromUnboxRep                                             $ ltile lvl `PointArray.accessI` p+        addFoeVicinity (p, aid2) =+          let b2 = getActorB aid2+          in if isFoe (bfid b) fact (bfid b2)+             then p : vicinityUnsafe p+             else [p]+        bigAdj = ES.fromList $ concatMap addFoeVicinity $ EM.assocs+                 $ EM.delete source $ lbig lvl  -- don't sidestep oneself         !source = bpos b-        !mpath =-          findPathBfs (EM.delete source $ lbig lvl)  -- don't sidestep oneself-                      lalter fovLit source target seps bfsArr+        !mpath = findPathBfs bigAdj lalter fovLit source target seps bfsArr         !bfsPath =           maybe oldBfsPath (\path -> EM.insert target path oldBfsPath) mpath         bap = BfsAndPath bfsArr bfsPath@@ -180,17 +195,20 @@   lvl <- getLevel $ blid b   let stopAtUnwalkable tapPath@(Just AndPath{..}) =         let (walkable, rest) =-              -- Unknown tiles are not walkable, so path stops at first such.+              -- Unknown tiles are not walkable, so path stops just before.               -- which is good, because by the time actor reaches the tile,-              -- it is known and target is recalculated with new info.+              -- it is known and target is recalculated with new info,+              -- perhaps sidestepping the tile, e.g., if explosive.               span (Tile.isWalkable coTileSpeedup . at lvl) pathList         in case rest of+          _ | null walkable -> TgtAndPath{..}           [] -> TgtAndPath{..}           [g] | g == pathGoal -> TgtAndPath{..}+            -- the exception is when the tile is explicitly targeted           newGoal : _ ->             let newTgt = TPoint TBlock (blid b) newGoal                 newPath = AndPath{ pathSource = bpos b-                                 , pathList = walkable ++ [newGoal]+                                 , pathList = walkable  -- no @newGoal@                                  , pathGoal = newGoal                                  , pathLen = length walkable + 1 }             in TgtAndPath{tapTgt = newTgt, tapPath = Just newPath}@@ -221,8 +239,8 @@   fact <- getsState $ (EM.! side) . sfactionD   let underAI = isAIFact fact       -- Under UI, playing a hero party, we let AI set our target each-      -- turn for henchmen that can't move and can't alter, usually to TUnknown.-      -- This is rather useless, but correct.+      -- turn for non-pointmen that can't move and can't alter,+      -- usually to TUnknown. This is rather useless, but correct.       enterSuspect = smarkSuspect > 0 || underAI       skill | enterSuspect = alterSkill  -- dig and search as skill allows             | otherwise = 0  -- only walkable tiles@@ -249,13 +267,13 @@ -- all dungeon styles would be complex and would slow down the engine. -- -- If the level has inaccessible open areas (at least from the stairs AI used)--- the level will be nevertheless here finally marked explored,+-- the level will be nevertheless here finally labeled as explored, -- to enable transition to other levels. -- We should generally avoid such levels, because digging and/or trying -- to find other stairs leading to disconnected areas is not KISS -- so we don't do this in AI, so AI is at a disadvantage. ----- If the closest unknown is more than 126 tiles away from the targetting+-- If the closest unknown is more than 126 tiles away from the targeting -- actor, the level will marked as explored. We could complicate the code -- and not mark if the unknown is too far as opposed to inaccessible, -- but then if it is both too distant and inaccessible, AI would be@@ -308,7 +326,7 @@     _ -> do       bfs <- getCacheBfs aid       let ts = mapMaybe (\x@(p, _) -> fmap (,x) (accessBfs bfs p)) smells-      return $! sortBy (comparing (fst &&& absoluteTimeNegate . snd . snd)) ts+      return $! sortOn (fst &&& absoluteTimeNegate . snd . snd) ts  data FleeViaStairsOrEscape =     ViaStairs@@ -325,17 +343,25 @@              -> [(Point, ItemBag)]              -> m [(Double, (Point, ItemBag))] embedBenefit fleeVia aid pbags = do-  COps{coTileSpeedup} <- getsState scops+  COps{cocave, coTileSpeedup} <- getsState scops   dungeon <- getsState sdungeon   explored <- getsClient sexplored   b <- getsState $ getActorBody aid+  fact <- getsState $ (EM.! bfid b) . sfactionD+  lvl <- getLevel (blid b)+  oursExploring <- getsState $ oursExploringAssocs (bfid b)+  let oursExploringLid =+        filter (\(_, body) -> blid body == blid b) oursExploring+      spawnFreqs = CK.cactorFreq $ okind cocave $ lkind lvl+      hasGroup grp = fromMaybe 0 (lookup grp spawnFreqs) > 0+      lvlSpawnsUs = any hasGroup $ fgroups (gplayer fact)   actorSk <- if fleeVia `elem` [ViaAnything, ViaExit]                   -- targeting, possibly when not a leader              then getsState $ getActorMaxSkills aid              else currentSkillsClient aid   let alterSkill = Ability.getSk Ability.SkAlter actorSk-  fact <- getsState $ (EM.! bfid b) . sfactionD-  lvl <- getLevel (blid b)+  condOurAdj <- getsState $ any (\(_, b2) -> isFriend (bfid b) fact (bfid b2))+                            . adjacentBigAssocs b   unexploredTrue <- unexploredDepth True (blid b)   unexploredFalse <- unexploredDepth False (blid b)   condEnoughGear <- condEnoughGearM aid@@ -371,11 +397,23 @@               aiCond = if unexpForth                        then easier && condEnoughGear                             || (not unexpBack || easier) && lidExplored-                       else easier && allExplored && null (lescape lvl)+                       else not unexpBack && easier && allExplored+                            && null (lescape lvl)               -- Prefer one direction of stairs, to team up               -- and prefer embed (may, e.g., create loot) over stairs.               v = if aiCond then if easier then 10 else 1 else 0+              guardingStash = case gstash fact of+                Nothing -> False+                Just (lid, p) ->+                  lid == blid b+                  && (length oursExploring > 1+                      || lvlSpawnsUs)+                  && (length oursExploringLid <= 1+                        -- not @==@ in case guard temporarily nonmoving+                      || p == bpos b && not condOurAdj)+                           -- don't leave the post; let the others explore           in case fleeVia of+            _ | guardingStash -> 0             ViaStairsUp | up -> 1             ViaStairsDown | not up -> 1             ViaStairs -> v@@ -394,9 +432,12 @@           else 0       underFeet p = p == bpos b  -- if enter and alter, be more permissive       -- Only actors with high enough @SkAlter@ can trigger terrain.-      -- If apply skill not high enough for embedded items, AI will only-      -- guard such tiles, assuming they must be advanced and so crucial.-      f (p, _) = underFeet p || alterSkill >= fromEnum (alterMinSkill p)+      -- Blocking actors and items not checked, because they can be moved+      -- before the actor gets to the location, or after.+      f (p, _) = underFeet p+                 || alterSkill >= fromEnum (alterMinSkill p)+                 || Tile.isSuspect coTileSpeedup (lvl `at` p)+                    && alterSkill >= 2       benFeats = map (\pbag -> (bens pbag, pbag)) $ filter f pbags       considered (benefitAndSacrifice, (p, _bag)) =         benefitAndSacrifice > 0@@ -430,7 +471,7 @@   return $!     let mix (benefit, ppbag) dist =           let maxd = subtractBfsDistance maxBfsDistance apartBfs-              v = fromIntegral $ (1 + maxd - dist) ^ (2 :: Int)+              v = intToDouble $ maxd `div` (dist + 1)           in (ceiling $ benefit * v, ppbag)     in mapMaybe (\bpp@(_, (p, _)) ->          mix bpp <$> accessBfs bfs p) vicAll@@ -438,7 +479,7 @@ -- | Check whether the actor has enough gear to go look for enemies. -- We assume weapons in equipment are better than any among organs -- or at least provide some essential diversity.--- Disabled if, due to tactic, actors follow leader and so would+-- Disabled if, due to doctrine, actors follow leader and so would -- repeatedly move towards and away form stairs at leader change, -- depending on current leader's gear. -- Number of items of a single kind is ignored, because variety is needed.@@ -446,14 +487,13 @@ condEnoughGearM aid = do   b <- getsState $ getActorBody aid   fact <- getsState $ (EM.! bfid b) . sfactionD-  let followTactic = ftactic (gplayer fact)-                     `elem` [Ability.TFollow, Ability.TFollowNoItems]+  let followDoctrine = fdoctrine (gplayer fact)+                       `elem` [Ability.TFollow, Ability.TFollowNoItems]   eqpAssocs <- getsState $ fullAssocs aid [CEqp]-  invAssocs <- getsState $ getActorAssocs aid CInv-  return $ not followTactic  -- keep it lazy+  return $ not followDoctrine  -- keep it lazy            && (any (IA.checkFlag Ability.Meleeable                     . aspectRecordFull . snd) eqpAssocs-               || length eqpAssocs + length invAssocs >= 5)+               || length eqpAssocs >= 3)  unexploredDepth :: MonadClientRead m => Bool -> LevelId -> m Bool unexploredDepth !up !lidCurrent = do@@ -471,22 +511,38 @@ -- | Closest (wrt paths) items. closestItems :: MonadClient m => ActorId -> m [(Int, (Point, ItemBag))] closestItems aid = do-  actorMaxSk <- getsState $ getActorMaxSkills aid-  if Ability.getSk Ability.SkMoveItem actorMaxSk <= 0 then return []-  else do-    body <- getsState $ getActorBody aid-    Level{lfloor} <- getLevel $ blid body-    if EM.null lfloor then return [] else do-      bfs <- getCacheBfs aid-      let mix pbag dist =-            let maxd = subtractBfsDistance maxBfsDistance apartBfs-                -- Beware of overflowing 32-bit integers.-                -- Here distance is the only factor influencing frequency.-                -- Whether item is desirable is checked later on.-                v = (maxd * 10) `div` (dist + 1)-            in (v, pbag)-      return $! mapMaybe (\(p, bag) ->-        mix (p, bag) <$> accessBfs bfs p) (EM.assocs lfloor)+  body <- getsState $ getActorBody aid+  Level{lfloor, lbig} <- getLevel $ blid body+  factionD <- getsState sfactionD+  per <- getPerFid $ blid body+  let canSee p = ES.member p (totalVisible per)+  -- Don't consider items at any stash location that an actor stands over+  -- or can stand over, but it's out of our LOS.+  -- In case of the own stash, don't consider regardless of actors and LOS.+  -- Own stash items are already owned, enemy stash is already targetted+  -- and allied or neutral stashes with actors on top are unlikely+  -- to be vacated and cause AI to wonder around forever or look up,+  -- leave, return hopeful, find a guard, repeat.+  let stashes = map (second gstash) $ EM.assocs factionD+      stashToRemove :: (FactionId, Maybe (LevelId, Point)) -> [Point]+      stashToRemove (fid, Just (lid, pos))+        | lid == blid body+          && (fid == bfid body || pos `EM.member` lbig || not (canSee pos)) =+            [pos]+      stashToRemove _ = []+      stashesToRemove = ES.fromList $ concatMap stashToRemove stashes+      lfloorBarStashes = EM.withoutKeys lfloor stashesToRemove+  if EM.null lfloorBarStashes then return [] else do+    bfs <- getCacheBfs aid+    let mix pbag dist =+          let maxd = subtractBfsDistance maxBfsDistance apartBfs+              -- Beware of overflowing 32-bit integers.+              -- Here distance is the only factor influencing frequency.+              -- Whether item is desirable is checked later on.+              v = (maxd * 10) `div` (dist + 1)+          in (v, pbag)+    return $! mapMaybe (\(p, bag) ->+      mix (p, bag) <$> accessBfs bfs p) (EM.assocs lfloorBarStashes)  -- | Closest (wrt paths) enemy actors. closestFoes :: MonadClient m@@ -498,3 +554,73 @@       bfs <- getCacheBfs aid       let ds = mapMaybe (\x@(_, b) -> fmap (,x) (accessBfs bfs (bpos b))) foes       return $! sortBy (comparing fst) ds++-- | Closest (wrt paths) enemy or our unguarded stash locations. If it's ours,+-- we want to guard it, it enemy, loot it. Neutral and friendly stashes+-- not chased to avoid loops of bloodless takeovers.+closestStashes :: MonadClient m => ActorId -> m [(Int, (FactionId, Point))]+closestStashes aid = do+  COps{cocave} <- getsState scops+  factionD <- getsState sfactionD+  b <- getsState $ getActorBody aid+  lvl <- getLevel (blid b)+  oursExploring <- getsState $ oursExploringAssocs (bfid b)+  let fact = factionD EM.! bfid b+      spawnFreqs = CK.cactorFreq $ okind cocave $ lkind lvl+      hasGroup grp = fromMaybe 0 (lookup grp spawnFreqs) > 0+      lvlSpawnsUs = any hasGroup $ fgroups (gplayer fact)+      qualifyStash (fid2, Faction{gstash}) = case gstash of+        Nothing -> Nothing+        Just (lid, pos) ->+          -- The condition below is more strict that in @updateTgt@+          -- to avoid loops by changing target of actor displacing+          -- and walking over stash to @TStash@.+          if lid == blid b+             && (fid2 == bfid b+                 && isNothing (posToBigLvl pos lvl)  -- unguarded+                 && (length oursExploring > 1  -- other actors able to explore+                     || lvlSpawnsUs)  -- or future spawned will be able+                 || isFoe (bfid b) fact fid2)+          then Just (fid2, pos)+          else Nothing+  case mapMaybe qualifyStash $ EM.assocs factionD of+    [] -> return []+    stashes -> do+      bfs <- getCacheBfs aid+      let ds = mapMaybe (\x@(_, pos) -> fmap (,x) (accessBfs bfs pos)) stashes+      return $! sortBy (comparing fst) ds++oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)]+oursExploringAssocs fid s =+  let f (!aid, !b) = bfid b == fid+                     && not (bproj b)+                     && bhp b > 0  -- dead can stay forever on a frozen level+                     && (bwatch b `elem` [WSleep, WWake]+                           -- if asleep, probably has walking skill normally;+                           -- when left alone will wake up and guard or explore+                        || let actorMaxSk = sactorMaxSkills s EM.! aid+                           in Ability.getSk Ability.SkMove actorMaxSk > 0+                              || Ability.getSk Ability.SkMove actorMaxSk < -50)+                                   -- a hacky way to rule out tmp immobile+  in filter f $ EM.assocs $ sactorD s++-- | Find the nearest walkable position in dark, if any. Deterministic,+-- to let all friends gather up and defend in the same shelter.+-- Ignore position underfoot.+closestHideout :: MonadClient m => ActorId -> m (Maybe (Point, Int))+closestHideout aid = do+  COps{coTileSpeedup} <- getsState scops+  b <- getsState $ getActorBody aid+  lvl <- getLevel (blid b)+  bfs <- getCacheBfs aid+  let minHideout :: (Point, BfsDistance) -> Point -> BfsDistance+                 -> (Point, BfsDistance)+      minHideout (pMin, distMin) p dist =+        if dist > minKnownBfs && dist < distMin+           && Tile.isHideout coTileSpeedup (lvl `at` p)+        then (p, dist)+        else (pMin, distMin)+      (p1, dist1) = PointArray.ifoldlA' minHideout (bpos b, maxBfsDistance) bfs+  return $! if p1 == bpos b  -- possibly hideout underfoot; ignore+            then Nothing+            else Just (p1, subtractBfsDistance dist1 apartBfs)

− engine-src/Game/LambdaHack/Client/ClientOptions.hs

@@ -1,94 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--- | Options that affect the behaviour of the client.-module Game.LambdaHack.Client.ClientOptions-  ( ClientOptions(..), defClientOptions-  ) where--import Prelude ()--import Game.LambdaHack.Core.Prelude--import Data.Binary-import GHC.Generics (Generic)---- | Options that affect the behaviour of the client (but not game rules).-data ClientOptions = ClientOptions-  { sgtkFontFamily     :: Maybe Text-      -- ^ Font family to use for the GTK main game window.-  , sdlFontFile        :: Maybe Text-      -- ^ Font file to use for the SDL2 main game window.-  , sdlScalableSizeAdd :: Maybe Int-      -- ^ Pixels to add to map cells on top of scalable font max glyph height.-      --   To get symmetric padding, add an even number.-  , sdlBitmapSizeAdd   :: Maybe Int-      -- ^ Pixels to add to map cells on top of fixed font max glyph height.-      --   To get symmetric padding, add an even number.-  , sscalableFontSize  :: Maybe Int-      -- ^ Font size to use for the main game window.-  , slogPriority       :: Maybe Int-      -- ^ How much to log (e.g., from SDL). 1 is all, 5 is errors, the default.-  , smaxFps            :: Maybe Int-      -- ^ Maximal frames per second.-      -- This is better low and fixed, to avoid jerkiness and delays-      -- that tell the player there are many intelligent enemies on the level.-      -- That's better than scaling AI sofistication down based-      -- on the FPS setting and machine speed.-  , sdisableAutoYes    :: Bool-      -- ^ Never auto-answer all prompts, even if under AI control.-  , snoAnim            :: Maybe Bool-      -- ^ Don't show any animations.-  , snewGameCli        :: Bool-      -- ^ Start a new game, overwriting the save file.-  , sbenchmark         :: Bool-      -- ^ Don't create directories and files and show time stats.-  , stitle             :: Maybe Text-  , sfontDir           :: Maybe FilePath-  , ssavePrefixCli     :: String-      -- ^ Prefix of the save game file name.-  , sfrontendTeletype  :: Bool-      -- ^ Whether to use the stdout/stdin frontend.-  , sfrontendNull      :: Bool-      -- ^ Whether to use null (no input/output) frontend.-  , sfrontendLazy      :: Bool-      -- ^ Whether to use lazy (output not even calculated) frontend.-  , sdbgMsgCli         :: Bool-      -- ^ Show clients' internal debug messages.-  , sstopAfterSeconds  :: Maybe Int-  , sstopAfterFrames   :: Maybe Int-  , sprintEachScreen   :: Bool-  , sexposePlaces      :: Bool-  , sexposeItems       :: Bool-  , sexposeActors      :: Bool-  }-  deriving (Show, Eq, Generic)--instance Binary ClientOptions---- | Default value of client options.-defClientOptions :: ClientOptions-defClientOptions = ClientOptions-  { sgtkFontFamily = Nothing-  , sdlFontFile = Nothing-  , sdlScalableSizeAdd = Nothing-  , sdlBitmapSizeAdd = Nothing-  , sscalableFontSize = Nothing-  , slogPriority = Nothing-  , smaxFps = Nothing-  , sdisableAutoYes = False-  , snoAnim = Nothing-  , snewGameCli = False-  , sbenchmark = False-  , stitle = Nothing-  , sfontDir = Nothing-  , ssavePrefixCli = ""-  , sfrontendTeletype = False-  , sfrontendNull = False-  , sfrontendLazy = False-  , sdbgMsgCli = False-  , sstopAfterSeconds = Nothing-  , sstopAfterFrames = Nothing-  , sprintEachScreen = False-  , sexposePlaces = False-  , sexposeItems = False-  , sexposeActors = False-  }

engine-src/Game/LambdaHack/Client/CommonM.hs view

@@ -14,10 +14,8 @@ import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.Request import           Game.LambdaHack.Client.State-import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA@@ -27,13 +25,15 @@ import           Game.LambdaHack.Common.Perception import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray-import           Game.LambdaHack.Core.Random import           Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Content.RuleKind import           Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace)+import           Game.LambdaHack.Core.Random+import qualified Game.LambdaHack.Definition.Ability as Ability+import           Game.LambdaHack.Definition.Defs  -- | Get the current perception of a client. getPerFid :: MonadClientRead m => LevelId -> m Perception@@ -44,6 +44,7 @@   return $! EM.findWithDefault assFail lid fper  -- | Calculate the position of an actor's target.+-- This matches @pathGoal@, but sometimes path is not defined. aidTgtToPos :: ActorId -> LevelId -> Maybe Target -> State -> Maybe Point aidTgtToPos _ _ Nothing _ = Nothing aidTgtToPos aid lidV (Just tgt) s = case tgt of@@ -65,11 +66,12 @@ -- actor or obstacle. Starts searching with the given eps and returns -- the first found eps for which the number reaches the distance between -- actor and target position, or Nothing if none can be found.-makeLine :: MonadStateRead m => Bool -> Actor -> Point -> Int -> m (Maybe Int)-makeLine onlyFirst body fpos epsOld = do-  COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops-  lvl <- getLevel (blid body)-  let dist = chessDist (bpos body) fpos+-- Treats unknown tiles as walkable, but prefers known.+makeLine :: Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int+makeLine onlyFirst body fpos epsOld cops lvl =+  let COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} = cops+      dist = chessDist (bpos body) fpos+      calcScore :: Int -> Int       calcScore eps = case bla rXmax rYmax eps (bpos body) fpos of         Just bl ->           let blDist = take (dist - 1) bl  -- goal not checked; actor well aware@@ -88,6 +90,7 @@                 | accessFirst -> -10000                 | otherwise -> minBound         Nothing -> error $ "" `showFailure` (body, fpos, epsOld)+      tryLines :: Int -> (Maybe Int, Int) -> Maybe Int       tryLines curEps (acc, _) | curEps == epsOld + dist = acc       tryLines curEps (acc, bestScore) =         let curScore = calcScore curEps@@ -95,10 +98,9 @@                      then (Just curEps, curScore)                      else (acc, bestScore)         in tryLines (curEps + 1) newAcc-  return $! if | dist <= 0 -> Nothing  -- ProjectAimOnself-               | calcScore epsOld > minBound -> Just epsOld  -- keep old-               | otherwise ->-                 tryLines (epsOld + 1) (Nothing, minBound)  -- generate best+  in if | dist <= 0 -> Nothing  -- ProjectAimOnself+        | calcScore epsOld > minBound -> Just epsOld  -- keep old+        | otherwise -> tryLines (epsOld + 1) (Nothing, minBound)  -- find best  -- @MonadStateRead@ would be enough, but the logic is sound only on client. currentSkillsClient :: MonadClientRead m => ActorId -> m Ability.Skills@@ -146,9 +148,17 @@   strongest <- pickWeaponM False (Just discoBenefit) kitAss actorSk source   case strongest of     [] -> return Nothing-    iis@((maxS, _) : _) -> do-      let maxIis = map snd $ takeWhile ((== maxS) . fst) iis-      (_, (iid, _)) <- rndToAction $ oneOf maxIis+    iis@(ii1@(value1, hasEffect1, timeout1, _, _, (itemFull1, _)) : _) -> do+      let minIis = takeWhile (\(value, hasEffect, timeout, _, _, _) ->+                                 value == value1+                                 && hasEffect == hasEffect1+                                 && timeout == timeout1)+                             iis+      -- Randomize only the no-timeout items. Others need to activate+      -- in the order shown in HUD and also not risk of only one always used.+      (_, _, _, _, iid, _) <- if timeout1 > 0 || itemSuspect itemFull1+                              then return ii1+                              else rndToAction $ oneOf minIis       -- Prefer COrgan, to hint to the player to trash the equivalent CEqp item.       let cstore = if isJust (lookup iid bodyAssocs) then COrgan else CEqp       return $ Just $ ReqMelee target iid cstore

engine-src/Game/LambdaHack/Client/HandleAtomicM.hs view

@@ -4,7 +4,8 @@   , cmdAtomicSemCli #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , invalidateInMelee, wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs+  , invalidateInMelee, invalidateInMeleeDueToItem+  , wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs   , createActor, destroyActor   , addItemToDiscoBenefit, perception   , discoverKind, discoverKindAndAspect, coverKind, coverAspectAndKind@@ -20,7 +21,6 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M-import           Data.Ord  import           Game.LambdaHack.Atomic import           Game.LambdaHack.Client.Bfs@@ -39,16 +39,16 @@ import           Game.LambdaHack.Common.Perception import           Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile+import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.CaveKind as CK import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.TileKind (TileKind) import           Game.LambdaHack.Definition.Defs --- | Client monad for saving and restarting games.+-- | Client monad for saving a game. class MonadClient m => MonadClientSetup m where   saveClient    :: m ()-  restartClient :: m ()  -- | Effect of atomic actions on client state. It is calculated -- with the global state from after the command is executed@@ -56,72 +56,87 @@ cmdAtomicSemCli :: MonadClientSetup m => State -> UpdAtomic -> m () {-# INLINE cmdAtomicSemCli #-} cmdAtomicSemCli oldState cmd = case cmd of+  UpdRegisterItems ais -> mapM_ (addItemToDiscoBenefit . fst) ais   UpdCreateActor aid b ais -> createActor aid b ais   UpdDestroyActor aid b _ -> destroyActor aid b True-  UpdCreateItem iid _ _ (CActor aid store) -> do+  UpdCreateItem _ iid _ _ (CActor aid store) -> do     wipeBfsIfItemAffectsSkills [store] aid     addItemToDiscoBenefit iid-  UpdCreateItem iid _ _ _ -> addItemToDiscoBenefit iid-  UpdDestroyItem _ _ _ (CActor aid store) ->+    invalidateInMeleeDueToItem aid store+  UpdCreateItem _ iid _ _ _ -> addItemToDiscoBenefit iid+  UpdDestroyItem _ _ _ _ (CActor aid store) -> do     wipeBfsIfItemAffectsSkills [store] aid+    invalidateInMeleeDueToItem aid store   UpdDestroyItem{} -> return ()-  UpdSpotActor aid b ais -> createActor aid b ais-  UpdLoseActor aid b _ -> destroyActor aid b False-  UpdSpotItem _ iid _ _ (CActor aid store) -> do+  UpdSpotActor aid b -> do+    ais <- getsState $ getCarriedAssocsAndTrunk b+    createActor aid b ais+  UpdLoseActor aid b -> destroyActor aid b False+  UpdSpotItem _ iid _ (CActor aid store) -> do     wipeBfsIfItemAffectsSkills [store] aid     addItemToDiscoBenefit iid-  UpdSpotItem _ iid _ _ _ -> addItemToDiscoBenefit iid-  UpdLoseItem _ _ _ _ (CActor aid store) ->+    invalidateInMeleeDueToItem aid store+  UpdSpotItem _ iid _ _ -> addItemToDiscoBenefit iid+  UpdLoseItem _ _ _ (CActor aid store) -> do     wipeBfsIfItemAffectsSkills [store] aid+    invalidateInMeleeDueToItem aid store   UpdLoseItem{} -> return ()-  UpdSpotItemBag (CActor aid store) _bag ais -> do+  UpdSpotItemBag _ (CActor aid store) bag -> do     wipeBfsIfItemAffectsSkills [store] aid-    mapM_ (addItemToDiscoBenefit . fst) ais-  UpdSpotItemBag _ _ ais ->-    mapM_ (addItemToDiscoBenefit . fst) ais-  UpdLoseItemBag (CActor aid store) _bag _ais ->+    mapM_ addItemToDiscoBenefit $ EM.keys bag+    invalidateInMeleeDueToItem aid store+  UpdSpotItemBag _ _ bag ->+    mapM_ addItemToDiscoBenefit $ EM.keys bag+  UpdLoseItemBag _ (CActor aid store) _ -> do     wipeBfsIfItemAffectsSkills [store] aid+    invalidateInMeleeDueToItem aid store   UpdLoseItemBag{} -> return ()   UpdMoveActor aid _ _ -> do     invalidateBfsAid aid     b <- getsState $ getActorBody aid-    -- Too costly to take projectiles into account. If blocked by them,-    -- instead we wait for them to move aside or we hit them.-    -- They are still considered whenever an actor moves himself-    -- and so his whole BFS data is invalidated.-    unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b+    -- BFS not invalidated, because distant actors may still move out+    -- of the way and close actors are considered when attempting to move+    -- and then BFS is invalidated, if needed.     invalidateInMelee (blid b)   UpdWaitActor aid _fromW toW ->     -- So that we can later ignore such actors when updating targets-    -- and not risk they beling pushed/displaces and targets getting wrong.+    -- and not risk they being pushed/displaced and targets getting illegal.     when (toW == WSleep) $       modifyClient $ updateTarget aid (const Nothing)   UpdDisplaceActor source target -> do     invalidateBfsAid source     invalidateBfsAid target     b <- getsState $ getActorBody source-    unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b-    tb <- getsState $ getActorBody target-    unless (bproj tb) $ invalidateBfsPathLid (blid tb) $ bpos tb+    -- BFS not invalidated, because distant actors may still move out+    -- of the way and close actors are considered when attempting to move+    -- and then BFS is invalidated, if needed.     invalidateInMelee (blid b)-  UpdMoveItem _ _ aid s1 s2 -> wipeBfsIfItemAffectsSkills [s1, s2] aid+  UpdMoveItem _ _ aid s1 s2 -> do+    wipeBfsIfItemAffectsSkills [s1, s2] aid+    invalidateInMeleeDueToItem aid s1+    invalidateInMeleeDueToItem aid s2   UpdRefillHP{} -> return ()   UpdRefillCalm{} -> return ()   UpdTrajectory{} -> return ()   UpdQuitFaction fid _ toSt _ -> do     side <- getsClient sside-    when (side == fid && maybe False ((/= Camping) . stOutcome) toSt) $ do-      let won = case toSt of-            Just Status{stOutcome=Conquer} -> True-            Just Status{stOutcome=Escape} -> True-            _ -> False-      when won $ do-        gameModeId <- getsState sgameModeId+    gameModeId <- getsState sgameModeId+    when (side == fid) $ case toSt of+      Just Status{stOutcome=Camping} ->+        modifyClient $ \cli ->+          cli {scampings = ES.insert gameModeId $ scampings cli}+      Just Status{stOutcome=Restart} ->+        modifyClient $ \cli ->+          cli {srestarts = ES.insert gameModeId $ srestarts cli}+      Just Status{stOutcome} | stOutcome `elem` victoryOutcomes -> do         scurChal <- getsClient scurChal         let sing = M.singleton scurChal 1             f = M.unionWith (+)             g = EM.insertWith f gameModeId sing         modifyClient $ \cli -> cli {svictories = g $ svictories cli}+      _ -> return ()+  UpdSpotStashFaction{} -> return ()+  UpdLoseStashFaction{} -> return ()   UpdLeadFaction fid source target -> do     side <- getsClient sside     when (side == fid) $ do@@ -138,7 +153,7 @@     -- @condBFS@ depends on the setting we change here (e.g., smarkSuspect).     invalidateBfsAll   UpdRecordKill{} -> return ()-  UpdTacticFaction{} -> do+  UpdDoctrineFaction{} -> do     -- Clear all targets except the leader's.     mleader <- getsClient sleader     mtgt <- case mleader of@@ -221,19 +236,14 @@   UpdCoverServer{} -> error "server command leaked to client"   UpdPerception lid outPer inPer -> perception lid outPer inPer   UpdRestart side sfper s scurChal soptions srandom -> do-    COps{cocave, comode} <- getsState scops+    COps{cocave} <- getsState scops     fact <- getsState $ (EM.! side) . sfactionD     snxtChal <- getsClient snxtChal     svictories <- getsClient svictories+    scampings <- getsClient scampings+    srestarts <- getsClient srestarts     stabs <- getsClient stabs-    let f !acc _p !i _a = i : acc-        modes = zip [0..] $ ofoldlGroup' comode "campaign scenario" f []-        g :: (Int, ContentId ModeKind) -> Int-        g (_, mode) = case EM.lookup mode svictories of-          Nothing -> 0-          Just cm -> fromMaybe 0 (M.lookup snxtChal cm)-        (snxtScenario, _) = minimumBy (comparing g) modes-        h lvl = CK.labyrinth (okind cocave $ lkind lvl)+    let h lvl = CK.labyrinth (okind cocave $ lkind lvl)                 && not (fhasGender $ gplayer fact)           -- Not to burrow through a labyrinth instead of leaving it for           -- the human player and to prevent AI losing time there instead@@ -246,14 +256,14 @@                   , srandom                   , scurChal                   , snxtChal-                  , snxtScenario                   , scondInMelee = EM.empty                   , svictories+                  , scampings+                  , srestarts                   , soptions                   , stabs }     salter <- getsState createSalter     modifyClient $ \cli1 -> cli1 {salter}-    restartClient   UpdRestartServer{} -> return ()   UpdResume _side sfperNew -> do #ifdef WITH_EXPENSIVE_ASSERTIONS@@ -275,6 +285,12 @@ invalidateInMelee lid =   modifyClient $ \cli -> cli {scondInMelee = EM.delete lid (scondInMelee cli)} +invalidateInMeleeDueToItem :: MonadClient m => ActorId -> CStore -> m ()+invalidateInMeleeDueToItem aid store =+  when (store `elem` [CEqp, COrgan]) $ do+    b <- getsState $ getActorBody aid+    invalidateInMelee (blid b)+ -- For now, only checking the stores. wipeBfsIfItemAffectsSkills :: MonadClient m => [CStore] -> ActorId -> m () wipeBfsIfItemAffectsSkills stores aid =@@ -299,31 +315,45 @@         _ -> tap   modifyClient $ \cli -> cli {stargetD = EM.map affect3 (stargetD cli)}   mapM_ (addItemToDiscoBenefit . fst) ais-  unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b+  unless (bproj b) $ invalidateBfsPathLid b   invalidateInMelee (blid b)  destroyActor :: MonadClient m => ActorId -> Actor -> Bool -> m () destroyActor aid b destroy = do-  when destroy $ modifyClient $ updateTarget aid (const Nothing)  -- gc-  modifyClient $ \cli -> cli {sbfsD = EM.delete aid $ sbfsD cli}  -- gc-  let affect tgt = case tgt of+  when destroy $  -- if vanishes for a moment only, keep target+    modifyClient $ \cli -> cli {stargetD = EM.delete aid $ stargetD cli} -- gc+  -- Here, among others, (local) flee time of an actor changing level is reset.+  modifyClient $ \cli -> cli { sbfsD = EM.delete aid $ sbfsD cli+                             , sfleeD = EM.delete aid $ sfleeD cli }+  localTime <- getsState $ getLocalTime $ blid b+  fleeD <- getsClient sfleeD+  let recentlyFled aid3 = maybe False (\(_, time) -> timeRecent5 localTime time)+                                (aid3 `EM.lookup` fleeD)+      dummyTarget = TPoint TKnown (blid b) (bpos b)+      affect aid3 tgt = case tgt of         TEnemy a | a == aid ->-          if destroy then+          if destroy || recentlyFled aid3+                          -- if fleeing, don't chase the enemy soon after;+                          -- unfortunately, the enemy also won't be recorded+                          -- in case he gets out of sight, in order to avoid+                          -- him when fleeing again, but all enemies should be+                          -- recorded in such a case, so not a big difference+          then             -- If *really* nothing more interesting, the actor will             -- go to last known location to perhaps find other foes.-            TPoint TKnown (blid b) (bpos b)+            dummyTarget           else             -- If enemy only hides (or we stepped behind obstacle) find him.             TPoint (TEnemyPos a) (blid b) (bpos b)-        TNonEnemy a | a == aid -> TPoint TKnown (blid b) (bpos b)+        TNonEnemy a | a == aid -> dummyTarget         _ -> tgt-      affect3 TgtAndPath{..} =+      affect3 aid3 TgtAndPath{..} =         let newMPath = case tapPath of               Just AndPath{pathGoal} | pathGoal /= bpos b -> Nothing               _ -> tapPath  -- foe slow enough, so old path good-        in TgtAndPath (affect tapTgt) newMPath-  modifyClient $ \cli -> cli {stargetD = EM.map affect3 (stargetD cli)}-  unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b+        in TgtAndPath (affect aid3 tapTgt) newMPath+  modifyClient $ \cli -> cli {stargetD = EM.mapWithKey affect3 (stargetD cli)}+  unless (bproj b) $ invalidateBfsPathLid b   invalidateInMelee (blid b)  addItemToDiscoBenefit :: MonadClient m => ItemId -> m ()

engine-src/Game/LambdaHack/Client/LoopM.hs view

@@ -15,13 +15,13 @@ import Game.LambdaHack.Core.Prelude  import Game.LambdaHack.Atomic-import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.HandleAtomicM import Game.LambdaHack.Client.HandleResponseM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Response import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI+import Game.LambdaHack.Common.ClientOptions  -- | Client monad in which one can receive responses from the server. class MonadClient m => MonadClientReadResponse m where@@ -55,39 +55,47 @@            , MonadClientReadResponse m            , MonadClientWriteRequest m )         => CCUI -> UIOptions -> ClientOptions -> m ()-loopCli ccui sUIOptions soptions = do-  modifyClient $ \cli -> cli {soptions}+loopCli ccui sUIOptions clientOptions = do+  modifyClient $ \cli -> cli {soptions = clientOptions}+  side <- getsClient sside   hasUI <- clientHasUI   if not hasUI then initAI else initUI ccui+  let cliendKindText = if not hasUI then "AI" else "UI"+  debugPossiblyPrint $ cliendKindText <+> "client"+                       <+> tshow side <+> "started 1/4."   -- Warning: state and client state are invalid here, e.g., sdungeon   -- and sper are empty.   restoredG <- tryRestore   restored <- case restoredG of-    Just (cli, msess) | not $ snewGameCli soptions -> do+    Just (cli, msess) | not $ snewGameCli clientOptions -> do       -- Restore game.       schanF <- getsSession schanF       sccui <- getsSession sccui       maybe (return ()) (\sess -> modifySession $ const         sess {schanF, sccui, sUIOptions}) msess-      putClient cli {soptions}+      let noAnim = fromMaybe False $ snoAnim $ soptions cli+      putClient cli {soptions = clientOptions {snoAnim = Just noAnim}}       return True     Just (_, msessR) -> do-      -- Preserve previous history, if any (--newGame).+      -- Preserve previous history, if any.       maybe (return ()) (\sessR -> modifySession $ \sess ->         sess {shistory = shistory sessR}) msessR       return False     _ -> return False+  debugPossiblyPrint $ cliendKindText <+> "client"+                       <+> tshow side <+> "started 2/4."   -- At this point @ClientState@ not overriten dumbly and @State@ valid.   tabA <- createTabBFS   tabB <- createTabBFS   modifyClient $ \cli -> cli {stabs = (tabA, tabB)}-  side <- getsClient sside   cmd1 <- receiveResponse+  debugPossiblyPrint $ cliendKindText <+> "client"+                       <+> tshow side <+> "started 3/4."   case (restored, cmd1) of     (True, RespUpdAtomic _ UpdResume{}) -> return ()     (True, RespUpdAtomic _ UpdRestart{}) ->       when hasUI $-        promptAdd "Ignoring an old savefile and starting a new game."+        clientPrintUI "Ignoring an old savefile and starting a new game."     (False, RespUpdAtomic _ UpdResume{}) ->       error $ "Savefile of client " ++ show side ++ " not usable."               `showFailure` ()@@ -95,7 +103,7 @@     (True, RespUpdAtomicNoState UpdResume{}) -> undefined     (True, RespUpdAtomicNoState UpdRestart{}) ->       when hasUI $-        promptAdd "Ignoring an old savefile and starting a new game."+        clientPrintUI "Ignoring an old savefile and starting a new game."     (False, RespUpdAtomicNoState UpdResume{}) ->       error $ "Savefile of client " ++ show side ++ " not usable."               `showFailure` ()@@ -103,10 +111,12 @@     _ -> error $ "unexpected command" `showFailure` (side, restored, cmd1)   handleResponse cmd1   -- State and client state now valid.-  let cliendKindText = if not hasUI then "AI" else "UI"-  debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side <+> "started."+  debugPossiblyPrint $ cliendKindText <+> "client"+                       <+> tshow side <+> "started 4/4."   loop-  debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side <+> "stopped."+  side2 <- getsClient sside+  debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side2+                       <+> "(initially" <+> tshow side <> ") stopped."  where   loop = do     cmd <- receiveResponse

engine-src/Game/LambdaHack/Client/MonadClient.hs view

@@ -7,7 +7,7 @@   , MonadClient(modifyClient)     -- * Assorted primitives   , getClient, putClient-  , debugPossiblyPrint, createTabBFS, rndToAction, rndToActionForget+  , debugPossiblyPrint, createTabBFS, dumpTextFile, rndToAction, condInMeleeM   ) where  import Prelude ()@@ -16,19 +16,22 @@  import           Control.Monad.ST.Strict (stToIO) import qualified Control.Monad.Trans.State.Strict as St-import           Data.Bits (finiteBitSize, xor, (.&.))+import qualified Data.EnumMap.Strict as EM import qualified Data.Primitive.PrimArray as PA import qualified Data.Text.IO as T+import           System.FilePath import           System.IO (hFlush, stdout)-import qualified System.Random as R -import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.State+import Game.LambdaHack.Common.ActorState+import Game.LambdaHack.Common.ClientOptions+import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Kind+import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State-import Game.LambdaHack.Common.Time+import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Core.Random @@ -53,7 +56,7 @@ debugPossiblyPrint t = do   sdbgMsgCli <- getsClient $ sdbgMsgCli . soptions   when sdbgMsgCli $ liftIO $ do-    T.hPutStrLn stdout t+    T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough     hFlush stdout  createTabBFS :: MonadClient m => m (PA.PrimArray PointI)@@ -63,6 +66,14 @@     tabAMutable <- PA.newPrimArray (rXmax * rYmax)  -- always enough     PA.unsafeFreezePrimArray tabAMutable +dumpTextFile :: MonadClientRead m => Text -> FilePath -> m FilePath+dumpTextFile t filename = liftIO $ do+  dataDir <- appDataDir+  tryCreateDir dataDir+  let path = dataDir </> filename+  T.writeFile path t+  return path+ -- | Invoke pseudo-random computation with the generator kept in the state. rndToAction :: MonadClient m => Rnd a -> m a rndToAction r = do@@ -71,16 +82,15 @@   modifyClient $ \cli -> cli {srandom = gen2}   return a --- | Invoke pseudo-random computation, don't change generator kept in state.--- Modify the used generator by @xoring@ with current global game time.-rndToActionForget :: MonadClientRead m => Rnd a -> m a-rndToActionForget r = do-  gen <- getsClient srandom-  let i = fst $ R.next gen-  time <- getsState stime-  -- Prevent overflow from @Int64@ to @Int@.-  let positiveIntSize = finiteBitSize (1 :: Int) - 1-      oneBitsPositiveInt = 2 ^ positiveIntSize - 1-      timeSmallBits = fromEnum $ timeTicks time .&. oneBitsPositiveInt-      genNew = R.mkStdGen $ i `xor` timeSmallBits-  return $! St.evalState r genNew+condInMeleeM :: MonadClient m => LevelId -> m Bool+condInMeleeM lid = do+  condInMelee <- getsClient scondInMelee+  case EM.lookup lid condInMelee of+    Just inM -> return inM+    Nothing -> do+      side <- getsClient sside+      actorMaxSkills <- getsState sactorMaxSkills+      inM <- getsState $ inMelee actorMaxSkills side lid+      modifyClient $ \cli ->+        cli {scondInMelee = EM.insert lid inM condInMelee}+      return inM

engine-src/Game/LambdaHack/Client/Preferences.hs view

@@ -5,7 +5,8 @@     -- * Internal operations   , effectToBenefit   , averageTurnValue, avgItemDelay, avgItemLife, durabilityMult-  , organBenefit, recBenefit, fakeItem, aspectToBenefit, aspectRecordToBenefit+  , organBenefit, recBenefit, fakeItem+  , aspectToBenefit, capStat, aspectRecordToBenefit #endif   ) where @@ -32,7 +33,7 @@  -- | How much AI benefits from applying the effect. -- The first component is benefit when applied to self, the second--- is benefit (preferably negative) when applied to enemy.+-- is benefit (preferably negative) when applied to enemy (via melee). -- This represents benefit from using the effect every @avgItemDelay@ turns, -- so if the item is not durable, the value is adjusted down elsewhere. -- The benefit includes the drawback of having to use the actor's turn,@@ -47,10 +48,10 @@ effectToBenefit cops fid factionD eff =   let delta x = (x, x)   in case eff of-    IK.Burn d -> delta $ -(min 1500 $ 15 * Dice.meanDice d)-      -- often splash damage, armor doesn't block (but HurtMelee doesn't boost)-    IK.Explode "single spark" -> delta (-1)  -- hardwired; probing and flavour-    IK.Explode "fragrance" -> (1, -5)  -- hardwired; situational+    IK.Burn d -> delta $ -(min 1000 $ 10 * Dice.meanDice d)+    IK.Explode IK.S_SINGLE_SPARK -> delta (-1)  -- probing and flavour+    IK.Explode IK.S_SPARK -> delta (-9)  -- small, to not affect weapon order+    IK.Explode IK.S_FRAGRANCE -> (1, -5)  -- situational     IK.Explode _ ->       -- There is a risk the explosion is focused and harmful to self       -- or not focused and beneficial to nearby foes, but not to self.@@ -59,24 +60,38 @@       -- Due to this assumption, healing explosives should be wrapped       -- in @OnSmash@, or else they are counted as an incentive for throwing       -- an item at foes, which in that case is counterproductive.-      delta (-100)+      delta (-50)  -- not too low so that S_INK_SAC used by AI     IK.RefillHP p ->       delta $ if p > 0-              then min 2000 (20 * fromIntegral p)-              else max (-1000) (10 * fromIntegral p)-        -- one HP healed is worth a bit more than one HP dealed to enemy,+              then min 2000 (20 * intToDouble p)+              else max (-1000) (10 * intToDouble p)+        -- one HP healed is worth a bit more than one HP dealt to enemy,         -- because if the actor survives, he may deal damage many times;         -- however, AI is mostly for non-heroes that fight in suicidal crowds,         -- so the two values are kept close enough to maintain berserk approach-    IK.RefillCalm p -> delta $ if p > 0-                               then min 100 (fromIntegral p)-                               else max (-500) (5 * fromIntegral p)+    IK.RefillCalm p ->+      ( if p > 0+        then min 100 (intToDouble p)+          -- this may cause ice to be attractive to AI,+          -- but it doesn't trigger it due to no @ConsideredByAI@+        else if p >= -5+             then max (-100) (intToDouble p)+             else max (-1500) (15 * intToDouble p)+          -- big Calm drains are incredibly dangerous, so don't be stupid+          -- and don't self-inflict them, particularly if you are an intelligent+          -- high-HP actor, which is likely if you collect and apply items+      , if p > 0+        then min 100 (intToDouble p)+        else max (-500) (5 * intToDouble p) )+          -- quite a powerful weapon, especially against high-HP foes     IK.Dominate -> (0, -100)  -- I obtained an actor with, say 10HP,                               -- worth 200, and enemy lost him, another 100;                               -- divided by 3, because impression needed first-    IK.Impress -> (0, -20)-    IK.PutToSleep -> (10, -50)  -- can affect friends, but more often enemies-    IK.Yell -> (-5, -10)  -- usually uncontrollably wakes up enemies, so bad+    IK.Impress -> (0, -20)  -- this causes heroes to waste a crucial resource+                            -- but makes aliens more aggresive than defensive;+                            -- also, smart use is hardcoded in AI action choice+    IK.PutToSleep -> (-10, -50)  -- can affect friends, but more often enemies+    IK.Yell -> (-1, -2)  -- usually uncontrollably wakes up enemies, so bad     IK.Summon grp d ->  -- contrived by not checking if enemies also control                         -- that group; safe for normal dungeon crawl content;                         -- not correct for symmetric scenarios, but let it be@@ -86,14 +101,13 @@             isFriend fid fact fid2             && grp `elem` fgroups (gplayer $ factionD EM.! fid2)       in -- Prefer applying summoning items to flinging them; the actor gets-         -- spawned further from for, but it's more robust+         -- spawned further from foes, but it's more robust.          if any friendlyHasGrp $ EM.keys factionD          then (ben, -1)          else (-ben * 3, 1)  -- the foe may spawn during battle and gang up-    IK.Ascend{} -> (-99, 99)-      -- note the reversed values: only change levels sensibly, in teams,-      -- and don't remove enemy too far, he may be easy to kill-      -- and may have loot+    IK.Ascend{} -> (0, 0)+      -- only change levels sensibly, in teams, and don't remove enemy too far,+      -- he may be easy to kill and may have essential loot     IK.Escape{} -> (-9999, 9999)  -- even if can escape, loots first and then                                   -- handles escape as a special case     -- The following two are expensive, because they ofen activate@@ -105,32 +119,34 @@     IK.Paralyze d -> delta $ -20 * Dice.meanDice d  -- clips     IK.ParalyzeInWater d -> delta $ -10 * Dice.meanDice d  -- clips; resistable     IK.InsertMove d -> delta $ 10 * Dice.meanDice d  -- turns-    IK.Teleport d -> if Dice.meanDice d <= 8-                     then (0, 0)    -- annoying either way-                     else (-9, -1)  -- for self, don't derail exploration-                                    -- for foes, fight with one less at a time-    IK.CreateItem COrgan "condition" _ ->+    IK.Teleport{} -> (-9, -1)  -- for self, don't derail exploration+                               -- for foes, fight with one less at a time+    IK.CreateItem _ COrgan IK.CONDITION _ ->       (1, -1)  -- varied, big bunch, but try to create it anyway-    IK.CreateItem COrgan grp timer ->  -- assumed temporary+    IK.CreateItem _ COrgan grp timer ->  -- assumed temporary       let turnTimer = IK.foldTimer 1 Dice.meanDice Dice.meanDice timer             -- copy count used instead of timer for organs with many copies           (total, count) = organBenefit turnTimer grp cops fid factionD-      in delta $ total / fromIntegral count+      in delta $ total / intToDouble count            -- the same when created in me and in foe            -- average over all matching grps; simplified: rarities ignored-    IK.CreateItem _ "treasure" _ -> (100, 0)  -- assumed not temporary-    IK.CreateItem _ "common item" _ -> (70, 0)-    IK.CreateItem _ "curious item" _ -> (70, 0)-    IK.CreateItem _ "any scroll" _ -> (50, 0)-    IK.CreateItem _ "any vial" _ -> (50, 0)-    IK.CreateItem _ "potion" _ -> (50, 0)-    IK.CreateItem _ "explosive" _ -> (50, 0)-    IK.CreateItem _ "any jewelry" _ -> (100, 0)-    IK.CreateItem _ grp _ ->  -- assumed not temporary and @grp@ tiny+    IK.CreateItem _ _ IK.TREASURE _ -> (100, 0)  -- assumed not temporary+    IK.CreateItem _ _ IK.COMMON_ITEM _ -> (70, 0)+    IK.CreateItem _ _ IK.CRAWL_ITEM _ -> (70, 0)+    IK.CreateItem _ _ IK.ANY_SCROLL _ -> (50, 0)+    IK.CreateItem _ _ IK.ANY_GLASS _ -> (75, 0)+    IK.CreateItem _ _ IK.ANY_POTION _ -> (100, 0)+    IK.CreateItem _ _ IK.ANY_FLASK _ -> (50, 0)+    IK.CreateItem _ _ IK.EXPLOSIVE _ -> (50, 0)+    IK.CreateItem _ _ IK.ANY_JEWELRY _ -> (100, 0)+    IK.CreateItem _ _ grp _ ->  -- assumed not temporary and @grp@ tiny       let (total, count) = recBenefit grp cops fid factionD-      in (total / fromIntegral count, 0)-    IK.DropItem _ _ COrgan "condition" ->-      delta 30  -- save for curing own bad conditions+      in (total / intToDouble count, 0)+    IK.DestroyItem{} -> delta (-10)  -- potentially harmful+    IK.ConsumeItems{} -> delta (-10)  -- potentially harmful+    IK.DropItem _ _ COrgan IK.CONDITION ->+      (0, -1)  -- negative value necessary to collect such items;+               -- smart use on self is hardcoded in AI action choice     IK.DropItem ngroup kcopy COrgan grp ->  -- assumed temporary       -- Simplified: we assume actor has an average number of copies       -- (and none have yet run out, e.g., prompt curing of poisoning)@@ -142,40 +158,77 @@           (total, count) = organBenefit turnTimer grp cops fid factionD           boundBonus n = if n == maxBound then 10 else 0       in delta $ boundBonus ngroup + boundBonus kcopy-                 - total / fromIntegral count+                 - total / intToDouble count                    -- the same when dropped from me and foe     IK.DropItem{} -> delta (-10)  -- depends a lot on what is dropped+    IK.Recharge n d -> delta $ intToDouble n * Dice.meanDice d / 10+      -- this high value to price weapons with @OnUser@ over fists+    IK.Discharge n d -> delta $ - intToDouble n * Dice.meanDice d / 10     IK.PolyItem -> (1, 0)  -- may fizzle, so AI never uses (could loop)     IK.RerollItem -> (1, 0)  -- may fizzle, so AI never uses (could loop)     IK.DupItem -> (1, 0)  -- may fizzle, so AI never uses (could loop)     IK.Identify -> (1, 0)  -- may fizzle, so AI never uses (could loop)-    IK.Detect IK.DetectAll radius -> (fromIntegral radius * 2, 0)-    IK.Detect IK.DetectLoot radius -> (fromIntegral radius * 2, 0)-    IK.Detect IK.DetectExit radius -> (fromIntegral radius / 2, 0)-    IK.Detect _ radius -> (fromIntegral radius, 0)-    IK.SendFlying _ -> (0, -100)  -- very context dependent, but lack of control-    IK.PushActor _ -> (0, -100)   -- is deadly on some maps, leading to harm;-    IK.PullActor _ -> (0, -100)   -- pushing others may crush them against wall-    IK.DropBestWeapon -> delta $ -50  -- often a whole turn wasted == InsertMove-    IK.ActivateInv ' ' -> delta $ -200  -- brutal and deadly-    IK.ActivateInv _ -> delta $ -50  -- depends on the items+    IK.Detect IK.DetectAll radius -> (intToDouble radius * 2, 0)+    IK.Detect IK.DetectLoot radius -> (intToDouble radius * 2, 0)+    IK.Detect IK.DetectExit radius -> (intToDouble radius / 2, 0)+    IK.Detect _ radius -> (intToDouble radius, 0)+    IK.SendFlying _ -> (0, -1)   -- very context dependent, but lack of control+    IK.PullActor _ -> (0, -1)    -- is deadly on some maps, leading to harm;+    IK.PushActor _ -> (0, -100)  -- pushing others may crush them against wall+                                 -- and give us time to fling at them     IK.ApplyPerfume -> delta 0  -- depends on smell sense of friends and foes-    IK.OneOf efs ->-      let bs = map (effectToBenefit cops fid factionD) efs+    IK.AtMostOneOf effs ->+      let bs = map (effectToBenefit cops fid factionD) effs           f (self, foe) (accSelf, accFoe) = (self + accSelf, foe + accFoe)           (effSelf, effFoe) = foldr f (0, 0) bs-      in (effSelf / fromIntegral (length bs), effFoe / fromIntegral (length bs))+      in (effSelf / intToDouble (length bs), effFoe / intToDouble (length bs))+    IK.OneOf effs ->+      let bs = map (effectToBenefit cops fid factionD) effs+          f (self, foe) (accSelf, accFoe) = (self + accSelf, foe + accFoe)+          (effSelf, effFoe) = foldr f (0, 0) bs+      in (effSelf / intToDouble (length bs), effFoe / intToDouble (length bs))     IK.OnSmash _ -> delta 0       -- can be beneficial; we'd need to analyze explosions, range, etc.-    IK.VerbNoLonger{} -> delta 0  -- flavour only, no benefit-    IK.VerbMsg{} -> delta 0  -- flavour only, no benefit-    IK.Composite [] -> delta 0-    IK.Composite (eff1 : _) -> effectToBenefit cops fid factionD eff1+    IK.OnCombine eff1 -> effectToBenefit cops fid factionD eff1+    IK.OnUser eff1 ->+      let (effSelf, _) = effectToBenefit cops fid factionD eff1+      in (effSelf, - effSelf)+           -- in both cases just applies the effect to itself,+           -- which is approximately equal to applying the opposite to foe;+           -- this may result in double-counting, but ensures that weapons+           -- that harm their wielders are properly discouted;+           -- in a way, this should be double-counted, because the effect+           -- not only hinders (or enhances) applying the item,+           -- but meleeing with it, too+    IK.NopEffect -> delta 0+    IK.AndEffect eff1 _ -> effectToBenefit cops fid factionD eff1       -- for simplicity; so in content make sure to place initial animations       -- among normal effects, not at the start of composite effect       -- (animations should not fail, after all), and start composite       -- effect with the main thing+    IK.OrEffect eff1 _ -> effectToBenefit cops fid factionD eff1+    IK.SeqEffect effs -> effectToBenefits cops fid factionD effs+    IK.When _cond eff1 ->+      -- Assuming the condition met most of the time. Really, too hard for AI.+      effectToBenefit cops fid factionD eff1+    IK.Unless _cond eff1 ->+      -- Assuming the condition *not* met most of the time.+      -- Really, too hard for AI.+      effectToBenefit cops fid factionD eff1+    IK.IfThenElse _cond eff1 _eff2 ->+      -- Assuming the first is much more common. Really, too hard for AI.+      effectToBenefit cops fid factionD eff1+    IK.VerbNoLonger{} -> delta 0  -- flavour only, no benefit+    IK.VerbMsg{} -> delta 0  -- flavour only, no benefit+    IK.VerbMsgFail{} -> delta 0 +effectToBenefits :: COps -> FactionId -> FactionDict -> [IK.Effect]+                 -> (Double, Double)+effectToBenefits cops fid factionD effs =+  let effPairs = map (effectToBenefit cops fid factionD) effs+      f (self, foe) (accSelf, accFoe) = (self + accSelf, foe + accFoe)+  in foldr f (0, 0) effPairs+ -- See the comment for @Paralyze@. averageTurnValue :: Double averageTurnValue = 10@@ -260,12 +313,12 @@   let f (!sacc, !pacc) !p _ !kind =         let count = Dice.meanDice (IK.icount kind)             paspect asp =-              fromIntegral p+              intToDouble p               * count * turnTimer                 -- the aspect stays for this many turns'                * aspectToBenefit asp             peffect eff =-              fromIntegral p+              intToDouble p               * count                 -- this many consecutive effects will be generated, if any               * fst (effectToBenefit cops fid factionD eff)@@ -333,20 +386,20 @@ aspectToBenefit asp =   case asp of     IK.Timeout{} -> 0-    IK.AddSkill Ability.SkMove p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkMelee p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkDisplace p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkAlter p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkWait p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkMoveItem p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkProject p -> Dice.meanDice p * 5-    IK.AddSkill Ability.SkApply p -> Dice.meanDice p * 5+    IK.AddSkill Ability.SkMove p -> capStat (Dice.meanDice p) * 5+    IK.AddSkill Ability.SkMelee p -> capStat (Dice.meanDice p) * 5+    IK.AddSkill Ability.SkDisplace p -> capStat (Dice.meanDice p)+    IK.AddSkill Ability.SkAlter p -> capStat (Dice.meanDice p)+    IK.AddSkill Ability.SkWait p -> capStat (Dice.meanDice p)+    IK.AddSkill Ability.SkMoveItem p -> capStat (Dice.meanDice p)+    IK.AddSkill Ability.SkProject p -> capStat (Dice.meanDice p) * 2+    IK.AddSkill Ability.SkApply p -> capStat (Dice.meanDice p) * 2     IK.AddSkill Ability.SkSwimming p -> Dice.meanDice p     IK.AddSkill Ability.SkFlying p -> Dice.meanDice p     IK.AddSkill Ability.SkHurtMelee p -> Dice.meanDice p  -- offence favoured     IK.AddSkill Ability.SkArmorMelee p -> Dice.meanDice p / 4                                               -- only partial protection-    IK.AddSkill Ability.SkArmorRanged p -> Dice.meanDice p / 8+    IK.AddSkill Ability.SkArmorRanged p -> Dice.meanDice p / 4     IK.AddSkill Ability.SkMaxHP p -> Dice.meanDice p     IK.AddSkill Ability.SkMaxCalm p -> Dice.meanDice p / 5     IK.AddSkill Ability.SkSpeed p -> Dice.meanDice p * 25@@ -355,15 +408,20 @@     IK.AddSkill Ability.SkSight p -> Dice.meanDice p * 5     IK.AddSkill Ability.SkSmell p -> Dice.meanDice p     IK.AddSkill Ability.SkShine p -> Dice.meanDice p * 2-    IK.AddSkill Ability.SkNocto p -> Dice.meanDice p * 10+    IK.AddSkill Ability.SkNocto p -> Dice.meanDice p * 30                                        -- > sight + light; stealth, slots     IK.AddSkill Ability.SkHearing p -> Dice.meanDice p     IK.AddSkill Ability.SkAggression _ -> 0  -- dunno-    IK.AddSkill Ability.SkOdor p -> - Dice.meanDice p  -- makes one trackable+    IK.AddSkill Ability.SkOdor p -> - Dice.meanDice p / 4+      -- rarely, if big enough, determines if one is trackable+    IK.AddSkill Ability.SkDeflectRanged p -> Dice.meanDice p * 100+    IK.AddSkill Ability.SkDeflectMelee p -> Dice.meanDice p * 100     IK.SetFlag{} -> 0+      -- valuing @UnderRanged@ and @UnderMelee@ vs retaining the charge+      -- and explicit applying is too hard, hence ignored     IK.ELabel{} -> 0     IK.ToThrow{} -> 0  -- counted elsewhere-    IK.HideAs{} -> 0+    IK.PresentAs{} -> 0     IK.EqpSlot{} -> 0     IK.Odds{} -> 0       -- Should be already rolled; if not, can't tell easily.@@ -372,6 +430,11 @@       -- in not fully-identified items, because they are so crucial       -- for evaluation. +-- We simplify, assuming stats are unlikely to be higher than 10+-- and to be affected by more than one non-organ item at a time.+capStat :: Double -> Double+capStat x = max (-10) $ min 10 x+ aspectRecordToBenefit :: IA.AspectRecord -> [Double] aspectRecordToBenefit arItem =   map aspectToBenefit $ IA.aspectRecordToList arItem@@ -385,7 +448,7 @@       -- because we assume it's in equipment and then       -- we can't effectively apply it, because it's never recharged,       -- because it activates as soon as recharged.-      -- We ignore the rare case of a periodic item kept in backpack+      -- We ignore the rare case of a periodic item kept in stash       -- to be applied manually. AI is too silly to choose it and we       -- certainly don't want AI to destroy periodic items out of silliness.       -- We don't assign a special bonus or malus due to being periodic,@@ -407,7 +470,7 @@       -- Timeout 2 means two such items are needed to use the effect each turn,       -- so a single such item may be worth half of the permanent value.       -- E.g., when item heals 1 HP each turn, that's precisly the calculation.-      timeout = fromIntegral $ IA.aTimeout arItem+      timeout = intToDouble $ IA.aTimeout arItem       scalePeriodic value = value / max 1 timeout       -- With non-periodic items, when we need to expend a turn to apply the       -- item or, e.g., we lose the opportunity to use another weapon if we hit@@ -421,10 +484,7 @@       timeoutSqrt = sqrt $ max 2 timeout       scaleTimeout v = v / timeoutSqrt       (effSelf, effFoe) =-        let effPairs = map (effectToBenefit cops fid factionD)-                           (IK.ieffects itemKind)-            f (self, foe) (accSelf, accFoe) = (self + accSelf, foe + accFoe)-        in foldr f (0, 0) effPairs+        effectToBenefits cops fid factionD (IK.ieffects itemKind)       -- Durability doesn't have any numerical impact on @eqpSum,       -- because item is never consumed by just being stored in equipment.       -- Also no numerical impact for flinging, because we can't fling it again@@ -446,6 +506,14 @@         else scaleTimeout (effSelf + effDice)                -- hits self with kintetic dice too, when applying              / if durable then 1 else durabilityMult+      -- This assumes attacker hurt skill and enemy armor skill balance+      -- and so this value doesn't need to be recomputed at each equipment+      -- change and distributing weapons among AI actors doesn't need+      -- to match each weapon to each actor's equipment. However,+      -- a bad side-effect is that if an actor has terrible hurt skill,+      -- a weapon with high dice is still used by him before a burning weapon.+      -- Unless the opponent has even more terrible armor, unlikely,+      -- the chosen weapon is definitely not the best.       effDice = - IK.damageUsefulness itemKind       -- For melee, we add the foe part only.       benMelee = if periodic@@ -475,11 +543,11 @@         hurtMult = armorHurtCalculation True (IA.aSkills arItem)                                              Ability.zeroSkills         dmg = Dice.meanDice $ IK.idamage itemKind-        rawDeltaHP = ceiling $ fromIntegral hurtMult * xD dmg / 100+        rawDeltaHP = ceiling $ intToDouble hurtMult * xD dmg / 100         -- For simplicity, we ignore range bonus/malus and @Lobable@.         IK.ThrowMod{IK.throwVelocity} = IA.aToThrow arItem         speed = speedFromWeight (IK.iweight itemKind) throwVelocity-        v = - fromIntegral (modifyDamageBySpeed rawDeltaHP speed) * 10 / xD 1+        v = - int64ToDouble (modifyDamageBySpeed rawDeltaHP speed) * 10 / xD 1           -- 1 damage valued at 10, just as in @damageUsefulness@       -- If item is periodic, we factor in the self value of effects,       -- because they are applied to self, whether the actor wants it or not.@@ -498,8 +566,9 @@       -- value those competently against any equally enormous bonuses       -- the item might provide to compensate and so be even considered.       cripplingDrawback = not (null aspectBenefits)-                          && minimum aspectBenefits < -20+                          && minimum aspectBenefits < -25       eqpSum = eqpBens - if cripplingDrawback then 100 else 0+      vApplyFling = max benApply (- benFling)       -- If a weapon heals enemy at impact, given choice, it won't be used       -- for melee, but can be equipped anyway, for beneficial aspects.       -- OTOH, cif it harms wearer too much, it won't be worn@@ -509,19 +578,31 @@             -- the flag probably known even if item not identified           && (benMelee < 0 || itemSuspect)           && eqpSum >= -20 =-          ( True  -- equip, melee crucial and only weapons in eqp can be used-          , eqpSum-            + maximum [benApply, - benMeleeAvg, 0] )  -- apply or melee or not+            let vEqp = eqpSum + maximum [benApply, - benMeleeAvg, 0]+                      -- equip plus apply or melee or not+                v = if | vEqp > 0 -> vEqp+                           -- pick up to equip; melee is crucial+                       | vApplyFling > 0 -> vApplyFling+                           -- at least pick up to apply or fling, if feasible,+                           -- and equip just in case interesting effect;+                           -- will be taken off if very harmful+                       | otherwise -> vEqp+                           -- do not pick up, but if forced, the best bet+                           -- is equip anyway+            in (True, v)         | (IA.goesIntoEqp arItem-          || isJust (lookup "condition" $ IK.ifreq itemKind))-               -- hack to record benefit, to use it in calculations later on+           || IA.checkFlag Ability.Condition arItem)+                -- hack to record benefit, to use, e.g., to assign colour           && (eqpSum > 0 || itemSuspect) =  -- weapon or other equippable           ( True  -- equip; long time bonus usually outweighs fling or apply           , eqpSum  -- possibly spent turn equipping, so reap the benefits             + if durable               then benApply  -- apply or not but don't fling               else 0)  -- don't remove from equipment by using up-        | otherwise =-          (False, max benApply (- benFling))  -- apply or fling-      benPickup = max benPickupRaw $ if itemSuspect then 10 else 0+        | otherwise = (False, vApplyFling)  -- apply or fling+      benPickupRaw2 = max benPickupRaw $ if itemSuspect then 10 else 0+      -- If periodic, pick up to deny to foes and sometimes to apply+      -- to activate the first effect only (easier than computing if the first+      -- effect is really beneficial, while all effects detrimental).+      benPickup = if periodic then max 1 benPickupRaw2 else benPickupRaw2   in Benefit{..}

engine-src/Game/LambdaHack/Client/Request.hs view

@@ -10,13 +10,13 @@  import Game.LambdaHack.Core.Prelude -import qualified Game.LambdaHack.Definition.Ability as Ability-import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Content.ModeKind+import qualified Game.LambdaHack.Definition.Ability as Ability+import           Game.LambdaHack.Definition.Defs  -- | Requests sent by AI clients to the server. If faction leader is to be -- changed, it's included as the second component.@@ -40,7 +40,7 @@   | ReqUIGameDropAndExit   | ReqUIGameSaveAndExit   | ReqUIGameSave-  | ReqUITactic Ability.Tactic+  | ReqUIDoctrine Ability.Doctrine   | ReqUIAutomate   deriving Show

engine-src/Game/LambdaHack/Client/State.hs view

@@ -17,18 +17,19 @@ import qualified Data.Map.Strict as M import qualified Data.Primitive.PrimArray as PA import           GHC.Generics (Generic)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  import           Game.LambdaHack.Client.Bfs-import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Perception import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Common.State+import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Content.ModeKind (ModeKind)@@ -39,10 +40,11 @@   { seps          :: Int            -- ^ a parameter of the aiming digital line   , stargetD      :: EM.EnumMap ActorId TgtAndPath       -- ^ targets of our actors in the dungeon; this is only useful for AI-      --   and for directing henchmen, in particular with following tactics,-      --   where henchmen go to the leader's target-  , sfleeD        :: EM.EnumMap ActorId Point-                                    -- ^ the position when fleeing requested+      --   and for directing non-pointmen, in particular with following+      --   doctrines, where non-pointmen go to the pointman's target+  , sfleeD        :: EM.EnumMap ActorId (Point, Time)+                                    -- ^ the position and time of last fleeing+                                    --   attempt (regardless if succeeded)   , sexplored     :: ES.EnumSet LevelId                                     -- ^ the set of fully explored levels   , sbfsD         :: EM.EnumMap ActorId BfsAndPath@@ -53,19 +55,22 @@       --   but they are costly to generate and not too large   , sfper         :: PerLid         -- ^ faction perception indexed by level   , salter        :: AlterLid       -- ^ cached alter skill data for positions-  , srandom       :: R.StdGen       -- ^ current random generator+                                    --   (actually, @Tile.alterMinWalk@ instead)+  , srandom       :: SM.SMGen       -- ^ current random generator   , _sleader      :: Maybe ActorId  -- ^ candidate new leader of the faction;                                     --   Faction.gleader is the old leader   , _sside        :: FactionId      -- ^ faction controlled by the client   , squit         :: Bool           -- ^ exit the game loop   , scurChal      :: Challenge      -- ^ current game challenge setup   , snxtChal      :: Challenge      -- ^ next game challenge setup-  , snxtScenario  :: Int            -- ^ next game scenario number   , smarkSuspect  :: Int            -- ^ whether to mark suspect features   , scondInMelee  :: EM.EnumMap LevelId Bool-                                    -- ^ whether we are in melee, per level+      -- ^ whether we are in melee, per level; this is not a set, due to+      --   an unbenchmarked theory that a constant shape map is faster   , svictories    :: EM.EnumMap (ContentId ModeKind) (M.Map Challenge Int)                                     -- ^ won games at particular difficulty lvls+  , scampings     :: ES.EnumSet (ContentId ModeKind)  -- ^ camped games+  , srestarts     :: ES.EnumSet (ContentId ModeKind)  -- ^ restarted games   , soptions      :: ClientOptions  -- ^ client options   , stabs         :: (PA.PrimArray PointI, PA.PrimArray PointI)       -- ^ Instead of a BFS queue (list) we use these two arrays,@@ -96,13 +101,14 @@   | TNonEnemy ActorId           -- ^ target a friend or neutral   | TPoint TGoal LevelId Point  -- ^ target a concrete spot   | TVector Vector              -- ^ target position relative to actor-  deriving (Show, Eq, Ord, Generic)+  deriving (Show, Eq, Generic)  instance Binary Target  -- | The goal of an actor. data TGoal =-    TEnemyPos ActorId  -- ^ last seen position of the targeted actor+    TStash FactionId  -- ^ shared inventory stash of our or an enemy faction+  | TEnemyPos ActorId  -- ^ last seen position of the targeted actor   | TEmbed ItemBag Point  -- ^ embedded item that can be triggered;                           -- in @TPoint (TEmbed bag p) _ q@ usually @bag@ is                           -- embbedded in @p@ and @q@ is an adjacent open tile@@ -112,7 +118,8 @@             --   to be walkable or altered or searched)   | TUnknown  -- ^ an unknown tile to be explored   | TKnown  -- ^ a known tile to be patrolled-  deriving (Show, Eq, Ord, Generic)+  | THideout  -- ^ a hideout to either flee to or find a hidden enemy sniper in+  deriving (Show, Eq, Generic)  instance Binary TGoal @@ -129,16 +136,17 @@     , sdiscoBenefit = EM.empty     , sfper = EM.empty     , salter = EM.empty-    , srandom = R.mkStdGen 42  -- will get modified in this and future games+    , srandom = SM.mkSMGen 42  -- will get modified in this and future games     , _sleader = Nothing  -- no heroes yet alive     , _sside     , squit = False     , scurChal = defaultChallenge     , snxtChal = defaultChallenge-    , snxtScenario = 0     , smarkSuspect = 1     , scondInMelee = EM.empty     , svictories = EM.empty+    , scampings = ES.empty+    , srestarts = ES.empty     , soptions = defClientOptions     , stabs = (undefined, undefined)     }@@ -188,10 +196,12 @@     put _sside     put scurChal     put snxtChal-    put snxtScenario     put smarkSuspect     put scondInMelee     put svictories+    put scampings+    put srestarts+    put soptions #ifdef WITH_EXPENSIVE_ASSERTIONS     put sfper #endif@@ -206,16 +216,17 @@     _sside <- get     scurChal <- get     snxtChal <- get-    snxtScenario <- get     smarkSuspect <- get     scondInMelee <- get     svictories <- get+    scampings <- get+    srestarts <- get+    soptions <- get     let sbfsD = EM.empty         sundo = ()         salter = EM.empty         srandom = read g         squit = False-        soptions = defClientOptions         stabs = (undefined, undefined) #ifndef WITH_EXPENSIVE_ASSERTIONS         sfper = EM.empty

engine-src/Game/LambdaHack/Client/UI.hs view

@@ -12,7 +12,7 @@   , CCUI(..)   , UIOptions, applyUIOptions, uCmdline, mkUIOptions     -- * Operations exposed for "Game.LambdaHack.Client.LoopM"-  , ChanFrontend, chanFrontend, promptAdd, tryRestore+  , ChanFrontend, chanFrontend, tryRestore, clientPrintUI #ifdef EXPOSE_INTERNAL     -- * Internal operations   , humanCommand@@ -28,13 +28,13 @@ import qualified Data.Map.Strict as M import qualified Data.Text as T -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.Request import           Game.LambdaHack.Client.State import           Game.LambdaHack.Client.UI.Content.Input import           Game.LambdaHack.Client.UI.ContentClientUI import           Game.LambdaHack.Client.UI.DisplayAtomicM+import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.FrameM import           Game.LambdaHack.Client.UI.Frontend import           Game.LambdaHack.Client.UI.HandleHelperM@@ -43,7 +43,6 @@ import           Game.LambdaHack.Client.UI.MonadClientUI import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.MsgM-import           Game.LambdaHack.Client.UI.Overlay import           Game.LambdaHack.Client.UI.SessionUI import           Game.LambdaHack.Client.UI.Slideshow import           Game.LambdaHack.Client.UI.SlideshowM@@ -51,6 +50,7 @@ import           Game.LambdaHack.Client.UI.UIOptionsParse import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.MonadStateRead import           Game.LambdaHack.Common.State@@ -68,7 +68,7 @@     if keyPressed && fleaderMode (gplayer fact) /= LeaderNull then do       -- Menu is entered in @displayRespUpdAtomicUI@ at @UpdAutoFaction@.       discardPressedKey-      -- Regaining control of faction cancels --stopAfter*.+      -- Regaining control of faction cancels some --stopAfter*.       modifyClient $ \cli ->         cli {soptions = (soptions cli) { sstopAfterSeconds = Nothing                                        , sstopAfterFrames = Nothing }}@@ -117,57 +117,59 @@ -- | Let the human player issue commands until any command takes time. humanCommand :: forall m. (MonadClient m, MonadClientUI m) => m ReqUI humanCommand = do-  modifySession $ \sess -> sess { slastLost = ES.empty-                                , shintMode = HintAbsent }+  FontSetup{propFont} <- getFontSetup+  modifySession $ \sess -> sess {slastLost = ES.empty}   let loop :: Maybe ActorId -> m ReqUI       loop mOldLeader = do+        keyPressed <- anyKeyPressed+        macroFrame <- getsSession smacroFrame+        -- This message, in particular, disturbs.+        when (keyPressed && not (null (unKeyMacro (keyPending macroFrame)))) $+          msgAdd MsgActionWarning "*interrupted*"         report <- getsSession $ newReport . shistory-        hintMode <- getsSession shintMode-        -- Hints are not considered non-empty reports.-        modifySession $ \sess -> sess-          {sreportNull = nullReport report || hintMode == HintShown}-        case hintMode of-          HintAbsent -> return ()-          HintShown -> modifySession $ \sess -> sess {shintMode = HintWiped}-          HintWiped -> modifySession $ \sess -> sess {shintMode = HintAbsent}-        slidesRaw <- reportToSlideshowKeep []-        over <- case unsnoc slidesRaw of+        modifySession $ \sess -> sess {sreportNull = nullVisibleReport report}+        slides <- reportToSlideshowKeepHalt False []+        over <- case unsnoc slides of           Nothing -> return []           Just (allButLast, (ov, _)) ->             if allButLast == emptySlideshow-            then+            then do               -- Display the only generated slide while waiting for next key.-              -- Strip the "--end-" prompt from it.-              return $! init ov+              -- Strip the "--end-" prompt from it, by ignoring @MonoFont@.+              let ovProp = ov EM.! propFont+              return $! if EM.size ov > 1 then ovProp else init ovProp             else do               -- Show, one by one, all slides, awaiting confirmation for each.-              void $ getConfirms ColorFull [K.spaceKM, K.escKM] slidesRaw+              void $ getConfirms ColorFull [K.spaceKM, K.escKM] slides               -- Indicate that report wiped out.               modifySession $ \sess -> sess {sreportNull = True}               -- Display base frame at the end.               return []-        LastRecord seqCurrent seqPrevious k <- getsSession slastRecord-        let slastRecord-              | k == 0 = LastRecord [] seqCurrent 0-              | otherwise = LastRecord [] (seqCurrent ++ seqPrevious) (k - 1)-        modifySession $ \sess -> sess {slastRecord}         leader <- getLeaderUI         b <- getsState $ getActorBody leader         when (bhp b <= 0 && Just leader /= mOldLeader) $ displayMore ColorBW           "If you move, the exertion will kill you. Consider asking for first aid instead."-        km <- promptGetKey ColorFull over False []+        let ovs = EM.fromList [(propFont, over)]+        km <- promptGetKey ColorFull ovs False []         abortOrCmd <- do           -- Look up the key.           CCUI{coinput=InputContent{bcmdMap}} <- getsSession sccui           case km `M.lookup` bcmdMap of             Just (_, _, cmd) -> do-              modifySession $ \sess -> sess-                {swaitTimes = if swaitTimes sess > 0-                              then - swaitTimes sess-                              else 0}-              cmdHumanSem cmd-            _ -> let msgKey = "unknown command <" <> K.showKM km <> ">"+              modifySession $ \sess -> sess {swaitTimes = if swaitTimes sess > 0+                                                          then - swaitTimes sess+                                                          else 0}+              restrictedCmdSemInCxtOfKM km cmd+            _ -> let msgKey = "unknown command '" <> K.showKM km <> "'"                  in weaveJust <$> failWith (T.pack msgKey)+        -- GC macro stack if there are no actions left to handle,+        -- removing all unnecessary macro frames at once,+        -- but leaving the last one for user's in-game macros.+        modifySession $ \sess ->+          let (smacroFrameNew, smacroStackMew) =+                dropEmptyMacroFrames (smacroFrame sess) (smacroStack sess)+          in sess { smacroFrame = smacroFrameNew+                  , smacroStack = smacroStackMew }         -- The command was failed or successful and if the latter,         -- possibly took some time.         case abortOrCmd of@@ -177,10 +179,6 @@             return cmdS           Left Nothing -> loop $ Just leader           Left (Just err) -> do-            -- Avoid "*never mind*<x4>".-            let l0 = ["*never mind*", "*aiming started*"]-                t = showFailError err-            if t `elem` l0 then msgAdd0 MsgAlert t-                           else msgAdd MsgAlert t+            msgAdd MsgActionAlert $ showFailError err             loop $ Just leader   loop Nothing

engine-src/Game/LambdaHack/Client/UI/ActorUI.hs view

@@ -2,8 +2,7 @@ -- | UI aspects of actors. module Game.LambdaHack.Client.UI.ActorUI   ( ActorUI(..), ActorDictUI-  , keySelected, partActor, partPronoun-  , ppCStoreWownW, ppContainerWownW, tryFindActor, tryFindHeroK+  , keySelected, partActor, partPronoun, tryFindActor, tryFindHeroK   ) where  import Prelude ()@@ -20,7 +19,6 @@ import           Game.LambdaHack.Common.State import           Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Definition.Defs  data ActorUI = ActorUI   { bsymbol  :: Char         -- ^ individual map symbol@@ -46,23 +44,6 @@ -- | The part of speech containing the actor's pronoun. partPronoun :: ActorUI -> MU.Part partPronoun b = MU.Text $ bpronoun b--ppCStoreWownW :: Bool -> CStore -> MU.Part -> [MU.Part]-ppCStoreWownW addPrepositions store owner =-  let (preposition, noun) = ppCStore store-      prep = [MU.Text preposition | addPrepositions]-  in prep ++ case store of-    CGround -> [MU.Text noun, "under", owner]-    CSha -> [MU.Text noun]-    _ -> [MU.WownW owner (MU.Text noun) ]--ppContainerWownW :: (ActorId -> MU.Part) -> Bool -> Container -> [MU.Part]-ppContainerWownW ownerFun addPrepositions c = case c of-  CFloor{} -> ["nearby"]-  CEmbed{} -> ["embedded nearby"]-  CActor aid store -> let owner = ownerFun aid-                      in ppCStoreWownW addPrepositions store owner-  CTrunk{} -> error $ "" `showFailure` c  tryFindActor :: State -> (ActorId -> Actor -> Bool) -> Maybe (ActorId, Actor) tryFindActor s p = find (uncurry p) $ EM.assocs $ sactorD s

engine-src/Game/LambdaHack/Client/UI/Animation.hs view

@@ -2,8 +2,8 @@ -- | Screen frames and animations. module Game.LambdaHack.Client.UI.Animation   ( Animation, renderAnim-  , pushAndDelay, twirlSplash, blockHit, blockMiss, subtleHit-  , deathBody, shortDeathBody, actorX, teleport, swapPlaces, fadeout+  , pushAndDelay, twirlSplash, twirlSplashShort, blockHit, blockMiss, subtleHit+  , deathBody, shortDeathBody, actorX, teleport, vanish, swapPlaces, fadeout #ifdef EXPOSE_INTERNAL     -- * Internal operations   , blank, cSym, mapPosToOffset, mzipSingleton, mzipPairs@@ -14,29 +14,32 @@  import Game.LambdaHack.Core.Prelude -import           Data.Bits+import           Data.Bits (xor) import qualified Data.EnumMap.Strict as EM+import           Data.Word (Word32)  import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Overlay-import Game.LambdaHack.Definition.Color+import Game.LambdaHack.Client.UI.PointUI import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random+import Game.LambdaHack.Definition.Color  -- | Animation is a list of frame modifications to play one by one, -- where each modification if a map from positions to level map symbols.-newtype Animation = Animation [IntOverlay]+newtype Animation = Animation [OverlaySpace]   deriving (Eq, Show)  -- | Render animations on top of a screen frame. -- -- Located in this module to keep @Animation@ abstract.-renderAnim :: PreFrame -> Animation -> PreFrames-renderAnim basicFrame (Animation anim) =-  let modifyFrame :: IntOverlay -> PreFrame-      modifyFrame am = overlayFrame am basicFrame-      modifyFrames :: (IntOverlay, IntOverlay) -> Maybe PreFrame+renderAnim :: Int -> PreFrame -> Animation -> PreFrames+renderAnim width basicFrame (Animation anim) =+  let modifyFrame :: OverlaySpace -> PreFrame+      -- Overlay not truncated, because guaranteed within bounds.+      modifyFrame am = overlayFrame width am basicFrame+      modifyFrames :: (OverlaySpace, OverlaySpace) -> Maybe PreFrame       modifyFrames (am, amPrevious) =         if am == amPrevious then Nothing else Just $ modifyFrame am   in Just basicFrame : map modifyFrames (zip anim ([] : anim))@@ -47,36 +50,39 @@ cSym :: Color -> Char -> Maybe AttrCharW32 cSym color symbol = Just $ attrChar2ToW32 color symbol -mapPosToOffset :: ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32])-mapPosToOffset ScreenContent{rwidth} (Point{..}, attr) =-  ((py + 1) * rwidth + px, [attr])+mapPosToOffset :: (Point, AttrCharW32) -> (PointUI, AttrString)+mapPosToOffset (p, attr) =+  let pUI = squareToUI $ mapToSquare p+  in (pUI, [attr]) -mzipSingleton :: ScreenContent -> Point -> Maybe AttrCharW32 -> IntOverlay-mzipSingleton coscreen p1 mattr1 = map (mapPosToOffset coscreen) $-  let mzip (pos, mattr) = fmap (pos,) mattr-  in catMaybes [mzip (p1, mattr1)]+mzipSingleton :: Point -> Maybe AttrCharW32 -> OverlaySpace+mzipSingleton p1 mattr1 =+  map mapPosToOffset $+    let mzip (pos, mattr) = fmap (pos,) mattr+    in catMaybes [mzip (p1, mattr1)] -mzipPairs :: ScreenContent -> (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32)-          -> IntOverlay-mzipPairs coscreen (p1, p2) (mattr1, mattr2) = map (mapPosToOffset coscreen) $-  let mzip (pos, mattr) = fmap (pos,) mattr-  in catMaybes $ if p1 /= p2-                 then [mzip (p1, mattr1), mzip (p2, mattr2)]-                 else -- If actor affects himself, show only the effect,-                      -- not the action.-                      [mzip (p1, mattr1)]+mzipPairs :: (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32)+          -> OverlaySpace+mzipPairs (p1, p2) (mattr1, mattr2) =+  map mapPosToOffset $+    let mzip (pos, mattr) = fmap (pos,) mattr+    in catMaybes $ if p1 /= p2+                   then [mzip (p1, mattr1), mzip (p2, mattr2)]+                   else -- If actor affects himself, show only the effect,+                        -- not the action.+                        [mzip (p1, mattr1)]  pushAndDelay :: Animation pushAndDelay = Animation [[]]  -- | Attack animation. A part of it also reused for self-damage and healing.-twirlSplash :: ScreenContent -> (Point, Point) -> Color -> Color -> Animation-twirlSplash coscreen poss c1 c2 = Animation $ map (mzipPairs coscreen poss)-  [ (blank           , cSym BrCyan '\'')-  , (blank           , cSym BrYellow '\'')-  , (blank           , cSym BrYellow '^')-  , (cSym c1      '\\',cSym BrCyan '^')-  , (cSym c1      '|', cSym BrCyan '^')+twirlSplash :: (Point, Point) -> Color -> Color -> Animation+twirlSplash poss c1 c2 = Animation $ map (mzipPairs poss)+  [ (blank           , cSym BrCyan '&')+  , (blank           , cSym BrCyan '&')+  , (blank           , blank)+  , (cSym c1      '\\',blank)+  , (cSym c1      '|', cSym BrCyan '&')   , (cSym c1      '%', blank)   , (cSym c1      '/', blank)   , (cSym c1      '-', blank)@@ -85,16 +91,25 @@   , (cSym c2      '%', blank)   ] +-- | Short attack animation.+twirlSplashShort :: (Point, Point) -> Color -> Color -> Animation+twirlSplashShort poss c1 c2 = Animation $ map (mzipPairs poss)+  [ (blank           , cSym BrCyan '&')+  , (blank           , cSym BrCyan '&')+  , (cSym c1      '\\',blank)+  , (cSym c1      '|', cSym BrCyan '&')+  , (cSym c2      '%', blank)+  ]+ -- | Attack that hits through a block.-blockHit :: ScreenContent -> (Point, Point) -> Color -> Color -> Animation-blockHit coscreen poss c1 c2 = Animation $ map (mzipPairs coscreen poss)-  [ (blank           , cSym BrCyan '\'')-  , (blank           , cSym BrYellow '\'')-  , (blank           , cSym BrYellow '^')-  , (blank           , cSym BrCyan '^')-  , (cSym BrBlue  '{', cSym BrCyan '\'')-  , (cSym BrBlue  '{', cSym BrYellow '\'')-  , (cSym BrBlue  '{', cSym BrYellow '\'')+blockHit :: (Point, Point) -> Color -> Color -> Animation+blockHit poss c1 c2 = Animation $ map (mzipPairs poss)+  [ (blank           , cSym BrCyan '&')+  , (blank           , cSym BrCyan '&')+  , (blank           , blank)+  , (cSym BrBlue  '{', blank)+  , (cSym BrBlue  '{', cSym BrCyan '&')+  , (cSym BrBlue  '{', blank)   , (cSym BrBlue  '}', blank)   , (cSym BrBlue  '}', blank)   , (cSym BrBlue  '}', blank)@@ -108,32 +123,36 @@   ]  -- | Attack that is blocked.-blockMiss :: ScreenContent -> (Point, Point) -> Animation-blockMiss coscreen poss = Animation $ map (mzipPairs coscreen poss)-  [ (blank           , cSym BrCyan '\'')-  , (blank           , cSym BrYellow '^')-  , (cSym BrBlue  '{', cSym BrYellow '\'')-  , (cSym BrBlue  '{', cSym BrCyan '\'')+blockMiss :: (Point, Point) -> Animation+blockMiss poss = Animation $ map (mzipPairs poss)+  [ (blank           , cSym BrCyan '&')+  , (blank           , cSym BrCyan '&')+  , (blank           , blank)   , (cSym BrBlue  '{', blank)-  , (cSym BrBlue  '}', blank)+  , (cSym BrBlue  '{', cSym BrCyan '&')+  , (cSym BrBlue  '{', blank)+  , (cSym BrBlue  '{', blank)   , (cSym BrBlue  '}', blank)   , (cSym Blue    '}', blank)   , (cSym Blue    '}', blank)+  , (cSym Blue    '}', blank)   ]  -- | Attack that is subtle (e.g., damage dice 0).-subtleHit :: ScreenContent -> Point -> Animation-subtleHit coscreen pos = Animation $ map (mzipSingleton coscreen pos)-  [ cSym BrCyan '\''-  , cSym BrYellow '\''-  , cSym BrYellow '^'-  , cSym BrCyan '^'-  , cSym BrCyan '\''+subtleHit :: (Point, Point) -> Animation+subtleHit poss = Animation $ map (mzipPairs poss)+  [ (blank           , cSym BrCyan '&')+  , (blank           , blank)+  , (blank           , cSym BrYellow '&')+  , (cSym BrBlue  '\\',blank)+  , (blank           , cSym BrYellow '&')+  , (cSym BrBlue  '/', blank)+  , (blank           , blank)   ]  -- | Death animation for an organic body.-deathBody :: ScreenContent -> Point -> Animation-deathBody coscreen pos = Animation $ map (mzipSingleton coscreen pos)+deathBody :: Point -> Animation+deathBody pos = Animation $ map (mzipSingleton pos)   [ cSym Red '%'   , cSym Red '-'   , cSym Red '-'@@ -150,8 +169,8 @@   ]  -- | Death animation for an organic body, short version (e.g., for enemies).-shortDeathBody :: ScreenContent -> Point -> Animation-shortDeathBody coscreen pos = Animation $ map (mzipSingleton coscreen pos)+shortDeathBody :: Point -> Animation+shortDeathBody pos = Animation $ map (mzipSingleton pos)   [ cSym Red '%'   , cSym Red '-'   , cSym Red '\\'@@ -164,17 +183,17 @@   ]  -- | Mark actor location animation.-actorX :: ScreenContent -> Point -> Animation-actorX coscreen pos = Animation $ map (mzipSingleton coscreen pos)-  [ cSym BrRed 'X'-  , cSym BrRed 'X'+actorX :: Point -> Animation+actorX pos = Animation $ map (mzipSingleton pos)+  [ cSym BrMagenta 'X'+  , cSym BrMagenta 'X'   , blank   , blank   ]  -- | Actor teleport animation.-teleport :: ScreenContent -> (Point, Point) -> Animation-teleport coscreen poss = Animation $ map (mzipPairs coscreen poss)+teleport :: (Point, Point) -> Animation+teleport poss = Animation $ map (mzipPairs poss)   [ (cSym BrMagenta 'o', cSym Magenta   '.')   , (cSym BrMagenta 'O', cSym Magenta   '.')   , (cSym Magenta   'o', cSym Magenta   'o')@@ -184,9 +203,20 @@   , (blank             , blank)   ] +-- | Terrain feature vanishing animation.+vanish :: Point -> Animation+vanish pos = Animation $ map (mzipSingleton pos)+  [ cSym BrMagenta 'o'+  , cSym BrMagenta 'O'+  , cSym Magenta   'o'+  , cSym Magenta   '.'+  , cSym Magenta   '.'+  , blank+  ]+ -- | Swap-places animation, both hostile and friendly.-swapPlaces :: ScreenContent -> (Point, Point) -> Animation-swapPlaces coscreen poss = Animation $ map (mzipPairs coscreen poss)+swapPlaces :: (Point, Point) -> Animation+swapPlaces poss = Animation $ map (mzipPairs poss)   [ (cSym BrMagenta 'o', cSym Magenta   'o')   , (cSym BrMagenta 'd', cSym Magenta   'p')   , (cSym BrMagenta '.', cSym Magenta   'p')@@ -203,6 +233,7 @@       ybound = rheight - 1       margin = (rwidth - 2 * rheight) `div` 2 - 2       edge = EM.fromDistinctAscList $ zip [1..] ".%&%;:,."+      fadeChar :: Int -> Int -> Int -> Int -> Char       fadeChar !r !n !x !y =         let d = x - 2 * y             ndy = n - d - 2 * ybound@@ -218,8 +249,11 @@               | otherwise = mnx         in EM.findWithDefault ' ' k edge       rollFrame !n = do-        r <- random-        let fadeAttr !y !x = attrChar1ToW32 $ fadeChar r n x y+        w <- randomWord32+        -- @fromIntegralWrap@ is potentially costly, but arch-independent.+        -- Also, it's fine if it wraps.+        let fadeAttr !y !x = attrChar1ToW32 $+              fadeChar ((fromIntegralWrap :: Word32 -> Int) w) n x y             fadeLine !y =               let x1 :: Int                   {-# INLINE x1 #-}@@ -227,8 +261,8 @@                   x2 :: Int                   {-# INLINE x2 #-}                   x2 = max 0 (xbound - (n - 2 * y))-              in [ (y * rwidth, map (fadeAttr y) [0..x1])-                 , (y * rwidth + x2, map (fadeAttr y) [x2..xbound]) ]+              in [ (PointUI 0 y, map (fadeAttr y) [0..x1])+                 , (PointUI (2 * x2) y, map (fadeAttr y) [x2..xbound]) ]         return $! concatMap fadeLine [0..ybound]       fs | out = [3, 3 + step .. rwidth - margin]          | otherwise = [rwidth - margin, rwidth - margin - step .. 1]

engine-src/Game/LambdaHack/Client/UI/Content/Input.hs view

@@ -3,11 +3,12 @@ module Game.LambdaHack.Client.UI.Content.Input   ( InputContentRaw(..), InputContent(..), makeData   , evalKeyDef-  , addCmdCategory, replaceDesc, moveItemTriple, repeatTriple-  , mouseLMB, mouseMMB, mouseRMB+  , addCmdCategory, replaceDesc, moveItemTriple, repeatTriple, repeatLastTriple+  , mouseLMB, mouseMMB, mouseMMBMute, mouseRMB   , goToCmd, runToAllCmd, autoexploreCmd, autoexplore25Cmd   , aimFlingCmd, projectI, projectA, flingTs, applyIK, applyI-  , grabItems, dropItems, descIs, descTs, defaultHeroSelect+  , grabItems, dropItems, descIs, defaultHeroSelect, macroRun25+  , memberCycle, memberCycleLevel #ifdef EXPOSE_INTERNAL     -- * Internal operations   , replaceCmd, projectICmd, grabCmd, dropCmd@@ -41,41 +42,47 @@  -- | Create binding of keys to movement and other standard commands, -- as well as commands defined in the config file.-makeData :: UIOptions        -- ^ UI client options+makeData :: Maybe UIOptions   -- ^ UI client options          -> InputContentRaw  -- ^ default key bindings from the content          -> InputContent     -- ^ concrete binding-makeData UIOptions{uCommands, uVi, uLaptop} (InputContentRaw copsClient) =-  let waitTriple = ([CmdMove], "", Wait)+makeData muiOptions (InputContentRaw copsClient) =+  let (uCommands0, uVi0, uLeftHand0) = case muiOptions of+        Just UIOptions{uCommands, uVi, uLeftHand} -> (uCommands, uVi, uLeftHand)+        Nothing -> ([], True, True)+      waitTriple = ([CmdMove], "", Wait)       wait10Triple = ([CmdMove], "", Wait10)       moveXhairOr n cmd v = ByAimMode $ AimModeCmd { exploration = cmd v                                                    , aiming = MoveXhair v n }-      bcmdList =-        (if | uVi -> filter (\(k, _) ->-              k `notElem` [K.mkKM "period", K.mkKM "C-period"])-            | uLaptop -> filter (\(k, _) ->-              k `notElem` [K.mkKM "i", K.mkKM "C-i", K.mkKM "I"])-            | otherwise -> id) copsClient-        ++ uCommands+      rawContent = copsClient ++ uCommands0+      movementDefinitions =+        K.moveBinding uVi0 uLeftHand0+          (\v -> ([CmdMove], "", moveXhairOr 1 MoveDir v))+          (\v -> ([CmdMove], "", moveXhairOr 10 RunDir v))         ++ [ (K.mkKM "KP_Begin", waitTriple)            , (K.mkKM "C-KP_Begin", wait10Triple)            , (K.mkKM "KP_5", wait10Triple)            , (K.mkKM "C-KP_5", wait10Triple) ]-        ++ (if | uVi ->-                 [ (K.mkKM "period", waitTriple)-                 , (K.mkKM "C-period", wait10Triple) ]  -- yell on % always-               | uLaptop ->-                 [ (K.mkKM "i", waitTriple)-                 , (K.mkKM "C-i", wait10Triple)-                 , (K.mkKM "I", wait10Triple) ]-               | otherwise ->-                 [])-        ++ K.moveBinding uVi uLaptop-             (\v -> ([CmdMove], "", moveXhairOr 1 MoveDir v))-             (\v -> ([CmdMove], "", moveXhairOr 10 RunDir v))-      rejectRepetitions t1 t2 = error $ "duplicate key"-                                        `showFailure` (t1, t2)+        ++ [(K.mkKM "period", waitTriple) | uVi0]+        ++ [(K.mkKM "C-period", wait10Triple) | uVi0]+        ++ [(K.mkKM "s", waitTriple) | uLeftHand0]+        ++ [(K.mkKM "S", wait10Triple) | uLeftHand0]+      -- This is the most common case of duplicate keys and it usually+      -- has an easy solution, so it's tested for first.+      !_A = flip assert () $+        let isNotMainMenu (_, (cats, _, _)) = all (`notElem` [CmdMainMenu]) cats+            rawContentNoMainMenu = filter isNotMainMenu rawContent+            movementKeys = map fst movementDefinitions+            filteredNoMainMenu = filter (\(k, _) -> k `notElem` movementKeys)+                                        rawContentNoMainMenu+        in rawContentNoMainMenu == filteredNoMainMenu+           `blame` "commands overwrite the enabled movement keys (you can disable some in config file and try again)"+           `swith` rawContentNoMainMenu \\ filteredNoMainMenu+      bcmdList = rawContent ++ movementDefinitions+      -- This catches repetitions (usually) not involving movement keys.+      rejectRepetitions k t1 t2 =+        error $ "duplicate key among command definitions (you can instead disable some movement key sets in config file and overwrite the freed keys)" `showFailure` (k, t1, t2)   in InputContent-  { bcmdMap = M.fromListWith rejectRepetitions+  { bcmdMap = M.fromListWithKey rejectRepetitions       [ (k, triple)       | (k, triple@(cats, _, _)) <- bcmdList       , all (`notElem` [CmdMainMenu]) cats@@ -84,7 +91,8 @@   , brevMap = M.fromListWith (flip (++)) $ concat       [ [(cmd, [k])]       | (k, (cats, _desc, cmd)) <- bcmdList-      , all (`notElem` [CmdMainMenu, CmdDebug, CmdNoHelp]) cats+      , not (null cats)+        && all (`notElem` [CmdMainMenu, CmdDebug]) cats       ]   } @@ -108,13 +116,24 @@ moveItemTriple stores1 store2 object auto =   let verb = MU.Text $ verbCStore store2       desc = makePhrase [verb, object]-  in ([CmdItemMenu], desc, MoveItem stores1 store2 Nothing auto)+  in ([CmdItemMenu, CmdItem], desc, MoveItem stores1 store2 Nothing auto) -repeatTriple :: Int -> CmdTriple-repeatTriple n = ( [CmdMeta]-                 , "voice recorded commands" <+> tshow n <+> "times"-                 , Repeat n )+repeatTriple :: Int -> [CmdCategory] -> CmdTriple+repeatTriple n cats =+  ( cats+  , if n == 1+    then "voice recorded macro again"+    else "voice recorded macro" <+> tshow n <+> "times"+  , Repeat n ) +repeatLastTriple :: Int -> [CmdCategory] -> CmdTriple+repeatLastTriple n cats =+  ( cats+  , if n == 1+    then "voice last action again"+    else "voice last action" <+> tshow n <+> "times in a row"+  , RepeatLast n )+ -- @AimFloor@ is not there, but @AimEnemy@ and @AimItem@ almost make up for it. mouseLMB :: HumanCmd -> Text -> CmdTriple mouseLMB goToOrRunTo desc =@@ -132,24 +151,27 @@         , (CaArenaName, Accept)         , (CaPercentSeen, XhairStair True) ] }   common =-    [ (CaMessage, ExecuteIfClear LastHistory)+    [ (CaMessage, LastHistory)     , (CaLevelNumber, AimAscend 1)     , (CaXhairDesc, AimEnemy)  -- inits aiming and then cycles enemies     , (CaSelected, PickLeaderWithPointer)---    , (CaCalmGauge, Macro ["KP_Begin", "C-V"])+--    , (CaCalmGauge, Macro ["KP_Begin", "C-v"])     , (CaCalmValue, Yell)-    , (CaHPGauge, Macro ["KP_Begin", "C-V"])+    , (CaHPGauge, Macro ["KP_Begin", "C-v"])     , (CaHPValue, Wait)     , (CaLeaderDesc, projectICmd flingTs) ]  mouseMMB :: CmdTriple mouseMMB = ( [CmdMouse]-           , "snap x-hair to floor under pointer"+           , "snap crosshair to floor under pointer/cycle detail level"            , XhairPointerFloor ) +mouseMMBMute :: CmdTriple+mouseMMBMute = ([CmdMouse], "", XhairPointerMute)+ mouseRMB :: CmdTriple mouseRMB = ( [CmdMouse]-           , "start aiming at enemy under pointer"+           , "start aiming at enemy under pointer/cycle detail level"            , ByAimMode aimMode )  where   aimMode = AimModeCmd@@ -157,7 +179,7 @@         [ (CaMapLeader, dropCmd)         , (CaMapParty, SelectWithPointer)         , (CaMap, AimPointerEnemy)-        , (CaArenaName, MainMenuAutoOff)+        , (CaArenaName, ExecuteIfClear MainMenuAutoOff)         , (CaPercentSeen, autoexplore25Cmd) ]     , aiming = ByArea $ common ++         [ (CaMap, XhairPointerEnemy)  -- hack; same effect, but matches LMB@@ -168,24 +190,26 @@     , (CaLevelNumber, AimAscend (-1))     , (CaXhairDesc, AimItem)     , (CaSelected, SelectWithPointer)---    , (CaCalmGauge, Macro ["C-KP_Begin", "V"])+--    , (CaCalmGauge, Macro ["C-KP_Begin", "A-v"])     , (CaCalmValue, Yell)-    , (CaHPGauge, Macro ["C-KP_Begin", "V"])+    , (CaHPGauge, Macro ["C-KP_Begin", "A-v"])     , (CaHPValue, Wait10)     , (CaLeaderDesc, ComposeUnlessError ClearTargetIfItemClear ItemClear) ]  -- This is duplicated wrt content, instead of included via @semicolon@,--- because the C- commands are less likely to be modified by the player.+-- because the C- commands are less likely to be modified by the player+-- and so more dependable than @semicolon@, @colon@, etc. goToCmd :: HumanCmd-goToCmd = Macro ["MiddleButtonRelease", "C-semicolon", "C-quotedbl", "C-V"]+goToCmd = Macro ["A-MiddleButtonRelease", "C-semicolon", "C-quotedbl", "C-v"]  -- This is duplicated wrt content, instead of included via @colon@,--- because the C- commands are less likely to be modified by the player.+-- because the C- commands are less likely to be modified by the player+-- and so more dependable than @semicolon@, @colon@, etc. runToAllCmd :: HumanCmd-runToAllCmd = Macro ["MiddleButtonRelease", "C-colon", "C-quotedbl", "C-V"]+runToAllCmd = Macro ["A-MiddleButtonRelease", "C-colon", "C-quotedbl", "C-v"]  autoexploreCmd :: HumanCmd-autoexploreCmd = Macro ["C-?", "C-quotedbl", "C-V"]+autoexploreCmd = Macro ["C-?", "C-quotedbl", "C-v"]  autoexplore25Cmd :: HumanCmd autoexplore25Cmd = Macro ["'", "C-?", "C-quotedbl", "'", "C-V"]@@ -197,7 +221,7 @@ projectICmd ts = ComposeUnlessError (ChooseItemProject ts) Project  projectI :: [TriggerItem] -> CmdTriple-projectI ts = ([], descIs ts, projectICmd ts)+projectI ts = ([CmdItem], descIs ts, projectICmd ts)  projectA :: [TriggerItem] -> CmdTriple projectA ts =@@ -208,39 +232,52 @@                 (projectI ts)  flingTs :: [TriggerItem]-flingTs = [TriggerItem { tiverb = "fling"-                       , tiobject = "projectile"+flingTs = [TriggerItem { tiverb = "start flinging"+                       , tiobject = "projectiles"                        , tisymbols = "" }]  applyIK :: [TriggerItem] -> CmdTriple applyIK ts =-  ([], descIs ts, ComposeUnlessError (ChooseItemApply ts) Apply)+  ([CmdItem], descIs ts, ComposeUnlessError (ChooseItemApply ts) Apply)  applyI :: [TriggerItem] -> CmdTriple applyI ts =   let apply = Compose2ndLocal Apply ItemClear-  in ([], descIs ts, ComposeUnlessError (ChooseItemApply ts) apply)+  in ([CmdItem], descIs ts, ComposeUnlessError (ChooseItemApply ts) apply)  grabCmd :: HumanCmd-grabCmd = MoveItem [CGround] CEqp (Just "grab") True-            -- @CEqp@ is the implicit default; refined in HandleHumanGlobalM+grabCmd = MoveItem [CGround] CStash (Just "grab") True+            -- @CStash@ is the implicit default; refined in HandleHumanGlobalM  grabItems :: Text -> CmdTriple-grabItems t = ([CmdItemMenu], t, grabCmd)+grabItems t = ([CmdItemMenu, CmdItem], t, grabCmd)  dropCmd :: HumanCmd-dropCmd = MoveItem [CEqp, CInv, CSha] CGround Nothing False+dropCmd = MoveItem [CStash, CEqp] CGround Nothing False  dropItems :: Text -> CmdTriple-dropItems t = ([CmdItemMenu], t, dropCmd)+dropItems t = ([CmdItemMenu, CmdItem], t, dropCmd)  descIs :: [TriggerItem] -> Text descIs [] = "trigger an item" descIs (t : _) = makePhrase [tiverb t, tiobject t] -descTs :: [TriggerTile] -> Text-descTs [] = "alter a tile"-descTs (t : _) = makePhrase [ttverb t, ttobject t]- defaultHeroSelect :: Int -> (String, CmdTriple) defaultHeroSelect k = ([Char.intToDigit k], ([CmdMeta], "", PickLeader k))++macroRun25 :: [String]+macroRun25 = ["C-comma", "C-v"]++memberCycle :: Direction -> [CmdCategory] -> CmdTriple+memberCycle d cats = ( cats+                     , "cycle"+                       <+> (if d == Backward then "backwards" else "")+                       <+> "among all party members"+                     , MemberCycle d )++memberCycleLevel :: Direction -> [CmdCategory] -> CmdTriple+memberCycleLevel d cats = ( cats+                          , "cycle"+                            <+> (if d == Backward then "backwards" else "")+                            <+> " among party members on the level"+                          , MemberCycleLevel d )

engine-src/Game/LambdaHack/Client/UI/Content/Screen.hs view

@@ -11,6 +11,7 @@  import Game.LambdaHack.Core.Prelude +import qualified Data.ByteString as BS import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T @@ -18,26 +19,35 @@  -- | Screen layout and features definition. data ScreenContent = ScreenContent-  { rwidth          :: X         -- ^ screen width-  , rheight         :: Y         -- ^ screen height-  , rmainMenuArt    :: Text      -- ^ the ASCII art for the main menu-  , rintroScreen    :: [String]  -- ^ the intro screen (first help screen) text-  , rmoveKeysScreen :: [String]  -- ^ the fixed move key help blurb-  , rapplyVerbMap   :: EM.EnumMap Char T.Text-                                 -- ^ verbs to use for apply actions+  { rwidth        :: X         -- ^ screen width+  , rheight       :: Y         -- ^ screen height+  , rwrap         :: X         -- ^ wrap messages after this number of columns+  , rwebAddress   :: String    -- ^ an extra blurb line for the main menu+  , rintroScreen  :: ([String], [[String]])+                               -- ^ the intro screen (first help screen) text+                               --   and the rest of the manual+  , rapplyVerbMap :: EM.EnumMap Char T.Text+                               -- ^ verbs to use for apply actions+  , rFontFiles    :: [(FilePath, BS.ByteString)]+                               -- ^ embedded game-supplied font files   }  -- | Catch invalid rule kind definitions. validateSingle :: ScreenContent -> [Text]-validateSingle ScreenContent{rmainMenuArt} =-  let ts = T.lines rmainMenuArt-      tsNot80 = filter ((/= 80) . T.length) ts-  in case tsNot80 of-     [] -> [ "rmainMenuArt doesn't have at least 24 lines, but "-             <> tshow (length ts)-           | length ts < 24]-     tNot80 : _ ->-       ["rmainMenuArt has a line with length other than 80:" <> tNot80]+validateSingle ScreenContent{rwebAddress, rintroScreen} =+  (let tsGt80 = filter ((> 80) . T.length) $ map T.pack [rwebAddress]+   in case tsGt80 of+      [] -> []+      tGt80 : _ -> ["rwebAddress's length is over 80:" <> tGt80])+  ++ (let tsGt41 = filter ((> 41) . T.length) $ map T.pack $ fst rintroScreen+      in case tsGt41 of+         [] -> []+         tGt41 : _ -> ["intro screen has a line with length over 41:" <> tGt41])+  ++ (let tsGt80 = filter ((> 80) . T.length) $ map T.pack $ intercalate [""]+                   $ snd rintroScreen+      in case tsGt80 of+         [] -> []+         tGt80 : _ -> ["manual has a line with length over 80:" <> tGt80])  makeData :: ScreenContent -> ScreenContent makeData sc =

engine-src/Game/LambdaHack/Client/UI/ContentClientUI.hs view

@@ -22,9 +22,10 @@   { coinput = InputContent M.empty [] M.empty   , coscreen = ScreenContent { rwidth = 0                              , rheight = 0-                             , rmainMenuArt = ""-                             , rintroScreen = []-                             , rmoveKeysScreen = []+                             , rwrap = 0+                             , rwebAddress = ""+                             , rintroScreen = ([], [])                              , rapplyVerbMap = EM.empty+                             , rFontFiles = []                              }   }

engine-src/Game/LambdaHack/Client/UI/DisplayAtomicM.hs view

@@ -4,1730 +4,2415 @@   ( displayRespUpdAtomicUI, displayRespSfxAtomicUI #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , updateItemSlot, markDisplayNeeded, lookAtMove-  , aidVerbMU, aidVerbMU0, aidVerbDuplicateMU-  , itemVerbMU, itemAidVerbMU-  , createActorUI, destroyActorUI, spotItem, moveActor, displaceActorUI-  , moveItemUI, quitFactionUI-  , displayGameOverLoot, displayGameOverAnalytics-  , discover, ppSfxMsg, strike-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Core.Prelude--import qualified Data.Char as Char-import qualified Data.EnumMap.Strict as EM-import qualified Data.EnumSet as ES-import           Data.Key (mapWithKeyM_)-import qualified Data.Ord as Ord-import qualified Data.Text as T-import           Data.Tuple-import           GHC.Exts (inline)-import qualified NLP.Miniutter.English as MU--import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client.ClientOptions-import           Game.LambdaHack.Client.MonadClient-import           Game.LambdaHack.Client.State-import           Game.LambdaHack.Client.UI.ActorUI-import           Game.LambdaHack.Client.UI.Animation-import           Game.LambdaHack.Client.UI.Content.Screen-import           Game.LambdaHack.Client.UI.ContentClientUI-import           Game.LambdaHack.Client.UI.DrawM-import           Game.LambdaHack.Client.UI.EffectDescription-import           Game.LambdaHack.Client.UI.FrameM-import           Game.LambdaHack.Client.UI.HandleHelperM-import           Game.LambdaHack.Client.UI.ItemDescription-import           Game.LambdaHack.Client.UI.ItemSlot-import qualified Game.LambdaHack.Client.UI.Key as K-import           Game.LambdaHack.Client.UI.MonadClientUI-import           Game.LambdaHack.Client.UI.Msg-import           Game.LambdaHack.Client.UI.MsgM-import           Game.LambdaHack.Client.UI.Overlay-import           Game.LambdaHack.Client.UI.SessionUI-import           Game.LambdaHack.Client.UI.SlideshowM-import           Game.LambdaHack.Client.UI.UIOptions-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Analytics-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.Types-import           Game.LambdaHack.Content.CaveKind (cdesc)-import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.ModeKind-import           Game.LambdaHack.Content.RuleKind-import qualified Game.LambdaHack.Content.TileKind as TK-import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Core.Frequency-import           Game.LambdaHack.Core.Random-import qualified Game.LambdaHack.Definition.Ability as Ability-import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Definition.Defs-import           Game.LambdaHack.Definition.Flavour---- * RespUpdAtomicUI---- | Visualize atomic updates sent to the client. This is done--- in the global state after the command is executed and after--- the client state is modified by the command.--- Don't modify client state (except a few fields), but only client--- session (e.g., by displaying messages). This is enforced by types.-displayRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m ()-{-# INLINE displayRespUpdAtomicUI #-}-displayRespUpdAtomicUI cmd = case cmd of-  -- Create/destroy actors and items.-  UpdCreateActor aid body _ -> createActorUI True aid body-  UpdDestroyActor aid body _ -> destroyActorUI True aid body-  UpdCreateItem iid _item kit c -> do-    recordItemLid iid c-    updateItemSlot c iid-    case c of-      CActor aid store -> do-        case store of-          COrgan -> do-            arItem <- getsState $ aspectRecordFromIid iid-            if IA.checkFlag Ability.Condition arItem then do-              bag <- getsState $ getContainerBag c-              let more = case EM.lookup iid bag of-                    Nothing -> False-                    Just kit2 -> fst kit2 /= fst kit-                  verb = MU.Text $-                    "become" <+> case fst kit of-                                   1 -> if more then "more" else ""-                                   k -> (if more then "additionally" else "")-                                        <+> tshow k <> "-fold"-              -- This describes all such items already among organs,-              -- which is useful, because it shows "charging".-              itemAidVerbMU MsgBecome aid verb iid (Left Nothing) COrgan-            else do-              ownerFun <- partActorLeaderFun-              let wown = ppContainerWownW ownerFun True c-              itemVerbMU MsgItemCreation iid kit-                         (MU.Text $ makePhrase $ "grow" : wown) c-          _ -> do-            ownerFun <- partActorLeaderFun-            let wown = ppContainerWownW ownerFun True c-            itemVerbMU MsgItemCreation iid kit-                       (MU.Text $ makePhrase $ "appear" : wown) c-      CEmbed lid _ -> markDisplayNeeded lid-      CFloor lid _ -> do-        itemVerbMU MsgItemCreation iid kit-                   (MU.Text $ "appear" <+> ppContainer c) c-        markDisplayNeeded lid-      CTrunk{} -> error $ "" `showFailure` c-  UpdDestroyItem iid _ kit c -> do-    itemVerbMU MsgItemDestruction iid kit "disappear" c-    lid <- getsState $ lidFromC c-    markDisplayNeeded lid-  UpdSpotActor aid body _ -> createActorUI False aid body-  UpdLoseActor aid body _ -> destroyActorUI False aid body-  UpdSpotItem verbose iid _ kit c -> spotItem verbose iid kit c-  {--  UpdLoseItem False _ _ _ _ -> return ()-  -- The message is rather cryptic, so let's disable it until it's decided-  -- if anemy inventories should be displayed, etc.-  UpdLoseItem True iid _ kit c@(CActor aid store) | store /= CSha -> do-    -- Actor putting an item into shared stash, most probably.-    side <- getsClient sside-    b <- getsState $ getActorBody aid-    subject <- partActorLeader aid b-    let ownW = ppCStoreWownW store subject-        verb = MU.Text $ makePhrase $ "be removed from" : ownW-    when (bfid b == side) $ itemVerbMU iid kit verb c-  -}-  UpdLoseItem{} -> return ()-  UpdSpotItemBag c bag _ ->-    mapWithKeyM_ (\iid kit -> spotItem True iid kit c) bag-  UpdLoseItemBag{} -> return ()-  -- Move actors and items.-  UpdMoveActor aid source target -> moveActor aid source target-  UpdWaitActor{} -> return ()-  UpdDisplaceActor source target -> displaceActorUI source target-  UpdMoveItem iid k aid c1 c2 -> moveItemUI iid k aid c1 c2-  -- Change actor attributes.-  UpdRefillHP _ 0 -> return ()-  UpdRefillHP aid hpDelta -> do-    CCUI{coscreen} <- getsSession sccui-    aidVerbMU MsgNumeric aid $ MU.Text-                             $ (if hpDelta > 0 then "heal" else "lose")-                               <+> tshow (abs hpDelta `divUp` oneM) <+> "HP"-    b <- getsState $ getActorBody aid-    arena <- getArenaUI-    side <- getsClient sside-    if | bproj b && (EM.null (beqp b) || isNothing (btrajectory b)) ->-           return ()  -- ignore caught proj or one hitting a wall-       | bhp b <= 0 && hpDelta < 0-         && (bfid b == side && not (bproj b) || arena == blid b) -> do-         let (firstFall, hurtExtra) = case (bfid b == side, bproj b) of-               (True, True) -> ("drop down", "tumble down")-               (True, False) -> ("fall down", "suffers woeful mutilation")-               (False, True) -> ("plummet", "crash")-               (False, False) -> ("collapse", "be reduced to a bloody pulp")-             verbDie = if alreadyDeadBefore then hurtExtra else firstFall-             alreadyDeadBefore = bhp b - hpDelta <= 0-         tfact <- getsState $ (EM.! bfid b) . sfactionD-         bUI <- getsSession $ getActorUI aid-         subjectRaw <- partActorLeader aid-         let subject = if alreadyDeadBefore || subjectRaw == "you"-                       then subjectRaw-                       else partActor bUI  -- avoid "fallen"-             msgDie = makeSentence [MU.SubjectVerbSg subject verbDie]-             targetIsFoe = isFoe (bfid b) tfact side-             targetIsFriend = isFriend (bfid b) tfact side-             msgClass | bproj b = MsgDeath-                      | targetIsFoe = MsgDeathGood-                      | targetIsFriend = MsgDeathBad-                      | otherwise = MsgDeath-         msgAdd msgClass msgDie-         -- We show death anims only if not dead already before this refill.-         let deathAct-               | alreadyDeadBefore =-                 twirlSplash coscreen (bpos b, bpos b) Color.Red Color.Red-               | bfid b == side = deathBody coscreen (bpos b)-               | otherwise = shortDeathBody coscreen (bpos b)-         unless (bproj b) $ animate (blid b) deathAct-       | otherwise -> do-         when (hpDelta >= bhp b && bhp b > 0) $-           aidVerbMU MsgWarning aid "return from the brink of death"-         mleader <- getsClient sleader-         when (Just aid == mleader) $ do-           actorMaxSk <- getsState $ getActorMaxSkills aid-           -- Regenerating actors never stop gaining HP, so we need to stop-           -- reporting it after they reach full HP for the first time.-           -- Also, no spam for non-leaders.-           when (bhp b >= xM (Ability.getSk Ability.SkMaxHP actorMaxSk)-                 && bhp b - hpDelta < xM (Ability.getSk Ability.SkMaxHP-                                                  actorMaxSk)) $-             msgAdd MsgVeryRare "You recover your health fully."-         when (bfid b == side && not (bproj b)) $ do-           markDisplayNeeded (blid b)-           when (hpDelta < 0) $ do-             sUIOptions <- getsSession sUIOptions-             currentWarning <--               getsState $ checkWarningHP sUIOptions aid (bhp b)-             when currentWarning $ do-               previousWarning <--                 getsState $ checkWarningHP sUIOptions aid (bhp b - hpDelta)-               unless previousWarning $-                 aidVerbMU0 MsgDeathThreat aid-                            "be down to a dangerous health level"-  UpdRefillCalm _ 0 -> return ()-  UpdRefillCalm aid calmDelta -> do-    side <- getsClient sside-    b <- getsState $ getActorBody aid-    when (bfid b == side && not (bproj b)) $ do-      if | calmDelta > 0 ->  -- regeneration or effect-           markDisplayNeeded (blid b)-         | calmDelta == minusM1 -> do-           fact <- getsState $ (EM.! side) . sfactionD-           s <- getState-           let closeFoe (!p, aid2) =  -- mimics isHeardFoe-                 let b2 = getActorBody aid2 s-                 in inline chessDist p (bpos b) <= 3-                    && not (actorWaitsOrSleeps b2)  -- uncommon-                    && inline isFoe side fact (bfid b2)  -- costly-               anyCloseFoes = any closeFoe $ EM.assocs $ lbig-                                           $ sdungeon s EM.! blid b-           unless anyCloseFoes $ do  -- obvious where the feeling comes from-             duplicated <- aidVerbDuplicateMU MsgHeardClose aid "hear something"-             unless duplicated stopPlayBack-         | otherwise ->  -- low deltas from hits; displayed elsewhere-           return ()-      when (calmDelta < 0) $ do-        sUIOptions <- getsSession sUIOptions-        currentWarning <--          getsState $ checkWarningCalm sUIOptions aid (bcalm b)-        when currentWarning $ do-          previousWarning <--            getsState $ checkWarningCalm sUIOptions aid (bcalm b - calmDelta)-          unless previousWarning $-            -- This messages is not shown if impression happens after-            -- Calm is low enough. However, this is rare and HUD shows the red.-            aidVerbMU0 MsgDeathThreat aid-                       "have grown agitated and impressed enough to be in danger of defecting"-  UpdTrajectory _ _ mt ->  -- if projectile dies just after, force one frame-    when (maybe True (null . fst) mt) pushFrame-  -- Change faction attributes.-  UpdQuitFaction fid _ toSt manalytics -> quitFactionUI fid toSt manalytics-  UpdLeadFaction fid (Just source) (Just target) -> do-    fact <- getsState $ (EM.! fid) . sfactionD-    lidV <- viewedLevelUI-    when (isAIFact fact) $ markDisplayNeeded lidV-    -- This faction can't run with multiple actors, so this is not-    -- a leader change while running, but rather server changing-    -- their leader, which the player should be alerted to.-    when (noRunWithMulti fact) stopPlayBack-    actorD <- getsState sactorD-    case EM.lookup source actorD of-      Just sb | bhp sb <= 0 -> assert (not $ bproj sb) $ do-        -- Regardless who the leader is, give proper names here, not 'you'.-        sbUI <- getsSession $ getActorUI source-        tbUI <- getsSession $ getActorUI target-        let subject = partActor tbUI-            object  = partActor sbUI-        msgAdd MsgLeader $-          makeSentence [ MU.SubjectVerbSg subject "take command"-                       , "from", object ]-      _ -> return ()-    lookAtMove target-  UpdLeadFaction _ Nothing (Just target) -> lookAtMove target-  UpdLeadFaction{} -> return ()-  UpdDiplFaction fid1 fid2 _ toDipl -> do-    name1 <- getsState $ gname . (EM.! fid1) . sfactionD-    name2 <- getsState $ gname . (EM.! fid2) . sfactionD-    let showDipl Unknown = "unknown to each other"-        showDipl Neutral = "in neutral diplomatic relations"-        showDipl Alliance = "allied"-        showDipl War = "at war"-    msgAdd MsgDiplomacy $-      name1 <+> "and" <+> name2 <+> "are now" <+> showDipl toDipl <> "."-  UpdTacticFaction{} -> return ()-  UpdAutoFaction fid b -> do-    side <- getsClient sside-    lidV <- viewedLevelUI-    markDisplayNeeded lidV-    when (fid == side) $ do-      unless b $ addPressedControlEsc  -- sets @swasAutomated@, enters main menu-      setFrontAutoYes b  -- now can stop auto-accepting prompts-  UpdRecordKill{} -> return ()-  -- Alter map.-  UpdAlterTile lid p fromTile toTile -> do-    markDisplayNeeded lid-    COps{cotile} <- getsState scops-    let feats = TK.tfeature $ okind cotile fromTile-        toAlter feat =-          case feat of-            TK.OpenTo tgroup -> Just tgroup-            TK.CloseTo tgroup -> Just tgroup-            TK.ChangeTo tgroup -> Just tgroup-            _ -> Nothing-        groupsToAlterTo = mapMaybe toAlter feats-        freq = map fst $ filter (\(_, q) -> q > 0)-               $ TK.tfreq $ okind cotile toTile-    when (null $ intersect freq groupsToAlterTo) $ do-      -- Player notices @fromTile can't be altered into @toTIle@,-      -- which is uncanny, so we produce a message.-      -- This happens when the player missed an earlier search of the tile-      -- performed by another faction.-      let subject = ""  -- a hack, because we don't handle adverbs well-          verb = "turn into"-          msg = makeSentence-            [ "the", MU.Text $ TK.tname $ okind cotile fromTile-            , "at position", MU.Text $ tshow p-            , "suddenly"  -- adverb-            , MU.SubjectVerbSg subject verb-            , MU.AW $ MU.Text $ TK.tname $ okind cotile toTile ]-      msgAdd MsgTileDisco msg-  UpdAlterExplorable lid _ -> markDisplayNeeded lid-  UpdAlterGold{} -> return ()  -- not displayed on HUD-  UpdSearchTile aid _p toTile -> do-    COps{cotile} <- getsState scops-    subject <- partActorLeader aid-    let fromTile = fromMaybe (error $ show toTile) $ Tile.hideAs cotile toTile-        subject2 = MU.Text $ TK.tname $ okind cotile fromTile-        object = MU.Text $ TK.tname $ okind cotile toTile-    let msg = makeSentence [ MU.SubjectVerbSg subject "reveal"-                           , "that the"-                           , MU.SubjectVerbSg subject2 "be"-                           , MU.AW object ]-    unless (subject2 == object) $ msgAdd MsgTileDisco msg-  UpdHideTile{} -> return ()-  UpdSpotTile{} -> return ()-  UpdLoseTile{} -> return ()-  UpdSpotEntry{} -> return ()-  UpdLoseEntry{} -> return ()-  UpdAlterSmell{} -> return ()-  UpdSpotSmell{} -> return ()-  UpdLoseSmell{} -> return ()-  -- Assorted.-  UpdTimeItem{} -> return ()-  UpdAgeGame{} -> do-    sdisplayNeeded <- getsSession sdisplayNeeded-    time <- getsState stime-    let clipN = time `timeFit` timeClip-        clipMod = clipN `mod` clipsInTurn-        ping = clipMod == 0-    when (sdisplayNeeded || ping) pushFrame-  UpdUnAgeGame{} -> return ()-  UpdDiscover c iid _ _ -> discover c iid-  UpdCover{} -> return ()  -- don't spam when doing undo-  UpdDiscoverKind{} -> return ()  -- don't spam when server tweaks stuff-  UpdCoverKind{} -> return ()  -- don't spam when doing undo-  UpdDiscoverAspect{} -> return ()  -- don't spam when server tweaks stuff-  UpdCoverAspect{} -> return ()  -- don't spam when doing undo-  UpdDiscoverServer{} -> error "server command leaked to client"-  UpdCoverServer{} -> error "server command leaked to client"-  UpdPerception{} -> return ()-  UpdRestart fid _ _ _ _ _ -> do-    COps{cocave, corule} <- getsState scops-    sstart <- getsSession sstart-    when (sstart == 0) resetSessionStart-    history <- getsSession shistory-    if lengthHistory history == 0 then do-      let title = rtitle corule-      msgAdd MsgAdmin $ "Welcome to" <+> title <> "!"-      -- Generate initial history. Only for UI clients.-      shistory <- defaultHistory-      modifySession $ \sess -> sess {shistory}-    else-      recordHistory-    lid <- getArenaUI-    lvl <- getLevel lid-    mode <- getGameMode-    curChal <- getsClient scurChal-    fact <- getsState $ (EM.! fid) . sfactionD-    let loneMode = case ginitial fact of-          [] -> True-          [(_, 1, _)] -> True-          _ -> False-    msgAdd MsgWarning $ "New game started in" <+> mname mode <+> "mode."-    msgAdd MsgAdmin $ mdesc mode-    let desc = cdesc $ okind cocave $ lkind lvl-    unless (T.null desc) $ do-      msgAdd0 MsgFocus "You take in your surroundings."-      msgAdd0 MsgLandscape desc-    -- We can fool the player only once (per scenario), but let's not do it-    -- in the same way each time. TODO: PCG-    blurb <- rndToActionForget $ oneOf-      [ "You think you saw movement."-      , "Something catches your peripherial vision."-      , "You think you felt a tremor under your feet."-      , "A whiff of chilly air passes around you."-      , "You notice a draft just when it dies down."-      , "The ground nearby is stained along some faint lines."-      , "Scarce black motes slowly settle on the ground."-      , "The ground in the immediate area is empty, as if just swiped."-      ]-    msgAdd MsgWarning blurb-    when (cwolf curChal && not loneMode) $-      msgAdd MsgWarning "Being a lone wolf, you begin without companions."-    when (lengthHistory history > 1) $ fadeOutOrIn False-    setFrontAutoYes $ isAIFact fact-    when (isAIFact fact) $ do-      -- Prod the frontend to flush frames and start showing them continuously.-      slides <- reportToSlideshow []-      void $ getConfirms ColorFull [K.spaceKM, K.escKM] slides-    -- Forget the furious keypresses when dying in the previous game.-    resetPressedKeys-  UpdRestartServer{} -> return ()-  UpdResume fid _ -> do-    COps{cocave} <- getsState scops-    resetSessionStart-    fact <- getsState $ (EM.! fid) . sfactionD-    setFrontAutoYes $ isAIFact fact-    unless (isAIFact fact) $ do-      lid <- getArenaUI-      lvl <- getLevel lid-      mode <- getGameMode-      msgAdd MsgAlert $ "Continuing" <+> mname mode <> "."-      msgAdd MsgPrompt $ mdesc mode-      let desc = cdesc $ okind cocave $ lkind lvl-      unless (T.null desc) $ do-        msgAdd MsgPromptFocus "You remember your surroundings."-        msgAdd MsgPrompt desc-      displayMore ColorFull "Are you up for the challenge?"-      promptAdd0 "Prove yourself!"-  UpdResumeServer{} -> return ()-  UpdKillExit{} -> frontendShutdown-  UpdWriteSave -> msgAdd MsgSpam "Saving backup."-  UpdHearFid _ hearMsg -> do-    mleader <- getsClient sleader-    case mleader of-      Just{} -> return ()  -- will display stuff when leader moves-      Nothing -> do-        lidV <- viewedLevelUI-        markDisplayNeeded lidV-        recordHistory-    msg <- ppHearMsg hearMsg-    msgAdd MsgHeard msg--updateItemSlot :: MonadClientUI m => Container -> ItemId -> m ()-updateItemSlot c iid = do-  arItem <- getsState $ aspectRecordFromIid iid-  ItemSlots itemSlots <- getsSession sslots-  let slore = IA.loreFromContainer arItem c-      lSlots = itemSlots EM.! slore-  case lookup iid $ map swap $ EM.assocs lSlots of-    Nothing -> do-      let l = assignSlot lSlots-          f = EM.insert l iid-          newSlots = ItemSlots $ EM.adjust f slore itemSlots-      modifySession $ \sess -> sess {sslots = newSlots}-    Just _l -> return ()  -- slot already assigned--markDisplayNeeded :: MonadClientUI m => LevelId -> m ()-markDisplayNeeded lid = do-  lidV <- viewedLevelUI-  when (lidV == lid) $ modifySession $ \sess -> sess {sdisplayNeeded = True}--lookAtMove :: MonadClientUI m => ActorId -> m ()-lookAtMove aid = do-  mleader <- getsClient sleader-  body <- getsState $ getActorBody aid-  side <- getsClient sside-  aimMode <- getsSession saimMode-  when (not (bproj body)-        && bfid body == side-        && isNothing aimMode) $ do  -- aiming does a more extensive look-    itemsBlurb <- lookAtItems True (bpos body) aid-    let msgClass = if Just aid == mleader then MsgAtFeetMajor else MsgAtFeet-    msgAdd msgClass itemsBlurb-  fact <- getsState $ (EM.! bfid body) . sfactionD-  adjBigAssocs <- getsState $ adjacentBigAssocs body-  adjProjAssocs <- getsState $ adjacentProjAssocs body-  if not (bproj body) && bfid body == side then do-    let foe (_, b2) = isFoe (bfid body) fact (bfid b2)-        adjFoes = filter foe $ adjBigAssocs ++ adjProjAssocs-    unless (null adjFoes) stopPlayBack-  else when (isFoe (bfid body) fact side) $ do-    let our (_, b2) = bfid b2 == side-        adjOur = filter our adjBigAssocs-    unless (null adjOur) stopPlayBack--aidVerbMU :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m ()-aidVerbMU msgClass aid verb = do-  subject <- partActorLeader aid-  msgAdd msgClass $ makeSentence [MU.SubjectVerbSg subject verb]--aidVerbMU0 :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m ()-aidVerbMU0 msgClass aid verb = do-  subject <- partActorLeader aid-  msgAdd0 msgClass $ makeSentence [MU.SubjectVerbSg subject verb]--aidVerbDuplicateMU :: MonadClientUI m-                   => MsgClass -> ActorId -> MU.Part -> m Bool-aidVerbDuplicateMU msgClass aid verb = do-  subject <- partActorLeader aid-  msgAddDuplicate (makeSentence [MU.SubjectVerbSg subject verb]) msgClass 1--itemVerbMU :: MonadClientUI m-           => MsgClass -> ItemId -> ItemQuant -> MU.Part -> Container -> m ()-itemVerbMU msgClass iid kit@(k, _) verb c = assert (k > 0) $ do-  lid <- getsState $ lidFromC c-  localTime <- getsState $ getLocalTime lid-  itemFull <- getsState $ itemToFull iid-  side <- getsClient sside-  factionD <- getsState sfactionD-  let arItem = aspectRecordFull itemFull-      subject = partItemWs side factionD k localTime itemFull kit-      msg | k > 1 && not (IA.checkFlag Ability.Condition arItem) =-              makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes subject verb]-          | otherwise = makeSentence [MU.SubjectVerbSg subject verb]-  msgAdd msgClass msg---- We assume the item is inside the specified container.--- So, this function can't be used for, e.g., @UpdDestroyItem@.-itemAidVerbMU :: MonadClientUI m-              => MsgClass -> ActorId -> MU.Part-              -> ItemId -> Either (Maybe Int) Int -> CStore-              -> m ()-itemAidVerbMU msgClass aid verb iid ek cstore = do-  body <- getsState $ getActorBody aid-  bag <- getsState $ getBodyStoreBag body cstore-  side <- getsClient sside-  factionD <- getsState sfactionD-  -- The item may no longer be in @c@, but it was-  case iid `EM.lookup` bag of-    Nothing -> error $ "" `showFailure` (aid, verb, iid, cstore)-    Just kit@(k, _) -> do-      itemFull <- getsState $ itemToFull iid-      let lid = blid body-      localTime <- getsState $ getLocalTime lid-      subject <- partActorLeader aid-      let object = case ek of-            Left (Just n) ->-              assert (n <= k `blame` (aid, verb, iid, cstore))-              $ partItemWs side factionD n localTime itemFull kit-            Left Nothing ->-              let (name, powers) =-                    partItem side factionD localTime itemFull kit-              in MU.Phrase [name, powers]-            Right n ->-              assert (n <= k `blame` (aid, verb, iid, cstore))-              $ let (name1, powers) =-                      partItemShort side factionD localTime itemFull kit-                in MU.Phrase ["the", MU.Car1Ws n name1, powers]-          msg = makeSentence [MU.SubjectVerbSg subject verb, object]-      msgAdd msgClass msg--createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()-createActorUI born aid body = do-  CCUI{coscreen} <- getsSession sccui-  side <- getsClient sside-  when (bfid body == side && not (bproj body)) $ do-    let upd = ES.insert aid-    modifySession $ \sess -> sess {sselected = upd $ sselected sess}-  factionD <- getsState sfactionD-  let fact = factionD EM.! bfid body-  localTime <- getsState $ getLocalTime $ blid body-  itemFull@ItemFull{itemBase, itemKind} <- getsState $ itemToFull (btrunk body)-  actorUI <- getsSession sactorUI-  let arItem = aspectRecordFull itemFull-  unless (aid `EM.member` actorUI) $ do-    UIOptions{uHeroNames} <- getsSession sUIOptions-    let baseColor = flavourToColor $ jflavour itemBase-        basePronoun | not (bproj body)-                      && IK.isymbol itemKind == '@'-                      && fhasGender (gplayer fact) = "he"-                    | otherwise = "it"-        nameFromNumber fn k = if k == 0-                              then makePhrase [MU.Ws $ MU.Text fn, "Captain"]-                              else fn <+> tshow k-        heroNamePronoun k =-          if gcolor fact /= Color.BrWhite-          then (nameFromNumber (fname $ gplayer fact) k, "he")-          else fromMaybe (nameFromNumber (fname $ gplayer fact) k, "he")-               $ lookup k uHeroNames-    (n, bsymbol) <--      if | bproj body -> return (0, if IA.checkFlag Ability.Blast arItem-                                    then IK.isymbol itemKind-                                    else '*')-         | baseColor /= Color.BrWhite -> return (0, IK.isymbol itemKind)-         | otherwise -> do-           let hasNameK k bUI = bname bUI == fst (heroNamePronoun k)-                                && bcolor bUI == gcolor fact-               findHeroK k = isJust $ find (hasNameK k) (EM.elems actorUI)-               mhs = map findHeroK [0..]-               n = fromMaybe (error $ show mhs) $ elemIndex False mhs-           return (n, if 0 < n && n < 10 then Char.intToDigit n else '@')-    let (object1, object2) = partItemShortest (bfid body) factionD localTime-                                              itemFull (1, [])-        (bname, bpronoun) =-          if | bproj body ->-               let adj = case btrajectory body of-                     Just (tra, _) | length tra < 5 -> "falling"-                     _ -> "flying"-               in (makePhrase [adj, object1, object2], basePronoun)-             | baseColor /= Color.BrWhite ->-               let name = makePhrase [object1, object2]-               in ( if IA.checkFlag Ability.Unique arItem-                    then makePhrase [MU.Capitalize $ MU.Text $ "the" <+> name]-                    else name-                  , basePronoun )-             | otherwise -> heroNamePronoun n-        bcolor | bproj body = if IA.checkFlag Ability.Blast arItem-                              then baseColor-                              else Color.BrWhite-               | baseColor == Color.BrWhite = gcolor fact-               | otherwise = baseColor-        bUI = ActorUI{..}-    modifySession $ \sess ->-      sess {sactorUI = EM.insert aid bUI actorUI}-  let verb = MU.Text $-        if born-        then if bfid body == side then "join you" else "appear suddenly"-        else "be spotted"-  mapM_ (\(iid, store) -> do-           let c = if not (bproj body) && iid == btrunk body-                   then CTrunk (bfid body) (blid body) (bpos body)-                   else CActor aid store-           updateItemSlot c iid-           recordItemLid iid c)-        ((btrunk body, CEqp)  -- store will be overwritten, unless projectile-         : filter ((/= btrunk body) . fst) (getCarriedIidCStore body))-  -- Don't spam if the actor was already visible (but, e.g., on a tile that is-  -- invisible this turn (in that case move is broken down to lose+spot)-  -- or on a distant tile, via teleport while the observer teleported, too).-  lastLost <- getsSession slastLost-  if | EM.null actorUI && bfid body == side ->-       return ()  -- don't speak about yourself in 3rd person-     | born && bproj body -> pushFrame  -- make sure first position displayed-     | ES.member aid lastLost || bproj body -> markDisplayNeeded (blid body)-     | otherwise -> do-       aidVerbMU MsgActorSpot aid verb-       animate (blid body) $ actorX coscreen (bpos body)-  when (bfid body /= side) $ do-    when (not (bproj body) && isFoe (bfid body) fact side) $ do-      -- Aim even if nobody can shoot at the enemy. Let's home in on him-      -- and then we can aim or melee. We set permit to False, because it's-      -- technically very hard to check aimability here, because we are-      -- in-between turns and, e.g., leader's move has not yet been taken-      -- into account.-      modifySession $ \sess -> sess {sxhair = Just $ TEnemy aid}-      foes <- getsState $ foeRegularList side (blid body)-      unless (ES.member aid lastLost || length foes > 1) $-        msgAdd0 MsgFirstEnemySpot "You are not alone!"-    stopPlayBack--destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()-destroyActorUI destroy aid b = do-  trunk <- getsState $ getItemBody $ btrunk b-  let baseColor = flavourToColor $ jflavour trunk-  unless (baseColor == Color.BrWhite) $  -- keep setup for heroes, etc.-    modifySession $ \sess -> sess {sactorUI = EM.delete aid $ sactorUI sess}-  let affect tgt = case tgt of-        Just (TEnemy a) | a == aid -> Just $-          if destroy then-            -- If *really* nothing more interesting, the actor will-            -- go to last known location to perhaps find other foes.-            TPoint TKnown (blid b) (bpos b)-          else-            -- If enemy only hides (or we stepped behind obstacle) find him.-            TPoint (TEnemyPos a) (blid b) (bpos b)-        Just (TNonEnemy a) | a == aid -> Just $ TPoint TKnown (blid b) (bpos b)-        _ -> tgt-  modifySession $ \sess -> sess {sxhair = affect $ sxhair sess}-  unless (bproj b) $-    modifySession $ \sess -> sess {slastLost = ES.insert aid $ slastLost sess}-  side <- getsClient sside-  fact <- getsState $ (EM.! side) . sfactionD-  let gameOver = isJust $ gquit fact  -- we are the UI faction, so we determine-  unless gameOver $ do-    when (bfid b == side && not (bproj b)) $ do-      stopPlayBack-      let upd = ES.delete aid-      modifySession $ \sess -> sess {sselected = upd $ sselected sess}-      when destroy $ do-        displayMore ColorBW "Alas!"-        mleader <- getsClient sleader-        when (isJust mleader)-          -- This is especially handy when the dead actor was a leader-          -- on a different level than the new one:-          clearAimMode-    -- If pushed, animate spotting again, to draw attention to pushing.-    markDisplayNeeded (blid b)--spotItem :: MonadClientUI m-         => Bool -> ItemId -> ItemQuant -> Container -> m ()-spotItem verbose iid kit c = do-  -- This is due to a move, or similar, which will be displayed,-  -- so no extra @markDisplayNeeded@ needed here and in similar places.-  recordItemLid iid c-  ItemSlots itemSlots <- getsSession sslots-  arItem <- getsState $ aspectRecordFromIid iid-  let slore = IA.loreFromContainer arItem c-  case lookup iid $ map swap $ EM.assocs $ itemSlots EM.! slore of-    Nothing -> do  -- never seen or would have a slot-      updateItemSlot c iid-      case c of-        CFloor lid p -> do-          sxhairOld <- getsSession sxhair-          case sxhairOld of-            Just TEnemy{} -> return ()  -- probably too important to overwrite-            Just (TPoint TEnemyPos{} _ _) -> return ()-            _ -> do-              -- Don't steal xhair if it's only an item on another level.-              -- For enemies, OTOH, capture xhair to alarm player.-              lidV <- viewedLevelUI-              when (lid == lidV) $ do-                bag <- getsState $ getFloorBag lid p-                modifySession $ \sess ->-                  sess {sxhair = Just $ TPoint (TItem bag) lidV p}-          itemVerbMU MsgItemSpot iid kit "be located" c-        _ -> return ()-    _ -> return ()  -- this item or another with the same @iid@-                    -- seen already (has a slot assigned), so old news-  when verbose $ case c of-    CActor aid store | store `elem` [CEqp, CInv, CGround, CSha] -> do-      -- Actor fetching an item from or to shared stash, most probably.-      subject <- partActorLeader aid-      let ownW = ppCStoreWownW False store subject-          verb = MU.Text $ makePhrase $ "be added to" : ownW-      itemVerbMU MsgItemMove iid kit verb c-    _ -> return ()--recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()-recordItemLid iid c = do-  mjlid <- getsSession $ EM.lookup iid . sitemUI-  when (isNothing mjlid) $ do-    lid <- getsState $ lidFromC c-    modifySession $ \sess ->-      sess {sitemUI = EM.insert iid lid $ sitemUI sess}--moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m ()-moveActor aid source target = do-  -- If source and target tile distant, assume it's a teleportation-  -- and display an animation. Note: jumps and pushes go through all-  -- intervening tiles, so won't be considered. Note: if source or target-  -- not seen, the (half of the) animation would be boring, just a delay,-  -- not really showing a transition, so we skip it (via 'breakUpdAtomic').-  -- The message about teleportation is sometimes shown anyway, just as the X.-  CCUI{coscreen} <- getsSession sccui-  body <- getsState $ getActorBody aid-  if adjacent source target-  then markDisplayNeeded (blid body)-  else do-    let ps = (source, target)-    animate (blid body) $ teleport coscreen ps-  lookAtMove aid--displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()-displaceActorUI source target = do-  CCUI{coscreen} <- getsSession sccui-  mleader <- getsClient sleader-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  spart <- partActorLeader source-  tpart <- partActorLeader target-  let msgClass = if mleader `elem` map Just [source, target]-                 then MsgAction  -- to avoid run after displace; configurable-                 else MsgActionMinor-      msg = makeSentence [MU.SubjectVerbSg spart "displace", tpart]-  msgAdd msgClass msg-  when (bfid sb /= bfid tb) $ do-    lookAtMove source-    lookAtMove target-  side <- getsClient sside-  -- Ours involved, but definitely not requested by player via UI.-  when (side `elem` [bfid sb, bfid tb] && mleader /= Just source) stopPlayBack-  let ps = (bpos tb, bpos sb)-  animate (blid sb) $ swapPlaces coscreen ps--moveItemUI :: MonadClientUI m-           => ItemId -> Int -> ActorId -> CStore -> CStore-           -> m ()-moveItemUI iid k aid cstore1 cstore2 = do-  let verb = verbCStore cstore2-  b <- getsState $ getActorBody aid-  fact <- getsState $ (EM.! bfid b) . sfactionD-  let underAI = isAIFact fact-  mleader <- getsClient sleader-  ItemSlots itemSlots <- getsSession sslots-  case lookup iid $ map swap $ EM.assocs $ itemSlots EM.! SItem of-    Just _l ->-      -- So far organs can't be put into backpack, so no need to call-      -- @updateItemSlot@ to add or reassign lore category.-      if cstore1 == CGround && Just aid == mleader && not underAI then-        itemAidVerbMU MsgItemMove aid (MU.Text verb) iid (Right k) cstore2-      else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops-        itemAidVerbMU MsgItemMove aid (MU.Text verb) iid (Left $ Just k) cstore2-    Nothing -> error $-      "" `showFailure` (iid, k, aid, cstore1, cstore2)--quitFactionUI :: MonadClientUI m-              => FactionId -> Maybe Status-              -> Maybe (FactionAnalytics, GenerationAnalytics)-              -> m ()-quitFactionUI fid toSt manalytics = do-  ClientOptions{sexposeItems} <- getsClient soptions-  fact <- getsState $ (EM.! fid) . sfactionD-  let fidName = MU.Text $ gname fact-      person = if fhasGender $ gplayer fact then MU.PlEtc else MU.Sg3rd-      horror = isHorrorFact fact-      camping = maybe True ((== Camping) . stOutcome) toSt-  side <- getsClient sside-  when (fid == side && not camping) $ do-    tellGameClipPS-    resetGameStart-  mode <- getGameMode-  allNframes <- getsSession sallNframes-  let startingPart = case toSt of-        _ | horror -> Nothing  -- Ignore summoned actors' factions.-        Just Status{stOutcome=Killed} -> Just "be eliminated"-        Just Status{stOutcome=Defeated} -> Just "be decisively defeated"-        Just Status{stOutcome=Camping} -> Just "order save and exit"-        Just Status{stOutcome=Conquer} -> Just "vanquish all foes"-        Just Status{stOutcome=Escape} -> Just "achieve victory"-        Just Status{stOutcome=Restart, stNewGame=Just gn} ->-          Just $ MU.Text $ "order mission restart in"-                           <+> fromGroupName gn <+> "mode"-        Just Status{stOutcome=Restart, stNewGame=Nothing} ->-          error $ "" `showFailure` (fid, toSt)-        Nothing -> Nothing  -- server wipes out Camping for savefile-      middlePart = case toSt of-        _ | fid /= side -> Nothing-        Just Status{stOutcome} -> lookup stOutcome $ mendMsg mode-        Nothing -> Nothing-      partingPart = case toSt of-        _ | fid /= side || allNframes == -1 -> Nothing-        Just Status{stOutcome} -> lookup stOutcome genericEndMessages-        Nothing -> Nothing-  case startingPart of-    Nothing -> return ()-    Just sp ->-      let msgClass = if fid == side then MsgOutcome else MsgDiplomacy-      in msgAdd msgClass-         $ makeSentence [MU.SubjectVerb person MU.Yes fidName sp]-  case (toSt, partingPart) of-    (Just status, Just pp) -> do-      isNoConfirms <- isNoConfirmsGame-      go <- if isNoConfirms-            then return False-            else displaySpaceEsc ColorFull ""-      recordHistory-        -- we are going to exit or restart, so record and clear, but only once-      (itemBag, total) <- getsState $ calculateTotal side-      when go $ do-        case middlePart of-          Nothing -> return ()-          Just sp1 -> do-            factionD <- getsState sfactionD-            itemToF <- getsState $ flip itemToFull-            let getTrunkFull (_, b) = itemToF $ btrunk b-            ourTrunks <- getsState $ map getTrunkFull-                                     . fidActorNotProjGlobalAssocs side-            let smartFaction fact2 = fleaderMode (gplayer fact2) /= LeaderNull-                smartEnemy trunkFull =-                  any (smartFaction . snd)-                  $ filter (\(fid2, _) -> fid2 /= side)-                  $ possibleActorFactions (itemKind trunkFull) factionD-                smartEnemyOurs = filter smartEnemy ourTrunks-                uniqueActor trunkFull = IA.checkFlag Ability.Unique-                                        $ aspectRecordFull trunkFull-                smartUniqueEnemyCaptured = any uniqueActor smartEnemyOurs-                smartEnemyCaptured = not $ null smartEnemyOurs-                sp2 | smartUniqueEnemyCaptured =-                  "\nOh, wait, who is this, towering behind your escaping crew? This changes everything. For everybody. Everywhere. Forever. Did you plan for this? What was exactly the idea and who decided to carry it through?"-                    | smartEnemyCaptured =-                  "\nOh, wait, who is this, hunched among your escaping crew? Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again. How will you play that move?"-                    | otherwise = ""-            msgAdd0 MsgPlot $ sp1 <> sp2-            void $ displaySpaceEsc ColorFull ""-        case manalytics of-          Nothing -> return ()-          Just (factionAn, generationAn) ->-            cycleLore []-              [ displayGameOverLoot (itemBag, total) generationAn-              , displayGameOverAnalytics factionAn generationAn-              , displayGameOverLore SEmbed True generationAn-              , displayGameOverLore SOrgan True generationAn-              , displayGameOverLore SCondition sexposeItems generationAn-              , displayGameOverLore SBlast True generationAn ]-      unless isNoConfirms $ do-        -- Show score for any UI client after any kind of game exit,-        -- even though it's saved only for human UI clients at game over-        -- (that is not a noConfirms or benchmark game).-        scoreSlides <- scoreToSlideshow total status-        void $ getConfirms ColorFull [K.spaceKM, K.escKM] scoreSlides-      -- The last prompt stays onscreen during shutdown, etc.-      when (not isNoConfirms || camping) $-        void $ displaySpaceEsc ColorFull pp-    _ -> return ()--displayGameOverLoot :: MonadClientUI m-                    => (ItemBag, Int) -> GenerationAnalytics -> m K.KM-displayGameOverLoot (heldBag, total) generationAn = do-  ClientOptions{sexposeItems} <- getsClient soptions-  COps{coitem} <- getsState scops-  ItemSlots itemSlots <- getsSession sslots-  -- We assume "gold grain", not "grain" with label "of gold":-  let currencyName = IK.iname $ okind coitem $ ouniqGroup coitem "currency"-      lSlotsRaw = EM.filter (`EM.member` heldBag) $ itemSlots EM.! SItem-      generationItem = generationAn EM.! SItem-      (itemBag, lSlots) =-        if sexposeItems-        then let generationBag = EM.map (\k -> (-k, [])) generationItem-                 bag = heldBag `EM.union` generationBag-                 slots = EM.fromAscList $ zip allSlots $ EM.keys bag-             in (bag, slots)-        else (heldBag, lSlotsRaw)-      promptFun iid itemFull2 k =-        let worth = itemPrice 1 $ itemKind itemFull2-            lootMsg = if worth == 0 then "" else-              let pile = if k == 1 then "exemplar" else "hoard"-              in makeSentence $-                   ["this treasure", pile, "is worth"]-                   ++ (if k > 1 then [ MU.Cardinal k, "times"] else [])-                   ++ [MU.CarWs worth $ MU.Text currencyName]-            holdsMsg =-              let n = generationItem EM.! iid-              in if | max 0 k == 1 && n == 1 ->-                      "You keep the only specimen extant:"-                    | max 0 k == 0 && n == 1 ->-                      "You don't have the only hypothesized specimen:"-                    | max 0 k == 0 && n == 0 ->-                      "No such specimen was recorded:"-                    | otherwise -> makePhrase [ "You hold"-                                              , MU.CardinalAWs (max 0 k) "piece"-                                              , "out of"-                                              , MU.Car n-                                              , "scattered:" ]-        in lootMsg <+> holdsMsg-  dungeonTotal <- getsState sgold-  let promptGold = spoilsBlurb currencyName total dungeonTotal-      -- Total number of items is meaningless in the presence of so much junk.-      prompt = promptGold-               <+> (if sexposeItems-                    then "Non-positive count means none held but this many generated."-                    else "")-      examItem = displayItemLore itemBag 0 promptFun-  viewLoreItems "GameOverLoot" lSlots itemBag prompt examItem--displayGameOverAnalytics :: MonadClientUI m-                         => FactionAnalytics -> GenerationAnalytics-                         -> m K.KM-displayGameOverAnalytics factionAn generationAn = do-  ClientOptions{sexposeActors} <- getsClient soptions-  side <- getsClient sside-  ItemSlots itemSlots <- getsSession sslots-  let ourAn = akillCounts-              $ EM.findWithDefault emptyAnalytics side factionAn-      foesAn = EM.unionsWith (+)-               $ concatMap EM.elems $ catMaybes-               $ map (`EM.lookup` ourAn) [KillKineticMelee .. KillOtherPush]-      trunkBagRaw = EM.map (, []) foesAn-      lSlotsRaw = EM.filter (`EM.member` trunkBagRaw) $ itemSlots EM.! STrunk-      killedBag = EM.fromList $ map (\iid -> (iid, trunkBagRaw EM.! iid))-                                    (EM.elems lSlotsRaw)-      generationTrunk = generationAn EM.! STrunk-      (trunkBag, lSlots) =-        if sexposeActors-        then let generationBag = EM.map (\k -> (-k, [])) generationTrunk-                 bag = killedBag `EM.union` generationBag-                 slots = EM.fromAscList $ zip allSlots $ EM.keys bag-             in (bag, slots)-        else (killedBag, lSlotsRaw)-      total = sum $ filter (> 0) $ map fst $ EM.elems trunkBag-      promptFun :: ItemId -> ItemFull-> Int -> Text-      promptFun iid _ k =-        let n = generationTrunk EM.! iid-        in makePhrase [ "You recall the adversary, which you killed"-                      , MU.CarWs (max 0 k) "time", "out of"-                      , MU.CarWs n "individual", "reported:" ]-      prompt = makeSentence ["your team vanquished", MU.CarWs total "adversary"]-                 -- total reported would include our own, so not given-               <+> (if sexposeActors-                    then "Non-positive count means none killed but this many reported."-                    else "")-      examItem = displayItemLore trunkBag 0 promptFun-  viewLoreItems "GameOverAnalytics" lSlots trunkBag prompt examItem--displayGameOverLore :: MonadClientUI m-                    => SLore -> Bool -> GenerationAnalytics -> m K.KM-displayGameOverLore slore exposeCount generationAn = do-  let generationLore = generationAn EM.! slore-      generationBag = EM.map (\k -> (if exposeCount then k else 1, []))-                             generationLore-      total = sum $ map fst $ EM.elems generationBag-      slots = EM.fromAscList $ zip allSlots $ EM.keys generationBag-      promptFun :: ItemId -> ItemFull-> Int -> Text-      promptFun _ _ k =-        makeSentence-          [ "this", MU.Text (ppSLore slore), "manifested during your quest"-          , MU.CarWs k "time" ]-      prompt | total == 0 =-               makeSentence [ "you didn't experience any"-                            , MU.Ws $ MU.Text (headingSLore slore)-                            , "this time" ]-             | otherwise =-               makeSentence [ "you experienced the following variety of"-                            , MU.CarWs total $ MU.Text (headingSLore slore) ]-      examItem = displayItemLore generationBag 0 promptFun-  viewLoreItems ("GameOverLore" ++ show slore)-                slots generationBag prompt examItem--discover :: MonadClientUI m => Container -> ItemId -> m ()-discover c iid = do-  COps{coitem} <- getsState scops-  lid <- getsState $ lidFromC c-  globalTime <- getsState stime-  localTime <- getsState $ getLocalTime lid-  itemFull <- getsState $ itemToFull iid-  bag <- getsState $ getContainerBag c-  side <- getsClient sside-  factionD <- getsState sfactionD-  (noMsg, nameWhere) <- case c of-    CActor aidOwner storeOwner -> do-      bOwner <- getsState $ getActorBody aidOwner-      partOwner <- partActorLeader aidOwner-      let name = if bproj bOwner-                 then []-                 else ppCStoreWownW True storeOwner partOwner-          isOurOrgan = bfid bOwner == side && storeOwner == COrgan-            -- assume own faction organs known intuitively-      return (isOurOrgan, name)-    CTrunk _ _ p | p == originPoint -> return (True, [])-      -- the special reveal at game over, using fake @CTrunk@; don't spam-    _ -> return (False, [])-  let kit = EM.findWithDefault (1, []) iid bag-      knownName = partItemMediumAW side factionD localTime itemFull kit-      -- Make sure the two names in the message differ. We may end up with-      -- "the pair turns out to be a pair of trousers of destruction",-      -- but that's almost sensible. The fun of English.-      name = IK.iname $ okind coitem $ case jkind $ itemBase itemFull of-        IdentityObvious ik -> ik-        IdentityCovered _ix ik -> ik  -- fake kind; we talk about appearances-      flav = flavourToName $ jflavour $ itemBase itemFull-      unknownName = MU.Phrase $ [MU.Text flav, MU.Text name] ++ nameWhere-      msg = makeSentence-        ["the", MU.SubjectVerbSg unknownName "turn out to be", knownName]-  unless (noMsg || globalTime == timeZero) $  -- no spam about initial equipment-    msgAdd MsgItemDisco msg--ppHearMsg :: MonadClientUI m => HearMsg -> m Text-ppHearMsg hearMsg = case hearMsg of-  HearUpd local cmd -> do-    COps{coTileSpeedup} <- getsState scops-    let sound = case cmd of-          UpdDestroyActor{} -> "shriek"-          UpdCreateItem{} -> "clatter"-          UpdTrajectory{} -> "thud"  -- Something hits a non-walkable tile.-          UpdAlterTile _ _ _ toTile -> if Tile.isDoor coTileSpeedup toTile-                                       then "creaking sound"-                                       else "rumble"-          UpdAlterExplorable _ k -> if k > 0 then "grinding noise"-                                             else "fizzing noise"-          _ -> error $ "" `showFailure` cmd-        distant = if local then [] else ["distant"]-        msg = makeSentence [ "you hear"-                           , MU.AW $ MU.Phrase $ distant ++ [sound] ]-    return $! msg-  HearStrike ik -> do-    COps{coitem} <- getsState scops-    let verb = IK.iverbHit $ okind coitem ik-        msg = makeSentence [ "you hear something", MU.Text verb, "someone"]-    return $! msg-  HearSummon isProj grp p -> do-    let verb = if isProj then "something lure" else "somebody summon"-        object = if p == 1  -- works, because exact number sent, not dice-                 then MU.Text $ fromGroupName grp-                 else MU.Ws $ MU.Text $ fromGroupName grp-    return $! makeSentence ["you hear", verb, object]-  HearTaunt t ->-    return $! makeSentence ["you overhear", MU.Text t]---- * RespSfxAtomicUI---- | Display special effects (text, animation) sent to the client.--- Don't modify client state (except a few fields), but only client--- session (e.g., by displaying messages). This is enforced by types.-displayRespSfxAtomicUI :: MonadClientUI m => SfxAtomic -> m ()-{-# INLINE displayRespSfxAtomicUI #-}-displayRespSfxAtomicUI sfx = case sfx of-  SfxStrike source target iid store ->-    strike False source target iid store-  SfxRecoil source target _ _ -> do-    spart <- partActorLeader source-    tpart <- partActorLeader target-    msgAdd MsgAction $-      makeSentence [MU.SubjectVerbSg spart "shrink away from", tpart]-  SfxSteal source target iid store ->-    strike True source target iid store-  SfxRelease source target _ _ -> do-    spart <- partActorLeader source-    tpart <- partActorLeader target-    msgAdd MsgAction $ makeSentence [MU.SubjectVerbSg spart "release", tpart]-  SfxProject aid iid cstore ->-    itemAidVerbMU MsgAction aid "fling" iid (Left $ Just 1) cstore-  SfxReceive aid iid cstore ->-    itemAidVerbMU MsgAction aid "receive" iid (Left $ Just 1) cstore-  SfxApply aid iid cstore -> do-    CCUI{coscreen=ScreenContent{rapplyVerbMap}} <- getsSession sccui-    ItemFull{itemKind} <- getsState $ itemToFull iid-    let actionPart = case EM.lookup (IK.isymbol itemKind) rapplyVerbMap of-          Just verb -> MU.Text verb-          Nothing -> "use"-    itemAidVerbMU MsgAction aid actionPart iid (Left $ Just 1) cstore-  SfxCheck aid iid cstore ->-    itemAidVerbMU MsgAction aid "deapply" iid (Left $ Just 1) cstore-  SfxTrigger aid p -> do-    COps{cotile} <- getsState scops-    b <- getsState $ getActorBody aid-    lvl <- getLevel $ blid b-    let name = TK.tname $ okind cotile $ lvl `at` p-        (msgClass, verb) = if p == bpos b-                           then (MsgActionMinor, "walk over")-                           else (MsgAction, "exploit")-          -- TODO: "struggle" when harmful, "wade through" when deep, etc.-          -- possibly use the verb from the first embedded item,-          -- but it's meant to go with the item as subject, no the actor-          -- TODO: "harass" when somebody else suffers the effect-    aidVerbMU msgClass aid $ MU.Text $ verb <+> name-  SfxShun aid _p ->-    aidVerbMU MsgAction aid "shun it"-  SfxEffect fidSource aid effect hpDelta -> do-    CCUI{coscreen} <- getsSession sccui-    b <- getsState $ getActorBody aid-    bUI <- getsSession $ getActorUI aid-    side <- getsClient sside-    mleader <- getsClient sleader-    let fid = bfid b-        isOurCharacter = fid == side && not (bproj b)-        isOurAlive = isOurCharacter && bhp b > 0-        isOurLeader = Just aid == mleader-        feelLookHP = feelLook MsgEffect-        feelLookCalm adjective =-          when (bhp b > 0) $ feelLook MsgEffectMinor adjective-        feelLook msgClass adjective =-          let verb = if isOurCharacter then "feel" else "look"-          in aidVerbMU msgClass aid $ MU.Text $ verb <+> adjective-    case effect of-        IK.Burn{} -> do-          feelLookHP "burned"-          let ps = (bpos b, bpos b)-          animate (blid b) $ twirlSplash coscreen ps Color.BrRed Color.Brown-        IK.Explode{} -> return ()  -- lots of visual feedback-        IK.RefillHP p | p == 1 -> return ()  -- no spam from regeneration-        IK.RefillHP p | p == -1 -> return ()  -- no spam from poison-        IK.RefillHP{} | hpDelta > 0 -> do-          feelLookHP "healthier"-          let ps = (bpos b, bpos b)-          animate (blid b) $ twirlSplash coscreen ps Color.BrGreen Color.Green-        IK.RefillHP{} -> do-          feelLookHP "wounded"-          let ps = (bpos b, bpos b)-          animate (blid b) $ twirlSplash coscreen ps Color.BrRed Color.Red-        IK.RefillCalm{} | bproj b -> return ()-        IK.RefillCalm p | p == 1 -> return ()  -- no spam from regen items-        IK.RefillCalm p | p > 0 -> feelLookCalm "calmer"-        IK.RefillCalm _ -> feelLookCalm "agitated"-        IK.Dominate -> do-          -- For subsequent messages use the proper name, never "you".-          let subject = partActor bUI-          if fid /= fidSource then do-            -- Before domination, possibly not seen if actor (yet) not ours.-            if | bcalm b == 0 ->  -- sometimes only a coincidence, but nm-                 aidVerbMU MsgEffectMinor aid-                 $ MU.Text "yield, under extreme pressure"-               | isOurAlive ->-                 aidVerbMU MsgEffectMinor aid-                 $ MU.Text "black out, dominated by foes"-               | otherwise ->-                 aidVerbMU MsgEffectMinor aid-                 $ MU.Text "decide abruptly to switch allegiance"-            fidName <- getsState $ gname . (EM.! fid) . sfactionD-            let verb = "be no longer controlled by"-            msgAdd MsgEffectMajor $ makeSentence-              [MU.SubjectVerbSg subject verb, MU.Text fidName]-            when isOurAlive $ displayMoreKeep ColorFull ""-          else do-            -- After domination, possibly not seen, if actor (already) not ours.-            fidSourceName <- getsState $ gname . (EM.! fidSource) . sfactionD-            let verb = "be now under"-            msgAdd MsgEffectMajor $ makeSentence-              [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]-        IK.Impress -> aidVerbMU MsgEffectMinor aid "be awestruck"-        IK.PutToSleep -> aidVerbMU MsgEffectMajor aid "be put to sleep"-        IK.Yell -> aidVerbMU MsgMisc aid "start"-        IK.Summon grp p -> do-          let verb = if bproj b then "lure" else "summon"-              object = (if p == 1  -- works, because exact number sent, not dice-                        then MU.AW-                        else MU.Ws) $ MU.Text $ fromGroupName grp-          aidVerbMU MsgEffectMajor aid $ MU.Phrase [verb, object]-        IK.Ascend up -> do-          COps{cocave} <- getsState scops-          aidVerbMU MsgEffectMajor aid $ MU.Text $-            "find a way" <+> if up then "upstairs" else "downstairs"-          when isOurLeader $ do-            destinations <- getsState $ whereTo (blid b) (bpos b) up-                                        . sdungeon-            case destinations of-              (lid, _) : _ -> do  -- only works until different levels possible-                lvl <- getLevel lid-                let desc = cdesc $ okind cocave $ lkind lvl-                unless (T.null desc) $ do-                  msgAdd0 MsgLandscape desc-                  msgAdd0 MsgFocus-                          "You turn your attention to nearby positions."-              [] -> return ()  -- spell fizzles; normally should not be sent-        IK.Escape{} | isOurCharacter -> do-          ours <- getsState $ fidActorNotProjGlobalAssocs side-          when (length ours > 1) $ do-            let object = partActor bUI-            msgAdd MsgOutcome $-              "The team joins" <+> makePhrase [object]-              <> ", forms a perimeter, repacks its belongings and leaves triumphant."-        IK.Escape{} -> return ()-        IK.Paralyze{} -> aidVerbMU MsgEffect aid "be paralyzed"-        IK.ParalyzeInWater{} ->-          aidVerbMU MsgEffectMinor aid "move with difficulty"-        IK.InsertMove d ->-          if Dice.supDice d >= 10-          then aidVerbMU MsgEffect aid "act with extreme speed"-          else aidVerbMU MsgEffectMinor aid "move swiftly"-        IK.Teleport t | Dice.supDice t <= 9 ->-          aidVerbMU MsgEffectMinor aid "blink"-        IK.Teleport{} -> aidVerbMU MsgEffect aid "teleport"-        IK.CreateItem{} -> return ()-        IK.DropItem _ _ COrgan _ -> return ()-        IK.DropItem{} -> aidVerbMU MsgEffect aid "be stripped"-        IK.PolyItem -> do-          subject <- partActorLeader aid-          let ppstore = MU.Text $ ppCStoreIn CGround-          msgAdd MsgEffect $ makeSentence-            [ MU.SubjectVerbSg subject "repurpose", "what lies", ppstore-            , "to a common item of the current level" ]-        IK.RerollItem -> do-          subject <- partActorLeader aid-          let ppstore = MU.Text $ ppCStoreIn CGround-          msgAdd MsgEffect $ makeSentence-            [ MU.SubjectVerbSg subject "reshape", "what lies", ppstore-            , "striving for the highest possible standards" ]-        IK.DupItem -> do-          subject <- partActorLeader aid-          let ppstore = MU.Text $ ppCStoreIn CGround-          msgAdd MsgEffect $ makeSentence-            [MU.SubjectVerbSg subject "multiply", "what lies", ppstore]-        IK.Identify -> do-          subject <- partActorLeader aid-          pronoun <- partPronounLeader aid-          msgAdd MsgEffectMinor $ makeSentence-            [ MU.SubjectVerbSg subject "look at"-            , MU.WownW pronoun $ MU.Text "inventory"-            , "intensely" ]-        IK.Detect d _ -> do-          subject <- partActorLeader aid-          let verb = MU.Text $ detectToVerb d-              object = MU.Ws $ MU.Text $ detectToObject d-          msgAdd MsgEffectMinor $-            makeSentence [MU.SubjectVerbSg subject verb, object]-          -- Don't make it modal if all info remains after no longer seen.-          unless (d `elem` [IK.DetectHidden, IK.DetectExit]) $-            displayMore ColorFull ""-        IK.SendFlying{} -> aidVerbMU MsgEffect aid "be sent flying"-        IK.PushActor{} -> aidVerbMU MsgEffect aid "be pushed"-        IK.PullActor{} -> aidVerbMU MsgEffect aid "be pulled"-        IK.DropBestWeapon -> aidVerbMU MsgEffectMajor aid "be disarmed"-        IK.ActivateInv{} -> return ()-        IK.ApplyPerfume ->-          msgAdd MsgEffectMinor-                 "The fragrance quells all scents in the vicinity."-        IK.OneOf{} -> return ()-        IK.OnSmash{} -> error $ "" `showFailure` sfx-        IK.VerbNoLonger t -> aidVerbMU MsgNoLonger aid $ MU.Text t-        IK.VerbMsg t -> aidVerbMU MsgEffectMinor aid $ MU.Text t-        IK.Composite{} -> error $ "" `showFailure` sfx-  SfxMsgFid _ sfxMsg -> do-    mleader <- getsClient sleader-    case mleader of-      Just{} -> return ()  -- will display stuff when leader moves-      Nothing -> do-        lidV <- viewedLevelUI-        markDisplayNeeded lidV-        recordHistory-    mmsg <- ppSfxMsg sfxMsg-    case mmsg of-      Just (msgClass, msg) -> msgAdd msgClass msg-      Nothing -> return ()-  SfxRestart -> fadeOutOrIn True-  SfxCollideTile source pos -> do-    COps{cotile} <- getsState scops-    sb <- getsState $ getActorBody source-    lvl <- getLevel $ blid sb-    spart <- partActorLeader source-    let object = MU.AW $ MU.Text $ TK.tname $ okind cotile $ lvl `at` pos-    msgAdd MsgVeryRare $! makeSentence-      [MU.SubjectVerbSg spart "collide", "painfully with", object]-  SfxTaunt voluntary aid -> do-    spart <- partActorLeader aid-    (_heardSubject, verb) <- displayTaunt voluntary rndToActionForget aid-    msgAdd MsgMisc $! makeSentence [MU.SubjectVerbSg spart (MU.Text verb)]--ppSfxMsg :: MonadClientUI m => SfxMsg -> m (Maybe (MsgClass, Text))-ppSfxMsg sfxMsg = case sfxMsg of-  SfxUnexpected reqFailure -> return $-    Just ( MsgWarning-         , "Unexpected problem:" <+> showReqFailure reqFailure <> "." )-  SfxExpected itemName reqFailure -> return $-    Just ( MsgWarning-         , "The" <+> itemName <+> "is not triggered:"-           <+> showReqFailure reqFailure <> "." )-  SfxFizzles -> return $ Just (MsgWarning, "It didn't work.")-  SfxNothingHappens -> return $ Just (MsgMisc, "Nothing happens.")-  SfxVoidDetection d -> return $-    Just ( MsgMisc-         , makeSentence ["no new", MU.Text $ detectToObject d, "detected"] )-  SfxUnimpressed aid -> do-    msbUI <- getsSession $ EM.lookup aid . sactorUI-    case msbUI of-      Nothing -> return Nothing-      Just sbUI -> do-        let subject = partActor sbUI-            verb = "be unimpressed"-        return $ Just (MsgWarning, makeSentence [MU.SubjectVerbSg subject verb])-  SfxSummonLackCalm aid -> do-    msbUI <- getsSession $ EM.lookup aid . sactorUI-    case msbUI of-      Nothing -> return Nothing-      Just sbUI -> do-        let subject = partActor sbUI-            verb = "lack Calm to summon"-        return $ Just (MsgWarning, makeSentence [MU.SubjectVerbSg subject verb])-  SfxSummonTooManyOwn aid -> do-    msbUI <- getsSession $ EM.lookup aid . sactorUI-    case msbUI of-      Nothing -> return Nothing-      Just sbUI -> do-        let subject = partActor sbUI-            verb = "can't keep track of their numerous friends, let alone summon any more"-        return $ Just (MsgWarning, makeSentence [subject, verb])-  SfxSummonTooManyAll aid -> do-    msbUI <- getsSession $ EM.lookup aid . sactorUI-    case msbUI of-      Nothing -> return Nothing-      Just sbUI -> do-        let subject = partActor sbUI-            verb = "can't keep track of everybody around, let alone summon anyone else"-        return $ Just (MsgWarning, makeSentence [subject, verb])-  SfxSummonFailure aid -> do-    msbUI <- getsSession $ EM.lookup aid . sactorUI-    case msbUI of-      Nothing -> return Nothing-      Just sbUI -> do-        let subject = partActor sbUI-            verb = "fail to summon anything"-        return $ Just (MsgWarning, makeSentence [MU.SubjectVerbSg subject verb])-  SfxLevelNoMore ->-    return $ Just (MsgWarning, "No more levels in this direction.")-  SfxLevelPushed ->-    return $ Just (MsgWarning, "You notice somebody pushed to another level.")-  SfxBracedImmune aid -> do-    msbUI <- getsSession $ EM.lookup aid . sactorUI-    case msbUI of-      Nothing -> return Nothing-      Just sbUI -> do-        let subject = partActor sbUI-            verb = "be braced and so immune to translocation"-        return $ Just (MsgMisc, makeSentence [MU.SubjectVerbSg subject verb])-                         -- too common-  SfxEscapeImpossible -> return $-    Just ( MsgWarning-         , "Escaping outside is unthinkable for members of this faction." )-  SfxStasisProtects -> return $-    Just ( MsgMisc  -- too common-         , "Paralysis and speed surge require recovery time." )-  SfxWaterParalysisResisted -> return Nothing  -- don't spam-  SfxTransImpossible -> return $-    Just (MsgWarning, "Translocation not possible.")-  SfxIdentifyNothing -> return $ Just (MsgWarning, "Nothing to identify.")-  SfxPurposeNothing -> return $-    Just ( MsgWarning-         , "The purpose of repurpose cannot be availed without an item"-           <+> ppCStoreIn CGround <> "." )-  SfxPurposeTooFew maxCount itemK -> return $-    Just ( MsgWarning-         , "The purpose of repurpose is served by" <+> tshow maxCount-           <+> "pieces of this item, not by" <+> tshow itemK <> "." )-  SfxPurposeUnique -> return $-    Just (MsgWarning, "Unique items can't be repurposed.")-  SfxPurposeNotCommon -> return $-    Just (MsgWarning, "Only ordinary common items can be repurposed.")-  SfxRerollNothing -> return $-    Just ( MsgWarning-         , "The shape of reshape cannot be assumed without an item"-           <+> ppCStoreIn CGround <> "." )-  SfxRerollNotRandom -> return $-    Just (MsgWarning, "Only items of variable shape can be reshaped.")-  SfxDupNothing -> return $-    Just ( MsgWarning-         , "Mutliplicity won't rise above zero without an item"-           <+> ppCStoreIn CGround <> "." )-  SfxDupUnique -> return $-    Just (MsgWarning, "Unique items can't be multiplied.")-  SfxDupValuable -> return $-    Just (MsgWarning, "Valuable items can't be multiplied.")-  SfxColdFish -> return $-    Just ( MsgMisc  -- repeatable-         , "Healing attempt from another faction is thwarted by your cold fish attitude." )-  SfxTimerExtended lid aid iid cstore delta -> do-    aidSeen <- getsState $ memActor aid lid-    if aidSeen then do-      b <- getsState $ getActorBody aid-      bUI <- getsSession $ getActorUI aid-      aidPronoun <- partPronounLeader aid-        -- assume almost always a prior message mentions the object-      factionD <- getsState sfactionD-      localTime <- getsState $ getLocalTime (blid b)-      itemFull <- getsState $ itemToFull iid-      side <- getsClient sside-      let kit = (1, [])-          (name, powers) = partItem (bfid b) factionD localTime itemFull kit-          storeOwn = ppCStoreWownW True cstore aidPronoun-          cond = [ "condition"-                 | IA.checkFlag Ability.Condition $ aspectRecordFull itemFull ]-          -- Note that when enemy actor causes the extension to himsefl,-          -- the player is not notified at all. So the shorter blurb below-          -- is the middle ground.-          (msgClass, parts) | bfid b == side =-            ( MsgLongerUs-            , ["the", name, powers] ++ cond ++ storeOwn ++ ["will now last"]-              ++ [MU.Text $ timeDeltaInSecondsText delta] ++ ["longer"] )-                | otherwise =  -- avoid TMI for not our actors-            -- Ideally we'd use a pronoun here, but the action (e.g., hit)-            -- that caused this extension can be invisible to some onlookers.-            -- So their narrative context needs to be taken into account.-            ( MsgLonger-            , [partItemShortWownW side factionD (partActor bUI) localTime-                                       itemFull (1, [])]-              ++ cond ++ ["is extended"] )-      return $ Just (msgClass, makeSentence parts)-    else return Nothing-  SfxCollideActor lid source target -> do-    sourceSeen <- getsState $ memActor source lid-    targetSeen <- getsState $ memActor target lid-    if sourceSeen && targetSeen then do-      spart <- partActorLeader source-      tpart <- partActorLeader target-      return $-        Just ( MsgWarning-             , makeSentence-                 [MU.SubjectVerbSg spart "collide", "awkwardly with", tpart] )-    else return Nothing--strike :: MonadClientUI m-       => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()-strike catch source target iid cstore = assert (source /= target) $ do-  CCUI{coscreen} <- getsSession sccui-  tb <- getsState $ getActorBody target-  sourceSeen <- getsState $ memActor source (blid tb)-  if not sourceSeen then-    animate (blid tb) $ subtleHit coscreen (bpos tb)-  else do-    hurtMult <- getsState $ armorHurtBonus source target-    sb <- getsState $ getActorBody source-    sMaxSk <- getsState $ getActorMaxSkills source-    spart <- partActorLeader source-    tpart <- partActorLeader target-    spronoun <- partPronounLeader source-    tpronoun <- partPronounLeader target-    tbUI <- getsSession $ getActorUI target-    localTime <- getsState $ getLocalTime (blid tb)-    bag <- getsState $ getBodyStoreBag sb cstore-    itemFullWeapon <- getsState $ itemToFull iid-    let kitWeapon = EM.findWithDefault (1, []) iid bag-    side <- getsClient sside-    factionD <- getsState sfactionD-    tfact <- getsState $ (EM.! bfid tb) . sfactionD-    eqpOrgKit <- getsState $ kitAssocs target [CEqp, COrgan]-    orgKit <- getsState $ kitAssocs target [COrgan]-    let notCond (_, (itemFullArmor, _)) =-          not $ IA.checkFlag Ability.Condition $ aspectRecordFull itemFullArmor-        isOrdinaryCond (_, (itemFullArmor, _)) =-          isJust $ lookup "condition" $ IK.ifreq $ itemKind itemFullArmor-        rateArmor (iidArmor, (itemFullArmor, (k, _))) =-          ( k * IA.getSkill Ability.SkArmorMelee-                            (aspectRecordFull itemFullArmor)-          , ( iidArmor-            , itemFullArmor ) )-        abs15 (v, _) = abs v >= 15-        condArmor = filter abs15 $ map rateArmor $ filter isOrdinaryCond orgKit-        fstGt0 (v, _) = v > 0-        eqpAndOrgArmor = filter fstGt0 $ map rateArmor-                         $ filter notCond eqpOrgKit-    mblockArmor <- case eqpAndOrgArmor of-      [] -> return Nothing-      _ -> Just-           <$> rndToActionForget (frequency $ toFreq "msg armor" eqpAndOrgArmor)-    let (blockWithWhat, blockWithWeapon) = case mblockArmor of-          Nothing -> ([], False)-          Just (iidArmor, itemFullArmor) ->-            let (object1, object2) =-                  partItemShortest (bfid tb) factionD localTime-                                   itemFullArmor (1, [])-                name | iidArmor == btrunk tb = "trunk"-                     | otherwise = MU.Phrase [object1, object2]-            in ( ["with", MU.WownW tpronoun name]-               , Dice.supDice (IK.idamage $ itemKind itemFullArmor) > 0 )-        verb = MU.Text $ IK.iverbHit $ itemKind itemFullWeapon-        partItemChoice =-          if iid `EM.member` borgan sb-          then partItemShortWownW side factionD spronoun localTime-          else partItemShortAW side factionD localTime-        weaponName = partItemChoice itemFullWeapon kitWeapon-        sleepy = if bwatch tb `elem` [WSleep, WWake]-                    && tpart /= "you"-                    && bhp tb > 0-                 then "the sleepy"-                 else ""-        -- For variety, attack adverb is based on attacker's and weapon's-        -- damage potential as compared to victim's current HP.-        -- We are not taking into account victim's armor yet.-        sHurt = armorHurtCalculation (bproj sb) sMaxSk Ability.zeroSkills-        sDamage =-          let dmg = Dice.supDice $ IK.idamage $ itemKind itemFullWeapon-              rawDeltaHP = fromIntegral sHurt * xM dmg `divUp` 100-              speedDeltaHP = case btrajectory sb of-                Just (_, speed) | bproj sb ->-                  - modifyDamageBySpeed rawDeltaHP speed-                _ -> - rawDeltaHP-          in min 0 speedDeltaHP-        deadliness = 1000 * (- sDamage) `div` max 1 (bhp tb)-        strongly-          | deadliness >= 10000 = "artfully"-          | deadliness >= 5000 = "madly"-          | deadliness >= 2000 = "mercilessly"-          | deadliness >= 1000 = "murderously"  -- one blow can wipe out all HP-          | deadliness >= 700 = "devastatingly"-          | deadliness >= 500 = "vehemently"-          | deadliness >= 400 = "forcefully"-          | deadliness >= 350 = "sturdily"-          | deadliness >= 300 = "accurately"-          | deadliness >= 20 = ""  -- common, terse case, between 2% and 30%-          | deadliness >= 10 = "cautiously"-          | deadliness >= 5 = "guardedly"-          | deadliness >= 3 = "hesitantly"-          | deadliness >= 2 = "clumsily"-          | deadliness >= 1 = "haltingly"-          | otherwise = "feebly"-        -- Here we take into account armor, so we look at @hurtMult@,-        -- so we finally convey the full info about effectiveness of the strike.-        blockHowWell  -- under some conditions, the message not shown at all-          | hurtMult > 90 = "incompetently"-          | hurtMult > 80 = "too late"-          | hurtMult > 70 = "too slowly"-          | hurtMult > 20 = if | deadliness >= 2000 -> "marginally"-                               | deadliness >= 1000 -> "partially"-                               | deadliness >= 100 -> "partly"  -- common-                               | deadliness >= 50 -> "to an extent"-                               | deadliness >= 20 -> "to a large extent"-                               | deadliness >= 5 -> "for the major part"-                               | otherwise -> "for the most part"-          | hurtMult > 1 = if | actorWaits tb -> "doggedly"-                              | hurtMult > 10 -> "nonchalantly"-                              | otherwise -> "bemusedly"-          | otherwise = "almost completely"-              -- 1% always gets through, but if fast missile, can be deadly-        blockPhrase =-          let (subjectBlock, verbBlock) =-                if | not $ bproj sb ->-                     (tpronoun, if blockWithWeapon-                                then "parry"-                                else "block")-                   | tpronoun == "it"-                     || projectileHitsWeakly && tpronoun /= "you" ->-                     -- Avoid ambiguity.-                     (partActor tbUI, if actorWaits tb-                                      then "deflect it"-                                      else "fend it off")-                   | otherwise ->-                     (tpronoun, if actorWaits tb-                                then "avert it"-                                else "ward it off")-          in MU.SubjectVerbSg subjectBlock verbBlock-        surprisinglyGoodDefense = deadliness >= 20 && hurtMult <= 70-        surprisinglyBadDefense = deadliness < 20 && hurtMult > 70-        yetButAnd-          | surprisinglyGoodDefense = ", but"-          | surprisinglyBadDefense = ", yet"-          | otherwise = " and"  -- no surprises-        projectileHitsWeakly = bproj sb && deadliness < 20-        msgArmor = if not projectileHitsWeakly-                        -- ensures if attack msg terse, armor message-                        -- mentions object, so we know who is hit-                      && hurtMult > 90-                      && (null condArmor || deadliness < 100)-                   then ""  -- at most minor armor, relatively to skill-                            -- of the hit, so we don't talk about blocking,-                            -- unless a condition is at play, too-                   else yetButAnd-                        <+> makePhrase ([blockPhrase, blockHowWell]-                                        ++ blockWithWhat)-        ps = (bpos tb, bpos sb)-        basicAnim-          | hurtMult > 70 = twirlSplash coscreen ps Color.BrRed Color.Red-          | hurtMult > 1 = blockHit coscreen ps Color.BrRed Color.Red-          | otherwise = blockMiss coscreen ps-        targetIsFoe = bfid sb == side  -- no big news if others hit our foes-                      && isFoe (bfid tb) tfact side-        targetIsFriend = isFriend (bfid tb) tfact side-                           -- warning if anybody hits our friends-        msgClassMelee = if targetIsFriend then MsgMeleeUs else MsgMelee-        msgClassRanged = if targetIsFriend then MsgRangedUs else MsgRanged-    -- The messages about parrying and immediately afterwards dying-    -- sound goofy, but there is no easy way to prevent that.-    -- And it's consistent.-    -- If/when death blow instead sets HP to 1 and only the next below 1,-    -- we can check here for HP==1; also perhaps actors with HP 1 should-    -- not be able to block.-    if | catch -> do  -- charge not needed when catching-         let msg = makeSentence-                     [MU.SubjectVerbSg spart "catch", tpart, "skillfully"]-         msgAdd MsgVeryRare msg-         animate (blid tb) $ blockHit coscreen ps Color.BrGreen Color.Green-       | not (hasCharge localTime itemFullWeapon kitWeapon) -> do-         -- Can easily happen with a thrown discharged item.-         -- Much less plausible with a wielded weapon.-         -- Theoretically possible if the weapon not identified-         -- (then timeout is a mean estimate), but they usually should be,-         -- even in foes' possession.-         let msg = if bproj sb-                   then makePhrase-                          [MU.Capitalize $ MU.SubjectVerbSg spart "connect"]-                        <> ", but it may be completely discharged."-                   else makePhrase-                          [ MU.Capitalize $ MU.SubjectVerbSg spart "try"-                          , "to", verb, tpart, "with"-                          , weaponName ]-                        <> ", but it may be not readied yet."-         msgAdd MsgVeryRare msg  -- and no animation-       | bproj sb && bproj tb -> do  -- server sends unless both are blasts-         -- Short message.-         msgAdd MsgVeryRare $-           makeSentence [MU.SubjectVerbSg spart "intercept", tpart]-         -- Basic non-bloody animation regardless of stats.-         animate (blid tb) $ blockHit coscreen ps Color.BrBlue Color.Blue-       | IK.idamage (itemKind itemFullWeapon) == 0 -> do-         let adverb = if bproj sb then "lightly" else "delicately"-             msg = makeSentence $-               [MU.SubjectVerbSg spart verb, tpart, adverb]-               ++ if bproj sb then [] else ["with", weaponName]-         msgAdd msgClassMelee msg  -- too common for color-         animate (blid tb) $ subtleHit coscreen (bpos sb)-       | bproj sb -> do  -- more terse than melee, because sometimes very spammy-         let msgRangedPowerful | targetIsFoe = MsgRangedPowerfulWe-                               | targetIsFriend = MsgRangedPowerfulUs-                               | otherwise = msgClassRanged-             (attackParts, msgRanged)-               | projectileHitsWeakly =-                 ( [MU.SubjectVerbSg spart "connect"]  -- weak, so terse-                 , msgClassRanged )-               | deadliness >= 300 =-                 ( [MU.SubjectVerbSg spart verb, tpart, "powerfully"]-                 , if targetIsFriend || deadliness >= 700-                   then msgRangedPowerful-                   else msgClassRanged )-               | otherwise =-                 ( [MU.SubjectVerbSg spart verb, tpart]  -- strong, for a proj-                 , msgClassRanged )-         msgAdd msgRanged $ makePhrase [MU.Capitalize $ MU.Phrase attackParts]-                            <> msgArmor <> "."-         animate (blid tb) basicAnim-       | bproj tb -> do  -- much less emotion and the victim not active.-         let attackParts =-               [MU.SubjectVerbSg spart verb, tpart, "with", weaponName]-         msgAdd MsgMelee $ makeSentence attackParts-         animate (blid tb) basicAnim-       | otherwise -> do  -- ordinary melee-         let msgMeleeInteresting | targetIsFoe = MsgMeleeInterestingWe-                                 | targetIsFriend = MsgMeleeInterestingUs-                                 | otherwise = msgClassMelee-             msgMeleePowerful | targetIsFoe = MsgMeleePowerfulWe-                              | targetIsFriend = MsgMeleePowerfulUs-                              | otherwise = msgClassMelee-             attackParts =-               [ MU.SubjectVerbSg spart verb, sleepy, tpart, strongly-               , "with", weaponName ]-             (tmpInfluenceBlurb, msgClassInfluence) =-               if null condArmor || T.null msgArmor-               then ("", msgClassMelee)-               else-                 let (armor, (_, itemFullArmor)) =-                       maximumBy (Ord.comparing $ abs . fst) condArmor-                     (object1, object2) =-                       partItemShortest (bfid tb) factionD localTime-                                        itemFullArmor (1, [])-                     name = makePhrase [object1, object2]-                     msgText =-                       if hurtMult > 20 && not surprisinglyGoodDefense-                          || surprisinglyBadDefense-                       then (if armor <= -15-                             then ", due to being"-                             else assert (armor >= 15) ", regardless of being")-                            <+> name-                       else (if armor >= 15-                             then ", thanks to being"-                             else assert (armor <= -15) ", despite being")-                            <+> name-                 in (msgText, msgMeleeInteresting)-             msgClass = if targetIsFriend && deadliness >= 300-                           || deadliness >= 2000-                        then msgMeleePowerful-                        else msgClassInfluence-         msgAdd msgClass $ makePhrase [MU.Capitalize $ MU.Phrase attackParts]-                           <> msgArmor <> tmpInfluenceBlurb <> "."-         animate (blid tb) basicAnim+  , ppHearMsg, ppHearDistanceAdjective, ppHearDistanceAdverb+  , updateItemSlot, markDisplayNeeded, lookAtMove+  , aidVerbMU, aidVerbDuplicateMU, itemVerbMUGeneral, itemVerbMU+  , itemVerbMUShort, itemAidVerbMU, mitemAidVerbMU, itemAidDistinctMU+  , manyItemsAidVerbMU+  , createActorUI, destroyActorUI, spotItemBag, moveActor, displaceActorUI+  , moveItemUI, quitFactionUI+  , displayGameOverLoot, displayGameOverAnalytics+  , discover, ppSfxMsg, strike+#endif+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import           Control.Concurrent (threadDelay)+import qualified Data.Char as Char+import qualified Data.EnumMap.Strict as EM+import qualified Data.EnumSet as ES+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import           Data.Tuple+import           GHC.Exts (inline)+import qualified NLP.Miniutter.English as MU++import           Game.LambdaHack.Atomic+import           Game.LambdaHack.Client.MonadClient+import           Game.LambdaHack.Client.State+import           Game.LambdaHack.Client.UI.ActorUI+import           Game.LambdaHack.Client.UI.Animation+import           Game.LambdaHack.Client.UI.Content.Screen+import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.DrawM+import           Game.LambdaHack.Client.UI.EffectDescription+import           Game.LambdaHack.Client.UI.Frame+import           Game.LambdaHack.Client.UI.FrameM+import           Game.LambdaHack.Client.UI.HandleHelperM+import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd+import           Game.LambdaHack.Client.UI.ItemDescription+import           Game.LambdaHack.Client.UI.ItemSlot+import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.MonadClientUI+import           Game.LambdaHack.Client.UI.Msg+import           Game.LambdaHack.Client.UI.MsgM+import           Game.LambdaHack.Client.UI.SessionUI+import           Game.LambdaHack.Client.UI.SlideshowM+import           Game.LambdaHack.Client.UI.UIOptions+import           Game.LambdaHack.Common.Actor+import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.Analytics+import           Game.LambdaHack.Common.ClientOptions+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.Types+import           Game.LambdaHack.Content.CaveKind (cdesc)+import qualified Game.LambdaHack.Content.ItemKind as IK+import           Game.LambdaHack.Content.ModeKind+import qualified Game.LambdaHack.Content.ModeKind as MK+import           Game.LambdaHack.Content.RuleKind+import qualified Game.LambdaHack.Content.TileKind as TK+import qualified Game.LambdaHack.Core.Dice as Dice+import           Game.LambdaHack.Core.Frequency+import           Game.LambdaHack.Core.Random+import qualified Game.LambdaHack.Definition.Ability as Ability+import qualified Game.LambdaHack.Definition.Color as Color+import           Game.LambdaHack.Definition.Defs+import           Game.LambdaHack.Definition.Flavour++-- * RespUpdAtomicUI++-- | Visualize atomic updates sent to the client. This is done+-- in the global state after the command is executed and after+-- the client state is modified by the command.+-- Doesn't modify client state (except a few fields), but only client+-- session (e.g., by displaying messages). This is enforced by types.+displayRespUpdAtomicUI :: (MonadClient m, MonadClientUI m) => UpdAtomic -> m ()+{-# INLINE displayRespUpdAtomicUI #-}+displayRespUpdAtomicUI cmd = case cmd of+  -- Create/destroy actors and items.+  UpdRegisterItems{} -> return ()+  UpdCreateActor aid body _ -> createActorUI True aid body+  UpdDestroyActor aid body _ -> destroyActorUI True aid body+  UpdCreateItem verbose iid _ kit@(kAdd, _) c -> do+    recordItemLid iid c+    updateItemSlot c iid+    if verbose then case c of+      CActor aid store -> do+        b <- getsState $ getActorBody aid+        case store of+          _ | bproj b ->+            itemVerbMU MsgItemCreation iid kit "appear" c+          COrgan -> do+            localTime <- getsState $ getLocalTime (blid b)+            arItem <- getsState $ aspectRecordFromIid iid+            if | IA.checkFlag Ability.Blast arItem -> return ()+               | IA.checkFlag Ability.Condition arItem -> do+                 side <- getsClient sside+                 discoBenefit <- getsClient sdiscoBenefit+                 bag <- getsState $ getContainerBag c+                 itemKind <- getsState $ getIidKind iid+                 let more = case EM.lookup iid bag of+                       Just (kTotal, _) | kTotal /= kAdd -> Just kTotal+                       _ -> Nothing+                     verbShow = MU.Text $+                       "become"+                       <+> case kit of+                         (1, _ : _) -> "somewhat"+                         (1, []) | isNothing more -> ""+                         _ | isNothing more -> "many-fold"+                         _ -> "additionally"+                     verbSave = MU.Text $+                       "become"+                       <+> case kit of+                         (1, t:_) ->  -- only exceptionally not singleton list+                                      -- or even more than one copy total+                           let total = deltaOfItemTimer localTime t+                           in timeDeltaInSecondsText total+                         (1, []) | isNothing more -> ""+                         (k, _) ->  -- usually the list empty; ignore anyway+                           (if isJust more then "additionally" else "")+                           <+> tshow k <> "-fold"+                           <+> case more of+                                 Nothing -> ""+                                 Just kTotal ->+                                   "(total:" <+> tshow kTotal <> "-fold)"+                     good = benInEqp (discoBenefit EM.! iid)+                     msgClass = case lookup IK.S_ASLEEP $ IK.ifreq itemKind of+                       Just n | n > 0 -> MsgStatusSleep+                       _ -> if | bfid b /= side -> MsgStatusOthers+                               | good -> MsgStatusGoodUs+                               | otherwise -> MsgStatusBadUs+                 -- This describes all such items already among organs,+                 -- which is useful, because it shows "charging".+                 itemAidDistinctMU msgClass aid verbShow verbSave iid+                 when (bfid b == side && not good) $+                   -- Others get conditions too often and good ones are not+                   -- dire enough and also too common.+                   msgAdd MsgTutorialHint "Temporary conditions, especially the bad ones, pass quickly, usually after just a few turns. While active, they are listed in the '@' organ menu and the effects of most of them are seen in the '#' skill menu."+               | otherwise -> do+                 wown <- ppContainerWownW partActorLeader True c+                 itemVerbMU MsgItemCreation iid kit+                            (MU.Text $ makePhrase $ "grow" : wown) c+          _ -> do+            wown <- ppContainerWownW partActorLeader True c+            itemVerbMU MsgItemCreation iid kit+                       (MU.Text $ makePhrase $ "appear" : wown) c+      CEmbed lid _ -> markDisplayNeeded lid+      CFloor lid _ -> do+        factionD <- getsState sfactionD+        itemVerbMU MsgItemCreation iid kit+                   (MU.Text $ "appear" <+> ppContainer factionD c) c+        markDisplayNeeded lid+      CTrunk{} -> return ()+    else do+      lid <- getsState $ lidFromC c+      markDisplayNeeded lid+  UpdDestroyItem verbose iid _ kit c ->+    if verbose then case c of+      CActor aid _  -> do+        b <- getsState $ getActorBody aid+        if bproj b then+          itemVerbMUShort MsgItemRuination iid kit "break" c+        else do+          ownW <- ppContainerWownW partActorLeader False c+          let verb = MU.Text $ makePhrase $ "vanish from" : ownW+          itemVerbMUShort MsgItemRuination iid kit verb c+      CEmbed lid _ -> markDisplayNeeded lid+      CFloor lid _ -> do+        factionD <- getsState sfactionD+        itemVerbMUShort MsgItemRuination iid kit+                        (MU.Text $ "break" <+> ppContainer factionD c) c+        markDisplayNeeded lid+      CTrunk{} -> return ()+    else do+      lid <- getsState $ lidFromC c+      markDisplayNeeded lid+  UpdSpotActor aid body -> createActorUI False aid body+  UpdLoseActor aid body -> destroyActorUI False aid body+  UpdSpotItem verbose iid kit c -> spotItemBag verbose c $ EM.singleton iid kit+  UpdLoseItem True iid kit c@(CActor aid _) -> do+    b <- getsState $ getActorBody aid+    when (not (bproj b) && bhp b > 0) $ do  -- don't spam+      ownW <- ppContainerWownW partActorLeader False c+      let verb = MU.Text $ makePhrase $ "be removed from" : ownW+      itemVerbMUShort MsgItemMovement iid kit verb c+  UpdLoseItem{} -> return ()+  UpdSpotItemBag verbose c bag -> spotItemBag verbose c bag+  UpdLoseItemBag{} -> return ()  -- rarely interesting and can be very long+  -- Move actors and items.+  UpdMoveActor aid source target -> moveActor aid source target+  UpdWaitActor aid WSleep _ -> do+    aidVerbMU MsgStatusWakeup aid "wake up"+    side <- getsClient sside+    b <- getsState $ getActorBody aid+    unless (bfid b == side) $+      msgAdd MsgTutorialHint "Woken up actors regain stats and skills, including sight radius and melee armor, over several turns. To avoid waking them up, make sure they don't lose HP nor too much Calm through noises, particularly close ones. Beware, however, that they slowly regenerate HP as they sleep and eventually wake up at full HP."+  UpdWaitActor{} -> return ()  -- falling asleep handled uniformly elsewhere+  UpdDisplaceActor source target -> displaceActorUI source target+  UpdMoveItem iid k aid c1 c2 -> moveItemUI iid k aid c1 c2+  -- Change actor attributes.+  UpdRefillHP _ 0 -> return ()+  UpdRefillHP aid hpDelta -> do+    let coarseDelta = abs hpDelta `div` oneM+        tDelta = if coarseDelta == 0+                 then if hpDelta > 0 then "a little" else "a fraction of an HP"+                 else tshow coarseDelta <+> "HP"+    b <- getsState $ getActorBody aid+    unless (bproj b) $+      aidVerbMU MsgNumericReport aid $ MU.Text+                ((if hpDelta > 0 then "heal" else "lose") <+> tDelta)+    arena <- getArenaUI+    side <- getsClient sside+    if | bproj b && (EM.null (beqp b) || isNothing (btrajectory b)) ->+           return ()  -- ignore caught proj or one hitting a wall+       | bhp b <= 0 && hpDelta < 0+         && (bfid b == side && not (bproj b) || arena == blid b) -> do+         let (firstFall, hurtExtra) = case (bfid b == side, bproj b) of+               (True, True) -> ("drop down", "tumble down")+               (True, False) -> ("fall down", "suffer woeful mutilation")+               (False, True) -> ("plummet", "crash")+               (False, False) -> ("collapse", "be reduced to a bloody pulp")+             verbDie = if alreadyDeadBefore then hurtExtra else firstFall+             -- Rarely, this is wrong, because 2 other actors hit the victim+             -- at exactly the same time. No big problem. Doubled "dies"+             -- messages appears instead of "dies; is mutilated".+             alreadyDeadBefore = bhp b - hpDelta <= 0+         tfact <- getsState $ (EM.! bfid b) . sfactionD+         bUI <- getsSession $ getActorUI aid+         subjectRaw <- partActorLeader aid+         let subject = if alreadyDeadBefore || subjectRaw == "you"+                       then subjectRaw+                       else partActor bUI  -- avoid "fallen"+             msgDie = makeSentence [MU.SubjectVerbSg subject verbDie]+             targetIsFoe = isFoe (bfid b) tfact side+             targetIsFriend = isFriend (bfid b) tfact side+             msgClass | bproj b = MsgDeathBoring+                      | targetIsFoe = MsgDeathVictory+                      | targetIsFriend = MsgDeathDeafeat+                      | otherwise = MsgDeathBoring+         if | bproj b -> msgAdd msgClass msgDie+            | bfid b == side -> do+              msgLnAdd msgClass $ msgDie <+> "Alas!"+              displayMore ColorBW ""+            | otherwise -> msgLnAdd msgClass msgDie+         -- We show death anims only if not dead already before this refill.+         let deathAct = if bfid b == side+                        then deathBody (bpos b)+                        else shortDeathBody (bpos b)+         unless (bproj b || alreadyDeadBefore) $ animate (blid b) deathAct+       | otherwise -> do+         when (hpDelta >= bhp b && bhp b > 0) $+           aidVerbMU MsgActionWarning aid "return from the brink of death"+         mleader <- getsClient sleader+         when (Just aid == mleader) $ do+           actorMaxSk <- getsState $ getActorMaxSkills aid+           -- Regenerating actors never stop gaining HP, so we need to stop+           -- reporting it after they reach full HP for the first time.+           -- Also, no spam for non-leaders.+           when (bhp b >= xM (Ability.getSk Ability.SkMaxHP actorMaxSk)+                 && bhp b - hpDelta < xM (Ability.getSk Ability.SkMaxHP+                                                  actorMaxSk)) $+             msgAdd MsgSpecialEvent "You recover your health fully. Any further gains will be transient."+         when (bfid b == side && not (bproj b)) $ do+           when (abs hpDelta >= oneM) $ markDisplayNeeded (blid b)+           when (hpDelta < 0) $ do+             when (hpDelta <= xM (-3)) $ msgAdd MsgTutorialHint "You took a lot of damage from one source. If the danger persists, consider retreating towards your teammates or buffing up or an instant escape, if consumables permit."+             sUIOptions <- getsSession sUIOptions+             currentWarning <-+               getsState $ checkWarningHP sUIOptions aid (bhp b)+             when currentWarning $ do+               previousWarning <-+                 getsState $ checkWarningHP sUIOptions aid (bhp b - hpDelta)+               unless previousWarning $+                 aidVerbMU MsgRiskOfDeath aid+                           "be down to a dangerous health level"+  UpdRefillCalm _ 0 -> return ()+  UpdRefillCalm aid calmDelta -> do+    side <- getsClient sside+    b <- getsState $ getActorBody aid+    when (bfid b == side && not (bproj b)) $ do+      if | calmDelta > 0 -> do  -- regeneration or effect+           mleader <- getsClient sleader+           when (Just aid == mleader) $ do+             actorMaxSk <- getsState $ getActorMaxSkills aid+             let bPrev = b {bcalm = bcalm b - calmDelta}+             when (calmEnough b actorMaxSk+                   && not (calmEnough bPrev actorMaxSk)) $+               msgAdd MsgNeutralEvent "You are again calm enough to manage your equipment outfit."+           -- If the leader regenerates Calm more often than once per+           -- standard game turn, this will not be reflected, for smoother+           -- and faster display. However, every halt for keypress+           -- shows Calm, so this only matters for macros, where speed is good.+           when (abs calmDelta > oneM) $ markDisplayNeeded (blid b)+         | calmDelta == minusM1 -> do+           fact <- getsState $ (EM.! side) . sfactionD+           s <- getState+           let closeFoe (!p, aid2) =  -- mimics isHeardFoe+                 let b2 = getActorBody aid2 s+                 in inline chessDist p (bpos b) <= 3+                    && not (actorWaitsOrSleeps b2)  -- uncommon+                    && inline isFoe side fact (bfid b2)  -- costly+               anyCloseFoes = any closeFoe $ EM.assocs $ lbig+                                           $ sdungeon s EM.! blid b+           unless anyCloseFoes $ do  -- obvious where the feeling comes from+             duplicated <- aidVerbDuplicateMU MsgHeardNearby aid+                                              "hear something"+             unless duplicated stopPlayBack+         | otherwise ->  -- low deltas from hits; displayed elsewhere+           return ()+      when (calmDelta < 0) $ do+        sUIOptions <- getsSession sUIOptions+        currentWarning <-+          getsState $ checkWarningCalm sUIOptions aid (bcalm b)+        when currentWarning $ do+          previousWarning <-+            getsState $ checkWarningCalm sUIOptions aid (bcalm b - calmDelta)+          unless previousWarning $+            -- This messages is not shown if impression happens after+            -- Calm is low enough. However, this is rare and HUD shows the red.+            aidVerbMU MsgRiskOfDeath aid+                      "have grown agitated and impressed enough to be in danger of defecting"+  UpdTrajectory _ _ mt ->  -- if projectile dies just after, force one frame+    when (isNothing mt) $ pushFrame False+  -- Change faction attributes.+  UpdQuitFaction fid _ toSt manalytics -> quitFactionUI fid toSt manalytics+  UpdSpotStashFaction verbose fid lid pos -> do+    when verbose $ do+      side <- getsClient sside+      if fid == side then+        msgLnAdd MsgFactionIntel+                 "You set up the shared inventory stash of your team."+      else do+        fact <- getsState $ (EM.! fid) . sfactionD+        let fidName = MU.Text $ gname fact+        msgAdd MsgFactionIntel $+          makeSentence [ "you have found the current"+                       , MU.WownW fidName "hoard location" ]+    animate lid $ actorX pos+  UpdLoseStashFaction verbose fid lid pos -> do+    when verbose $ do+      side <- getsClient sside+      if fid == side then+        msgAdd MsgFactionIntel+               "You've lost access to your shared inventory stash!"+      else do+        fact <- getsState $ (EM.! fid) . sfactionD+        let fidName = MU.Text $ gname fact+        msgAdd MsgFactionIntel $+          makeSentence [fidName, "no longer control their hoard"]+    animate lid $ vanish pos+  UpdLeadFaction fid (Just source) mtgt@(Just target) -> do+    mleader <- getsClient sleader+    when (mtgt /= mleader) $ do+      fact <- getsState $ (EM.! fid) . sfactionD+      lidV <- viewedLevelUI+      when (isAIFact fact) $ markDisplayNeeded lidV+      -- This faction can't run with multiple actors, so this is not+      -- a leader change while running, but rather server changing+      -- their leader, which the player should be alerted to.+      when (noRunWithMulti fact) stopPlayBack+      actorD <- getsState sactorD+      case EM.lookup source actorD of+        Just sb | bhp sb <= 0 -> assert (not $ bproj sb) $ do+          -- Regardless who the leader is, give proper names here, not 'you'.+          sbUI <- getsSession $ getActorUI source+          tbUI <- getsSession $ getActorUI target+          let subject = partActor tbUI+              object  = partActor sbUI+          msgAdd MsgPointmanSwap $+            makeSentence [ MU.SubjectVerbSg subject "take command"+                         , "from", object ]+        _ -> return ()+      lookAtMove target+  UpdLeadFaction _ Nothing mtgt@(Just target) -> do+    mleader <- getsClient sleader+    when (mtgt /= mleader) $+      lookAtMove target+  UpdLeadFaction{} -> return ()+  UpdDiplFaction fid1 fid2 _ toDipl -> do+    name1 <- getsState $ gname . (EM.! fid1) . sfactionD+    name2 <- getsState $ gname . (EM.! fid2) . sfactionD+    let showDipl Unknown = "unknown to each other"+        showDipl Neutral = "in neutral diplomatic relations"+        showDipl Alliance = "allied"+        showDipl War = "at war"+    msgAdd MsgFactionIntel $+      name1 <+> "and" <+> name2 <+> "are now" <+> showDipl toDipl <> "."+  UpdDoctrineFaction{} -> return ()+  UpdAutoFaction fid b -> do+    side <- getsClient sside+    lidV <- viewedLevelUI+    markDisplayNeeded lidV+    when (fid == side) $ do+      unless b addPressedControlEsc  -- sets @swasAutomated@, enters main menu+      setFrontAutoYes b  -- now can stop auto-accepting prompts+  UpdRecordKill{} -> return ()+  -- Alter map.+  UpdAlterTile lid p fromTile toTile -> do+    COps{cotile} <- getsState scops+    markDisplayNeeded lid+    let feats = TK.tfeature $ okind cotile fromTile+        toAlter feat =+          case feat of+            TK.OpenTo tgroup -> Just tgroup+            TK.CloseTo tgroup -> Just tgroup+            TK.ChangeTo tgroup -> Just tgroup+            TK.OpenWith _ _ tgroup -> Just tgroup+            TK.CloseWith _ _ tgroup -> Just tgroup+            TK.ChangeWith _ _ tgroup -> Just tgroup+            _ -> Nothing+        groupsToAlterTo = mapMaybe toAlter feats+        freq = map fst $ filter (\(_, q) -> q > 0)+               $ TK.tfreq $ okind cotile toTile+        unexpected = null $ intersect freq groupsToAlterTo+    mactorAtPos <- getsState $ posToBig p lid+    mleader <- getsClient sleader+    when (unexpected || isJust mactorAtPos && mactorAtPos /= mleader) $ do+      -- Player notices @fromTile can't be altered into @toTIle@,+      -- which is uncanny, so we produce a message.+      -- This happens when the player missed an earlier search of the tile+      -- performed by another faction.+      let subject = ""  -- a hack, because we don't handle adverbs well+          verb = "turn into"+          msg = makeSentence $+            [ "the", MU.Text $ TK.tname $ okind cotile fromTile+            , "at position", MU.Text $ tshow p ]+            ++ ["suddenly" | unexpected]  -- adverb+            ++ [ MU.SubjectVerbSg subject verb+               , MU.AW $ MU.Text $ TK.tname $ okind cotile toTile ]+      msgAdd (if unexpected then MsgSpecialEvent else MsgNeutralEvent) msg+  UpdAlterExplorable lid _ -> markDisplayNeeded lid+  UpdAlterGold{} -> return ()  -- not displayed on HUD+  UpdSearchTile aid _p toTile -> do+    COps{cotile} <- getsState scops+    subject <- partActorLeader aid+    let fromTile = fromMaybe (error $ show toTile) $ Tile.hideAs cotile toTile+        subject2 = MU.Text $ TK.tname $ okind cotile fromTile+        object = MU.Text $ TK.tname $ okind cotile toTile+    let msg = makeSentence [ MU.SubjectVerbSg subject "reveal"+                           , "that the"+                           , MU.SubjectVerbSg subject2 "be"+                           , MU.AW object ]+    unless (subject2 == object) $ do+      msgAdd MsgTerrainReveal msg+      msgAdd MsgTutorialHint "Solid terrain drawn in pink is not fully known until searched. This is usually done by bumping into it, which also triggers effects and transformations the terrain is capable of. Once revealed, the terrain can be inspected in aiming mode started with the '*' key or with mouse."+  UpdHideTile{} -> return ()+  UpdSpotTile{} -> return ()+  UpdLoseTile{} -> return ()+  UpdSpotEntry{} -> return ()+  UpdLoseEntry{} -> return ()+  UpdAlterSmell{} -> return ()+  UpdSpotSmell{} -> return ()+  UpdLoseSmell{} -> return ()+  -- Assorted.+  UpdTimeItem{} -> return ()+  UpdAgeGame{} -> do+    sdisplayNeeded <- getsSession sdisplayNeeded+    sturnDisplayed <- getsSession sturnDisplayed+    time <- getsState stime+    let clipN = time `timeFit` timeClip+        clipMod = clipN `mod` clipsInTurn+        turnPing = clipMod == 0  -- e.g., to see resting counter+    if | sdisplayNeeded -> pushFrame True+           -- adds delay, because it's not an extra animation-like frame,+           -- but showing some real information accumulated up to this point+       | turnPing && not sturnDisplayed -> pushFrame False+       | otherwise -> return ()+    when turnPing $+      modifySession $ \sess -> sess {sturnDisplayed = False}+  UpdUnAgeGame{} -> return ()+  UpdDiscover c iid _ _ -> discover c iid+  UpdCover{} -> return ()  -- don't spam when doing undo+  UpdDiscoverKind{} -> return ()  -- don't spam when server tweaks stuff+  UpdCoverKind{} -> return ()  -- don't spam when doing undo+  UpdDiscoverAspect{} -> return ()  -- don't spam when server tweaks stuff+  UpdCoverAspect{} -> return ()  -- don't spam when doing undo+  UpdDiscoverServer{} -> error "server command leaked to client"+  UpdCoverServer{} -> error "server command leaked to client"+  UpdPerception{} -> return ()+  UpdRestart fid _ _ _ _ srandom -> do+    cops@COps{cocave, comode, corule} <- getsState scops+    oldSess <- getSession+    svictories <- getsClient svictories+    snxtChal <- getsClient snxtChal+    let uiOptions@UIOptions{uHistory1PerLine} = sUIOptions oldSess+        f !acc _p !i _a = i : acc+        modes = zip [0..] $ ofoldlGroup' comode CAMPAIGN_SCENARIO f []+        g :: (Int, ContentId ModeKind) -> Int+        g (_, mode) = case EM.lookup mode svictories of+          Nothing -> 0+          Just cm -> fromMaybe 0 (M.lookup snxtChal cm)+        (snxtScenario, _) = minimumBy (comparing g) modes+        nxtGameTutorial = MK.mtutorial $ snd $ nxtGameMode cops snxtScenario+    putSession $+      (emptySessionUI uiOptions)+        { schanF = schanF oldSess+        , sccui = sccui oldSess+        , shistory = shistory oldSess+        , snxtScenario+        , scurTutorial = snxtTutorial oldSess  -- quite random for screensavers+        , snxtTutorial = nxtGameTutorial+        , soverrideTut = soverrideTut oldSess+        , sstart = sstart oldSess+        , sgstart = sgstart oldSess+        , sallTime = sallTime oldSess+        , snframes = snframes oldSess+        , sallNframes = sallNframes oldSess+        , srandomUI = srandom+        }+    when (sstart oldSess == 0) resetSessionStart+    when (lengthHistory uHistory1PerLine (shistory oldSess) == 0) $ do+      let title = T.pack $ rtitle corule+      msgAdd MsgBookKeeping $ "Welcome to" <+> title <> "!"+      -- Generate initial history. Only for UI clients.+      shistory <- defaultHistory+      modifySession $ \sess -> sess {shistory}+    recordHistory  -- to ensure EOL even at creation of history+    lid <- getArenaUI+    lvl <- getLevel lid+    gameMode <- getGameMode+    curChal <- getsClient scurChal+    fact <- getsState $ (EM.! fid) . sfactionD+    let loneMode = case ginitial fact of+          [] -> True+          [(_, 1, _)] -> True+          _ -> False+    msgAdd MsgBookKeeping "-------------------------------------------------"+    recordHistory+    msgAdd MsgActionWarning+           ("New game started in" <+> mname gameMode <+> "mode.")+    msgAdd MsgPlotExposition $ mdesc gameMode+    let desc = cdesc $ okind cocave $ lkind lvl+    unless (T.null desc) $ do+      msgLnAdd MsgBackdropFocus "You take in your surroundings."+      msgAdd MsgBackdropInfo desc+    -- We can fool the player only once (per scenario), but let's not do it+    -- in the same way each time. TODO: PCG+    blurb <- rndToActionUI $ oneOf+      [ "You think you saw movement."+      , "Something catches your peripherial vision."+      , "You think you felt a tremor under your feet."+      , "A whiff of chilly air passes around you."+      , "You notice a draft just when it dies down."+      , "The ground nearby is stained along some faint lines."+      , "Scarce black motes slowly settle on the ground."+      , "The ground in the immediate area is empty, as if just swiped."+      ]+    msgLnAdd MsgBadMiscEvent blurb  -- being here is a bad turn of events+    when (cwolf curChal && not loneMode) $+      msgAdd MsgActionWarning "Being a lone wolf, you begin without companions."+    when (lengthHistory uHistory1PerLine (shistory oldSess) > 1) $+      fadeOutOrIn False+    setFrontAutoYes $ isAIFact fact+    -- Forget the furious keypresses when dying in the previous game.+    resetPressedKeys+    -- Help newbies when actors obscured by text and no obvious key to press:+    displayMore ColorFull "\nAre you up for the challenge?"+    msgAdd MsgPromptGeneric+           "A grand story starts right here! (Press '?' for context and help.)"+  UpdRestartServer{} -> return ()+  UpdResume fid _ -> do+    COps{cocave} <- getsState scops+    resetSessionStart+    fact <- getsState $ (EM.! fid) . sfactionD+    setFrontAutoYes $ isAIFact fact+    unless (isAIFact fact) $ do+      lid <- getArenaUI+      lvl <- getLevel lid+      gameMode <- getGameMode+      msgAdd MsgActionAlert $ "Continuing" <+> mname gameMode <> "."+      msgAdd MsgPromptGeneric $ mdesc gameMode+      let desc = cdesc $ okind cocave $ lkind lvl+      unless (T.null desc) $ do+        msgLnAdd MsgPromptFocus "You remember your surroundings."+        msgAdd MsgPromptGeneric desc+      displayMore ColorFull "\nAre you up for the challenge?"+      msgAdd MsgPromptGeneric+             "Prove yourself! (Press '?' for context and help.)"+  UpdResumeServer{} -> return ()+  UpdKillExit{} -> do+#ifdef USE_JSFILE+      -- Some browsers seem to trash Local Storage when page reloaded or closed+      -- or the browser closed, while they still internally finish the saving+      -- in the background, so wait 2s. If the exit is without a save,+      -- the wait is spurious, but it's not supposed to be common.+      -- TODO: replace the @liftIO@ with a @MonadClientUI@ delay function.+    liftIO $ threadDelay 2000000+#else+    liftIO $ threadDelay 200000+#endif+    -- The prompt is necessary to force frontend to show this before exiting.+    void $ displayMore ColorBW "Done."  -- in case it follows "Saving..."+    side <- getsClient sside+    debugPossiblyPrintUI $ "Client" <+> tshow side <+> "closing frontend."+    frontendShutdown+    debugPossiblyPrintUI $ "Client" <+> tshow side <+> "closed frontend."+  UpdWriteSave -> msgAdd MsgInnerWorkSpam "Saving backup."+  UpdHearFid _ distance hearMsg -> do+    mleader <- getsClient sleader+    case mleader of+      Just{} -> return ()  -- will display stuff when leader moves+      Nothing -> do+        lidV <- viewedLevelUI+        markDisplayNeeded lidV+        recordHistory+    msg <- ppHearMsg distance hearMsg+    let msgClass = case distance of+          Nothing -> MsgHeardOutside+          Just 0 -> MsgHeardNearby+          Just _ -> MsgHeardFaraway+    msgAdd msgClass msg+    case hearMsg of+      HearUpd UpdDestroyActor{} ->+        msgAdd MsgTutorialHint "Events out of your sight radius (as listed in the '#' skill menu) can sometimes be heard, depending on your hearing radius. Some, such as death shrieks, can always be heard regardless of skill and distance, including when they come from a different floor."+      HearTaunt{} ->+        msgAdd MsgTutorialHint "Enemies you can't see are sometimes heard yelling and emitting other noises. Whether you can hear them, depends on their distance and your hearing radius, as listed in the '#' skill menu."+      _ -> return ()++updateItemSlot :: MonadClientUI m => Container -> ItemId -> m ()+updateItemSlot c iid = do+  arItem <- getsState $ aspectRecordFromIid iid+  ItemSlots itemSlots <- getsSession sslots+  let slore = IA.loreFromContainer arItem c+      lSlots = itemSlots EM.! slore+  case lookup iid $ map swap $ EM.assocs lSlots of+    Nothing -> do+      let l = assignSlot lSlots+          f = EM.insert l iid+          newSlots = ItemSlots $ EM.adjust f slore itemSlots+      modifySession $ \sess -> sess {sslots = newSlots}+    Just _l -> return ()  -- slot already assigned++markDisplayNeeded :: MonadClientUI m => LevelId -> m ()+markDisplayNeeded lid = do+  lidV <- viewedLevelUI+  when (lidV == lid) $ modifySession $ \sess -> sess {sdisplayNeeded = True}++lookAtMove :: (MonadClient m, MonadClientUI m) => ActorId -> m ()+lookAtMove aid = do+  mleader <- getsClient sleader+  body <- getsState $ getActorBody aid+  side <- getsClient sside+  aimMode <- getsSession saimMode+  when (not (bproj body)+        && bfid body == side+        && isNothing aimMode) $ do  -- aiming does a more extensive look+    stashBlurb <- lookAtStash (blid body) (bpos body)+    (itemsBlurb, _) <- lookAtItems True (bpos body) aid Nothing+    let msgClass = if Just aid == mleader+                   then MsgAtFeetMajor+                   else MsgAtFeetMinor+        blurb = stashBlurb <+> itemsBlurb+    unless (T.null blurb) $+      msgAdd msgClass blurb+  fact <- getsState $ (EM.! bfid body) . sfactionD+  adjBigAssocs <- getsState $ adjacentBigAssocs body+  adjProjAssocs <- getsState $ adjacentProjAssocs body+  if not (bproj body) && bfid body == side then do+    let foe (_, b2) = isFoe (bfid body) fact (bfid b2)+        adjFoes = filter foe $ adjBigAssocs ++ adjProjAssocs+    unless (null adjFoes) stopPlayBack+  else when (isFoe (bfid body) fact side) $ do+    let our (_, b2) = bfid b2 == side+        adjOur = filter our adjBigAssocs+    unless (null adjOur) stopPlayBack++aidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)+          => a -> ActorId -> MU.Part -> m ()+aidVerbMU msgClass aid verb = do+  subject <- partActorLeader aid+  msgAdd msgClass $ makeSentence [MU.SubjectVerbSg subject verb]++aidVerbDuplicateMU :: (MonadClient m, MonadClientUI m, MsgShared a)+                   => a -> ActorId -> MU.Part -> m Bool+aidVerbDuplicateMU msgClass aid verb = do+  subject <- partActorLeader aid+  msgAddDuplicate msgClass (makeSentence [MU.SubjectVerbSg subject verb])++itemVerbMUGeneral :: MonadClientUI m+                  => Bool -> ItemId -> ItemQuant -> MU.Part -> Container+                  -> m Text+itemVerbMUGeneral verbose iid kit@(k, _) verb c = assert (k > 0) $ do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  lid <- getsState $ lidFromC c+  localTime <- getsState $ getLocalTime lid+  itemFull <- getsState $ itemToFull iid+  side <- getsClient sside+  factionD <- getsState sfactionD+  let arItem = aspectRecordFull itemFull+      partItemWsChosen | verbose = partItemWs+                       | otherwise = partItemWsShort+      subject = partItemWsChosen rwidth side factionD k localTime itemFull kit+      msg | k > 1 && not (IA.checkFlag Ability.Condition arItem) =+              makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes subject verb]+          | otherwise = makeSentence [MU.SubjectVerbSg subject verb]+  return $! msg++itemVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)+           => a -> ItemId -> ItemQuant -> MU.Part -> Container -> m ()+itemVerbMU msgClass iid kit verb c = do+  msg <- itemVerbMUGeneral True iid kit verb c+  msgAdd msgClass msg++itemVerbMUShort :: (MonadClient m, MonadClientUI m, MsgShared a)+                => a -> ItemId -> ItemQuant -> MU.Part -> Container+                -> m ()+itemVerbMUShort msgClass iid kit verb c = do+  msg <- itemVerbMUGeneral False iid kit verb c+  msgAdd msgClass msg++itemAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)+              => a -> ActorId -> MU.Part -> ItemId -> Either Int Int+              -> m ()+itemAidVerbMU msgClass aid verb iid ek = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  body <- getsState $ getActorBody aid+  side <- getsClient sside+  factionD <- getsState sfactionD+  let lid = blid body+      fakeKit = quantSingle+  localTime <- getsState $ getLocalTime lid+  subject <- partActorLeader aid+  -- The item may no longer be in @c@, but it was.+  itemFull <- getsState $ itemToFull iid+  let object = case ek of+        Left n ->+          partItemWs rwidth side factionD n localTime itemFull fakeKit+        Right n ->+          let (name1, powers) =+                partItemShort rwidth side factionD localTime itemFull fakeKit+          in MU.Phrase ["the", MU.Car1Ws n name1, powers]+      msg = makeSentence [MU.SubjectVerbSg subject verb, object]+  msgAdd msgClass msg++mitemAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)+               => a -> ActorId -> MU.Part -> ItemId -> Maybe MU.Part+               -> m ()+mitemAidVerbMU msgClass aid verb iid msuffix = do+  itemD <- getsState sitemD+  case msuffix of+    Just suffix | iid `EM.member` itemD ->+      itemAidVerbMU msgClass aid (MU.Phrase [verb, suffix]) iid (Right 1)+    _ -> do+#ifdef WITH_EXPENSIVE_ASSERTIONS+      side <- getsClient sside+      b <- getsState $ getActorBody aid+      bUI <- getsSession $ getActorUI aid+      -- It's not actually expensive, but it's particularly likely+      -- to fail with wild content, indicating server game rules logic+      -- needs to be fixed/extended.+      -- Observer from another faction may receive the effect information+      -- from the server, because the affected actor is visible,+      -- but the position of the item may be out of FOV. This is fine;+      -- the message is then shorter, because only the effect was seen,+      -- while the cause remains misterious.+      assert (isNothing msuffix  -- item description not requested+              || bfid b /= side  -- not from affected faction; only observing+              `blame` "item never seen by the affected actor"+              `swith` (aid, b, bUI, verb, iid, msuffix)) $+#endif+        aidVerbMU msgClass aid verb++itemAidDistinctMU :: (MonadClient m, MonadClientUI m)+                  => MsgClassDistinct -> ActorId -> MU.Part -> MU.Part -> ItemId+                  -> m ()+itemAidDistinctMU msgClass aid verbShow verbSave iid = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  body <- getsState $ getActorBody aid+  side <- getsClient sside+  factionD <- getsState sfactionD+  let lid = blid body+      fakeKit = quantSingle+  localTime <- getsState $ getLocalTime lid+  subject <- partActorLeader aid+  -- The item may no longer be in @c@, but it was.+  itemFull <- getsState $ itemToFull iid+  let object = let (name, powers) =+                     partItem rwidth side factionD localTime itemFull fakeKit+               in MU.Phrase [name, powers]+      t1 = makeSentence [MU.SubjectVerbSg subject verbShow, object]+      t2 = makeSentence [MU.SubjectVerbSg subject verbSave, object]+      dotsIfShorter = if t1 == t2 then "" else ".."+  msgAddDistinct msgClass (t1 <> dotsIfShorter, t2)++manyItemsAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)+                   => a -> ActorId -> MU.Part+                   -> [(ItemId, ItemQuant)] -> (Int -> Either (Maybe Int) Int)+                   -> m ()+manyItemsAidVerbMU msgClass aid verb sortedAssocs ekf = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  body <- getsState $ getActorBody aid+  side <- getsClient sside+  factionD <- getsState sfactionD+  let lid = blid body+      fakeKit = quantSingle+  localTime <- getsState $ getLocalTime lid+  subject <- partActorLeader aid+  -- The item may no longer be in @c@, but it was.+  itemToF <- getsState $ flip itemToFull+  let object (iid, (k, _)) =+        let itemFull = itemToF iid+        in case ekf k of+          Left (Just n) ->+            partItemWs rwidth side factionD n localTime itemFull fakeKit+          Left Nothing ->+            let (name, powers) =+                  partItem rwidth side factionD localTime itemFull fakeKit+            in MU.Phrase [name, powers]+          Right n ->+            let (name1, powers) =+                  partItemShort rwidth side factionD localTime itemFull fakeKit+            in MU.Phrase ["the", MU.Car1Ws n name1, powers]+      msg = makeSentence [ MU.SubjectVerbSg subject verb+                         , MU.WWandW $ map object sortedAssocs]+  msgAdd msgClass msg++createActorUI :: (MonadClient m, MonadClientUI m)+              => Bool -> ActorId -> Actor -> m ()+createActorUI born aid body = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  side <- getsClient sside+  when (bfid body == side && not (bproj body)) $ do+    let upd = ES.insert aid+    modifySession $ \sess -> sess {sselected = upd $ sselected sess}+  factionD <- getsState sfactionD+  let fact = factionD EM.! bfid body+  localTime <- getsState $ getLocalTime $ blid body+  itemFull@ItemFull{itemBase, itemKind} <- getsState $ itemToFull (btrunk body)+  actorUI <- getsSession sactorUI+  let arItem = aspectRecordFull itemFull+  unless (aid `EM.member` actorUI) $ do+    UIOptions{uHeroNames} <- getsSession sUIOptions+    let baseColor = flavourToColor $ jflavour itemBase+        basePronoun | not (bproj body)+                      && IK.isymbol itemKind == '@'+                      && fhasGender (gplayer fact) = "he"+                    | otherwise = "it"+        nameFromNumber fn k = if k == 0+                              then makePhrase [MU.Ws $ MU.Text fn, "Captain"]+                              else fn <+> tshow k+        heroNamePronoun k =+          if gcolor fact /= Color.BrWhite+          then (nameFromNumber (fname $ gplayer fact) k, "he")+          else fromMaybe (nameFromNumber (fname $ gplayer fact) k, "he")+               $ lookup k uHeroNames+        (n, bsymbol) =+          if | bproj body -> (0, if IA.checkFlag Ability.Blast arItem+                                 then IK.isymbol itemKind+                                 else '*')+             | baseColor /= Color.BrWhite -> (0, IK.isymbol itemKind)+             | otherwise -> case bnumber body of+                 Nothing ->+                   error $ "numbered actor without server-assigned number"+                           `showFailure` (aid, body)+                 Just bn -> (bn, if 0 < bn && bn < 10+                                 then Char.intToDigit bn+                                 else '@')+        (object1, object2) =+          partItemShortest rwidth (bfid body) factionD localTime+                           itemFull quantSingle+        (bname, bpronoun) =+          if | bproj body ->+               let adj = case btrajectory body of+                     Just (tra, _) | length tra < 5 -> "falling"+                     _ -> "flying"+               in (makePhrase [adj, object1, object2], basePronoun)+             | baseColor /= Color.BrWhite ->+               (makePhrase [object1, object2], basePronoun)+             | otherwise -> heroNamePronoun n+        bcolor | bproj body = if IA.checkFlag Ability.Blast arItem+                              then baseColor+                              else Color.BrWhite+               | baseColor == Color.BrWhite = gcolor fact+               | otherwise = baseColor+        bUI = ActorUI{..}+    modifySession $ \sess ->+      sess {sactorUI = EM.insert aid bUI actorUI}+  let (verb, joinYou) =+        if born+        then if bfid body == side+             then ("join you", True)+             else ("appear suddenly", False)+        else ("be spotted", False)+  mapM_ (\(iid, store) -> do+           let c = if not (bproj body) && iid == btrunk body+                   then CTrunk (bfid body) (blid body) (bpos body)+                   else CActor aid store+           updateItemSlot c iid+           recordItemLid iid c)+        ((btrunk body, CEqp)  -- store will be overwritten, unless projectile+         : filter ((/= btrunk body) . fst) (getCarriedIidCStore body))+  -- Don't spam if the actor was already visible (but, e.g., on a tile that is+  -- invisible this turn (in that case move is broken down to lose+spot)+  -- or on a distant tile, via teleport while the observer teleported, too).+  lastLost <- getsSession slastLost+  firstEnemy <-+    if bfid body /= side then do+      firstE <-+        if not (bproj body) && isFoe (bfid body) fact side then do+          -- Aim even if nobody can shoot at the enemy. Let's home in on him+          -- and then we can aim or melee. We set permit to False, because it's+          -- technically very hard to check aimability here, because we are+          -- in-between turns and, e.g., leader's move has not yet been taken+          -- into account.+          xhair <- getsSession sxhair+          case xhair of+            Just (TVector _) -> return ()  -- explicitly set; keep it+            _ -> modifySession $ \sess ->+                   sess { sxhair = Just $ TEnemy aid+                        , sitemSel = Nothing } -- reset flinging totally+          foes <- getsState $ foeRegularList side (blid body)+          itemsSize <- getsState $ guardItemSize body+          if ES.member aid lastLost+          then return False+          else if length foes > 1+               then do+                 when (itemsSize > 0) $ do+                   msgAdd MsgSpottedThreat "Another armed threat!"+                 return False+               else do+                 if itemsSize > 0+                 then msgAdd MsgSpottedThreat "Armed intrusion ahead!"+                 else msgAdd MsgSpottedThreat "You are not alone!"+                 return True+        else return False+      stopPlayBack+      return firstE+    else return False+  if | EM.null actorUI && bfid body == side ->+       return ()  -- don't speak about yourself in 3rd person+     | born && bproj body ->+         pushFrame False  -- make sure first position displayed+     | ES.member aid lastLost || bproj body -> markDisplayNeeded (blid body)+     | otherwise -> do+       aidVerbMU MsgSpottedActor aid verb+       if | joinYou -> msgAdd MsgTutorialHint "You survive this mission, or die trying, as a team. After a few moves, feel free to switch the controlled teammate (marked on the map with the yellow box) using the Tab key to another party member (marked with a green box)."  -- assuming newbies don't remap their keys+          | firstEnemy -> msgAdd MsgTutorialHint "Enemies can be dealt with using melee (by bumping), ranged combat, terrain effects, stealth (not being seen) or hasty retreat (particularly if they are asleep)."+          | otherwise -> return ()+       animate (blid body) $ actorX (bpos body)++destroyActorUI :: (MonadClient m, MonadClientUI m)+               => Bool -> ActorId -> Actor -> m ()+destroyActorUI destroy aid b = do+  trunk <- getsState $ getItemBody $ btrunk b+  let baseColor = flavourToColor $ jflavour trunk+  unless (baseColor == Color.BrWhite) $  -- keep setup for heroes, etc.+    modifySession $ \sess -> sess {sactorUI = EM.delete aid $ sactorUI sess}+  let dummyTarget = TPoint TKnown (blid b) (bpos b)+      affect tgt = case tgt of+        Just (TEnemy a) | a == aid -> Just $+          if destroy then+            -- If *really* nothing more interesting, the actor will+            -- go to last known location to perhaps find other foes.+            dummyTarget+          else+            -- If enemy only hides (or we stepped behind obstacle) find him.+            TPoint (TEnemyPos a) (blid b) (bpos b)+        Just (TNonEnemy a) | a == aid -> Just dummyTarget+        _ -> tgt+  modifySession $ \sess -> sess {sxhair = affect $ sxhair sess}+  unless (bproj b) $+    modifySession $ \sess -> sess {slastLost = ES.insert aid $ slastLost sess}+  side <- getsClient sside+  fact <- getsState $ (EM.! side) . sfactionD+  let gameOver = isJust $ gquit fact  -- we are the UI faction, so we determine+  unless gameOver $ do+    when (bfid b == side && not (bproj b)) $ do+      stopPlayBack+      let upd = ES.delete aid+      modifySession $ \sess -> sess {sselected = upd $ sselected sess}+      when destroy $ do+        mleader <- getsClient sleader+        when (isJust mleader)+          -- This is especially handy when the dead actor was a leader+          -- on a different level than the new one:+          clearAimMode+    -- If pushed, animate spotting again, to draw attention to pushing.+    markDisplayNeeded (blid b)++spotItemBag :: forall m. (MonadClient m, MonadClientUI m)+            => Bool -> Container -> ItemBag -> m ()+spotItemBag verbose c bag = do+  -- This is due to a move, or similar, which will be displayed,+  -- so no extra @markDisplayNeeded@ needed here and in similar places.+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  side <- getsClient sside+  getKind <- getsState $ flip getIidKindId+  lid <- getsState $ lidFromC c+  localTime <- getsState $ getLocalTime lid+  factionD <- getsState sfactionD+  -- Queried just once, so many copies of a new item can be reported. OK.+  ItemSlots itemSlots <- getsSession sslots+  sxhairOld <- getsSession sxhair+  let resetXhair = case c of+        CFloor _ p -> case sxhairOld of+          Just TEnemy{} -> return ()  -- probably too important to overwrite+          Just (TPoint TEnemyPos{} _ _) -> return ()+          Just (TPoint TStash{} _ _) -> return ()+          Just (TVector _) -> return ()  -- explicitly set; keep it+          _ -> do+            -- Don't steal xhair if it's only an item on another level.+            -- For enemies, OTOH, capture xhair to alarm player.+            lidV <- viewedLevelUI+            when (lid == lidV) $ do+              bagFloor <- getsState $ getFloorBag lid p+              modifySession $ \sess ->+                sess { sxhair = Just $ TPoint (TItem bagFloor) lidV p+                     , sitemSel = Nothing }  -- reset flinging totally+        _ -> return ()+      locatedWhere = ppContainer factionD c+      beLocated = MU.Text $+        "be located" <+> if locatedWhere == ppContainer EM.empty c+                         then ""  -- boring+                         else locatedWhere+      subjectMaybe :: (ItemId, ItemQuant) -> m (Maybe (Int, MU.Part, MU.Part))+      subjectMaybe (iid, kit@(k, _)) = do+        recordItemLid iid c+        itemFull <- getsState $ itemToFull iid+        let arItem = aspectRecordFull itemFull+            slore = IA.loreFromContainer arItem c+        case lookup iid $ map swap $ EM.assocs $ itemSlots EM.! slore of+          Nothing -> do  -- never seen or would have a slot+            updateItemSlot c iid+            case c of+              CFloor{} -> do+                let subjectShort = partItemWsShortest rwidth side factionD k+                                                      localTime itemFull kit+                    subjectLong = partItemWsLong rwidth side factionD k+                                                 localTime itemFull kit+                return $ Just (k, subjectShort, subjectLong)+              _ -> return Nothing+          _ -> return Nothing  -- this item or another with the same @iid@+                               -- seen already (has a slot assigned); old news+      -- @SortOn@ less efficient here, because function cheap.+      sortItems iis = sortOn (getKind . fst) iis+      sortedAssocs = sortItems $ EM.assocs bag+  subjectMaybes <- mapM subjectMaybe sortedAssocs+  let subjects = catMaybes subjectMaybes+      sendMsg plural = do+        let subjectShort = MU.WWandW $ map (\(_, part, _) -> part) subjects+            subjectLong = MU.WWandW $ map (\(_, _, part) -> part) subjects+            msg subject =+              if plural+              then makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes+                                                subject beLocated]+              else makeSentence [MU.SubjectVerbSg subject beLocated]+            msgShort = msg subjectShort+            msgLong = msg subjectLong+            dotsIfShorter = if msgShort == msgLong then "" else ".."+        resetXhair+        msgAddDistinct MsgSpottedItem (msgShort <> dotsIfShorter, msgLong)+  case subjects of+    [] -> return ()+    [(1, _, _)] -> sendMsg False+    _ -> sendMsg True+  when verbose $ case c of+    CActor aid store -> do+      let verb = MU.Text $ verbCStore store+      b <- getsState $ getActorBody aid+      fact <- getsState $ (EM.! bfid b) . sfactionD+      let underAI = isAIFact fact+      mleader <- getsClient sleader+      if Just aid == mleader && not underAI then+        manyItemsAidVerbMU MsgItemMovement aid verb sortedAssocs Right+      else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops+        manyItemsAidVerbMU MsgItemMovement aid verb sortedAssocs (Left . Just)+    _ -> return ()++recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()+recordItemLid iid c = do+  mjlid <- getsSession $ EM.lookup iid . sitemUI+  when (isNothing mjlid) $ do+    lid <- getsState $ lidFromC c+    modifySession $ \sess ->+      sess {sitemUI = EM.insert iid lid $ sitemUI sess}++moveActor :: (MonadClient m, MonadClientUI m)+          => ActorId -> Point -> Point -> m ()+moveActor aid source target = do+  -- If source and target tile distant, assume it's a teleportation+  -- and display an animation. Note: jumps and pushes go through all+  -- intervening tiles, so won't be considered. Note: if source or target+  -- not seen, the (half of the) animation would be boring, just a delay,+  -- not really showing a transition, so we skip it (via 'breakUpdAtomic').+  -- The message about teleportation is sometimes shown anyway, just as the X.+  body <- getsState $ getActorBody aid+  if adjacent source target+  then markDisplayNeeded (blid body)+  else do+    let ps = (source, target)+    animate (blid body) $ teleport ps+  lookAtMove aid++displaceActorUI :: (MonadClient m, MonadClientUI m)+                => ActorId -> ActorId -> m ()+displaceActorUI source target = do+  mleader <- getsClient sleader+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  spart <- partActorLeader source+  tpart <- partActorLeader target+  let msgClass = if mleader `elem` map Just [source, target]+                 then MsgActionMajor  -- to interrupt run after a displace;+                 else MsgActionMinor  -- configurable+      msg = makeSentence [MU.SubjectVerbSg spart "displace", tpart]+  msgAdd msgClass msg+  lookAtMove source+  when (bfid sb /= bfid tb) $+    lookAtMove target  -- in case only this one is ours+  side <- getsClient sside+  -- Ours involved, but definitely not requested by player via UI.+  when (side `elem` [bfid sb, bfid tb] && mleader /= Just source) stopPlayBack+  let ps = (bpos tb, bpos sb)+  animate (blid sb) $ swapPlaces ps++-- @UpdMoveItem@ is relatively rare (except within the player's faction),+-- but it ensures that even if only one of the stores is visible+-- (e.g., stash floor is not or actor posision is not), some messages+-- will be printed (via verbose @UpdLoseItem@).+moveItemUI :: (MonadClient m, MonadClientUI m)+           => ItemId -> Int -> ActorId -> CStore -> CStore+           -> m ()+moveItemUI iid k aid cstore1 cstore2 = do+  let verb = MU.Text $ verbCStore cstore2+  b <- getsState $ getActorBody aid+  fact <- getsState $ (EM.! bfid b) . sfactionD+  let underAI = isAIFact fact+  mleader <- getsClient sleader+  ItemSlots itemSlots <- getsSession sslots+  case lookup iid $ map swap $ EM.assocs $ itemSlots EM.! SItem of+    Just _l ->+      -- So far organs can't be put into stash, so no need to call+      -- @updateItemSlot@ to add or reassign lore category.+      if cstore1 == CGround && Just aid == mleader && not underAI then+        itemAidVerbMU MsgItemMovement aid verb iid (Right k)+      else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops+        itemAidVerbMU MsgItemMovement aid verb iid (Left k)+    Nothing -> error $+      "" `showFailure` (iid, k, aid, cstore1, cstore2)++quitFactionUI :: (MonadClient m, MonadClientUI m)+              => FactionId -> Maybe Status+              -> Maybe (FactionAnalytics, GenerationAnalytics)+              -> m ()+quitFactionUI fid toSt manalytics = do+  ClientOptions{sexposeItems} <- getsClient soptions+  fact <- getsState $ (EM.! fid) . sfactionD+  let fidName = MU.Text $ gname fact+      person = if fhasGender $ gplayer fact then MU.PlEtc else MU.Sg3rd+      horror = isHorrorFact fact+      camping = maybe True ((== Camping) . stOutcome) toSt+  side <- getsClient sside+  when (fid == side && not camping) $ do+    tellGameClipPS+    resetGameStart+  gameMode <- getGameMode+  allNframes <- getsSession sallNframes+  let startingPart = case toSt of+        _ | horror -> Nothing  -- Ignore summoned actors' factions.+        Just Status{stOutcome=stOutcome@Restart, stNewGame=Just gn} ->+          Just $ MU.Text $ nameOutcomeVerb stOutcome+                           <+> "to restart in" <+> fromGroupName gn <+> "mode"+                             -- when multiplayer: "order mission restart in"+        Just Status{stOutcome=Restart, stNewGame=Nothing} ->+          error $ "" `showFailure` (fid, toSt)+        Just Status{stOutcome} -> Just $ MU.Text $ nameOutcomeVerb stOutcome+          -- when multiplayer, for @Camping@: "order save and exit"+        Nothing -> Nothing+      middlePart = case toSt of+        _ | fid /= side -> Nothing+        Just Status{stOutcome} -> lookup stOutcome $ mendMsg gameMode+        Nothing -> Nothing+      partingPart = if fid /= side || allNframes == -1+                    then Nothing+                    else endMessageOutcome . stOutcome <$> toSt+  case startingPart of+    Nothing -> return ()+    Just sp ->+      let blurb = makeSentence [MU.SubjectVerb person MU.Yes fidName sp]+      in msgLnAdd MsgFinalOutcome blurb+  case (toSt, partingPart) of+    (Just status, Just pp) -> do+      noConfirmsGame <- isNoConfirmsGame+      go <- if noConfirmsGame+            then return False+            else displaySpaceEsc ColorFull ""  -- short, just @startingPart@+      recordHistory+        -- we are going to exit or restart, so record and clear, but only once+      (itemBag, total) <- getsState $ calculateTotal side+      when go $ do+        case middlePart of+          Nothing -> return ()+          Just sp1 -> do+            factionD <- getsState sfactionD+            itemToF <- getsState $ flip itemToFull+            let getTrunkFull (aid, b) = (aid, itemToF $ btrunk b)+            ourTrunks <- getsState $ map getTrunkFull+                                     . fidActorNotProjGlobalAssocs side+            let smartFaction fact2 = fleaderMode (gplayer fact2) /= LeaderNull+                canBeSmart = any (smartFaction . snd)+                canBeOurFaction = any (\(fid2, _) -> fid2 == side)+                smartEnemy trunkFull =+                  let possible =+                        possibleActorFactions (itemKind trunkFull) factionD+                  in not (canBeOurFaction possible) && canBeSmart possible+                smartEnemiesOurs = filter (smartEnemy . snd) ourTrunks+                uniqueActor trunkFull = IA.checkFlag Ability.Unique+                                        $ aspectRecordFull trunkFull+                uniqueEnemiesOurs = filter (uniqueActor . snd) smartEnemiesOurs+                smartUniqueEnemyCaptured = not $ null uniqueEnemiesOurs+                smartEnemyCaptured = not $ null smartEnemiesOurs+            smartEnemySentence <- case uniqueEnemiesOurs ++ smartEnemiesOurs of+              [] -> return ""+              (enemyAid, _) : _ -> do+                bUI <- getsSession $ getActorUI enemyAid+                return $! makePhrase [MU.Capitalize (partActor bUI)] <> "?"+            let won = maybe False ((`elem` victoryOutcomes) . stOutcome) toSt+                lost = maybe False ((`elem` deafeatOutcomes) . stOutcome) toSt+                msgClass | won = MsgGoodMiscEvent+                         | lost = MsgBadMiscEvent+                         | otherwise = MsgNeutralEvent+                (sp2, escPrompt) =+                  if | lost -> ("", "Accept the unacceptable?")+                     | smartUniqueEnemyCaptured ->+                       ( "\nOh, wait, who is this, towering behind your escaping crew?" <+> smartEnemySentence <+> "This changes everything. For everybody. Everywhere. Forever. Did you plan for this? Are you sure it was your idea?"+                       , "What happens now?" )+                     | smartEnemyCaptured ->+                       ( "\nOh, wait, who is this, hunched among your escaping crew?" <+> smartEnemySentence <+> "Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again."+                       , "How will you play that move?" )+                     | otherwise -> ("", "Let's see what we've got here.")+            msgAdd msgClass sp1+            msgAdd MsgFactionIntel sp2+            void $ displaySpaceEsc ColorFull escPrompt+        case manalytics of+          Nothing -> return ()+          Just (factionAn, generationAn) ->+            cycleLore []+              [ displayGameOverLoot (itemBag, total) generationAn+              , displayGameOverLore SOrgan True generationAn+              , displayGameOverAnalytics factionAn generationAn+              , displayGameOverLore SCondition sexposeItems generationAn+              , displayGameOverLore SBlast True generationAn+              , displayGameOverLore SEmbed True generationAn ]+      unless noConfirmsGame $ do+        -- Show score for any UI client after any kind of game exit,+        -- even though it's saved only for human UI clients at game over+        -- (that is not a noConfirms or benchmark game).+        scoreSlides <- scoreToSlideshow total status+        void $ getConfirms ColorFull [K.spaceKM, K.escKM] scoreSlides+      -- The last prompt stays onscreen during shutdown, etc.+      when (not noConfirmsGame || camping) $ do+        msgAdd MsgPromptGeneric pp+        when camping $ msgAdd MsgPromptGeneric "Saving..."+        pushFrame False  -- don't leave frozen prompts on the browser screen+    _ -> when (isJust startingPart && (stOutcome <$> toSt) == Just Killed) $+      -- Needed not to overlook the competitor dying in raid scenario.+      displayMore ColorFull ""++displayGameOverLoot :: (MonadClient m, MonadClientUI m)+                    => (ItemBag, Int) -> GenerationAnalytics -> m K.KM+displayGameOverLoot (heldBag, total) generationAn = do+  ClientOptions{sexposeItems} <- getsClient soptions+  COps{coitem} <- getsState scops+  ItemSlots itemSlots <- getsSession sslots+  -- We assume "gold grain", not "grain" with label "of gold":+  let currencyName = IK.iname $ okind coitem $ ouniqGroup coitem IK.S_CURRENCY+      lSlotsRaw = EM.filter (`EM.member` heldBag) $ itemSlots EM.! SItem+      generationItem = generationAn EM.! SItem+      (itemBag, lSlots) =+        if sexposeItems+        then let generationBag = EM.map (\k -> (-k, [])) generationItem+                 bag = heldBag `EM.union` generationBag+                 slots = EM.fromDistinctAscList $ zip allSlots $ EM.keys bag+             in (bag, slots)+        else (heldBag, lSlotsRaw)+      promptFun iid itemFull2 k =+        let worth = itemPrice 1 $ itemKind itemFull2+            lootMsg = if worth == 0 then "" else+              let pile = if k == 1 then "exemplar" else "hoard"+              in makeSentence $+                   ["this treasure", pile, "is worth"]+                   ++ (if k > 1 then [ MU.Cardinal k, "times"] else [])+                   ++ [MU.CarWs worth $ MU.Text currencyName]+            holdsMsg =+              let n = generationItem EM.! iid+              in if | max 0 k == 1 && n == 1 ->+                      "You keep the only specimen extant:"+                    | max 0 k == 0 && n == 1 ->+                      "You don't have the only hypothesized specimen:"+                    | max 0 k == 0 && n == 0 ->+                      "No such specimen was recorded:"+                    | otherwise ->+                        makePhrase [ "You hold"+                                   , if k == n+                                     then "all pieces"+                                     else MU.CardinalAWs (max 0 k) "piece"+                                   , "out of"+                                   , MU.Car n+                                   , "scattered:" ]+        in lootMsg <+> holdsMsg+  dungeonTotal <- getsState sgold+  let promptGold = spoilsBlurb currencyName total dungeonTotal+      -- Total number of items is meaningless in the presence of so much junk.+      prompt =+        promptGold+        <+> (if sexposeItems+             then "Non-positive count means none held but this many generated."+             else "")+      examItem = displayItemLore itemBag 0 promptFun+  viewLoreItems "GameOverLoot" lSlots itemBag prompt examItem True++displayGameOverAnalytics :: (MonadClient m, MonadClientUI m)+                         => FactionAnalytics -> GenerationAnalytics+                         -> m K.KM+displayGameOverAnalytics factionAn generationAn = do+  ClientOptions{sexposeActors} <- getsClient soptions+  side <- getsClient sside+  ItemSlots itemSlots <- getsSession sslots+  let ourAn = akillCounts+              $ EM.findWithDefault emptyAnalytics side factionAn+      foesAn = EM.unionsWith (+)+               $ concatMap EM.elems $ catMaybes+               $ map (`EM.lookup` ourAn) [KillKineticMelee .. KillOtherPush]+      trunkBagRaw = EM.map (, []) foesAn+      lSlotsRaw = EM.filter (`EM.member` trunkBagRaw) $ itemSlots EM.! STrunk+      killedBag = EM.fromList $ map (\iid -> (iid, trunkBagRaw EM.! iid))+                                    (EM.elems lSlotsRaw)+      generationTrunk = generationAn EM.! STrunk+      (trunkBag, lSlots) =+        if sexposeActors+        then let generationBag = EM.map (\k -> (-k, [])) generationTrunk+                 bag = killedBag `EM.union` generationBag+                 slots = EM.fromDistinctAscList $ zip allSlots $ EM.keys bag+             in (bag, slots)+        else (killedBag, lSlotsRaw)+      total = sum $ filter (> 0) $ map fst $ EM.elems trunkBag+      -- Not just "killed 1 out of 4", because it's sometimes "2 out of 1",+      -- if an enemy was revived.+      promptFun :: ItemId -> ItemFull-> Int -> Text+      promptFun iid _ k =+        let n = generationTrunk EM.! iid+        in makePhrase [ "You recall the adversary, which you killed on"+                      , MU.CarWs (max 0 k) "occasion", "while reports mention"+                      , MU.CarWs n "individual", "in total:" ]+      prompt =+        makeSentence ["your team vanquished", MU.CarWs total "adversary"]+          -- total reported would include our own, so not given+        <+> (if sexposeActors+             then "Non-positive count means none killed but this many reported."+             else "")+      examItem = displayItemLore trunkBag 0 promptFun+  viewLoreItems "GameOverAnalytics" lSlots trunkBag prompt examItem False++displayGameOverLore :: (MonadClient m, MonadClientUI m)+                    => SLore -> Bool -> GenerationAnalytics -> m K.KM+displayGameOverLore slore exposeCount generationAn = do+  let generationLore = generationAn EM.! slore+      generationBag = EM.map (\k -> (if exposeCount then k else 1, []))+                             generationLore+      total = sum $ map fst $ EM.elems generationBag+      slots = EM.fromDistinctAscList $ zip allSlots $ EM.keys generationBag+      promptFun :: ItemId -> ItemFull-> Int -> Text+      promptFun _ _ k =+        makeSentence+          [ "this", MU.Text (ppSLore slore), "manifested during your quest"+          , MU.CarWs k "time" ]+      verb = if slore `elem` [SCondition, SBlast]+             then "experienced"+             else "saw"+      prompt | total == 0 =+               makeSentence [ "you didn't experience any"+                            , MU.Ws $ MU.Text (headingSLore slore)+                            , "this time" ]+             | otherwise =+               makeSentence [ "you", verb, "the following variety of"+                            , MU.CarWs total $ MU.Text (headingSLore slore) ]+      examItem = displayItemLore generationBag 0 promptFun+      displayRanged = slore `notElem` [SOrgan, STrunk]+  viewLoreItems ("GameOverLore" ++ show slore)+                slots generationBag prompt examItem displayRanged++-- The item may be used up already and so not present in the container,+-- e.g., if the item destroyed itself. This is OK. Message is still needed.+discover :: (MonadClient m, MonadClientUI m) => Container -> ItemId -> m ()+discover c iid = do+  COps{coitem} <- getsState scops+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  lid <- getsState $ lidFromC c+  globalTime <- getsState stime+  localTime <- getsState $ getLocalTime lid+  itemFull <- getsState $ itemToFull iid+  bag <- getsState $ getContainerBag c+  side <- getsClient sside+  factionD <- getsState sfactionD+  (noMsg, nameWhere) <- case c of+    CActor aidOwner storeOwner -> do+      bOwner <- getsState $ getActorBody aidOwner+      name <- if bproj bOwner+              then return []+              else ppContainerWownW partActorLeader True c+      let arItem = aspectRecordFull itemFull+          inMetaGame = IA.checkFlag Ability.MetaGame arItem+          isOurOrgan = bfid bOwner == side+                       && storeOwner == COrgan+                       && not inMetaGame+            -- assume own faction organs known intuitively,+            -- except backstories and other meta game items+      return (isOurOrgan, name)+    CTrunk _ _ p | p == originPoint -> return (True, [])+      -- the special reveal at game over, using fake @CTrunk@; don't spam+    _ -> return (False, [])+  let kit = EM.findWithDefault quantSingle iid bag+              -- may be used up by that time+      knownName = makePhrase+        [partItemMediumAW rwidth side factionD localTime itemFull kit]+      flav = flavourToName $ jflavour $ itemBase itemFull+      (object1, object2) =+        partItemShortest rwidth side factionD localTime itemFull kit+      name1 = makePhrase [object1, object2]+      -- Make sure the two names in the message differ.+      (ikObvious, itemKind) = case jkind $ itemBase itemFull of+        IdentityObvious ik -> (True, ik)+        IdentityCovered _ix ik -> (False, ik)+          -- fake kind (template); OK, we talk about appearances+      name2 = IK.iname $ okind coitem itemKind+      name = if ikObvious && T.unwords (tail (T.words knownName)) /= name1+             then name1  -- avoid "a pair turns out to be"+             else name2  -- avoid "chip of scientific explanation"+      unknownName = MU.Phrase $ [MU.Text flav, MU.Text name] ++ nameWhere+      msg = makeSentence+        [ "the"+        , MU.SubjectVerbSg unknownName "turn out to be"+        , MU.Text knownName ]+  unless (noMsg || globalTime == timeZero) $  -- no spam about initial equipment+    msgAdd MsgItemDiscovery msg++ppHearMsg :: MonadClientUI m => Maybe Int -> HearMsg -> m Text+ppHearMsg distance hearMsg = case hearMsg of+  HearUpd cmd -> do+    COps{coTileSpeedup} <- getsState scops+    let sound = case cmd of+          UpdDestroyActor{} -> "shriek"+          UpdCreateItem{} -> "clatter"+          UpdTrajectory{} -> "thud"  -- A non-blast projectle hits a tile.+          UpdAlterTile _ _ fromTile toTile ->+            if | Tile.isOpenable coTileSpeedup fromTile+                 && Tile.isClosable coTileSpeedup toTile+                 || Tile.isClosable coTileSpeedup fromTile+                    && Tile.isOpenable coTileSpeedup toTile -> "creaking sound"+               | Tile.isWalkable coTileSpeedup fromTile+                 && Tile.isWalkable coTileSpeedup toTile -> "splash"+               | otherwise -> "rumble"+          UpdAlterExplorable _ k ->+            if k > 0 then "grinding noise" else "fizzing noise"+          _ -> error $ "" `showFailure` cmd+        adjective = MU.Text $ ppHearDistanceAdjective distance+        msg = makeSentence ["you hear", MU.AW $ MU.Phrase [adjective, sound]]+    return $! msg+  HearStrike ik -> do+    COps{coitem} <- getsState scops+    let verb = IK.iverbHit $ okind coitem ik+        adverb = MU.Text $ ppHearDistanceAdverb distance+        msg = makeSentence [ "you", adverb, "hear something"+                           , MU.Text verb, "someone" ]+    return $! msg+  HearSummon isProj grp p -> do+    let verb = if isProj then "something lure" else "somebody summon"+        part = MU.Text $ fromGroupName grp+        object = if p == 1  -- works, because exact number sent, not dice+                 then MU.AW part+                 else MU.Ws part+        adverb = MU.Text $ ppHearDistanceAdverb distance+    return $! makeSentence ["you", adverb, "hear", verb, object]+  HearCollideTile -> do+    let adverb = MU.Text $ ppHearDistanceAdverb distance+    return $! makeSentence ["you", adverb, "hear someone crash into something"]+  HearTaunt t -> do+    let adverb = MU.Text $ ppHearDistanceAdverb distance+    return $! makePhrase ["You", adverb, "overhear", MU.Text t]++ppHearDistanceAdjective :: Maybe Int -> Text+ppHearDistanceAdjective Nothing = "indistinct"+ppHearDistanceAdjective (Just 0) = "very close"+ppHearDistanceAdjective (Just 1) = "close"+ppHearDistanceAdjective (Just 2) = ""+ppHearDistanceAdjective (Just 3) = "remote"+ppHearDistanceAdjective (Just 4) = "distant"+ppHearDistanceAdjective (Just _) = "far-off"++ppHearDistanceAdverb :: Maybe Int -> Text+ppHearDistanceAdverb Nothing = "indistinctly"+ppHearDistanceAdverb (Just 0) = "very clearly"+ppHearDistanceAdverb (Just 1) = "clearly"+ppHearDistanceAdverb (Just 2) = ""+ppHearDistanceAdverb (Just 3) = "remotely"+ppHearDistanceAdverb (Just 4) = "distantly"+ppHearDistanceAdverb (Just _) = "barely"++-- * RespSfxAtomicUI++-- | Display special effects (text, animation) sent to the client.+-- Don't modify client state (except a few fields), but only client+-- session (e.g., by displaying messages). This is enforced by types.+displayRespSfxAtomicUI :: (MonadClient m, MonadClientUI m) => SfxAtomic -> m ()+{-# INLINE displayRespSfxAtomicUI #-}+displayRespSfxAtomicUI sfx = case sfx of+  SfxStrike source target iid ->+    strike False source target iid+  SfxRecoil source target iid -> do+    sourceSeen <- getsState $ EM.member source . sactorD+    if not sourceSeen then do+      tb <- getsState $ getActorBody target+      animate (blid tb) $ blockMiss (bpos tb, bpos tb)+    else do+      CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+      sb <- getsState $ getActorBody source+      tb <- getsState $ getActorBody source+      spart <- partActorLeader source+      tpart <- partActorLeader target+      side <- getsClient sside+      factionD <- getsState sfactionD+      localTime <- getsState $ getLocalTime (blid tb)+      itemFullWeapon <- getsState $ itemToFull iid+      let kitWeapon = quantSingle+          (weaponName, _) = partItemShort rwidth side factionD+                                          localTime itemFullWeapon kitWeapon+          weaponNameOwn = partItemShortWownW rwidth side factionD spart+                                             localTime itemFullWeapon kitWeapon+          verb = if bproj sb then "deflect" else "fend off"+          objects | iid == btrunk sb = ["the", spart]+                  | iid `EM.member` borgan sb =  ["the", weaponNameOwn]+                  | otherwise = ["the", weaponName, "of", spart]+      msgAdd MsgActionMajor $+        makeSentence $ MU.SubjectVerbSg tpart verb : objects+      animate (blid tb) $ blockMiss (bpos tb, bpos sb)+  SfxSteal source target iid ->+    strike True source target iid+  SfxRelease source target _ -> do+    spart <- partActorLeader source+    tpart <- partActorLeader target+    msgAdd MsgActionMajor $+      makeSentence [MU.SubjectVerbSg spart "release", tpart]+  SfxProject aid iid ->+    itemAidVerbMU MsgActionMajor aid "fling" iid (Left 1)+  SfxReceive aid iid ->+    itemAidVerbMU MsgActionMajor aid "receive" iid (Left 1)+  SfxApply aid iid -> do+    CCUI{coscreen=ScreenContent{rapplyVerbMap}} <- getsSession sccui+    ItemFull{itemKind} <- getsState $ itemToFull iid+    let actionPart = case EM.lookup (IK.isymbol itemKind) rapplyVerbMap of+          Just verb -> MU.Text verb+          Nothing -> "trigger"+    itemAidVerbMU MsgActionMajor aid actionPart iid (Left 1)+  SfxCheck aid iid ->+    itemAidVerbMU MsgActionMajor aid "recover" iid (Left 1)+  SfxTrigger _ _ _ fromTile -> do+    COps{cotile} <- getsState scops+    let subject = MU.Text $ TK.tname $ okind cotile fromTile+        verb = "shake"+        msg = makeSentence ["the", MU.SubjectVerbSg subject verb]+    msgAdd MsgNeutralEvent msg+  SfxShun aid _ _ _ ->+    aidVerbMU MsgActionMajor aid "shun it"+  SfxEffect fidSource aid iid effect hpDelta -> do+    -- In most messages below @iid@ is ignored, because it's too common,+    -- e.g., caused by some combat hits, or rather obvious,+    -- e.g., in case of embedded items, or would be counterintuitive,+    -- e.g., when actor is said to be intimidated by a particle, not explosion.+    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+    b <- getsState $ getActorBody aid+    bUI <- getsSession $ getActorUI aid+    side <- getsClient sside+    mleader <- getsClient sleader+    itemD <- getsState sitemD+    let fid = bfid b+        isOurCharacter = fid == side && not (bproj b)+        isAlive = bhp b > 0+        isOurAlive = isOurCharacter && isAlive+        isOurLeader = Just aid == mleader+        -- The message classes are close enough. It's melee or similar.+        feelLookHPBad bigAdj projAdj = do+          feelLook MsgBadMiscEvent MsgGoodMiscEvent bigAdj projAdj+          when isOurCharacter $ msgAdd MsgTutorialHint "You took damage of a different kind than the normal piercing hit, which means you armor didn't block any part of it. Normally, your HP (hit points, health) do not regenerate, so losing them is a big deal. Apply healing concoctions or take a long sleep to replenish your HP (but in this hectic environment not even uninterrupted resting that leads to sleep is easy)."+        feelLookHPGood = feelLook MsgGoodMiscEvent MsgBadMiscEvent+        feelLookCalm bigAdj projAdj = when isAlive $+          feelLook MsgEffectMinor MsgEffectMinor bigAdj projAdj+        -- Ignore @iid@, because it's usually obvious what item caused that+        -- and because the effects are not particularly disortienting.+        feelLook msgClassOur msgClassTheir bigAdj projAdj =+          let (verb, adjective) =+                if bproj b+                then ("get", projAdj)+                else ( if isOurCharacter then "feel" else "look"+                     , if isAlive then bigAdj else projAdj )+                         -- dead body is an item, not a person+              msgClass = if | bproj b -> MsgEffectMinor+                            | isOurCharacter -> msgClassOur+                            | otherwise -> msgClassTheir+          in aidVerbMU msgClass aid $ MU.Text $ verb <+> adjective+    case effect of+      IK.Burn{} -> do+        feelLookHPBad "burned" "scorched"+        let ps = (bpos b, bpos b)+        animate (blid b) $ twirlSplash ps Color.BrRed Color.Brown+      IK.Explode{} -> return ()  -- lots of visual feedback+      IK.RefillHP p | p == 1 -> return ()  -- no spam from regeneration+      IK.RefillHP p | p == -1 -> return ()  -- no spam from poison+      IK.RefillHP{} | hpDelta > 0 -> do+        feelLookHPGood "healthier" "mended"+        let ps = (bpos b, bpos b)+        animate (blid b) $ twirlSplash ps Color.BrGreen Color.Green+      IK.RefillHP{} -> do+        feelLookHPBad "wounded" "broken"+        let ps = (bpos b, bpos b)+        animate (blid b) $ twirlSplash ps Color.BrRed Color.Red+      IK.RefillCalm{} | not isAlive -> return ()+      IK.RefillCalm{} | bproj b -> return ()+      IK.RefillCalm p | p == 1 -> return ()  -- no spam from regen items+      IK.RefillCalm p | p > 0 -> feelLookCalm "calmer" "stabilized"+      IK.RefillCalm _ -> feelLookCalm "agitated" "wobbly"+      IK.Dominate | not isAlive -> return ()+      IK.Dominate -> do+        -- For subsequent messages use the proper name, never "you".+        let subject = partActor bUI+        if fid /= fidSource then do+          -- Before domination, possibly not seen if actor (yet) not ours.+          if bcalm b == 0  -- sometimes only a coincidence, but nm+          then aidVerbMU MsgEffectMinor aid "yield, under extreme pressure"+          else do+            let verb = if isOurAlive+                       then "black out, dominated by foes"+                       else "decide abruptly to switch allegiance"+                -- Faction is being switched, so item that caused domination+                -- and vanished may not be known to the new faction.+                msuffix = if iid == btrunk b || iid `EM.notMember` itemD+                          then Nothing+                          else Just $ if isOurAlive+                                      then "through"+                                      else "under the influence of"+            mitemAidVerbMU MsgEffectMinor aid verb iid msuffix+          fidNameRaw <- getsState $ gname . (EM.! fid) . sfactionD+          -- Avoid "controlled by Controlled foo".+          let fidName = T.unwords $ tail $ T.words fidNameRaw+              verb = "be no longer controlled by"+          msgLnAdd MsgEffectMajor $ makeSentence+            [MU.SubjectVerbSg subject verb, MU.Text fidName]+          when isOurAlive $ displayMoreKeep ColorFull ""  -- Ln makes it short+        else do+          -- After domination, possibly not seen, if actor (already) not ours.+          fidSourceNameRaw <- getsState $ gname . (EM.! fidSource) . sfactionD+          -- Avoid "Controlled control".+          let fidSourceName = T.unwords $ tail $ T.words fidSourceNameRaw+              verb = "be now under"+          msgAdd MsgEffectMajor $ makeSentence+            [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]+      IK.Impress | not isAlive -> return ()+      IK.Impress -> aidVerbMU MsgEffectMinor aid "be awestruck"+      IK.PutToSleep | not isAlive -> return ()+      IK.PutToSleep -> do+        let verb = "be put to sleep"+            msuffix = Just $ if fidSource == bfid b then "due to" else "by"+        mitemAidVerbMU MsgEffectMajor aid verb iid msuffix+      IK.Yell | not isAlive -> return ()+      IK.Yell -> aidVerbMU MsgMiscellanous aid "start"+      IK.Summon grp p -> do+        let verbBase = if bproj b then "lure" else "summon"+            part = MU.Text $ fromGroupName grp+            object = if p == 1  -- works, because exact number sent, not dice+                     then MU.AW part+                     else MU.Ws part+            verb = MU.Phrase [verbBase, object]+            msuffix = Just "with"+        mitemAidVerbMU MsgEffectMajor aid verb iid msuffix+      IK.Ascend{} | not isAlive -> return ()+      IK.Ascend up -> do+        COps{cocave} <- getsState scops+        aidVerbMU MsgEffectMajor aid $ MU.Text $+          "find a way" <+> if up then "upstairs" else "downstairs"+        when isOurLeader $ do+          destinations <- getsState $ whereTo (blid b) (bpos b) up+                                      . sdungeon+          case destinations of+            (lid, _) : _ -> do  -- only works until different levels possible+              lvl <- getLevel lid+              let desc = cdesc $ okind cocave $ lkind lvl+              unless (T.null desc) $+                msgAdd MsgBackdropInfo $ desc <> "\n"+              msgAdd MsgTutorialHint "New floor is new opportunities, though the old level is still there and others may roam it after you left. Viewing all floors, without moving between them, can be done using the '<' and '>' keys."+            [] -> return ()  -- spell fizzles; normally should not be sent+      IK.Escape{} | isOurCharacter -> do+        ours <- getsState $ fidActorNotProjGlobalAssocs side+        when (length ours > 1) $ do+          (_, total) <- getsState $ calculateTotal side+          if total == 0+          then msgAdd MsgFactionIntel $+                 "The team joins" <+> makePhrase [partActor bUI]+                 <> ", forms a perimeter and leaves triumphant."+          else msgAdd MsgItemCreation $+                 "The team joins" <+> makePhrase [partActor bUI]+                 <> ", forms a perimeter, repacks its belongings and leaves triumphant."+      IK.Escape{} -> return ()+      IK.Paralyze{} | not isAlive -> return ()+      IK.Paralyze{} ->+        mitemAidVerbMU MsgEffectMedium aid "be paralyzed" iid (Just "with")+      IK.ParalyzeInWater{} | not isAlive -> return ()+      IK.ParalyzeInWater{} ->+        aidVerbMU MsgEffectMinor aid "move with difficulty"+      IK.InsertMove{} | not isAlive -> return ()+      IK.InsertMove d ->+        -- Usually self-inflicted of from embeds, so obvious, so no @iid@.+        if Dice.supDice d >= 10+        then aidVerbMU MsgEffectMedium aid "act with extreme speed"+        else aidVerbMU MsgEffectMinor aid "move swiftly"+      IK.Teleport t | Dice.supDice t <= 9 -> do+        -- Actor may be sent away before noticing the item that did it.+        let msuffix = if iid `EM.notMember` itemD+                      then Nothing+                      else Just "due to"+        mitemAidVerbMU MsgEffectMinor aid "blink" iid msuffix+      IK.Teleport{} -> do+        -- Actor may be sent away before noticing the item that did it.+        let msuffix = if iid `EM.notMember` itemD+                      then Nothing+                      else Just "propelled by"+        mitemAidVerbMU MsgEffectMedium aid "teleport" iid msuffix+      IK.CreateItem{} -> return ()+      IK.DestroyItem{} -> return ()+      IK.ConsumeItems{} -> return ()+      IK.DropItem _ _ COrgan _ -> return ()+      IK.DropItem{} ->  -- rare enough+        mitemAidVerbMU MsgEffectMedium aid "be stripped" iid (Just "with")+      IK.Recharge{} | not isAlive -> return ()+      IK.Recharge{} -> aidVerbMU MsgEffectMedium aid "heat up"+      IK.Discharge{} | not isAlive -> return ()+      IK.Discharge{} -> aidVerbMU MsgEffectMedium aid "cool down"+      IK.PolyItem -> do+        subject <- partActorLeader aid+        let ppstore = MU.Text $ ppCStoreIn CGround+        msgAdd MsgEffectMedium $ makeSentence+          [ MU.SubjectVerbSg subject "repurpose", "what lies", ppstore+          , "to a common item of the current level" ]+      IK.RerollItem -> do+        subject <- partActorLeader aid+        let ppstore = MU.Text $ ppCStoreIn CGround+        msgAdd MsgEffectMedium $ makeSentence+          [ MU.SubjectVerbSg subject "reshape", "what lies", ppstore+          , "striving for the highest possible standards" ]+      IK.DupItem -> do+        subject <- partActorLeader aid+        let ppstore = MU.Text $ ppCStoreIn CGround+        msgAdd MsgEffectMedium $ makeSentence+          [MU.SubjectVerbSg subject "multiply", "what lies", ppstore]+      IK.Identify -> do+        subject <- partActorLeader aid+        pronoun <- partPronounLeader aid+        msgAdd MsgEffectMinor $ makeSentence+          [ MU.SubjectVerbSg subject "look at"+          , MU.WownW pronoun $ MU.Text "inventory"+          , "intensely" ]+      IK.Detect d _ -> do+        subject <- partActorLeader aid+        factionD <- getsState sfactionD+        localTime <- getsState $ getLocalTime $ blid b+        let verb = MU.Text $ detectToVerb d+            object = MU.Ws $ MU.Text $ detectToObject d+        (periodic, itemFull) <-+          if iid `EM.member` itemD then do+            itemFull <- getsState $ itemToFull iid+            let arItem = aspectRecordFull itemFull+            return (IA.checkFlag Ability.Periodic arItem, itemFull)+          else do+#ifdef WITH_EXPENSIVE_ASSERTIONS+            -- It's not actually expensive, but it's particularly likely+            -- to fail with wild content, indicating server game rules logic+            -- needs to be fixed/extended:+            -- Observer from another faction may receive the effect information+            -- from the server, because the affected actor is visible,+            -- but the position of the item may be out of FOV. This is fine;+            -- the message is then shorter, because only the effect was seen,+            -- while the cause remains misterious.+            let !_A = if fid /= side  -- not from affected faction; observing+                      then ()+                      else error $ "item never seen by the affected actor"+                                   `showFailure` (aid, b, bUI, verb, iid, sfx)+#endif+            return (False, undefined)+        let iidDesc =+              let (name1, powers) = partItemShort rwidth side factionD localTime+                                                  itemFull quantSingle+              in makePhrase ["the", name1, powers]+            -- If item not periodic, most likely intentional, so don't spam.+            means = [MU.Text $ "(via" <+> iidDesc <> ")" | periodic]+        msgAdd MsgEffectMinor $+          makeSentence $ [MU.SubjectVerbSg subject verb] ++ [object] ++ means+        -- Don't make it modal if all info remains after no longer seen.+        unless (fid /= side || d `elem` [IK.DetectHidden, IK.DetectExit]) $+          displayMore ColorFull ""  -- the sentence short+      IK.SendFlying{} | not isAlive -> return ()+      IK.SendFlying{} -> aidVerbMU MsgEffectMedium aid "be sent flying"+      IK.PushActor{} | not isAlive -> return ()+      IK.PushActor{} -> aidVerbMU MsgEffectMedium aid "be pushed"+      IK.PullActor{} | not isAlive -> return ()+      IK.PullActor{} -> aidVerbMU MsgEffectMedium aid "be pulled"+      IK.ApplyPerfume ->+        msgAdd MsgEffectMinor+               "The fragrance quells all scents in the vicinity."+      IK.AtMostOneOf{} -> return ()+      IK.OneOf{} -> return ()+      IK.OnSmash{} -> error $ "" `showFailure` sfx+      IK.OnCombine{} -> error $ "" `showFailure` sfx+      IK.OnUser{} -> error $ "" `showFailure` sfx+      IK.NopEffect -> error $ "" `showFailure` sfx+      IK.AndEffect{} -> error $ "" `showFailure` sfx+      IK.OrEffect{} -> error $ "" `showFailure` sfx+      IK.SeqEffect{} -> error $ "" `showFailure` sfx+      IK.When{} -> error $ "" `showFailure` sfx+      IK.Unless{} -> error $ "" `showFailure` sfx+      IK.IfThenElse{} -> error $ "" `showFailure` sfx+      IK.VerbNoLonger{} | not isAlive -> return ()+      IK.VerbNoLonger verb ending -> do+        let msgClass = if fid == side+                       then MsgStatusStopUs+                       else MsgStatusStopThem+        subject <- partActorLeader aid+        msgAdd msgClass $+          makePhrase [MU.Capitalize $ MU.SubjectVerbSg subject $ MU.Text verb]+          <> ending+      IK.VerbMsg verb ending -> do+        subject <- partActorLeader aid+        msgAdd MsgEffectMedium $+          makePhrase [MU.Capitalize $ MU.SubjectVerbSg subject $ MU.Text verb]+          <> ending+      IK.VerbMsgFail verb ending -> do+        subject <- partActorLeader aid+        msgAdd MsgActionWarning $+          makePhrase [MU.Capitalize $ MU.SubjectVerbSg subject $ MU.Text verb]+          <> ending+  SfxItemApplied iid c ->+    itemVerbMU MsgInnerWorkSpam iid (1, []) "have been triggered" c+  SfxMsgFid _ sfxMsg -> do+    mleader <- getsClient sleader+    case mleader of+      Just{} -> return ()  -- will display stuff when leader moves+      Nothing -> do+        lidV <- viewedLevelUI+        markDisplayNeeded lidV+        recordHistory+    mmsg <- ppSfxMsg sfxMsg+    case mmsg of+      Just (Left (msgClass, msg)) -> msgAdd msgClass msg+      Just (Right (msgClass, (t1, t2))) -> do+        let dotsIfShorter = if t1 == t2 then "" else ".."+        msgAddDistinct msgClass  (t1 <> dotsIfShorter, t2)+      Nothing -> return ()+  SfxRestart -> fadeOutOrIn True+  SfxCollideTile source pos -> do+    COps{cotile} <- getsState scops+    sb <- getsState $ getActorBody source+    lvl <- getLevel $ blid sb+    spart <- partActorLeader source+    let object = MU.AW $ MU.Text $ TK.tname $ okind cotile $ lvl `at` pos+    -- Neutral message, because minor damage and we don't say, which faction.+    msgAdd MsgNeutralEvent $! makeSentence+      [MU.SubjectVerbSg spart "collide", "painfully with", object]+  SfxTaunt voluntary aid -> do+    side <- getsClient sside+    b <- getsState $ getActorBody aid+    unless (bproj b && bfid b == side) $ do  -- don't spam+      spart <- partActorLeader aid+      (_heardSubject, verb) <- displayTaunt voluntary rndToActionUI aid+      msgAdd MsgMiscellanous $!+        makeSentence [MU.SubjectVerbSg spart (MU.Text verb)]++returnJustLeft :: MonadClientUI m+               => (MsgClassShowAndSave, Text)+               -> m (Maybe (Either (MsgClassShowAndSave, Text)+                                   (MsgClassDistinct, (Text, Text))))+returnJustLeft = return . Just . Left++ppSfxMsg :: MonadClientUI m+         => SfxMsg -> m (Maybe (Either (MsgClassShowAndSave, Text)+                                       (MsgClassDistinct, (Text, Text))))+ppSfxMsg sfxMsg = case sfxMsg of+  SfxUnexpected reqFailure -> returnJustLeft+    ( MsgActionWarning+    , "Unexpected problem:" <+> showReqFailure reqFailure <> "." )+  SfxExpected itemName reqFailure -> returnJustLeft+    ( MsgActionWarning+    , "The" <+> itemName <+> "is not triggered:"+      <+> showReqFailure reqFailure <> "." )+  SfxExpectedEmbed iid lid reqFailure -> do+    iidSeen <- getsState $ EM.member iid . sitemD+    if iidSeen then do+      itemFull <- getsState $ itemToFull iid+      side <- getsClient sside+      factionD <- getsState sfactionD+      localTime <- getsState $ getLocalTime lid+      let (object1, object2) =+            partItemShortest maxBound side factionD localTime+                             itemFull quantSingle+          name = makePhrase [object1, object2]+      returnJustLeft+        ( MsgActionWarning+        , "The" <+> "embedded" <+> name <+> "is not activated:"+          <+> showReqFailure reqFailure <> "." )+    else return Nothing+  SfxFizzles iid c -> do+    msg <- itemVerbMUGeneral True iid (1, []) "do not work" c+    return $ Just $ Right (MsgStatusWarning, ("It didn't work.", msg))+  SfxNothingHappens iid c -> do+    msg <- itemVerbMUGeneral True iid (1, []) "do nothing, predictably" c+    return $ Just $ Right (MsgStatusBenign, ("Nothing happens.", msg))+  SfxNoItemsForTile toolsToAlterWith -> do+    revCmd <- revCmdMap+    let km = revCmd HumanCmd.AlterDir+        tItems = describeToolsAlternative toolsToAlterWith+    returnJustLeft ( MsgActionWarning+                   , "To transform the terrain, prepare the following items on the ground or in equipment:"+                     <+> tItems+                     <+> "and use the '"+                     <> T.pack (K.showKM km)+                     <> "' terrain modification command."+                   )+  SfxVoidDetection d -> returnJustLeft+    ( MsgMiscellanous+    , makeSentence ["no new", MU.Text $ detectToObject d, "detected"] )+  SfxUnimpressed aid -> do+    msbUI <- getsSession $ EM.lookup aid . sactorUI+    case msbUI of+      Nothing -> return Nothing+      Just sbUI -> do+        let subject = partActor sbUI+            verb = "be unimpressed"+        returnJustLeft ( MsgActionWarning+                       , makeSentence [MU.SubjectVerbSg subject verb] )+  SfxSummonLackCalm aid -> do+    msbUI <- getsSession $ EM.lookup aid . sactorUI+    case msbUI of+      Nothing -> return Nothing+      Just sbUI -> do+        let subject = partActor sbUI+            verb = "lack Calm to summon"+        returnJustLeft ( MsgActionWarning+                       , makeSentence [MU.SubjectVerbSg subject verb] )+  SfxSummonTooManyOwn aid -> do+    msbUI <- getsSession $ EM.lookup aid . sactorUI+    case msbUI of+      Nothing -> return Nothing+      Just sbUI -> do+        let subject = partActor sbUI+            verb = "can't keep track of their numerous friends, let alone summon any more"+        returnJustLeft (MsgActionWarning, makeSentence [subject, verb])+  SfxSummonTooManyAll aid -> do+    msbUI <- getsSession $ EM.lookup aid . sactorUI+    case msbUI of+      Nothing -> return Nothing+      Just sbUI -> do+        let subject = partActor sbUI+            verb = "can't keep track of everybody around, let alone summon anyone else"+        returnJustLeft (MsgActionWarning, makeSentence [subject, verb])+  SfxSummonFailure aid -> do+    msbUI <- getsSession $ EM.lookup aid . sactorUI+    case msbUI of+      Nothing -> return Nothing+      Just sbUI -> do+        let subject = partActor sbUI+            verb = "fail to summon anything"+        returnJustLeft ( MsgActionWarning+                       , makeSentence [MU.SubjectVerbSg subject verb] )+  SfxLevelNoMore -> returnJustLeft+    (MsgActionWarning, "No more levels in this direction.")+  SfxLevelPushed -> returnJustLeft+    (MsgActionWarning, "You notice somebody pushed to another level.")+  SfxBracedImmune aid -> do+    msbUI <- getsSession $ EM.lookup aid . sactorUI+    case msbUI of+      Nothing -> return Nothing+      Just sbUI -> do+        let subject = partActor sbUI+            verb = "be braced and so immune to translocation"+        returnJustLeft ( MsgMiscellanous+                       , makeSentence [MU.SubjectVerbSg subject verb] )+                         -- too common+  SfxEscapeImpossible -> returnJustLeft+    ( MsgActionWarning+    , "Escaping outside is unthinkable for members of this faction." )+  SfxStasisProtects -> returnJustLeft+    ( MsgMiscellanous  -- too common+    , "Paralysis and speed surge require recovery time." )+  SfxWaterParalysisResisted -> return Nothing  -- don't spam+  SfxTransImpossible -> returnJustLeft+    (MsgActionWarning, "Translocation not possible.")+  SfxIdentifyNothing -> returnJustLeft+    (MsgActionWarning, "Nothing to identify.")+  SfxPurposeNothing -> returnJustLeft+    ( MsgActionWarning+    , "The purpose of repurpose cannot be availed without an item"+      <+> ppCStoreIn CGround <> "." )+  SfxPurposeTooFew maxCount itemK -> returnJustLeft+    ( MsgActionWarning+    , "The purpose of repurpose is served by" <+> tshow maxCount+      <+> "pieces of this item, not by" <+> tshow itemK <> "." )+  SfxPurposeUnique -> returnJustLeft+    (MsgActionWarning, "Unique items can't be repurposed.")+  SfxPurposeNotCommon -> returnJustLeft+    (MsgActionWarning, "Only ordinary common items can be repurposed.")+  SfxRerollNothing -> returnJustLeft+    ( MsgActionWarning+    , "The shape of reshape cannot be assumed without an item"+      <+> ppCStoreIn CGround <> "." )+  SfxRerollNotRandom -> returnJustLeft+    (MsgActionWarning, "Only items of variable shape can be reshaped.")+  SfxDupNothing -> returnJustLeft+    ( MsgActionWarning+    , "Mutliplicity won't rise above zero without an item"+      <+> ppCStoreIn CGround <> "." )+  SfxDupUnique -> returnJustLeft+    (MsgActionWarning, "Unique items can't be multiplied.")+  SfxDupValuable -> returnJustLeft+    (MsgActionWarning, "Valuable items can't be multiplied.")+  SfxColdFish -> returnJustLeft+    ( MsgMiscellanous  -- repeatable+    , "Healing attempt from another faction is thwarted by your cold fish attitude." )+  SfxReadyGoods -> returnJustLeft+    ( MsgMiscellanous  -- repeatable+    , "Crafting is alien to you, accustomed to buying ready goods all your life." )+  SfxTimerExtended aid iid cstore delta -> do+    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+    aidSeen <- getsState $ EM.member aid . sactorD+    iidSeen <- getsState $ EM.member iid . sitemD+    if aidSeen && iidSeen then do+      b <- getsState $ getActorBody aid+      bUI <- getsSession $ getActorUI aid+      factionD <- getsState sfactionD+      localTime <- getsState $ getLocalTime (blid b)+      itemFull <- getsState $ itemToFull iid+      side <- getsClient sside+      bag <- getsState $ getBodyStoreBag b cstore+      let (name, powers) =+            partItem rwidth (bfid b) factionD localTime itemFull quantSingle+          total = case bag EM.! iid of+            (_, []) -> error $ "" `showFailure` (bag, iid, aid, cstore, delta)+            (_, t:_) -> deltaOfItemTimer localTime t+              -- only exceptionally not singleton list+      storeOwn <- ppContainerWownW partPronounLeader True (CActor aid cstore)+      -- Ideally we'd use a pronoun here, but the action (e.g., hit)+      -- that caused this extension can be invisible to some onlookers.+      -- So their narrative context needs to be taken into account.+      -- The upside is that the messages do not bind pronouns+      -- and so commute and so repetitions can be squashed.+      let cond = [ "condition"+                 | IA.checkFlag Ability.Condition $ aspectRecordFull itemFull ]+          usShow =+            ["the", name, powers] ++ cond+            ++ storeOwn ++ ["will now last longer"]+          usSave =+            ["the", name, powers] ++ cond+            ++ storeOwn ++ ["will now last"]+            ++ [MU.Text $ timeDeltaInSecondsText delta <+> "longer"]+            ++ [MU.Text $ "(total:" <+> timeDeltaInSecondsText total <> ")"]+          -- Note that when enemy actor causes the extension to himself,+          -- the player is not notified at all. So the shorter blurb+          -- displayed on the screen is middle ground and full is in history.+          themShow =+            [partItemShortWownW rwidth side factionD (partActor bUI) localTime+                                itemFull quantSingle]+            ++ cond ++ ["is extended"]+          themSave =+            [partItemShortWownW rwidth side factionD (partActor bUI) localTime+                                itemFull quantSingle]+            ++ cond ++ ["is extended by"]+            ++ [MU.Text $ timeDeltaInSecondsText delta]+            ++ [MU.Text $ "(total:" <+> timeDeltaInSecondsText total <> ")"]+          (msgClass, parts1, parts2) =+            if bfid b == side+            then (MsgStatusLongerUs, usShow, usSave)+            else (MsgStatusLongThem, themShow, themSave)+      return $ Just $ Right+        (msgClass, (makeSentence parts1, makeSentence parts2))+    else return Nothing+  SfxCollideActor source target -> do+    sourceSeen <- getsState $ EM.member source . sactorD+    targetSeen <- getsState $ EM.member target . sactorD+    if sourceSeen && targetSeen then do+      spart <- partActorLeader source+      tpart <- partActorLeader target+      -- Neutral message, because minor damage and we don't say, which faction.+      -- And the collision may even be intentional.+      returnJustLeft+        ( MsgSpecialEvent+        , makeSentence+            [MU.SubjectVerbSg spart "collide", "awkwardly with", tpart] )+    else return Nothing+  SfxItemYield iid k lid -> do+    iidSeen <- getsState $ EM.member iid . sitemD+    if iidSeen then do+      let fakeKit = quantSingle+          fakeC = CFloor lid originPoint+          verb = MU.Text $ "yield" <+> makePhrase [MU.CardinalAWs k "item"]+      msg <- itemVerbMUGeneral False iid fakeKit verb fakeC+      returnJustLeft (MsgSpecialEvent, msg)  -- differentiate wrt item creation+    else return Nothing++strike :: (MonadClient m, MonadClientUI m)+       => Bool -> ActorId -> ActorId -> ItemId -> m ()+strike catch source target iid = assert (source /= target) $ do+  sourceSeen <- getsState $ EM.member source . sactorD+  if not sourceSeen then do+    tb <- getsState $ getActorBody target+    animate (blid tb) $ blockMiss (bpos tb, bpos tb)+  else do+    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+    tb <- getsState $ getActorBody target+    hurtMult <- getsState $ armorHurtBonus source target+    sb <- getsState $ getActorBody source+    sMaxSk <- getsState $ getActorMaxSkills source+    spart <- partActorLeader source+    tpart <- partActorLeader target+    spronoun <- partPronounLeader source+    tpronoun <- partPronounLeader target+    tbUI <- getsSession $ getActorUI target+    localTime <- getsState $ getLocalTime (blid tb)+    itemFullWeapon <- getsState $ itemToFull iid+    let kitWeapon = quantSingle+    side <- getsClient sside+    factionD <- getsState sfactionD+    tfact <- getsState $ (EM.! bfid tb) . sfactionD+    eqpOrgKit <- getsState $ kitAssocs target [CEqp, COrgan]+    orgKit <- getsState $ kitAssocs target [COrgan]+    let isCond (_, (itemFullArmor, _)) =+          IA.checkFlag Ability.Condition $ aspectRecordFull itemFullArmor+        -- We exclude genetic flaws, backstory items, etc., because they+        -- can't be easily taken off, so no point spamming the player.+        isOrdinaryCond ikit@(_, (itemFullArmor, _)) =+          not (IA.checkFlag Ability.MetaGame (aspectRecordFull itemFullArmor))+          && isCond ikit+        relevantSkArmor =+          if bproj sb then Ability.SkArmorRanged else Ability.SkArmorMelee+        rateArmor (iidArmor, (itemFullArmor, (k, _))) =+          ( k * IA.getSkill relevantSkArmor (aspectRecordFull itemFullArmor)+          , ( iidArmor+            , itemFullArmor ) )+        abs15 (v, _) = abs v >= 15+        condArmor = filter abs15 $ map rateArmor $ filter isOrdinaryCond orgKit+        fstGt0 (v, _) = v > 0+        wornArmor =+          filter fstGt0 $ map rateArmor $ filter (not . isCond) eqpOrgKit+    mblockArmor <- case wornArmor of+      [] -> return Nothing+      _ -> Just+           <$> rndToActionUI (frequency $ toFreq "msg armor" wornArmor)+    let (blockWithWhat, blockWithWeapon) = case mblockArmor of+          Just (iidArmor, itemFullArmor) | iidArmor /= btrunk tb ->+            let (object1, object2) =+                  partItemShortest rwidth (bfid tb) factionD localTime+                                   itemFullArmor quantSingle+                name = MU.Phrase [object1, object2]+            in ( ["with", MU.WownW tpronoun name]+               , Dice.supDice (IK.idamage $ itemKind itemFullArmor) > 0 )+          _ -> ([], False)+        verb = MU.Text $ IK.iverbHit $ itemKind itemFullWeapon+        partItemChoice =+          if iid `EM.member` borgan sb+          then partItemShortWownW rwidth side factionD spronoun localTime+          else partItemShortAW rwidth side factionD localTime+        weaponNameWith = if iid == btrunk sb+                         then []+                         else ["with", partItemChoice itemFullWeapon kitWeapon]+        sleepy = if bwatch tb `elem` [WSleep, WWake]+                    && tpart /= "you"+                    && bhp tb > 0+                 then "the sleepy"+                 else ""+        unBurn (IK.Burn d) = Just d+        unBurn _ = Nothing+        unRefillHP (IK.RefillHP n) | n < 0 = Just (-n)+        unRefillHP _ = Nothing+        kineticDmg =+          let dmg = Dice.supDice $ IK.idamage $ itemKind itemFullWeapon+              rawDeltaHP = intCast sHurt * xM dmg `divUp` 100+          in case btrajectory sb of+            Just (_, speed) | bproj sb ->+              - modifyDamageBySpeed rawDeltaHP speed+            _ -> - rawDeltaHP+        burnDmg = - (sum $ map Dice.supDice+                     $ mapMaybe unBurn $ IK.ieffects $ itemKind itemFullWeapon)+        fillDmg =+          - (sum $ mapMaybe unRefillHP $ IK.ieffects $ itemKind itemFullWeapon)+        -- For variety, attack adverb is based on attacker's and weapon's+        -- damage potential as compared to victim's current HP.+        -- We are not taking into account victim's armor yet.+        sHurt = armorHurtCalculation (bproj sb) sMaxSk Ability.zeroSkills+        nonPiercingDmg = burnDmg + fillDmg+        sDamage = min 0 $ kineticDmg + xM nonPiercingDmg+        deadliness = 1000 * (- sDamage) `div` max 1 (bhp tb)+        strongly+          | deadliness >= 10000 = "artfully"+          | deadliness >= 5000 = "madly"+          | deadliness >= 2000 = "mercilessly"+          | deadliness >= 1000 = "murderously"  -- one blow can wipe out all HP+          | deadliness >= 700 = "devastatingly"+          | deadliness >= 500 = "vehemently"+          | deadliness >= 400 = "forcefully"+          | deadliness >= 350 = "sturdily"+          | deadliness >= 300 = "accurately"+          | deadliness >= 20 = ""  -- common, terse case, between 2% and 30%+          | deadliness >= 10 = "cautiously"+          | deadliness >= 5 = "guardedly"+          | deadliness >= 3 = "hesitantly"+          | deadliness >= 2 = "clumsily"+          | deadliness >= 1 = "haltingly"+          | otherwise = "feebly"+        -- Here we take into account armor, so we look at @hurtMult@,+        -- so we finally convey the full info about effectiveness of the strike.+        blockHowWell  -- under some conditions, the message not shown at all+          | hurtMult > 90 = "incompetently"+          | hurtMult > 80 = "too late"+          | hurtMult > 70 = "too slowly"+          | hurtMult > 20 || nonPiercingDmg < 0 =+                            if | deadliness >= 2000 -> "marginally"+                               | deadliness >= 1000 -> "partially"+                               | deadliness >= 100 -> "partly"  -- common+                               | deadliness >= 50 -> "to an extent"+                               | deadliness >= 20 -> "to a large extent"+                               | deadliness >= 5 -> "for the major part"+                               | otherwise -> "for the most part"+          | hurtMult > 1 = if | actorWaits tb -> "doggedly"+                              | deadliness >= 50 -> "easily"  -- common+                              | deadliness >= 20 -> "effortlessly"+                              | deadliness >= 5 -> "nonchalantly"+                              | otherwise -> "bemusedly"+          | otherwise = "almost completely"+              -- a fraction gets through, but if fast missile, can be deadly+        avertVerb = if actorWaits tb then "avert it" else "ward it off"+        blockPhrase =+          let (subjectBlock, verbBlock) =+                if | not $ bproj sb ->+                     (tpronoun, if blockWithWeapon+                                then "parry"+                                else "block")+                   | tpronoun == "it"+                     || projectileHitsWeakly && tpronoun /= "you" ->+                     -- Avoid ambiguity.+                     (partActor tbUI, avertVerb)+                   | otherwise -> (tpronoun, avertVerb)+          in MU.SubjectVerbSg subjectBlock verbBlock+        surprisinglyGoodDefense = deadliness >= 20 && hurtMult <= 70+        surprisinglyBadDefense = deadliness < 20 && hurtMult > 70+        yetButAnd+          | surprisinglyGoodDefense = ", but"+          | surprisinglyBadDefense = ", yet"+          | otherwise = " and"  -- no surprises+        projectileHitsWeakly = bproj sb && deadliness < 20+        msgArmor = if not projectileHitsWeakly+                        -- ensures if attack msg terse, armor message+                        -- mentions object, so we know who is hit+                      && hurtMult > 90+                        -- at most minor armor relatively to skill of the hit+                      && (null condArmor || deadliness < 100)+                      || null blockWithWhat+                      || kineticDmg >= -1000  -- -1/1000 HP+                   then ""+                   else yetButAnd+                        <+> makePhrase ([blockPhrase, blockHowWell]+                                        ++ blockWithWhat)+        ps = (bpos tb, bpos sb)+        basicAnim+          | hurtMult > 70 = twirlSplash ps Color.BrRed Color.Red+          | hurtMult > 1 = if nonPiercingDmg >= 0  -- no extra anim+                           then blockHit ps Color.BrRed Color.Red+                           else blockMiss ps+          | otherwise = blockMiss ps+        targetIsFoe = bfid sb == side  -- no big news if others hit our foes+                      && isFoe (bfid tb) tfact side+        targetIsFriend = isFriend (bfid tb) tfact side+                           -- warning if anybody hits our friends+        msgClassMelee =+          if targetIsFriend then MsgMeleeNormalUs else MsgMeleeOthers+        msgClassRanged =+          if targetIsFriend then MsgRangedNormalUs else MsgRangedOthers+        animateAlive lid anim =+          if bhp tb > 0+          then animate lid anim+          else animate lid $ twirlSplashShort ps Color.BrRed Color.Red+    -- The messages about parrying and immediately afterwards dying+    -- sound goofy, but there is no easy way to prevent that.+    -- And it's consistent.+    -- If/when death blow instead sets HP to 1 and only the next below 1,+    -- we can check here for HP==1; also perhaps actors with HP 1 should+    -- not be able to block.+    if | catch -> do  -- charge not needed when catching+         let msg = makeSentence+                     [MU.SubjectVerbSg spart "catch", tpart, "skillfully"]+         msgAdd MsgSpecialEvent msg+         when (bfid sb == side) $+           msgAdd MsgTutorialHint "You managed to catch a projectile, thanks to being braced and hitting it exactly when it was at arm's reach. The obtained item has been put into the shared stash of the party."+         animate (blid tb) $ blockHit ps Color.BrGreen Color.Green+       | not (hasCharge localTime kitWeapon) -> do+         -- Can easily happen with a thrown discharged item.+         -- Much less plausible with a wielded weapon.+         -- Theoretically possible if the weapon not identified+         -- (then timeout is a mean estimate), but they usually should be,+         -- even in foes' possession.+         let msg = if bproj sb+                   then makePhrase+                          [MU.Capitalize $ MU.SubjectVerbSg spart "connect"]+                        <> ", but it may be completely discharged."+                   else makePhrase+                          ([ MU.Capitalize $ MU.SubjectVerbSg spart "try"+                           , "to"+                           , verb+                           , tpart ]+                           ++ weaponNameWith)+                        <> if null weaponNameWith+                           then ", but there are no charges left."+                           else ", but it may be not readied yet."+         msgAdd MsgSpecialEvent msg  -- and no animation+       | bproj sb && bproj tb -> do  -- server sends unless both are blasts+         -- Short message.+         msgAdd MsgSpecialEvent $+           makeSentence [MU.SubjectVerbSg spart "intercept", tpart]+         -- Basic non-bloody animation regardless of stats.+         animateAlive (blid tb) $ blockHit ps Color.BrBlue Color.Blue+       | kineticDmg >= -1000  -- -1/1000 HP+         -- We ignore nested effects, because they are, in general, avoidable.+         && nonPiercingDmg >= 0 -> do+         let adverb | itemSuspect itemFullWeapon && bfid sb == side =+                        "tentatively"  -- we didn't identify the weapon before+                    | bproj sb = "lightly"+                    | otherwise = "delicately"+             msg = makeSentence $+               [MU.SubjectVerbSg spart verb, tpart, adverb]+               ++ if bproj sb then [] else weaponNameWith+         msgAdd msgClassMelee msg  -- too common for color+         animate (blid tb) $ subtleHit ps+       | bproj sb -> do  -- more terse than melee, because sometimes very spammy+         let msgRangedPowerful | targetIsFoe = MsgRangedMightyWe+                               | targetIsFriend = MsgRangedMightyUs+                               | otherwise = msgClassRanged+             (attackParts, msgRanged)+               | projectileHitsWeakly =+                 ( [MU.SubjectVerbSg spart "connect"]  -- weak, so terse+                 , msgClassRanged )+               | deadliness >= 300 =+                 ( [MU.SubjectVerbSg spart verb, tpart, "powerfully"]+                 , if targetIsFriend || deadliness >= 700+                   then msgRangedPowerful+                   else msgClassRanged )+               | otherwise =+                 ( [MU.SubjectVerbSg spart verb, tpart]  -- strong, for a proj+                 , msgClassRanged )+         msgAdd msgRanged $ makePhrase [MU.Capitalize $ MU.Phrase attackParts]+                            <> msgArmor <> "."+         animateAlive (blid tb) basicAnim+       | bproj tb -> do  -- much less emotion and the victim not active.+         let attackParts =+               [MU.SubjectVerbSg spart verb, tpart] ++ weaponNameWith+         msgAdd MsgMeleeOthers $ makeSentence attackParts+         animateAlive (blid tb) basicAnim+       | otherwise -> do  -- ordinary melee+         let msgMeleeInteresting | targetIsFoe = MsgMeleeComplexWe+                                 | targetIsFriend = MsgMeleeComplexUs+                                 | otherwise = msgClassMelee+             msgMeleePowerful | targetIsFoe = MsgMeleeMightyWe+                              | targetIsFriend = MsgMeleeMightyUs+                              | otherwise = msgClassMelee+             attackParts =+               [MU.SubjectVerbSg spart verb, sleepy, tpart, strongly]+               ++ weaponNameWith+             (tmpInfluenceBlurb, msgClassInfluence) =+               if null condArmor || T.null msgArmor+               then ("", msgClassMelee)+               else+                 let (armor, (_, itemFullArmor)) =+                       maximumBy (comparing $ abs . fst) condArmor+                     (object1, object2) =+                       partItemShortest rwidth (bfid tb) factionD localTime+                                        itemFullArmor quantSingle+                     name = makePhrase [object1, object2]+                     msgText =+                       if hurtMult > 70+                       then (if armor <= -15+                             then ", due to being"+                             else assert (armor >= 15) ", regardless of being")+                            <+> name+                       else (if armor >= 15+                             then ", thanks to being"+                             else assert (armor <= -15) ", despite being")+                            <+> name+                 in (msgText, msgMeleeInteresting)+             msgClass = if targetIsFriend && deadliness >= 300+                           || deadliness >= 2000+                        then msgMeleePowerful+                        else msgClassInfluence+         msgAdd msgClass $ makePhrase [MU.Capitalize $ MU.Phrase attackParts]+                           <> msgArmor <> tmpInfluenceBlurb <> "."+         actorMaxSkills <- getsState sactorMaxSkills+         when (bfid sb == side+               && not (actorCanMeleeToHarm actorMaxSkills target tb)) $+           msgAdd MsgTutorialHint "This enemy can't harm you. Left alone could it possibly be of some use?"+         animateAlive (blid tb) basicAnim

engine-src/Game/LambdaHack/Client/UI/DrawM.hs view

@@ -36,6 +36,8 @@ import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.State import           Game.LambdaHack.Client.UI.ActorUI+import           Game.LambdaHack.Client.UI.Content.Screen+import           Game.LambdaHack.Client.UI.ContentClientUI import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend (frontendName) import           Game.LambdaHack.Client.UI.ItemDescription@@ -84,8 +86,8 @@         let percentage =              100 * bhp b               `div` xM (max 5 $ Ability.getSk Ability.SkMaxHP actorMaxSk)-            chs n = "[" <> T.replicate n "*"-                        <> T.replicate (4 - n) "_" <> "]"+            chs n = "[" <> T.replicate (4 - n) "_"+                        <> T.replicate n "*" <> "]"             stars = chs $ fromEnum $ max 0 $ min 4 $ percentage `div` 20             hpIndicator = if bfid b == side then Nothing else Just stars         return (Just $ bname bUI, hpIndicator)@@ -105,14 +107,15 @@           then do             bag <- getsState $ getFloorBag lid p             case EM.assocs bag of-              [] -> return $! "exact spot" <+> tshow p+              [] -> return $! "spot" <+> tshow p               [(iid, kit@(k, _))] -> do                 localTime <- getsState $ getLocalTime lid                 itemFull <- getsState $ itemToFull iid                 side <- getsClient sside                 factionD <- getsState sfactionD+                CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui                 let (name, powers) =-                      partItem side factionD localTime itemFull kit+                      partItem rwidth side factionD localTime itemFull kit                 return $! makePhrase [MU.Car1Ws k name, powers]               _ -> return $! "many items at" <+> tshow p           else return $! "an exact spot on level" <+> tshow (abs $ fromEnum lid)@@ -121,25 +124,26 @@       case mleader of         Nothing -> return (Just "a relative shift", Nothing)         Just aid -> do-          tgtPos <- getsState $ aidTgtToPos aid lidV mtarget+          mtgtPos <- getsState $ aidTgtToPos aid lidV mtarget           let invalidMsg = "an invalid relative shift"               validMsg p = "shift to" <+> tshow p-          return (Just $ maybe invalidMsg validMsg tgtPos, Nothing)+          return (Just $ maybe invalidMsg validMsg mtgtPos, Nothing)     Nothing -> return (Nothing, Nothing) -targetDescXhair :: MonadClientUI m => m (Maybe Text, Maybe (Text, Watchfulness))+targetDescXhair :: MonadClientUI m+                => m (Maybe Text, Maybe Text, Maybe Watchfulness) targetDescXhair = do   sxhair <- getsSession sxhair   (mhairDesc, mxhairHP) <- targetDesc sxhair-  case mxhairHP of-    Nothing -> return (mhairDesc, Nothing)-    Just tHP -> do-      let aid = case sxhair of-            Just (TEnemy a) -> a-            Just (TNonEnemy a) -> a-            _ -> error $ "HP text for non-actor target" `showFailure` sxhair+  let maid = case sxhair of+        Just (TEnemy a) -> Just a+        Just (TNonEnemy a) -> Just a+        _ -> Nothing+  case maid of+    Nothing -> return (mhairDesc, mxhairHP, Nothing)+    Just aid -> do       watchfulness <- bwatch <$> getsState (getActorBody aid)-      return $ (mhairDesc, Just (tHP, watchfulness))+      return (mhairDesc, mxhairHP, Just watchfulness)  drawFrameTerrain :: forall m. MonadClientUI m => LevelId -> m (U.Vector Word32) drawFrameTerrain drawnLevelId = do@@ -225,7 +229,10 @@ drawFramePath :: forall m. MonadClientUI m => LevelId -> m FrameForall drawFramePath drawnLevelId = do  SessionUI{saimMode} <- getSession- if isNothing saimMode then return $! FrameForall $ \_ -> return () else do+ sreportNull <- getsSession sreportNull+ if isNothing saimMode || sreportNull+ then return $! FrameForall $ \_ -> return ()+ else do   COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops   StateClient{seps} <- getClient   -- Not @ScreenContent@, because pathing in level's map.@@ -249,15 +256,17 @@         | pathGoal == xhairPos -> return tapPath       _ -> getCachePath aid xhairPos) mleader   assocsAtxhair <- getsState $ posToAidAssocs xhairPos drawnLevelId-  let lpath = if null bline then [] else maybe [] pathList mpath+  let lpath = delete xhairPos+              $ if null bline then [] else maybe [] pathList mpath       shiftedBTrajectory = case assocsAtxhair of         (_, Actor{btrajectory = Just p, bpos = prPos}) : _->           trajectoryToPath prPos (fst p)         _ -> []-      shiftedLine = if null shiftedBTrajectory-                    then bline-                    else shiftedBTrajectory-      acOnPathOrLine :: Char.Char -> Point -> ContentId TileKind+      shiftedLine = delete xhairPos+                    $ if null shiftedBTrajectory+                      then bline+                      else shiftedBTrajectory+      acOnPathOrLine :: Char -> Point -> ContentId TileKind                      -> Color.AttrCharW32       acOnPathOrLine !ch !p0 !tile =         let fgOnPathOrLine =@@ -309,11 +318,11 @@                             then Color.HighlightYellowAim                             else Color.HighlightYellow               bg = if | mleader == Just aid -> leaderColor-                      | bwatch == WSleep -> Color.HighlightGreen+                      | bwatch == WSleep -> Color.HighlightBlue                       | dominated -> if bfid == side  -- dominated by us-                                     then Color.HighlightWhite-                                     else Color.HighlightMagenta-                      | ES.member aid sselected -> Color.HighlightBlue+                                     then Color.HighlightCyan+                                     else Color.HighlightBrown+                      | ES.member aid sselected -> Color.HighlightGreen                       | otherwise -> Color.HighlightNone               fg | bfid /= side || bhp <= 0 = bcolor                  | otherwise =@@ -362,6 +371,8 @@       Just leader -> do         mtgt <- getsClient $ getTarget leader         getsState $ aidTgtToPos leader drawnLevelId mtgt+  side <- getsClient sside+  factionD <- getsState sfactionD   let visionMarks =         if smarkVision         then IS.toList $ ES.enumSetToIntSet totVisible@@ -391,28 +402,36 @@       xhairColor = if isJust saimMode                    then Color.HighlightRedAim                    else Color.HighlightRed+      locateStash (fid, fact) = case gstash fact of+        Just (lid, pos) | lid == drawnLevelId ->+          let stashColor = if fid == side+                           then Color.HighlightWhite+                           else Color.HighlightMagenta+          in Just (pos, stashColor)+        _ -> Nothing+      stashesToDisplay = mapMaybe locateStash $ EM.assocs factionD       upd :: FrameForall       upd = FrameForall $ \v -> do         when (isJust saimMode) $ mapVL backlightVision visionMarks v         case mtgtPos of           Nothing -> return ()-          Just p -> mapVL (writeSquare Color.HighlightGrey)-                          [fromEnum p] v+          Just p -> mapVL (writeSquare Color.HighlightGrey) [fromEnum p] v+        mapM_ (\(pos, color) -> mapVL (writeSquare color) [fromEnum pos] v)+              stashesToDisplay         case mxhairPos of  -- overwrites target           Nothing -> return ()-          Just p -> mapVL (writeSquare xhairColor)-                          [fromEnum p] v+          Just p -> mapVL (writeSquare xhairColor) [fromEnum p] v         when (dm == ColorBW) $ mapVL turnBW lDungeon v   return upd -drawFrameStatus :: MonadClientUI m => LevelId -> m AttrLine+drawFrameStatus :: MonadClientUI m => LevelId -> m AttrString drawFrameStatus drawnLevelId = do   cops@COps{corule=RuleContent{rXmax=_rXmax}} <- getsState scops   SessionUI{sselected, saimMode, swaitTimes, sitemSel} <- getSession   mleader <- getsClient sleader   xhairPos <- xhairToPos   mbfs <- maybe (return Nothing) (\aid -> Just <$> getCacheBfs aid) mleader-  (mhairDesc, mxhairHPWatchfulness) <- targetDescXhair+  (mhairDesc, mxhairHP, mxhairWatchfulness) <- targetDescXhair   lvl <- getLevel drawnLevelId   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD@@ -434,16 +453,16 @@   speedDisplay <- case mleader of     Nothing -> return []     Just leader -> do-      actorMaxSk <- getsState $ getActorMaxSkills leader+      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader       kitAssRaw <- getsState $ kitAssocs leader [CEqp, COrgan]-      let speed = Ability.getSk Ability.SkSpeed actorMaxSk+      let speed = Ability.getSk Ability.SkSpeed actorCurAndMaxSk           unknownBonus = unknownSpeedBonus $ map (fst . snd) kitAssRaw           speedString = displaySpeed speed ++ if unknownBonus then "?" else ""           conditionBonus = conditionSpeedBonus $ map snd kitAssRaw           cspeed = case compare conditionBonus 0 of+            LT -> Color.Red             EQ -> Color.White             GT -> Color.Green-            LT -> Color.Red       return $! map (Color.attrChar2ToW32 cspeed) speedString   let speedStatus = if length speedDisplay >= speedStatusWidth                     then []@@ -463,38 +482,45 @@             text = fromMaybe (pText <+> lText) mt         in if T.null text then "" else " " <> text       -- The indicators must fit, they are the actual information.-      pathCsr = displayPathText xhairPos (fst <$> mxhairHPWatchfulness)+      pathCsr = displayPathText xhairPos mxhairHP       trimTgtDesc n t = assert (not (T.null t) && n > 2 `blame` (t, n)) $         if T.length t <= n then t else T.take (n - 3) t <> "..."       -- The indicators must fit, they are the actual information.-      widthXhairOrItem = widthTgt - T.length pathCsr - 8+      widthXhairOrItem = widthTgt - T.length pathCsr       nMember = MU.Ord $ 1 + sum (EM.elems $ gvictims fact)       fallback = if MK.fleaderMode (gplayer fact) == MK.LeaderNull-                 then "This faction never picks a leader"+                 then "This faction never picks a pointman"                  else makePhrase                         ["Waiting for", nMember, "team member to spawn"]-      leaderName bUI = trimTgtDesc (widthTgt - 8) (bname bUI)+      leaderName bUI = trimTgtDesc (widthTgt - 10) (bname bUI)       leaderBlurbLong = maybe fallback (\bUI ->-        "Leader:" <+> leaderName bUI) mbodyUI+        "Pointman:" <+> leaderName bUI) mbodyUI       leaderBlurbShort = maybe fallback leaderName mbodyUI   ours <- getsState $ fidActorNotProjGlobalAssocs side+  ns <- getsState $ EM.size . getFactionStashBag side   let na = length ours       nl = ES.size $ ES.fromList $ map (blid . snd) ours-      ns = EM.size $ gsha fact       -- To be replaced by something more useful.-      teamBlurb = textToAL $ trimTgtDesc widthTgt $+      teamBlurb = textToAS $ trimTgtDesc widthTgt $         makePhrase [ "Team:"                    , MU.CarWs na "actor", "on"                    , MU.CarWs nl "level" <> ","                    , "stash", MU.Car ns ]       markSleepTgtDesc-        | (snd <$> mxhairHPWatchfulness) /= Just WSleep = textToAL-        | otherwise = textFgToAL Color.Green+        | mxhairWatchfulness /= Just WSleep = textToAS+        | otherwise = textFgToAS Color.cSleep+      xdetail AimMode{detailLevel} =+        "x" <> tshow (1 + fromEnum detailLevel)+      xhairName aimMode = "Crosshair" <+> xdetail aimMode       xhairBlurb =-        maybe teamBlurb (\t ->-          textToAL (if isJust saimMode then "x-hair>" else "X-hair:")-          <+:> markSleepTgtDesc (trimTgtDesc widthXhairOrItem t))-        mhairDesc+        maybe+          teamBlurb+          (\t -> case saimMode of+             Just aimMode ->+               textToAS (xhairName aimMode <> ":")+               <+:> markSleepTgtDesc (trimTgtDesc (widthXhairOrItem - 14) t)+             Nothing -> markSleepTgtDesc (trimTgtDesc widthXhairOrItem t))+          mhairDesc       tgtOrItem         | Just (iid, fromCStore, _) <- sitemSel         , Just leader <- mleader@@ -507,10 +533,17 @@                 localTime <- getsState $ getLocalTime (blid b)                 itemFull <- getsState $ itemToFull iid                 factionD <- getsState sfactionD+                CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui                 let (name, powers) =-                      partItem (bfid b) factionD localTime itemFull kit+                      partItem rwidth (bfid b) factionD localTime itemFull kit                     t = makePhrase [MU.Car1Ws k name, powers]-                return (textToAL $ "Item:" <+> trimTgtDesc (widthTgt - 6) t, "")+                    xhairHP = maybe "" (" " <>) mxhairHP+                    (xItemWidth, xItemText) = case saimMode of+                      Just aimMode -> (9, "Item" <+> xdetail aimMode)+                      Nothing -> (6, "Item")+                    trimTD =+                      trimTgtDesc (widthTgt - T.length xhairHP - xItemWidth) t+                return (textToAS $ xItemText <> ":" <+> trimTD, xhairHP)         | otherwise =             return (xhairBlurb, pathCsr)   (xhairLine, pathXhairOrNull) <- tgtOrItem@@ -521,18 +554,20 @@         if | T.length leaderBlurbShort > withForLeader -> ""            | T.length leaderBlurbLong > withForLeader -> leaderBlurbShort            | otherwise -> leaderBlurbLong-      damageGap = emptyAttrLine+      damageGap = blankAttrString                   $ widthTgt - damageStatusWidth - T.length leaderBottom-      xhairGap = emptyAttrLine (widthTgt - T.length pathXhairOrNull+      xhairGap = blankAttrString (widthTgt - T.length pathXhairOrNull                                          - length xhairLine)-      xhairStatus = xhairLine ++ xhairGap ++ textToAL pathXhairOrNull-      selectedGap = emptyAttrLine (widthStatus - leaderStatusWidth+      xhairStatus = xhairLine ++ xhairGap ++ textToAS pathXhairOrNull+      selectedGap = blankAttrString (widthStatus - leaderStatusWidth                                                - selectedStatusWidth                                                - length speedStatus)       status = arenaStatus-               <+:> xhairStatus+               <> [Color.spaceAttrW32]+               <> xhairStatus                <> selectedStatus ++ selectedGap ++ speedStatus ++ leaderStatus-               <+:> (textToAL leaderBottom ++ damageGap ++ damageStatus)+               <> [Color.spaceAttrW32]+               <> (textToAS leaderBottom ++ damageGap ++ damageStatus)   -- Keep it at least partially lazy, to avoid allocating the whole list:   return #ifdef WITH_EXPENSIVE_ASSERTIONS@@ -549,31 +584,37 @@   updPath <- drawFramePath drawnLevelId   updActor <- drawFrameActor drawnLevelId   updExtra <- drawFrameExtra dm drawnLevelId+  soptions <- getsClient soptions   let upd = FrameForall $ \v -> do         unFrameForall updContent v         -- vty frontend is screen-reader friendly, so avoid visual fluff-        unless (frontendName == "vty") $ unFrameForall updPath v+        unless (frontendName soptions == "vty") $ unFrameForall updPath v         unFrameForall updActor v         unFrameForall updExtra v   return (baseTerrain, upd)  -- Comfortably accomodates 3-digit level numbers and 25-character -- level descriptions (currently enforced max).-drawArenaStatus :: COps -> Level -> Int -> AttrLine+--+-- Sometimes the level seems fully explored, but the display shows+-- 99% or even goes from 100% to 99% at some moment.+-- This is due to monsters, e.g., clearning rubble or burning bush,+-- and so creating a new explorable terrain.+drawArenaStatus :: COps -> Level -> Int -> AttrString drawArenaStatus COps{cocave}                 Level{lkind, ldepth=Dice.AbsDepth ld, lseen, lexpl}                 width =   let ck = okind cocave lkind       seenN = 100 * lseen `div` max 1 lexpl       seenTxt | seenN >= 100 = "all"-              | otherwise = T.justifyLeft 3 ' ' (tshow seenN <> "%")+              | otherwise = tshow seenN <> "%"       lvlN = T.justifyLeft 2 ' ' (tshow ld)       seenStatus = "[" <> seenTxt <+> "seen]"-  in textToAL $ T.justifyLeft width ' '-              $ T.take 29 (lvlN <+> T.justifyLeft 26 ' ' (cname ck))-                <+> seenStatus+  in textToAS $ T.take (width - 10)+                       (T.justifyLeft (width - 10) ' ' (lvlN <+> cname ck))+                <> T.justifyRight 10 ' ' seenStatus -drawLeaderStatus :: MonadClientUI m => Int -> m AttrLine+drawLeaderStatus :: MonadClientUI m => Int -> m AttrString drawLeaderStatus waitT = do   time <- getsState stime   let calmHeaderText = "Calm"@@ -585,10 +626,10 @@   case mleader of     Just leader -> do       b <- getsState $ getActorBody leader-      actorMaxSk <- getsState $ getActorMaxSkills leader+      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader       (hpCheckWarning, calmCheckWarning)         <- getsState $ checkWarnings sUIOptions leader-      bdark <- getsState $ \s -> not (actorInAmbient b s)+      bdark <- getsState $ not . actorInAmbient b       let showTrunc x = let t = show x                         in if length t > 3                            then if x > 0 then "***" else "---"@@ -604,9 +645,9 @@               = addColor Color.BrRed  -- alarming news have priority             | snd resCurrentTurn > 0 || snd resPreviousTurn > 0               = addColor Color.BrGreen-            | otherwise = stringToAL  -- only if nothing at all noteworthy+            | otherwise = stringToAS  -- only if nothing at all noteworthy           checkSleep body resDelta-            | bwatch body == WSleep = addColor Color.Green+            | bwatch body == WSleep = addColor Color.cSleep             | otherwise = checkDelta resDelta           calmAddAttr = checkSleep b $ bcalmDelta b           -- We only show ambient light, because in fact client can't tell@@ -615,57 +656,84 @@           darkPick | bdark = "."                    | otherwise = ":"           calmHeader = calmAddAttr $ calmHeaderText <> darkPick+          maxCalm = max 0 $ Ability.getSk Ability.SkMaxCalm actorCurAndMaxSk           calmText = showTrunc (bcalm b `divUp` oneM)                      <> (if bdark then slashPick else "/")-                     <> showTrunc (max 0 $ Ability.getSk Ability.SkMaxCalm-                                                         actorMaxSk)+                     <> showTrunc maxCalm           bracePick | actorWaits b = "}"                     | otherwise = ":"           hpAddAttr = checkDelta $ bhpDelta b           hpHeader = hpAddAttr $ hpHeaderText <> bracePick+          maxHP = max 0 $ Ability.getSk Ability.SkMaxHP actorCurAndMaxSk           hpText = showTrunc (bhp b `divUp` oneM)                    <> (if not bdark then slashPick else "/")-                   <> showTrunc (max 0 $ Ability.getSk Ability.SkMaxHP-                                                       actorMaxSk)+                   <> showTrunc maxHP           justifyRight n t = replicate (n - length t) ' ' ++ t-          colorWarning w = if w then addColor Color.Red else stringToAL+          colorWarning w enough full | w = addColor Color.Red+                                     | not enough = addColor Color.Brown+                                     | full = addColor Color.Magenta+                                     | otherwise = stringToAS       return $! calmHeader-                <> colorWarning calmCheckWarning (justifyRight 7 calmText)+                <> colorWarning calmCheckWarning+                                (calmEnough b actorCurAndMaxSk)+                                (bcalm b > xM maxCalm)+                                (justifyRight 7 calmText)                 <+:> hpHeader-                <> colorWarning hpCheckWarning (justifyRight 7 hpText)+                <> colorWarning hpCheckWarning+                                True+                                (bhp b > xM maxHP)+                                (justifyRight 7 hpText)     Nothing -> do       -- This is a valuable feedback for passing of time while faction       -- leaderless and especially while temporarily actor-less..       let slashPick = slashes !! (max 0 waitGlobal `mod` length slashes)-      return $! stringToAL (calmHeaderText ++ ":  --" ++ slashPick ++ "--")-                <+:> stringToAL (hpHeaderText <> ":  --/--")+      return $! stringToAS (calmHeaderText ++ ":  --" ++ slashPick ++ "--")+                <+:> stringToAS (hpHeaderText <> ":  --/--") -drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrLine+drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrString drawLeaderDamage width leader = do   kitAssRaw <- getsState $ kitAssocs leader [CEqp, COrgan]-  actorSk <- leaderSkillsClientUI-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let hasTimeout itemFull =-        let arItem = aspectRecordFull itemFull-            timeout = IA.aTimeout arItem-        in timeout > 0-      hasEffect itemFull =-        any IK.forApplyEffect $ IK.ieffects $ itemKind itemFull-      ppDice :: (Int, ItemFullKit) -> [(Bool, AttrLine)]-      ppDice (nch, (itemFull, (k, _))) =-        let tdice = show $ IK.idamage $ itemKind itemFull-            tdiceEffect = if hasEffect itemFull+  actorCurAndMaxSk <- leaderSkillsClientUI+  let unBurn (IK.Burn d) = Just d+      unBurn _ = Nothing+      unRefillHP (IK.RefillHP n) = Just n+      unRefillHP _ = Nothing+      hasNonDamagesEffect itemFull =+        any (\eff -> IK.forApplyEffect eff && not (IK.forDamageEffect eff))+            (IK.ieffects $ itemKind itemFull)+      ppDice :: Bool -> (Bool, Int, Int, ItemFullKit)+             -> [(Bool, (AttrString, AttrString))]+      ppDice showInBrief (hasEffect, timeout, nch, (itemFull, (k, _))) =+        let dice = IK.idamage $ itemKind itemFull+            tdice = case Dice.reduceDice dice of+              Just d | showInBrief -> show d+              _ -> show dice+            -- We ignore nested effects because they are, in general, avoidable.+            -- We also ignore repeated effect kinds for HUD simplicity.+            tBurn = maybe "" (('+' :) . show)  $ listToMaybe $ mapMaybe unBurn+                                               $ IK.ieffects $ itemKind itemFull+            nRefillHP = maybe 0 (min 0) $ listToMaybe $ mapMaybe unRefillHP+                                        $ IK.ieffects $ itemKind itemFull+            tRefillHP | nRefillHP < 0 = '+' : show (- nRefillHP)+                      | otherwise = ""+            tdiceEffect = if hasEffect && hasNonDamagesEffect itemFull                           then map Char.toUpper tdice                           else tdice-        in if hasTimeout itemFull+            ldice color = map (Color.attrChar2ToW32 color) tdiceEffect+            lBurnHP charged =+              let cburn = if charged then Color.BrRed else Color.Red+                  chp = if charged then Color.BrMagenta else Color.Magenta+              in map (Color.attrChar2ToW32 cburn) tBurn+                 ++ map (Color.attrChar2ToW32 chp) tRefillHP+            possiblyHasTimeout = timeout > 0 || itemSuspect itemFull+        in if possiblyHasTimeout            then replicate (k - nch)-                  (False, map (Color.attrChar2ToW32 Color.Cyan) tdiceEffect)-                ++ replicate nch-                     (True, map (Color.attrChar2ToW32 Color.BrCyan) tdiceEffect)-           else [(True, map (Color.attrChar2ToW32 Color.BrBlue) tdiceEffect)]-      lbonus :: AttrLine+                          (False, (ldice Color.Cyan, lBurnHP False))+                ++ replicate nch (True, (ldice Color.BrCyan, lBurnHP True))+           else [(True, (ldice Color.BrBlue, lBurnHP True))]+      lbonus :: AttrString       lbonus =-        let bonusRaw = Ability.getSk Ability.SkHurtMelee actorMaxSk+        let bonusRaw = Ability.getSk Ability.SkHurtMelee actorCurAndMaxSk             bonus = min 200 $ max (-200) bonusRaw             unknownBonus = unknownMeleeBonus $ map (fst . snd) kitAssRaw             tbonus = if bonus == 0@@ -676,32 +744,51 @@                           <> if unknownBonus then "%?" else "%"             conditionBonus = conditionMeleeBonus $ map snd kitAssRaw             cbonus = case compare conditionBonus 0 of+              LT -> Color.Red               EQ -> Color.White               GT -> Color.Green-              LT -> Color.Red         in map (Color.attrChar2ToW32 cbonus) tbonus   let kitAssOnlyWeapons =         filter (IA.checkFlag Ability.Meleeable                 . aspectRecordFull . fst . snd) kitAssRaw   discoBenefit <- getsClient sdiscoBenefit-  strongest <- map (second snd . snd) <$>-    pickWeaponM True (Just discoBenefit) kitAssOnlyWeapons actorSk leader-  let (lT, lRatherNoT) = span (hasTimeout . fst . snd) strongest-      strongestToDisplay = lT ++ take 1 lRatherNoT-      lToDisplay = concatMap ppDice strongestToDisplay-      (ldischarged, lrest) = span (not . fst) lToDisplay-      lWithBonus = case map snd lrest of-        [] -> []  -- unlikely; means no timeout-free organ-        l1 : rest -> (l1 ++ lbonus) : rest-      lFlat = intercalate [Color.spaceAttrW32]-              $ map snd ldischarged ++ lWithBonus-      lFits = if length lFlat > width-              then take (width - 3) lFlat ++ stringToAL "..."-              else lFlat+  strongest <-+    map (\(_, hasEffect, timeout, ncha, _, itemFullKit) ->+          (hasEffect, timeout, ncha, itemFullKit))+    <$> pickWeaponM True (Just discoBenefit) kitAssOnlyWeapons+                    actorCurAndMaxSk leader+  let possiblyHasTimeout (_, timeout, _, (itemFull, _)) =+        timeout > 0 || itemSuspect itemFull+      (lT, lTrest) = span possiblyHasTimeout strongest+      strongestToDisplay = lT ++ case lTrest of+        [] -> []+        noTimeout : lTrest2 -> noTimeout : filter possiblyHasTimeout lTrest2+          -- the second portion of timeout weapons won't ever be used+          -- but often it's the player's mistake, so show them anyway+      showStrongest showInBrief l =+        let lToDisplay = concatMap (ppDice showInBrief) l+            (ldischarged, lrest) = span (not . fst) lToDisplay+            lWithBonus = case map snd lrest of+              [] -> []  -- no timeout-free organ, e.g., rattlesnake or hornet+              (ldmg, lextra) : rest -> (ldmg ++ lbonus, lextra) : rest+            displayDmgAndExtra (ldmg, lextra) =+              if map Color.charFromW32 ldmg == "0"+              then case lextra of+                [] -> ldmg+                _plus : lextraRest -> lextraRest+              else ldmg ++ lextra+        in intercalate [Color.spaceAttrW32]+           $ map displayDmgAndExtra $ map snd ldischarged ++ lWithBonus+      lFull = showStrongest False strongestToDisplay+      lBrief = showStrongest True strongestToDisplay+      lFits | length lFull <= width = lFull+                -- the prevailing case, so optimized for this case only+            | length lBrief <= width = lBrief+            | otherwise = take (width - 3) lBrief ++ stringToAS "..."   return $! lFits  drawSelected :: MonadClientUI m-             => LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrLine)+             => LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrString) drawSelected drawnLevelId width selected = do   mleader <- getsClient sleader   side <- getsClient sside@@ -715,8 +802,8 @@         -- Domination not considered at all, because map already shows it         -- and so here is the only place where selection is conveyed.         let bg = if | mleader == Just aid -> Color.HighlightYellow-                    | bwatch == WSleep -> Color.HighlightGreen-                    | ES.member aid selected -> Color.HighlightBlue+                    | bwatch == WSleep -> Color.HighlightBlue+                    | ES.member aid selected -> Color.HighlightGreen                     | otherwise -> Color.HighlightNone             sattr = Color.Attr {Color.fg = bcolor, bg}         in Color.attrCharToW32 $ Color.AttrChar sattr@@ -735,18 +822,18 @@  checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool checkWarningHP UIOptions{uhpWarningPercent} leader hp s =-  let actorMaxSk = getActorMaxSkills leader s-      maxHp = Ability.getSk Ability.SkMaxHP actorMaxSk+  let actorCurAndMaxSk = getActorMaxSkills leader s+      maxHp = Ability.getSk Ability.SkMaxHP actorCurAndMaxSk   in hp <= xM (uhpWarningPercent * maxHp `div` 100)  checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool checkWarningCalm UIOptions{uhpWarningPercent} leader calm s =   let b = getActorBody leader s-      actorMaxSk = getActorMaxSkills leader s+      actorCurAndMaxSk = getActorMaxSkills leader s       isImpression iid =-        maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getIidKind iid s+        maybe False (> 0) $ lookup IK.S_IMPRESSED $ IK.ifreq $ getIidKind iid s       isImpressed = any isImpression $ EM.keys $ borgan b-      maxCalm = Ability.getSk Ability.SkMaxCalm actorMaxSk+      maxCalm = Ability.getSk Ability.SkMaxCalm actorCurAndMaxSk   in calm <= xM (uhpWarningPercent * maxCalm `div` 100)      && isImpressed

engine-src/Game/LambdaHack/Client/UI/EffectDescription.hs view

@@ -1,11 +1,15 @@+{-# LANGUAGE DeriveGeneric #-} -- | Description of effects. module Game.LambdaHack.Client.UI.EffectDescription-  ( DetailLevel(..), effectToSuffix, detectToObject, detectToVerb+  ( DetailLevel(..), defaultDetailLevel+  , effectToSuffix, detectToObject, detectToVerb   , skillName, skillDesc, skillToDecorator, skillSlots   , kindAspectToSuffix, aspectToSentence, affixDice+  , describeToolsAlternative, describeCrafting, wrapInParens #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , slotToSentence, tmodToSuff, affixBonus, wrapInParens, wrapInChevrons+  , conditionToObject, activationFlagToObject, slotToSentence, tmodToSuff+  , affixBonus, wrapInChevrons #endif   ) where @@ -13,7 +17,9 @@  import Game.LambdaHack.Core.Prelude +import           Data.Binary import qualified Data.Text as T+import           GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU  import           Game.LambdaHack.Common.Actor@@ -24,10 +30,14 @@ import           Game.LambdaHack.Definition.Ability import           Game.LambdaHack.Definition.Defs -data DetailLevel =-    DetailNone | DetailLow | DetailMedium | DetailHigh | DetailAll-  deriving (Eq, Ord, Enum, Bounded)+data DetailLevel = DetailLow | DetailMedium | DetailHigh | DetailAll+  deriving (Show, Eq, Ord, Enum, Bounded, Generic) +instance Binary DetailLevel++defaultDetailLevel :: DetailLevel+defaultDetailLevel = DetailAll  -- TODO: take from config file+ -- | Suffix to append to a basic content name if the content causes the effect. -- -- We show absolute time in seconds, not @moves@, because actors can have@@ -88,20 +98,42 @@     Teleport dice | Dice.supDice dice <= 9 ->       "of blinking" <+> wrapInParens (tshow dice)     Teleport dice -> "of teleport" <+> wrapInParens (tshow dice)-    CreateItem COrgan grp tim ->+    CreateItem _ COrgan grp tim ->       let stime = if isTimerNone tim then "" else "for" <+> tshow tim <> ":"       in "(keep" <+> stime <+> fromGroupName grp <> ")"-    CreateItem{} -> "of gain"+    CreateItem _ _ grp _ ->+      makePhrase ["of gain", MU.AW $ MU.Text $ fromGroupName grp]+    DestroyItem{} -> "of loss"+    ConsumeItems{} -> "of consumption from the ground"+      -- too much noise from crafting     DropItem n k store grp ->       let (preT, postT) =             if | n == 1 && k == maxBound -> ("one", "kind")                | n == maxBound && k == maxBound -> ("all", "kinds")-               | otherwise -> ("", "")+               | k == 1 || store /= COrgan -> ("", "")+               | k == maxBound -> ("", "condition fully")+               | otherwise -> ("", "condition" <+> tshow k <> "-fold")           (verb, fromStore) =             if store == COrgan             then ("nullify", "")             else ("drop", "from" <+> snd (ppCStore store))       in "of" <+> verb <+> preT <+> fromGroupName grp <+> postT <+> fromStore+    Recharge n dice ->+      let times = if n == 1 then "" else tshow n <+> "times"+      in case Dice.reduceDice dice of+        Nothing -> "of recharge" <+> times+                   <+> "by" <+> tshow dice <+> "* 0.05s"+        Just p -> let dt = timeDeltaScale (Delta timeClip) p+                  in "of recharge" <+> times+                     <+> "by" <+> timeDeltaInSecondsText dt+    Discharge n dice ->+      let times = if n == 1 then "" else tshow n <+> "times"+      in case Dice.reduceDice dice of+        Nothing -> "of discharge" <+> times+                   <+> "by" <+> tshow dice <+> "* 0.05s"+        Just p -> let dt = timeDeltaScale (Delta timeClip) p+                  in "of discharge" <+> times+                     <+> "by" <+> timeDeltaInSecondsText dt     PolyItem -> "of repurpose on the ground"     RerollItem -> "of deeply reshape on the ground"     DupItem -> "of multiplication on the ground"@@ -111,22 +143,97 @@     SendFlying tmod -> "of impact" <+> tmodToSuff "" tmod     PushActor tmod -> "of pushing" <+> tmodToSuff "" tmod     PullActor tmod -> "of pulling" <+> tmodToSuff "" tmod-    DropBestWeapon -> "of disarming"-    ActivateInv ' ' -> "of backpack burst"-    ActivateInv symbol -> "of burst '" <> T.singleton symbol <> "'"-    OneOf l ->-      let subject = if length l <= 5 then "marvel" else "wonder"-          header = makePhrase ["of", MU.CardinalWs (length l) subject]-          marvels = T.intercalate ", " $ map (effectToSuffix detailLevel) l-      in if detailLevel >= DetailAll && marvels /= ""-         then header <+> "[" <> marvels <> "]"-         else header  -- of no wonders :)+    AtMostOneOf effs ->+      let ts = filter (/= "") $ map (effectToSuffix detailLevel) effs+          subject = "marvel"+          header = makePhrase ["of", MU.CardinalWs (length ts) subject]+          sometimes = if length effs > length ts then "(sometimes)" else ""+      in case ts of+        [] -> ""+        [wonder] -> wonder <+> sometimes+        _ | detailLevel < DetailAll -> header+        _ -> header <+> "[" <> T.intercalate ", " ts <> "]" <+> sometimes+    OneOf effs ->+      let ts = filter (/= "") $ map (effectToSuffix detailLevel) effs+          subject = "wonder"+          header = makePhrase ["of", MU.CardinalWs (length ts) subject]+          sometimes = if length effs > length ts then "(sometimes)" else ""+      in case ts of+        [] -> ""+        [wonder] -> wonder <+> sometimes+        _ | detailLevel < DetailAll -> header+        _ -> header <+> "[" <> T.intercalate ", " ts <> "]" <+> sometimes     OnSmash _ -> ""  -- printed inside a separate section-    VerbNoLonger _ -> ""  -- no description for a flavour effect-    VerbMsg _ -> ""  -- no description for an effect that prints a description-    Composite effs -> T.intercalate " and then "-                    $ filter (/= "") $ map (effectToSuffix detailLevel) effs+    OnCombine _ -> ""  -- printed inside a separate section+    OnUser eff -> let t = effectToSuffix detailLevel eff+                  in if T.null t then "" else "(on user:" <+> t <> ")"+    NopEffect -> ""  -- never printed+    AndEffect (ConsumeItems tools raw) eff -> case detailLevel of+      DetailAll ->+       let (tcraft, traw, ttools) = describeCrafting tools raw eff+       in tcraft <+> traw <+> ttools+      DetailHigh -> "of crafting (recipes in lore menu)"+      _ -> "of crafting"+    AndEffect eff1 eff2 ->+      let t = T.intercalate " and then "+              $ nub $ filter (not . T.null)+              $ map (effectToSuffix detailLevel) [eff1, eff2]+      in if T.null t then "of conjunctive processing" else t+    OrEffect eff1 eff2 ->+      let t = T.intercalate " or else "+              $ nub $ filter (not . T.null)+              $ map (effectToSuffix detailLevel) [eff1, eff2]+      in if T.null t then "of alternative processing" else t+    SeqEffect effs ->+      let t = T.intercalate " then "+              $ nub $ filter (not . T.null)+              $ map (effectToSuffix detailLevel) effs+      in if T.null t then "of sequential processing" else t+    When cond eff ->+      let object = conditionToObject cond+          object2 = effectToSuffix detailLevel eff+      in if T.null object2+         then ""  -- no 'conditional processing' --- probably a hack+         else "when" <+> object <+> "then" <+> object2+    Unless cond eff ->+      let object = conditionToObject cond+          object2 = effectToSuffix detailLevel eff+      in if T.null object2+         then ""+         else "unless" <+> object <+> "then" <+> object2+    IfThenElse cond eff1 eff2 ->+      let object = conditionToObject cond+          object1 = effectToSuffix detailLevel eff1+          object2 = effectToSuffix detailLevel eff2+      in if T.null object1 && T.null object2+         then ""+         else "if" <+> object <+> "then" <+> object1 <+> "else" <+> object2+    VerbNoLonger{} -> ""  -- no description for a flavour effect+    VerbMsg{} -> ""  -- no description for an effect that prints a description+    VerbMsgFail{} -> "" +conditionToObject :: Condition -> Text+conditionToObject = \case+  HpLeq n -> "HP <=" <+> tshow n+  HpGeq n -> "HP >=" <+> tshow n+  CalmLeq n -> "Calm <=" <+> tshow n+  CalmGeq n -> "Calm >=" <+> tshow n+  TriggeredBy activationFlag ->+    "activated" <+> activationFlagToObject activationFlag++activationFlagToObject :: ActivationFlag -> Text+activationFlagToObject = \case+  ActivationMeleeable -> "by meleeing"+  ActivationPeriodic -> "periodically"+  ActivationUnderRanged -> "under ranged attack"+  ActivationUnderMelee -> "under melee attack"+  ActivationProjectile -> "when flung"+  ActivationTrigger -> "by triggering"+  ActivationOnSmash -> "on smash"+  ActivationOnCombine -> "when combined"+  ActivationEmbed -> "embedded in terrain"+  ActivationConsume -> "when consumed"+ detectToObject :: DetectKind -> Text detectToObject d = case d of   DetectAll -> "detail"@@ -135,6 +242,7 @@   DetectExit -> "exit"   DetectHidden -> "secret"   DetectEmbed -> "feature"+  DetectStash -> "stash"  detectToVerb :: DetectKind -> Text detectToVerb d = case d of@@ -144,13 +252,14 @@   DetectExit -> "learn nearby"   DetectHidden -> "uncover nearby"   DetectEmbed -> "notice nearby"+  DetectStash -> "locate"  slotToSentence :: EqpSlot -> Text slotToSentence es = case es of   EqpSlotMove -> "Those unskilled in locomotion equip it."   EqpSlotMelee -> "Those unskilled in close combat equip it."   EqpSlotDisplace -> "Those unskilled in moving in crowds equip it."-  EqpSlotAlter -> "Those unskilled in terrain alteration equip it."+  EqpSlotAlter -> "Those unskilled in terrain modification equip it."   EqpSlotWait -> "Those unskilled in watchfulness equip it."   EqpSlotMoveItem -> "Those unskilled in inventory management equip it."   EqpSlotProject -> "Those unskilled in item flinging equip it."@@ -172,11 +281,11 @@ skillName SkMove = "move stat" skillName SkMelee = "melee stat" skillName SkDisplace = "displace stat"-skillName SkAlter = "alter tile stat"+skillName SkAlter = "modify terrain stat" skillName SkWait = "wait stat" skillName SkMoveItem = "manage items stat" skillName SkProject = "fling stat"-skillName SkApply = "apply stat"+skillName SkApply = "trigger stat" skillName SkSwimming = "swimming" skillName SkFlying = "flying" skillName SkHurtMelee = "to melee damage"@@ -188,10 +297,12 @@ skillName SkSight = "sight radius" skillName SkSmell = "smell radius" skillName SkShine = "shine radius"-skillName SkNocto = "night vision radius"+skillName SkNocto = "noctovision radius" skillName SkHearing = "hearing radius" skillName SkAggression = "aggression level" skillName SkOdor = "odor level"+skillName SkDeflectRanged = "ranged deflection"+skillName SkDeflectMelee = "melee deflection"  skillDesc :: Skill -> Text skillDesc skill =@@ -206,7 +317,7 @@     SkDisplace -> capStatName <+>       "determines whether the character can displace adjacent actors. In some cases displacing is not possible regardless of skill: when the target is braced, dying, has no move skill or when both actors are supported by adjacent friendly units. Missiles can be displaced always, unless more than one occupies the map location."     SkAlter -> capStatName <+>-      "determines which kinds of terrain can be altered or triggered by the character. Opening doors and searching suspect tiles require skill 2, some stairs require 3, closing doors requires 4, others require 4 or 5. Actors not smart enough to be capable of using stairs can't be dominated."+      "determines which kinds of terrain can be activated and modified by the character. Opening doors and searching suspect tiles require skill 2, some stairs require 3, closing doors requires 4, others require 4 or 5. Actors not smart enough to be capable of using stairs can't be dominated."     SkWait -> capStatName <+>       "determines whether the character can wait, brace for combat (potentially blocking the effects of some attacks), sleep and lurk."     SkMoveItem -> capStatName <+>@@ -214,17 +325,17 @@     SkProject -> capStatName <+>       "determines which kinds of items the character can propel. Items that can be lobbed to explode at a precise location, such as flasks, require skill 3. Other items travel until they meet an obstacle and skill 1 is enough to fling them. In some cases, e.g., of too intricate or two awkward items at low Calm, throwing is not possible regardless of the skill value."     SkApply -> capStatName <+>-      "determines which kinds of items the character can activate. Items that assume literacy require skill 2, others can be used already at skill 1. In some cases, e.g., when the item needs recharging, has no possible effects or is too intricate for the character Calm level, applying may not be possible."+      "determines which kinds of items the character can use. Items that assume literacy require skill 2, others can be used already at skill 1. In some cases, e.g., when the item needs recharging, has no possible effects or is too intricate for distracted use, triggering may not be possible."     SkSwimming -> capSkillName <+>       "is the degree of avoidance of bad effects of terrain containing water, whether shallow or deep."     SkFlying -> capSkillName <+>       "is the degree of avoidance of bad effects of any hazards spread on the ground."     SkHurtMelee -> capSkillName <+>-      "is a percentage of additional damage dealt by the actor (either a character or a missile) with any weapon. The value is capped at 200%, then the armor percentage of the defender is subtracted from it and the resulting total is capped at 99%."+      "is a percentage of additional damage dealt by the actor (either a character or a missile) with any weapon. The value is capped at 200% and then the armor percentage of the defender is subtracted from it."     SkArmorMelee -> capSkillName <+>-      "is a percentage of melee damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 99% (always at least 1% of damage gets through). It includes 50% bonus from being braced for combat, if applicable."+      "is a percentage of melee damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 95% (always at least 5% of damage gets through). It includes 50% bonus from being braced for combat, if applicable."     SkArmorRanged -> capSkillName <+>-      "is a percentage of ranged damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 99% (always at least 1% of damage gets through). It includes 25% bonus from being braced for combat, if applicable."+      "is a percentage of ranged damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 95% (always at least 5% of damage gets through). It includes 25% bonus from being braced for combat, if applicable."     SkMaxHP -> capSkillName <+>       "is a cap on HP of the actor, except for some rare effects able to overfill HP. At any direct enemy damage (but not, e.g., incremental poisoning damage or wounds inflicted by mishandling a device) HP is cut back to the cap."     SkMaxCalm -> capSkillName <+>@@ -245,6 +356,10 @@       "represents the willingness of the actor to engage in combat, especially close quarters, and conversely, to break engagement when overpowered."     SkOdor -> "The '" <> skName <> "' property" <+>       "represents the ability to communicate (more specifically, communicate one's presence) through personal odor. Zero or less means the odor is not trackable."+    SkDeflectRanged -> "The '" <> skName <> "' property" <+>+      "tells whether complete invulnerability to ranged attacks, piercing and of every other kind, is effective, and from how many sources."+    SkDeflectMelee -> "The '" <> skName <> "' property" <+>+      "tells whether complete invulnerability to melee attacks, piercing and of every other kind, is effective, and from how many sources."  skillToDecorator :: Skill -> Actor -> Int -> Text skillToDecorator skill b t =@@ -284,6 +399,8 @@     SkHearing -> tshowRadius t     SkAggression -> tshow t     SkOdor -> tshow t+    SkDeflectRanged -> tshow t+    SkDeflectMelee -> tshow t  skillSlots :: [Skill] skillSlots = [minBound .. maxBound]@@ -306,11 +423,11 @@     AddSkill SkMove t -> wrapInParens $ affixDice t <+> "move"     AddSkill SkMelee t -> wrapInParens $ affixDice t <+> "melee"     AddSkill SkDisplace t -> wrapInParens $ affixDice t <+> "displace"-    AddSkill SkAlter t -> wrapInParens $ affixDice t <+> "alter"+    AddSkill SkAlter t -> wrapInParens $ affixDice t <+> "modify"     AddSkill SkWait t -> wrapInParens $ affixDice t <+> "wait"     AddSkill SkMoveItem t -> wrapInParens $ affixDice t <+> "manage items"     AddSkill SkProject t -> wrapInParens $ affixDice t <+> "fling"-    AddSkill SkApply t -> wrapInParens $ affixDice t <+> "apply"+    AddSkill SkApply t -> wrapInParens $ affixDice t <+> "trigger"     AddSkill SkSwimming t -> wrapInParens $ affixDice t <+> "swimming"     AddSkill SkFlying t -> wrapInParens $ affixDice t <+> "flying"     AddSkill SkHurtMelee _ ->@@ -327,20 +444,33 @@     AddSkill SkHearing t -> wrapInParens $ affixDice t <+> "hearing"     AddSkill SkAggression t -> wrapInParens $ affixDice t <+> "aggression"     AddSkill SkOdor t -> wrapInParens $ affixDice t <+> "odor"+    AddSkill SkDeflectRanged d ->+      if | Dice.infDice d >= 1 -> wrapInChevrons "deflecting ranged attacks"+         | Dice.supDice d <= -1 -> wrapInChevrons "vulnerable to ranged attacks"+         | otherwise -> ""  -- bad content?+    AddSkill SkDeflectMelee d ->+      if | Dice.infDice d >= 1 -> wrapInChevrons "deflecting melee attacks"+         | Dice.supDice d <= -1 -> wrapInChevrons "vulnerable to melee attacks"+         | otherwise -> ""  -- bad content?     SetFlag Fragile -> wrapInChevrons "fragile"     SetFlag Lobable -> wrapInChevrons "can be lobbed"     SetFlag Durable -> wrapInChevrons "durable"     SetFlag Equipable -> ""-    SetFlag Meleeable -> ""+    SetFlag Benign -> ""     SetFlag Precious -> ""     SetFlag Blast -> ""     SetFlag Condition -> ""-    SetFlag Unique -> ""  -- marked by capital letters in name-    SetFlag Periodic -> ""  -- printed specially+    SetFlag Unique -> ""  -- named specially by the content writer+    SetFlag MetaGame -> ""     SetFlag MinorEffects -> ""  -- cryptic override+    SetFlag MinorAspects -> ""  -- cryptic override+    SetFlag Meleeable -> ""+    SetFlag Periodic -> ""  -- printed specially+    SetFlag UnderRanged -> wrapInChevrons "applied under ranged attack"+    SetFlag UnderMelee -> wrapInChevrons "applied under melee attack"     ELabel{} -> ""  -- too late     ToThrow tmod -> wrapInChevrons $ tmodToSuff "flies" tmod-    HideAs{} -> ""+    PresentAs{} -> ""     EqpSlot{} -> ""  -- used in @slotToSentence@ instead     Odds{} -> "" @@ -353,17 +483,21 @@     SetFlag Lobable -> Nothing     SetFlag Durable -> Nothing     SetFlag Equipable -> Nothing-    SetFlag Meleeable ->-      Just "It is considered for melee strikes by default."+    SetFlag Benign -> Just "It affects the opponent in a benign way."     SetFlag Precious -> Just "It seems precious."     SetFlag Blast -> Nothing     SetFlag Condition -> Nothing-    SetFlag Unique -> Nothing-    SetFlag Periodic -> Nothing+    SetFlag Unique -> Just "It is one of a kind."+    SetFlag MetaGame -> Just "It's characteristic to a person and easy to recognize once learned, even under very different circumstances."     SetFlag MinorEffects -> Nothing+    SetFlag MinorAspects -> Nothing+    SetFlag Meleeable -> Just "It is considered for melee strikes."+    SetFlag Periodic -> Nothing+    SetFlag UnderRanged -> Nothing+    SetFlag UnderMelee -> Nothing     ELabel{} -> Nothing     ToThrow{} -> Nothing-    HideAs{} -> Nothing+    PresentAs{} -> Nothing     EqpSlot es -> Just $ slotToSentence es     Odds{} -> Just "Individual specimens sometimes have yet other properties." @@ -383,3 +517,37 @@  affixDice :: Dice.Dice -> Text affixDice d = maybe "+?" affixBonus $ Dice.reduceDice d++describeTools :: [(Int, GroupName ItemKind)] -> MU.Part+describeTools =+  let carAWs (k, grp) = MU.CarAWs k (MU.Text $ fromGroupName grp)+  in MU.WWandW . map carAWs++describeToolsAlternative :: [[(Int, GroupName ItemKind)]] -> Text+describeToolsAlternative grps =+  T.intercalate " or " $ map (\grp -> makePhrase [describeTools grp])+                       $ filter (not . null) grps++describeCrafting :: [(Int, GroupName ItemKind)]+                 -> [(Int, GroupName ItemKind)]+                 -> Effect+                 -> (Text, Text, Text)+describeCrafting tools raw eff =+  let unCreate (CreateItem (Just k) _ grp _) = [(k, grp)]+      unCreate (SeqEffect effs) = concatMap unCreate effs+      unCreate _ = []+      grpsCreate = unCreate eff+      tcraft = makePhrase $+        "of crafting"+        : (if null grpsCreate+           then ["nothing"]+           else [describeTools grpsCreate])+      traw = makePhrase $+        if null raw+        then []+        else ["from", describeTools raw]+      ttools = makePhrase $+        if null tools+        then []+        else ["using", describeTools tools]+  in (tcraft, traw, ttools)

engine-src/Game/LambdaHack/Client/UI/Frame.hs view

@@ -1,9 +1,11 @@-{-# LANGUAGE RankNTypes, TypeFamilies #-}+{-# LANGUAGE RankNTypes #-} -- | Screen frames. module Game.LambdaHack.Client.UI.Frame-  ( FrameST, FrameForall(..), FrameBase(..), Frame, PreFrame, PreFrames-  , SingleFrame(..)-  , blankSingleFrame, overlayFrame, overlayFrameWithLines+  ( ColorMode(..)+  , FrameST, FrameForall(..), FrameBase(..), Frame+  , PreFrame3, PreFrames3, PreFrame, PreFrames+  , SingleFrame(..), OverlaySpace+  , blankSingleFrame, truncateOverlay, overlayFrame #ifdef EXPOSE_INTERNAL     -- * Internal operations   , truncateAttrLine@@ -15,6 +17,7 @@ import Game.LambdaHack.Core.Prelude  import           Control.Monad.ST.Strict+import qualified Data.IntMap.Strict as IM import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM@@ -22,10 +25,16 @@  import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Definition.Defs +-- | Color mode for the display.+data ColorMode =+    ColorFull  -- ^ normal, with full colours+  | ColorBW    -- ^ black and white only+  deriving Eq+ type FrameST s = G.Mutable U.Vector s Word32 -> ST s ()  -- | Efficiently composable representation of an operation@@ -38,82 +47,152 @@   {unFrameBase :: forall s. ST s (G.Mutable U.Vector s Word32)}  -- | A frame, that is, a base frame and all its modifications.-type Frame = (FrameBase, FrameForall)+type Frame = ((FrameBase, FrameForall), (OverlaySpace, OverlaySpace))  -- | Components of a frame, before it's decided if the first can be overwritten -- in-place or needs to be copied.-type PreFrame = (U.Vector Word32, FrameForall)+type PreFrame3 = (PreFrame, (OverlaySpace, OverlaySpace))  -- | Sequence of screen frames, including delays. Potentially based on a single -- base frame.+type PreFrames3 = [Maybe PreFrame3]++-- | A simpler variant of @PreFrame3@.+type PreFrame = (U.Vector Word32, FrameForall)++-- | A simpler variant of @PreFrames3@. type PreFrames = [Maybe PreFrame]  -- | Representation of an operation of overwriting a frame with a single line -- at the given row.-writeLine :: Int -> AttrLine -> FrameForall+writeLine :: Int -> AttrString -> FrameForall {-# INLINE writeLine #-}-writeLine offset l = FrameForall $ \v -> do+writeLine offset al = FrameForall $ \v -> do   let writeAt _ [] = return ()       writeAt off (ac32 : rest) = do         VM.write v off (Color.attrCharW32 ac32)         writeAt (off + 1) rest-  writeAt offset l+  writeAt offset al --- | An overlay that fits on the screen (or is meant to be truncated on display)--- and is padded to fill the whole screen--- and is displayed as a single game screen frame.+-- | A frame that is padded to fill the whole screen with an optional+-- overlay to display in proportional font. ----- Note that we don't provide a list of color-highlighed positions separately,--- because overlays need to obscure not only map, but the highlights as well.-newtype SingleFrame = SingleFrame-  {singleFrame :: PointArray.Array Color.AttrCharW32}+-- Note that we don't provide a list of color-highlighed box positions+-- to be drawn separately, because overlays need to obscure not only map,+-- but the highlights as well, so highlights need to be included earlier.+data SingleFrame = SingleFrame+  { singleArray       :: PointArray.Array Color.AttrCharW32+  , singlePropOverlay :: OverlaySpace+  , singleMonoOverlay :: OverlaySpace }   deriving (Eq, Show) +type OverlaySpace = [(PointUI, AttrString)]+ blankSingleFrame :: ScreenContent -> SingleFrame blankSingleFrame ScreenContent{rwidth, rheight} =-  SingleFrame $ PointArray.replicateA rwidth rheight Color.spaceAttrW32+  SingleFrame (PointArray.replicateA rwidth rheight Color.spaceAttrW32)+              []+              []  -- | Truncate the overlay: for each line, if it's too long, it's truncated -- and if there are too many lines, excess is dropped and warning is appended.-truncateLines :: ScreenContent -> Bool -> Overlay -> Overlay-truncateLines ScreenContent{rwidth, rheight} onBlank l =-  let canvasLength = if onBlank then rheight else rheight - 2-      topLayer = if length l <= canvasLength-                 then l ++ [[] | length l < canvasLength && length l > 3]-                 else take (canvasLength - 1) l-                      ++ [stringToAL "--a portion of the text trimmed--"]-      f lenPrev lenNext layerLine =-        truncateAttrLine rwidth layerLine (max lenPrev lenNext)-      lens = map (min (rwidth - 1) . length) topLayer-  in zipWith3 f (0 : lens) (drop 1 lens ++ [0]) topLayer+-- The width, in the second argument, is calculated in characters,+-- not in UI (mono font) coordinates, so that taking and dropping characters+-- is performed correctly.+truncateOverlay :: Bool -> Int -> Int -> Bool -> Int -> Bool -> Overlay+                -> OverlaySpace+truncateOverlay halveXstart width rheight wipeAdjacentRaw fillLen onBlank ov =+  let wipeAdjacent = wipeAdjacentRaw && not onBlank+      canvasLength = if onBlank then rheight else rheight - 2+      supHeight = maximum $ 0 : map (\(PointUI _ y, _) -> y) ov+      trimmedY = canvasLength - 1+      -- Sadly, this does not trim the other, concurrent, overlays that may+      -- obscure the last line and so contend with the "trimmed" message.+      -- Tough luck; just avoid overrunning overlays in higher level code.+      ovTopFiltered = filter (\(PointUI _ y, _) -> y < trimmedY) ov+      trimmedAlert = ( PointUI 0 trimmedY+                     , stringToAL "--a portion of the text trimmed--" )+      extraLine | supHeight < 3+                  || supHeight >= trimmedY+                  || not wipeAdjacent = []+                | otherwise =+        let supHs = filter (\(PointUI _ y, _) -> y == supHeight) ov+        in if null supHs+           then []+           else let (PointUI xLast yLast, _) =+                      minimumBy (comparing $ \(PointUI x _, _) -> x) supHs+                in [(PointUI xLast (yLast + 1), emptyAttrLine)]+      ovTop = IM.elems $ IM.fromListWith (++)+              $ map (\pal@(PointUI _ y, _) -> (y, [pal]))+              $ if supHeight >= canvasLength+                then ovTopFiltered ++ [trimmedAlert]+                else ov ++ extraLine+      -- Unlike the trimming above, adding spaces around overlay depends+      -- on there being no gaps and a natural order.+      -- Probably also gives messy results when X offsets are not all the same.+      -- Below we at least mitigate the case of multiple lines per row.+      f lenPrev lenNext lal =+        -- This is crude, because an al at lower x may be longer, but KISS.+        -- @sortOn@ is significantly faster than @SortBy@ here,+        -- though it takes more memory. The below is an explicit compromise.+        let xlal = map (\pll@(PointUI x _, _) -> (x, pll)) lal+        in case sortBy (comparing fst) xlal of+          [] -> error "empty list of overlay lines at the given row"+          minAl : rest ->+            g lenPrev lenNext fillLen minAl+            : map (g 0 0 0) rest+      g lenPrev lenNext fillL (xstartRaw, (p, layerLine)) =+        let xstart = if halveXstart then xstartRaw `div` 2 else xstartRaw+            -- TODO: lenPrev and lenNext is from the same kind of font;+            -- if fonts are mixed, too few spaces are added.+            -- We'd need to keep a global store of line lengths+            -- for every position on the screen, filled first going+            -- over all texts and only afterwards texts rendered.+            maxLen = if wipeAdjacent then max lenPrev lenNext else 0+            fillFromStart = max fillL (1 + maxLen) - xstart+            available = width - xstart+        in (p, truncateAttrLine wipeAdjacent available fillFromStart layerLine)+      rightExtentOfLine (PointUI xstartRaw _, al) =+        let xstart = if halveXstart then xstartRaw `div` 2 else xstartRaw+        in min (width - 1) (xstart + length (attrLine al))+      lens = map (maximum . map rightExtentOfLine) ovTop+      f2 = map g2+      g2 (p@(PointUI xstartRaw _), layerLine) =+        let xstart = if halveXstart then xstartRaw `div` 2 else xstartRaw+            available = width - xstart+        in (p, truncateAttrLine False available 0 layerLine)+  in concat $ if onBlank+              then map f2 ovTop+              else zipWith3 f (0 : lens) (drop 1 lens ++ [0]) ovTop  -- | Add a space at the message end, for display overlayed over the level map.--- Also trim (do not wrap!) too long lines.-truncateAttrLine :: X -> AttrLine -> X -> AttrLine-truncateAttrLine w xs lenMax =-  case compare w (length xs) of-    LT -> let discarded = drop w xs-          in if all (== Color.spaceAttrW32) discarded-             then take w xs-             else take (w - 1) xs ++ [Color.attrChar2ToW32 Color.BrBlack '$']-    EQ -> xs-    GT -> let xsSpace =-                if | null xs -> xs-                   | last xs == Color.spaceAttrW32 -> xs ++ [Color.spaceAttrW32]-                   | otherwise -> xs ++ [Color.spaceAttrW32, Color.spaceAttrW32]-              whiteN = max (40 - length xsSpace) (1 + lenMax - length xsSpace)-          in xsSpace ++ replicate whiteN Color.spaceAttrW32+-- Also trim (do not wrap!) too long lines. Also add many spaces when under+-- longer lines.+truncateAttrLine :: Bool -> Int -> Int -> AttrLine -> AttrString+truncateAttrLine addSpaces available fillFromStart aLine =+  let al = attrLine aLine+      len = length al+  in if | null al -> if addSpaces+                     then replicate fillFromStart Color.spaceAttrW32+                     else al+        | len == available - 1 && addSpaces -> al ++ [Color.spaceAttrW32]+        | otherwise -> case compare available len of+            LT -> take (available - 1) al ++ [Color.trimmedLineAttrW32]+            GT | addSpaces ->+              let alSpace = al ++ [Color.spaceAttrW32, Color.spaceAttrW32]+                  whiteN = fillFromStart - len - 2+              in if whiteN <= 0+                 then alSpace  -- speedup (supposedly) for menus+                 else alSpace ++ replicate whiteN Color.spaceAttrW32+            _ -> al  -- | Overlays either the game map only or the whole empty screen frame. -- We assume the lines of the overlay are not too long nor too many.-overlayFrame :: IntOverlay -> PreFrame -> PreFrame-overlayFrame ov (m, ff) = (m, FrameForall $ \v -> do-  unFrameForall ff v-  mapM_ (\(offset, l) -> unFrameForall (writeLine offset l) v) ov)--overlayFrameWithLines :: ScreenContent -> Bool -> Overlay -> PreFrame-                      -> PreFrame-overlayFrameWithLines coscreen@ScreenContent{rwidth} onBlank l fr =-  let ov = map (\(y, al) -> (y * rwidth, al))-           $ zip [0..] $ truncateLines coscreen onBlank l-  in overlayFrame ov fr+overlayFrame :: Int -> OverlaySpace -> PreFrame -> PreFrame+overlayFrame width ov (m, ff) =+  ( m+  , FrameForall $ \v -> do+      unFrameForall ff v+      mapM_ (\(PointUI px py, l) ->+               let offset = py * width + px `div` 2+               in unFrameForall (writeLine offset l) v) ov )

engine-src/Game/LambdaHack/Client/UI/FrameM.hs view

@@ -1,9 +1,10 @@ -- | A set of Frame monad operations. module Game.LambdaHack.Client.UI.FrameM-  ( pushFrame, promptGetKey, stopPlayBack, animate, fadeOutOrIn+  ( pushFrame, promptGetKey, addToMacro, dropEmptyMacroFrames, lastMacroFrame+  , stopPlayBack, animate, fadeOutOrIn #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , drawOverlay, renderFrames, resetPlayBack+  , drawOverlay, oneLineBasicFrame, renderAnimFrames, resetPlayBack #endif   ) where @@ -11,24 +12,31 @@  import Game.LambdaHack.Core.Prelude +import qualified Data.Bifunctor as B import qualified Data.EnumMap.Strict as EM+import qualified Data.Map.Strict as M import qualified Data.Vector.Unboxed as U -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.State import           Game.LambdaHack.Client.UI.Animation+import           Game.LambdaHack.Client.UI.Content.Input import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.ContentClientUI import           Game.LambdaHack.Client.UI.DrawM import           Game.LambdaHack.Client.UI.Frame+import qualified Game.LambdaHack.Client.UI.Frontend as Frontend+import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.MonadClientUI import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.MsgM import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.SessionUI+import           Game.LambdaHack.Client.UI.Slideshow import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.MonadStateRead import           Game.LambdaHack.Common.State@@ -36,94 +44,183 @@ import qualified Game.LambdaHack.Definition.Color as Color  -- | Draw the current level with the overlay on top.--- If the overlay is too long, it's truncated.--- Similarly, for each line of the overlay, if it's too wide, it's truncated. drawOverlay :: MonadClientUI m-            => ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame-drawOverlay dm onBlank topTrunc lid = do-  CCUI{coscreen=coscreen@ScreenContent{rwidth, rheight}} <- getsSession sccui+            => ColorMode -> Bool -> FontOverlayMap -> LevelId+            -> m PreFrame3+drawOverlay dm onBlank ovs lid = do+  CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui   basicFrame <- if onBlank                 then do                   let m = U.replicate (rwidth * rheight)                                       (Color.attrCharW32 Color.spaceAttrW32)                   return (m, FrameForall $ \_v -> return ())                 else drawHudFrame dm lid-  return $! overlayFrameWithLines coscreen onBlank topTrunc basicFrame+  FontSetup{..} <- getFontSetup+  soptions <- getsClient soptions+  let isTeletype = Frontend.frontendName soptions == "teletype"+      propWidth = if isMonoFont propFont then 2 * rwidth else 4 * rwidth+      ovProp | not $ isSquareFont propFont+             = truncateOverlay False propWidth rheight False 0 onBlank+               $ EM.findWithDefault [] propFont ovs+             | isTeletype  -- hack for debug output+             = map (second attrLine) $ concat $ EM.elems ovs+             | otherwise = []+      ovMono = if not $ isSquareFont monoFont+               then truncateOverlay False (2 * rwidth) rheight False 0 onBlank+                    $ EM.findWithDefault [] monoFont ovs+               else []+      ovOther | not $ isSquareFont propFont+              = truncateOverlay True rwidth rheight True 0 onBlank+                $ EM.findWithDefault [] squareFont ovs+                  -- no backdrop for square font, so @wipeAdjacent@+                  -- needs to be @True@ or the extra blank line starts too late+              | isTeletype  -- hack for debug output+              = []+              | otherwise+              = truncateOverlay True rwidth rheight True 20 onBlank+                $ concat $ EM.elems ovs+                    -- 20 needed not to leave gaps in skill menu+                    -- in the absence of backdrop+      ovBackdrop =+        if not (isSquareFont propFont) && not onBlank+        then let propOutline =+                   truncateOverlay False propWidth rheight True 0 onBlank+                   $ EM.findWithDefault [] propFont ovs+                 monoOutline =+                   truncateOverlay False (2 * rwidth) rheight True 0 onBlank+                   $ EM.findWithDefault [] monoFont ovs+                 g x al Nothing = Just (x, x + length al - 1)+                 g x al (Just (xmin, xmax)) =+                   Just (min xmin x, max xmax (x + length al - 1))+                 f em (PointUI x y, al) = EM.alter (g x al) y em+                 extentMap = foldl' f EM.empty $ propOutline ++ monoOutline+                 listBackdrop (y, (xmin, xmax)) =+                   ( PointUI (2 * (xmin `div` 2)) y+                   , blankAttrString+                     $ min (rwidth - 2 * (xmin `div` 2))+                           (1 + xmax `divUp` 2 - xmin `div` 2) )+             in map listBackdrop $ EM.assocs extentMap+        else []+      overlayedFrame = overlayFrame rwidth ovOther+                       $ overlayFrame rwidth ovBackdrop basicFrame+  return (overlayedFrame, (ovProp, ovMono)) +oneLineBasicFrame :: MonadClientUI m => LevelId -> DisplayFont -> m PreFrame3+oneLineBasicFrame arena font = do+  report <- getReportUI False+  let par1 = firstParagraph $ foldr (<+:>) [] $ renderReport True report+      truncRep = EM.fromList [(font, [(PointUI 0 0, par1)])]+  drawOverlay ColorFull False truncRep arena+ -- | Push the frame depicting the current level to the frame queue. -- Only one line of the report is shown, as in animations, -- because it may not be our turn, so we can't clear the message -- to see what is underneath.-pushFrame :: MonadClientUI m => m ()-pushFrame = do+pushFrame :: MonadClientUI m => Bool -> m ()+pushFrame delay = do   -- The delay before reaction to keypress was too long in case of many   -- projectiles flying and ending flight, so frames need to be skipped.   keyPressed <- anyKeyPressed   unless keyPressed $ do     lidV <- viewedLevelUI-    report <- getReportUI-    let truncRep = [renderReport report]-    frame <- drawOverlay ColorFull False truncRep lidV-    displayFrames lidV [Just frame]+    FontSetup{propFont} <- getFontSetup+    frame <- oneLineBasicFrame lidV propFont+    -- Pad with delay before and after to let player see, e.g., door being+    -- opened a few ticks after it came into vision, the same turn.+    displayFrames lidV $+      if delay then [Nothing, Just frame, Nothing] else [Just frame] -promptGetKey :: MonadClientUI m-             => ColorMode -> Overlay -> Bool -> [K.KM] -> m K.KM-promptGetKey dm ov onBlank frontKeyKeys = do+promptGetKey :: (MonadClient m, MonadClientUI m)+             => ColorMode -> FontOverlayMap -> Bool -> [K.KM]+             -> m K.KM+promptGetKey dm ovs onBlank frontKeyKeys = do   lidV <- viewedLevelUI-  keyPressed <- anyKeyPressed   report <- getsSession $ newReport . shistory-  let msgDisturbs = anyInReport disturbsResting report-  lastPlayOld <- getsSession slastPlay-  km <- case lastPlayOld of-    km : kms | not keyPressed-               && (null frontKeyKeys || km `elem` frontKeyKeys)-               && not msgDisturbs -> do-      frontKeyFrame <- drawOverlay dm onBlank ov lidV-      displayFrames lidV [Just frontKeyFrame]-      modifySession $ \sess -> sess {slastPlay = kms}-      msgAdd MsgMacro $ "Voicing '" <> tshow km <> "'."+  let interrupted = anyInReport disturbsResting report+  macroFrame <- getsSession smacroFrame+  km <- case keyPending macroFrame of+    KeyMacro (km : kms) | (null frontKeyKeys || km `elem` frontKeyKeys)+                          && not interrupted -> do+      -- No need to display the frame, because a frame was displayed+      -- when the player chose to play a macro and each turn or more often+      -- a frame is displayed elsewhere.+      -- The only excepton is when navigating menus through macros,+      -- but there the speed is particularly welcome.+      modifySession $ \sess ->+        sess {smacroFrame = (smacroFrame sess) {keyPending = KeyMacro kms}}+      msgAdd MsgMacroOperation $ "Voicing '" <> tshow km <> "'."       return km-    _ : _ -> do-      -- We can't continue playback, so wipe out old slastPlay, srunning, etc.+    KeyMacro (_ : _) -> do+      frontKeyFrame <- drawOverlay dm onBlank ovs lidV+      -- We can't continue playback, so wipe out macros, etc.       resetPlayBack       resetPressedKeys-      let ov2 = [textFgToAL Color.BrYellow "*interrupted*" | keyPressed] ++ ov-      frontKeyFrame <- drawOverlay dm onBlank ov2 lidV       recordHistory+      modifySession $ \sess ->+        sess { sdisplayNeeded = False+             , sturnDisplayed = True }       connFrontendFrontKey frontKeyKeys frontKeyFrame-    [] -> do-      -- If we ask for a key, then we don't want to run any more-      -- and we want to avoid changing leader back to initial run leader-      -- at the nearest @stopPlayBack@, etc.-      modifySession $ \sess -> sess {srunning = Nothing}-      frontKeyFrame <- drawOverlay dm onBlank ov lidV+    KeyMacro [] -> do+      frontKeyFrame <- drawOverlay dm onBlank ovs lidV       when (dm /= ColorFull) $ do         side <- getsClient sside         fact <- getsState $ (EM.! side) . sfactionD-        unless (isAIFact fact) $  -- don't forget special autoplay keypresses+        unless (isAIFact fact) -- don't forget special autoplay keypresses           -- Forget the furious keypresses just before a special event.           resetPressedKeys       recordHistory+      -- If we ask for a key, then we don't want to run any more+      -- and we want to avoid changing leader back to initial run leader+      -- at the nearest @stopPlayBack@, etc.+      modifySession $ \sess ->+        sess { srunning = Nothing+             , sdisplayNeeded = False+             , sturnDisplayed = True }       connFrontendFrontKey frontKeyKeys frontKeyFrame-  LastRecord seqCurrent seqPrevious k <- getsSession slastRecord-  let slastRecord = LastRecord (km : seqCurrent) seqPrevious k-  modifySession $ \sess -> sess { slastRecord-                                , sdisplayNeeded = False }+  -- In-game macros need to be recorded here, not in @UI.humanCommand@,+  -- to also capture choice of items from menus, etc.+  -- Notice that keys coming from macros (from content, in-game, config)+  -- are recorded as well and this is well defined and essential.+  CCUI{coinput=InputContent{bcmdMap}} <- getsSession sccui+  modifySession $ \sess ->+    sess {smacroFrame = addToMacro bcmdMap km $ smacroFrame sess}   return km -stopPlayBack :: MonadClientUI m => m ()-stopPlayBack = msgAdd0 MsgStopPlayback "!"+addToMacro :: M.Map K.KM HumanCmd.CmdTriple -> K.KM -> KeyMacroFrame+           -> KeyMacroFrame+addToMacro bcmdMap km macroFrame =+  case (\(_, _, cmd) -> cmd) <$> M.lookup km bcmdMap of+    Nothing -> macroFrame+    Just HumanCmd.Record -> macroFrame+    Just HumanCmd.RepeatLast{} -> macroFrame+    _ -> macroFrame { keyMacroBuffer =+                        (km :) `B.first` keyMacroBuffer macroFrame }+           -- This is noop when not recording a macro,+           -- which is exactly the required semantics. +dropEmptyMacroFrames :: KeyMacroFrame -> [KeyMacroFrame]+                     -> (KeyMacroFrame, [KeyMacroFrame])+dropEmptyMacroFrames mf [] = (mf, [])+dropEmptyMacroFrames (KeyMacroFrame _ (KeyMacro []) _)+                     (mf : mfs) = dropEmptyMacroFrames mf mfs+dropEmptyMacroFrames mf mfs = (mf, mfs)++lastMacroFrame :: KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame+lastMacroFrame mf [] = mf+lastMacroFrame _ (mf : mfs) = lastMacroFrame mf mfs++stopPlayBack :: (MonadClient m, MonadClientUI m) => m ()+stopPlayBack = msgAdd MsgStopPlayback "!"+ resetPlayBack :: MonadClientUI m => m () resetPlayBack = do-  lastPlayOld <- getsSession slastPlay-  unless (null lastPlayOld) $ do-    modifySession $ \sess -> sess {slastPlay = []}-    LastRecord _ _ k <- getsSession slastRecord-    when (k > 0) $ do-      -- Needed to properly cancel macros that contain apostrophes.-      modifySession $ \sess -> sess {slastRecord = LastRecord [] [] 0}-      promptAdd0 "Macro recording aborted."+  -- We wipe any actions in progress, but keep the data needed to repeat+  -- the last global macros and the last command.+  modifySession $ \sess ->+    let lastFrame = lastMacroFrame (smacroFrame sess) (smacroStack sess)+    in sess { smacroFrame = lastFrame {keyPending = mempty}+            , smacroStack = []+            , sxhairGoTo = Nothing }   srunning <- getsSession srunning   case srunning of     Nothing -> return ()@@ -140,15 +237,22 @@       modifySession (\sess -> sess {srunning = Nothing})  -- | Render animations on top of the current screen frame.-renderFrames :: MonadClientUI m => LevelId -> Animation -> m PreFrames-renderFrames arena anim = do-  report <- getReportUI-  let truncRep = [renderReport report]-  basicFrame <- drawOverlay ColorFull False truncRep arena+renderAnimFrames :: MonadClientUI m+                 => Bool -> LevelId -> Animation -> m PreFrames3+renderAnimFrames onBlank arena anim = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui   snoAnim <- getsClient $ snoAnim . soptions+  FontSetup{..} <- getFontSetup+  -- This hack is needed so that the prop part of the overlay does not+  -- overwrite the fadeout animation.+  let ovFont = if not onBlank || fromMaybe False snoAnim+               then propFont+               else squareFont+  basicFrame <- oneLineBasicFrame arena ovFont   return $! if fromMaybe False snoAnim             then [Just basicFrame]-            else renderAnim basicFrame anim+            else map (fmap (\fr -> (fr, snd basicFrame)))+                 $ renderAnim rwidth (fst basicFrame) anim  -- | Render and display animations on top of the current screen frame. animate :: MonadClientUI m => LevelId -> Animation -> m ()@@ -157,13 +261,13 @@   -- projectiles hitting actors, so frames need to be skipped.   keyPressed <- anyKeyPressed   unless keyPressed $ do-    frames <- renderFrames arena anim+    frames <- renderAnimFrames False arena anim     displayFrames arena frames  fadeOutOrIn :: MonadClientUI m => Bool -> m () fadeOutOrIn out = do   arena <- getArenaUI   CCUI{coscreen} <- getsSession sccui-  animMap <- rndToActionForget $ fadeout coscreen out 2-  animFrs <- renderFrames arena animMap+  animMap <- rndToActionUI $ fadeout coscreen out 2+  animFrs <- renderAnimFrames True arena animMap   displayFrames arena (tail animFrs)  -- no basic frame between fadeout and in

engine-src/Game/LambdaHack/Client/UI/Frontend.hs view

@@ -22,11 +22,13 @@ import qualified Control.Concurrent.STM as STM import           Control.Monad.ST.Strict import           Data.IORef+import           Data.Kind (Type)+import qualified Data.Text.IO as T import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import           Data.Word+import           System.IO (hFlush, stdout) -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Frame import qualified Game.LambdaHack.Client.UI.Frontend.Chosen as Chosen@@ -34,13 +36,14 @@ import qualified Game.LambdaHack.Client.UI.Frontend.Teletype as Teletype import           Game.LambdaHack.Client.UI.Key (KMP (..)) import qualified Game.LambdaHack.Client.UI.Key as K-import           Game.LambdaHack.Common.Point+import           Game.LambdaHack.Client.UI.PointUI+import           Game.LambdaHack.Common.ClientOptions import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Color as Color  -- | The instructions sent by clients to the raw frontend, indexed -- by the returned value.-data FrontReq :: * -> * where+data FrontReq :: Type -> Type where   -- | Show a frame.   FrontFrame :: Frame -> FrontReq ()   -- | Perform an explicit delay of the given length.@@ -84,14 +87,19 @@ #endif               | otherwise = Chosen.startup coscreen soptions       maxFps = fromMaybe defaultMaxFps $ smaxFps soptions-      delta = max 1 $ microInSec `div` maxFps+      delta = max 1 $ round $ intToDouble microInSec / max 0.000001 maxFps   rf <- startup+  when (sdbgMsgCli soptions) $ do+    T.hPutStr stdout "Frontend startup up.\n"+      -- hPutStrLn not atomic enough+    hFlush stdout   fautoYesRef <- newIORef $ not $ sdisableAutoYes soptions   fdelay <- newMVar 0   fasyncTimeout <- async $ frameTimeoutThread delta fdelay rf   -- Warning: not linking @fasyncTimeout@, so it'd better not crash.   let fs = FrontSetup{..}-  return $ fchanFrontend fs rf+      chanFrontend = fchanFrontend fs rf+  return chanFrontend  -- Display a frame, wait for any of the specified keys (for any key, -- if the list is empty). Repeat if an unexpected key received.@@ -100,7 +108,7 @@   autoYes <- readIORef $ fautoYesRef fs   if autoYes && (null keys || K.spaceKM `elem` keys) then do     display rf frame-    return $! KMP {kmpKeyMod = K.spaceKM, kmpPointer = originPoint}+    return $! KMP {kmpKeyMod = K.spaceKM, kmpPointer = PointUI 0 0}   else do     -- Wait until timeout is up, not to skip the last frame of animation.     display rf frame@@ -134,17 +142,17 @@  display :: RawFrontend -> Frame -> IO () display rf@RawFrontend{fshowNow, fcoscreen=ScreenContent{rwidth, rheight}}-        (m, upd) = do+        ((m, upd), (ovProp, ovMono)) = do   let new :: forall s. ST s (G.Mutable U.Vector s Word32)       new = do         v <- unFrameBase m         unFrameForall upd v         return v-      singleFrame = PointArray.Array rwidth rheight (U.create new)+      singleArray = PointArray.Array rwidth rheight (U.create new)   putMVar fshowNow () -- 1. wait for permission to display; 3. ack-  fdisplay rf $ SingleFrame singleFrame+  fdisplay rf $ SingleFrame singleArray ovProp ovMono -defaultMaxFps :: Int+defaultMaxFps :: Double defaultMaxFps = 24  microInSec :: Int@@ -179,8 +187,14 @@   loop  -- | The name of the chosen frontend.-frontendName :: String-frontendName = Chosen.frontendName+frontendName :: ClientOptions -> String+frontendName soptions =+  if | sfrontendNull soptions -> "null test"+     | sfrontendLazy soptions -> "lazy test"+#ifndef REMOVE_TELETYPE+     | sfrontendTeletype soptions -> Teletype.frontendName+#endif+     | otherwise -> Chosen.frontendName  lazyStartup :: ScreenContent -> IO RawFrontend lazyStartup coscreen = createRawFrontend coscreen (\_ -> return ()) (return ())@@ -189,9 +203,9 @@ nullStartup coscreen = createRawFrontend coscreen seqFrame (return ())  seqFrame :: SingleFrame -> IO ()-seqFrame SingleFrame{singleFrame} =+seqFrame SingleFrame{singleArray} =   let seqAttr () attr = Color.colorToRGB (Color.fgFromW32 attr)                         `seq` Color.bgFromW32 attr                         `seq` Color.charFromW32 attr == ' '                         `seq` ()-  in return $! PointArray.foldlA' seqAttr () singleFrame+  in return $! PointArray.foldlA' seqAttr () singleArray

engine-src/Game/LambdaHack/Client/UI/Frontend/Common.hs view

@@ -16,8 +16,8 @@ import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Key (KMP (..)) import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Common.Misc-import           Game.LambdaHack.Common.Point  -- | Raw frontend definition. The minimal closed set of values that need -- to depend on the specifics of the chosen frontend.@@ -64,7 +64,7 @@     , fshutdown     , fshowNow     , fchanKey-    , fprintScreen = return ()  -- dummy, except fro SDL2+    , fprintScreen = return ()  -- dummy, except for SDL2     , fcoscreen     } @@ -74,7 +74,7 @@   res <- STM.atomically $ STM.tryReadTQueue fchanKey   when (isJust res) $ resetChanKey fchanKey -saveKMP :: RawFrontend -> K.Modifier -> K.Key -> Point -> IO ()+saveKMP :: RawFrontend -> K.Modifier -> K.Key -> PointUI -> IO () saveKMP !rf !modifier !key !kmpPointer = do   -- Instantly show any frame waiting for display.   void $ tryTakeMVar $ fshowNow rf@@ -86,8 +86,9 @@ -- | Translates modifiers to our own encoding. modifierTranslate :: Bool -> Bool -> Bool -> Bool -> K.Modifier modifierTranslate modCtrl modShift modAlt modMeta+  | (modAlt || modMeta) && modShift = K.AltShift+  | modAlt || modMeta = K.Alt   | modCtrl && modShift = K.ControlShift   | modCtrl = K.Control-  | modAlt || modMeta = K.Alt   | modShift = K.Shift   | otherwise = K.NoModifier

engine-src/Game/LambdaHack/Client/UI/Frontend/Curses.hs view

@@ -15,12 +15,12 @@ import qualified UI.HSCurses.Curses as C import qualified UI.HSCurses.CursesHelper as C -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K-import           Game.LambdaHack.Common.Point+import           Game.LambdaHack.Client.UI.PointUI+import           Game.LambdaHack.Common.ClientOptions import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Color as Color @@ -56,7 +56,7 @@   let storeKeys :: IO ()       storeKeys = do         K.KM{..} <- keyTranslate <$> C.getKey C.refresh-        saveKMP rf modifier key originPoint+        saveKMP rf modifier key (PointUI 0 0)         storeKeys   void $ async storeKeys   return $! rf@@ -69,7 +69,7 @@         -> FrontendSession         -> SingleFrame         -> IO ()-display coscreen FrontendSession{..} SingleFrame{singleFrame} = do+display coscreen FrontendSession{..} SingleFrame{singleArray} = do   -- let defaultStyle = C.defaultCursesStyle   -- Terminals with white background require this:   let defaultStyle = sstyles M.! (Color.defFG, Color.Black)@@ -79,7 +79,7 @@   -- because otherwise it would overflow a standard size xterm window,   -- due to the curses historical limitations.   let sf = chunk $ map Color.attrCharFromW32-                 $ PointArray.toListA singleFrame+                 $ PointArray.toListA singleArray       level = init sf ++ [init $ last sf]       nm = zip [0..] $ map (zip [0..]) level       chunk [] = []@@ -96,6 +96,8 @@                       if fg /= Color.Blue                       then (fg, Color.Blue)                       else (fg, Color.BrBlack)+                    Color.HighlightBrown -> (fg, Color.Black)+                    Color.HighlightCyan -> (fg, Color.Black)                     Color.HighlightGrey ->                       if fg /= Color.BrBlack                       then (fg, Color.BrBlack)

engine-src/Game/LambdaHack/Client/UI/Frontend/Dom.hs view

@@ -10,7 +10,6 @@ import           Control.Concurrent import qualified Control.Monad.IO.Class as IO import           Control.Monad.Trans.Reader (ask)-import qualified Data.Char as Char import           Data.IORef import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U@@ -21,34 +20,54 @@ import GHCJS.DOM.Document (createElement, getBodyUnchecked) import GHCJS.DOM.Element (Element (Element), setInnerHTML) import GHCJS.DOM.ElementCSSInlineStyle (getStyle)-import GHCJS.DOM.EventM (EventM, mouseAltKey, mouseButton, mouseCtrlKey,-                         mouseMetaKey, mouseShiftKey, on, preventDefault,-                         stopPropagation)-import GHCJS.DOM.GlobalEventHandlers (contextMenu, keyDown, mouseDown, mouseUp,-                                      wheel)+import GHCJS.DOM.EventM+  ( EventM+  , mouseAltKey+  , mouseButton+  , mouseCtrlKey+  , mouseMetaKey+  , mouseShiftKey+  , on+  , preventDefault+  , stopPropagation+  )+import GHCJS.DOM.GlobalEventHandlers (contextMenu, keyDown, mouseUp, wheel) import GHCJS.DOM.HTMLCollection (itemUnsafe)-import GHCJS.DOM.HTMLTableElement (HTMLTableElement (HTMLTableElement), getRows,-                                   setCellPadding, setCellSpacing)-import GHCJS.DOM.HTMLTableRowElement (HTMLTableRowElement (HTMLTableRowElement),-                                      getCells)-import GHCJS.DOM.KeyboardEvent (getAltGraphKey, getAltKey, getCtrlKey, getKey,-                                getMetaKey, getShiftKey)+import GHCJS.DOM.HTMLElement (focus)+import GHCJS.DOM.HTMLTableElement+  ( HTMLTableElement (HTMLTableElement)+  , getRows+  , setCellPadding+  , setCellSpacing+  )+import GHCJS.DOM.HTMLTableRowElement+  (HTMLTableRowElement (HTMLTableRowElement), getCells)+import GHCJS.DOM.KeyboardEvent+  (getAltGraphKey, getAltKey, getCtrlKey, getKey, getMetaKey, getShiftKey) import GHCJS.DOM.Node (appendChild_, replaceChild_, setTextContent) import GHCJS.DOM.NonElementParentNode (getElementByIdUnsafe) import GHCJS.DOM.RequestAnimationFrameCallback-import GHCJS.DOM.Types (CSSStyleDeclaration, DOM,-                        HTMLDivElement (HTMLDivElement),-                        HTMLTableCellElement (HTMLTableCellElement),-                        IsMouseEvent, Window, runDOM, unsafeCastTo)+import GHCJS.DOM.Types+  ( CSSStyleDeclaration+  , DOM+  , HTMLDivElement (HTMLDivElement)+  , HTMLTableCellElement (HTMLTableCellElement)+  , IsMouseEvent+  , JSString+  , Window+  , runDOM+  , unsafeCastTo+  ) import GHCJS.DOM.WheelEvent (getDeltaY) import GHCJS.DOM.Window (requestAnimationFrame_) -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Common.Area+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Content.TileKind (floorSymbol)@@ -84,7 +103,7 @@   -- Create the session record.   divBlockRaw <- createElement doc ("div" :: Text)   divBlock <- unsafeCastTo HTMLDivElement divBlockRaw-  let cell = "<td>" ++ [Char.chr 160]+  let cell = "<td>\x00a0"       row = "<tr>" ++ concat (replicate (rwidth coscreen) cell)       rows = concat (replicate (rheight coscreen) row)   tableElemRaw <- createElement doc ("table" :: Text)@@ -105,7 +124,10 @@         modMeta <- ask >>= getMetaKey         modAltG <- ask >>= getAltGraphKey         return $! modifierTranslate modCtrl modShift (modAlt || modAltG) modMeta-  void $ doc `on` keyDown $ do+  gameMap <- getElementByIdUnsafe doc ("gameMap" :: Text)+  divMap <- unsafeCastTo HTMLDivElement gameMap+  focus divMap+  void $ divMap `on` keyDown $ do     keyId <- ask >>= getKey     modifier <- readMod --  This is currently broken at least for Shift-F1, etc., so won't be used:@@ -117,13 +139,14 @@         modifierNoShift = case modifier of  -- to prevent S-!, etc.           K.Shift -> K.NoModifier           K.ControlShift -> K.Control+          K.AltShift -> K.Alt           _ -> modifier     -- IO.liftIO $ do     --   putStrLn $ "keyId: " ++ keyId     --   putStrLn $ "key: " ++ K.showKey key     --   putStrLn $ "modifier: " ++ show modifier     when (key == K.Esc) $ IO.liftIO $ resetChanKey (fchanKey rf)-    IO.liftIO $ saveKMP rf modifierNoShift key originPoint+    IO.liftIO $ saveKMP rf modifierNoShift key (PointUI 0 0)     -- Pass through C-+ and others, but disable special behaviour on Tab, etc.     let browserKeys = "+-0tTnNdxcv"     unless (modifier == K.Alt@@ -134,10 +157,11 @@   -- Handle mouseclicks, per-cell.   let setupMouse i a =         let Point{..} = punindex (rwidth coscreen) i-        in handleMouse rf a px py+              -- abuse of convention in that @Point@ used for screen, not map+            pUI = squareToUI $ PointSquare px py+        in handleMouse rf a pUI   V.imapM_ setupMouse scharCells   -- Display at the end to avoid redraw. Replace "Please wait".-  gameMap <- getElementByIdUnsafe doc ("gameMap" :: Text)   pleaseWait <- getElementByIdUnsafe doc ("pleaseWait" :: Text)   replaceChild_ gameMap divBlock pleaseWait   IO.liftIO $ putMVar rfMVar rf@@ -147,15 +171,15 @@ shutdown :: IO () shutdown = return () -- nothing to clean up -setProp :: CSSStyleDeclaration -> Text -> Text -> DOM ()+setProp :: CSSStyleDeclaration -> JSString -> Text -> DOM () setProp style propRef propValue =-  setProperty style propRef propValue (Nothing :: Maybe Text)+  setProperty style propRef propValue (Nothing :: Maybe JSString)  -- | Let each table cell handle mouse events inside. handleMouse :: RawFrontend-            -> (HTMLTableCellElement, CSSStyleDeclaration) -> Int -> Int+            -> (HTMLTableCellElement, CSSStyleDeclaration) -> PointUI             -> DOM ()-handleMouse rf (cell, _) cx cy = do+handleMouse rf (cell, _) pUI = do   let readMod :: IsMouseEvent e => EventM HTMLTableCellElement e K.Modifier       readMod = do         modCtrl <- mouseCtrlKey@@ -169,9 +193,8 @@         let mkey = if | wheelY < -0.01 -> Just K.WheelNorth                       | wheelY > 0.01 -> Just K.WheelSouth                       | otherwise -> Nothing  -- probably a glitch-            pointer = Point cx cy         maybe (return ())-              (\key -> IO.liftIO $ saveKMP rf modifier key pointer) mkey+              (\key -> IO.liftIO $ saveKMP rf modifier key pUI) mkey       saveMouse = do         -- <https://hackage.haskell.org/package/ghcjs-dom-0.2.1.0/docs/GHCJS-DOM-EventM.html>         but <- mouseButton@@ -181,10 +204,9 @@               1 -> K.MiddleButtonRelease               2 -> K.RightButtonRelease  -- not handled in contextMenu               _ -> K.LeftButtonRelease  -- any other is alternate left-            pointer = Point cx cy         -- IO.liftIO $ putStrLn $-        --   "m: " ++ show but ++ show modifier ++ show pointer-        IO.liftIO $ saveKMP rf modifier key pointer+        --   "m: " ++ show but ++ show modifier ++ show pUI+        IO.liftIO $ saveKMP rf modifier key pUI   void $ cell `on` wheel $ do     saveWheel     preventDefault@@ -196,10 +218,6 @@     saveMouse     preventDefault     stopPropagation-  void $ cell `on` mouseDown $ do-    -- Just disable selecting a region.-    preventDefault-    stopPropagation  -- | Get the list of all cells of an HTML table. flattenTable :: ScreenContent@@ -231,27 +249,29 @@ display FrontendSession{..} !curFrame = flip runDOM undefined $ do   let setChar :: Int -> (Word32, Word32) -> DOM Int       setChar !i (!w, !wPrev) | w == wPrev = return $! i + 1-      setChar i (w, _) = do+      setChar i (w, wPrev) = do         let Point{..} = toEnum i             Color.AttrChar{acAttr=Color.Attr{fg=fgRaw,bg}, acChar} =               Color.attrCharFromW32 $ Color.AttrCharW32 w             fg | py `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite                | otherwise = fgRaw             (!cell, !style) = scharCells V.! i-        if | acChar == ' ' -> setTextContent cell $ Just [Char.chr 160]+        if | acChar == ' ' -> setTextContent cell $ Just ("\x00a0" :: JSString)            | acChar == floorSymbol && not (Color.isBright fg) ->-             setTextContent cell $ Just [Char.chr 8901]+             setTextContent cell $ Just ("\x22C5" :: JSString)            | otherwise -> setTextContent cell $ Just [acChar]         setProp style "color" $ Color.colorToRGB fg-        setProp style "border-color" $ Color.colorToRGB-                                     $ Color.highlightToColor bg+        let bgPrev = Color.bgFromW32 $ Color.AttrCharW32 wPrev+        when (bg /= bgPrev) $+          setProp style "border-color"+                        (Color.colorToRGB $ Color.highlightToColor bg)         return $! i + 1   !prevFrame <- readIORef spreviousFrame   writeIORef spreviousFrame curFrame   -- This continues asynchronously, if can't otherwise.   callback <- newRequestAnimationFrameCallbackSync $ \_ ->-    U.foldM'_ setChar 0 $ U.zip (PointArray.avector $ singleFrame curFrame)-                                (PointArray.avector $ singleFrame prevFrame)+    U.foldM'_ setChar 0 $ U.zip (PointArray.avector $ singleArray curFrame)+                                (PointArray.avector $ singleArray prevFrame)   -- This attempts to ensure no redraws while callback executes   -- and a single redraw when it completes.   requestAnimationFrame_ scurrentWindow callback

engine-src/Game/LambdaHack/Client/UI/Frontend/Gtk.hs view

@@ -6,7 +6,7 @@  import Prelude () -import Game.LambdaHack.Core.Prelude hiding (Alt)+import Game.LambdaHack.Core.Prelude  import           Control.Concurrent import qualified Control.Monad.IO.Class as IO@@ -14,16 +14,17 @@ import qualified Data.IntMap.Strict as IM import           Data.IORef import qualified Data.Text as T+import           Data.Word (Word32) import qualified Game.LambdaHack.Common.PointArray as PointArray-import           Graphics.UI.Gtk hiding (Point)+import           Graphics.UI.Gtk import           System.Exit (exitFailure) -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K-import           Game.LambdaHack.Common.Point+import           Game.LambdaHack.Client.UI.PointUI+import           Game.LambdaHack.Common.ClientOptions import qualified Game.LambdaHack.Definition.Color as Color import           Game.LambdaHack.Definition.Defs @@ -45,7 +46,7 @@ startup coscreen soptions = startupBound $ startupFun coscreen soptions  startupFun :: ScreenContent -> ClientOptions -> MVar RawFrontend -> IO ()-startupFun coscreen soptions@ClientOptions{..} rfMVar = do+startupFun coscreen _ rfMVar = do   -- Init GUI.   unsafeInitGUIForThreadedRTS   -- Text attributes.@@ -59,6 +60,14 @@           if fg /= Color.Blue           then (fg, Color.Blue)           else (fg, Color.BrBlack)+        Color.HighlightBrown ->+          if fg /= Color.Blue+          then (fg, Color.Brown)+          else (fg, Color.BrBlack)+        Color.HighlightCyan ->+          if fg /= Color.Blue+          then (fg, Color.Cyan)+          else (fg, Color.BrBlack)         Color.HighlightGrey ->           if fg /= Color.BrBlack           then (fg, Color.BrBlack)@@ -106,19 +115,19 @@     n <- eventKeyName     mods <- eventModifier     let key = K.keyTranslate $ T.unpack n-        md = modTranslate mods-        modifier = case modifier of  -- to prevent S-!, etc.+        modifier = modTranslate mods  -- Shift included+        modifierNoShift = case modifier of  -- to prevent S-!, etc.           K.Shift -> K.NoModifier           K.ControlShift -> K.Control+          K.AltShift -> K.Alt           _ -> modifier-        pointer = originPoint     when (key == K.Esc) $ IO.liftIO $ resetChanKey (fchanKey rf)-    IO.liftIO $ saveKMP rf modifier key pointer+    IO.liftIO $ saveKMP rf modifierNoShift key (PointUI 0 0)     return True   -- Set the font specified in config, if any.-  f <- fontDescriptionFromString-       $ fromMaybe "Monospace" sgtkFontFamily-         <+> maybe "16" tshow sscalableFontSize <> "px"+  -- The list are monospace fonts that have fixed size regardless+  -- of boldness (on some OSes at least).+  f <- fontDescriptionFromString ("DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace 16px" :: String)   widgetModifyFont sview (Just f)   IO.liftIO $ do     textViewSetLeftMargin sview 3@@ -137,7 +146,7 @@       (iter, _) <- textViewGetIterAtPosition sview bx by       cx <- textIterGetLineOffset iter       cy <- textIterGetLine iter-      let pointer = Point cx cy+      let pointer = PointUI cx cy           -- Store the mouse event coords in the keypress channel.           storeK key = saveKMP rf modifier key pointer       case scrollDir of@@ -187,7 +196,7 @@             MiddleButton -> Just K.MiddleButtonRelease             RightButton -> Just K.RightButtonRelease             _ -> Nothing  -- probably a glitch-          pointer = Point cx cy+          pointer = PointUI cx cy       -- Store the mouse event coords in the keypress channel.       maybe (return ())             (\key -> IO.liftIO $ saveKMP rf modifier key pointer) mkey@@ -237,34 +246,34 @@         -> FrontendSession         -> SingleFrame         -> IO ()-display coscreen FrontendSession{..} SingleFrame{singleFrame} = do+display coscreen FrontendSession{..} SingleFrame{singleArray} = do   let f !w (!n, !l) = if n == -1                       then (rwidth coscreen - 2, Color.charFromW32 w : '\n' : l)                       else (n - 1, Color.charFromW32 w : l)       (_, levelChar) =-        PointArray.foldrA' f (rwidth coscreen - 1, []) singleFrame+        PointArray.foldrA' f (rwidth coscreen - 1, []) singleArray       !gfChar = T.pack levelChar   postGUISync $ do     tb <- textViewGetBuffer sview     textBufferSetText tb gfChar     ib <- textBufferGetStartIter tb     ie <- textIterCopy ib-    let defEnum = fromAttr Color.defAttr-        setTo :: (X, Int) -> Color.AttrCharW32 -> IO (X, Int)+    let defEnum = toEnum $ fromAttr Color.defAttr+        setTo :: (X, Word32) -> Color.AttrCharW32 -> IO (X, Word32)         setTo (!lx, !previous) !w           | (lx + 1) `mod` (rwidth coscreen + 1) /= 0 = do-            let current :: Int-                current = Color.attrEnumFromW32 w+            let current :: Word32+                current = Color.attrCharW32 w             if current == previous             then return (lx + 1, previous)             else do               textIterSetOffset ie lx               when (previous /= defEnum) $-                textBufferApplyTag tb (stags IM.! previous) ib ie+                textBufferApplyTag tb (stags IM.! fromEnum previous) ib ie               textIterSetOffset ib lx               return (lx + 1, current)         setTo (lx, previous) w = setTo (lx + 1, previous) w-    (lx, previous) <- PointArray.foldMA' setTo (-1, defEnum) singleFrame+    (lx, previous) <- PointArray.foldMA' setTo (-1, defEnum) singleArray     textIterSetOffset ie lx     when (previous /= defEnum) $-      textBufferApplyTag tb (stags IM.! previous) ib ie+      textBufferApplyTag tb (stags IM.! fromEnum previous) ib ie

engine-src/Game/LambdaHack/Client/UI/Frontend/Sdl.hs view

@@ -39,11 +39,13 @@ import qualified SDL.Raw.Video import qualified SDL.Vect as Vect -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.File import           Game.LambdaHack.Common.Misc import           Game.LambdaHack.Common.Point@@ -57,8 +59,15 @@ data FrontendSession = FrontendSession   { swindow          :: SDL.Window   , srenderer        :: SDL.Renderer-  , sfont            :: TTF.Font-  , satlas           :: IORef FontAtlas+  , squareFont       :: TTF.Font+  , squareFontSize   :: Int+  , mapFontIsBitmap  :: Bool+  , spropFont        :: Maybe TTF.Font+  , sboldFont        :: Maybe TTF.Font+  , smonoFont        :: Maybe TTF.Font+  , squareAtlas      :: IORef FontAtlas+  , smonoAtlas       :: IORef FontAtlas+  , sbasicTexture    :: IORef SDL.Texture   , stexture         :: IORef SDL.Texture   , spreviousFrame   :: IORef SingleFrame   , sforcedShutdown  :: IORef Bool@@ -84,40 +93,103 @@  -- lowest: pattern SDL_LOG_PRIORITY_VERBOSE = (1) :: LogPriority  -- our default: pattern SDL_LOG_PRIORITY_ERROR = (5) :: LogPriority  SDL.logSetAllPriority $ toEnum $ fromMaybe 5 slogPriority- let title = fromJust stitle-     fontFileName = T.unpack (fromJust sdlFontFile)-     fontFileOrig | isRelative fontFileName = fromJust sfontDir </> fontFileName-                  | otherwise = fontFileName- (fontFileExists, fontFile) <- do-   fontFileOrigExists <- doesFileExist fontFileOrig-   if fontFileOrigExists-   then return (True, fontFileOrig)-   else do-     -- Handling old font format specified in old game config files.-     let fontFileAlt = dropExtension fontFileOrig <.> "fnt"-     fontFileAltExists <- doesFileExist fontFileAlt-     return (fontFileAltExists, fontFileAlt)- unless fontFileExists $-   fail $ "Font file does not exist: " ++ fontFileOrig- let fontSize = fromJust sscalableFontSize  -- will be ignored for bitmap fonts  TTF.initialize- sfont <- TTF.load fontFile fontSize- let isBitmapFile = "fon" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                 || "fnt" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                 || "bdf" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                 || "FON" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                 || "FNT" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                 || "BDF" `isSuffixOf` T.unpack (fromJust sdlFontFile)-     sdlSizeAdd = fromJust $ if isBitmapFile-                             then sdlBitmapSizeAdd-                             else sdlScalableSizeAdd- boxSize <- (+ sdlSizeAdd) <$> TTF.height sfont+ let title = T.pack $ fromJust stitle+     chosenFontsetID = fromJust schosenFontset+     chosenFontset = case lookup chosenFontsetID sfontsets of+       Nothing -> error $ "Fontset not defined in config file"+                          `showFailure` chosenFontsetID+       Just fs -> fs+     -- If some auxiliary fonts are equal and at the same size, this wastefully+     -- opens them many times. However, native builds are efficient enough+     -- and slow machines should use the most frugal case (only square font)+     -- in which no waste occurs and all rendering is aided with an atlas.+     findFontFile t =+       if T.null t+       then return Nothing+       else case lookup t sfonts of+         Nothing -> error $ "Font not defined in config file" `showFailure` t+         Just (FontProportional fname fsize fhint) -> do+           sdlFont <- loadFontFile fname fsize+           setHintMode sdlFont fhint+           -- TODO: when SDL_ttf can do it, check that not a bitmap font+           realSize <- TTF.height sdlFont+           let !_A = assert (realSize > 0) ()  -- sanity+           return $ Just (sdlFont, realSize)+         Just (FontMonospace fname fsize fhint) -> do+           sdlFont <- loadFontFile fname fsize+           setHintMode sdlFont fhint+           isFontMono <- TTF.isMonospace sdlFont+           realSize <- TTF.height sdlFont+           let !_A = assert (isFontMono && realSize > 0) ()  -- sanity+           return $ Just (sdlFont, realSize)+         Just (FontMapScalable fname fsize fhint cellSizeAdd) -> do+           sdlFont <- loadFontFile fname fsize+           setHintMode sdlFont fhint+           isFontMono <- TTF.isMonospace sdlFont+           realSize <- TTF.height sdlFont+           let !_A = assert (isFontMono && realSize > 0) ()  -- sanity+           return $ Just (sdlFont, realSize + cellSizeAdd)+         Just (FontMapBitmap fname cellSizeAdd) -> do+           sdlFont <- loadFontFile fname 0  -- size ignored for bitmap fonts+           isFontMono <- TTF.isMonospace sdlFont+           realSize <- TTF.height sdlFont+           let !_A = assert (isFontMono && realSize > 0) ()  -- sanity+           return $ Just (sdlFont, realSize + cellSizeAdd)+     loadFontFile fname fsize = do+       let fontFileName = T.unpack fname+           fontSize = round $ fromJust sallFontsScale * intToDouble fsize+       if isRelative fontFileName+       then do+         case lookup fontFileName $ rFontFiles coscreen of+           Nothing -> fail $ "Font file not supplied with the game: "+                             ++ fontFileName+                             ++ " within "+                             ++ show (map fst $ rFontFiles coscreen)+           Just bs -> TTF.decode bs fontSize+       else do+         fontFileExists <- doesFileExist fontFileName+         if not fontFileExists+         then fail $ "Font file does not exist: " ++ fontFileName+         else TTF.load fontFileName fontSize+     setHintMode _ HintingHeavy = return ()  -- default+     setHintMode sdlFont HintingLight = TTF.setHinting sdlFont TTF.Light+ (squareFont, squareFontSize, mapFontIsBitmap) <-+   if fromJust sallFontsScale == 1.0 then do+     mfontMapBitmap <- findFontFile $ fontMapBitmap chosenFontset+     case mfontMapBitmap of+       Just (sdlFont, size) -> return (sdlFont, size, True)+       Nothing -> do+         mfontMapScalable <- findFontFile $ fontMapScalable chosenFontset+         case mfontMapScalable of+           Just (sdlFont, size) -> return (sdlFont, size, False)+           Nothing -> error "Neither bitmap nor scalable map font defined"+   else do+     mfontMapScalable <- findFontFile $ fontMapScalable chosenFontset+     case mfontMapScalable of+        Just (sdlFont, size) -> return (sdlFont, size, False)+        Nothing -> error "Scaling requested but scalable map font not defined"+ let halfSize = squareFontSize `div` 2+     boxSize = 2 * halfSize  -- map font determines cell size for all others+ -- Real size of these fonts ignored.+ spropFont <- fst <$$> findFontFile (fontPropRegular chosenFontset)+ sboldFont <- fst <$$> findFontFile (fontPropBold chosenFontset)+ smonoFont <- fst <$$> findFontFile (fontMono chosenFontset)+ let !_A =+       assert+         (isJust spropFont && isJust sboldFont && isJust smonoFont+          || isNothing spropFont && isNothing sboldFont && isNothing smonoFont+          `blame` "Either all auxiliary fonts should be defined or none"+          `swith` chosenFontset) ()  -- The hacky log priority 0 tells SDL frontend to init and quit at once,  -- for testing on CIs without graphics access.  if slogPriority == Just 0 then do   rf <- createRawFrontend coscreen (\_ -> return ()) (return ())   putMVar rfMVar rf-  TTF.free sfont+  maybe (return ()) TTF.free spropFont+  maybe (return ()) TTF.free sboldFont+  maybe (return ()) TTF.free smonoFont+  TTF.free squareFont   TTF.quit   SDL.quit  else do@@ -125,7 +197,12 @@   SDL.initialize [SDL.InitVideo]   let screenV2 = SDL.V2 (toEnum $ rwidth coscreen * boxSize)                         (toEnum $ rheight coscreen * boxSize)-      windowConfig = SDL.defaultWindow {SDL.windowInitialSize = screenV2}+      windowConfig = SDL.defaultWindow+        { SDL.windowInitialSize = screenV2+        , SDL.windowMode = case fromMaybe NotFullscreen sfullscreenMode of+            ModeChange -> SDL.Fullscreen+            BigBorderlessWindow -> SDL.FullscreenDesktop+            NotFullscreen -> SDL.Windowed }       rendererConfig = SDL.RendererConfig         { rendererType          = if sbenchmark                                   then SDL.AcceleratedRenderer@@ -134,6 +211,20 @@         }   swindow <- SDL.createWindow title windowConfig   srenderer <- SDL.createRenderer swindow (-1) rendererConfig+  unless (fromMaybe NotFullscreen sfullscreenMode == NotFullscreen) $+    -- This is essential to preserve game map aspect ratio in fullscreen, etc.,+    -- if the aspect ratios of video mode and game map view don't match.+    SDL.rendererLogicalSize srenderer SDL.$= Just screenV2+  let clearScreen = do+        -- Display black screen ASAP to hide any garbage. This is also needed+        -- to clear trash on the margins in fullscreen. No idea why the double+        -- calls are needed, sometimes. Perhaps it's double-buffered.+        SDL.rendererRenderTarget srenderer SDL.$= Nothing+        SDL.clear srenderer  -- clear the backbuffer+        SDL.present srenderer+        SDL.clear srenderer  -- clear the other half of the double buffer?+        SDL.present srenderer+  clearScreen   let initTexture = do         texture <- SDL.createTexture srenderer SDL.ARGB8888                                      SDL.TextureAccessTarget screenV2@@ -141,12 +232,13 @@         SDL.rendererDrawBlendMode srenderer SDL.$= SDL.BlendNone         SDL.rendererDrawColor srenderer SDL.$= colorToRGBA Color.Black         SDL.clear srenderer  -- clear the texture-        SDL.rendererRenderTarget srenderer SDL.$= Nothing-        SDL.copy srenderer texture Nothing Nothing  -- clear the backbuffer         return texture+  basicTexture <- initTexture+  sbasicTexture <- newIORef basicTexture   texture <- initTexture-  satlas <- newIORef EM.empty   stexture <- newIORef texture+  squareAtlas <- newIORef EM.empty+  smonoAtlas <- newIORef EM.empty   spreviousFrame <- newIORef $ blankSingleFrame coscreen   sforcedShutdown <- newIORef False   scontinueSdlLoop <- newIORef True@@ -157,22 +249,31 @@     createRawFrontend coscreen (display sess) (shutdown sess)   let rf = rfWithoutPrintScreen {fprintScreen = printScreen sess}   putMVar rfMVar rf-  let pointTranslate :: forall i. (Enum i) => Vect.Point Vect.V2 i -> Point+  let pointTranslate :: forall i. (Enum i) => Vect.Point Vect.V2 i -> PointUI       pointTranslate (SDL.P (SDL.V2 x y)) =-        Point (fromEnum x `div` boxSize) (fromEnum y `div` boxSize)+        PointUI (fromEnum x `div` halfSize) (fromEnum y `div` boxSize)       redraw = do         -- Textures may be trashed and even invalid, especially on Windows.-        atlas <- readIORef satlas-        writeIORef satlas EM.empty+        atlas <- readIORef squareAtlas+        writeIORef squareAtlas EM.empty+        monoAtlas <- readIORef smonoAtlas+        writeIORef smonoAtlas EM.empty+        oldBasicTexture <- readIORef sbasicTexture+        newBasicTexture <- initTexture         oldTexture <- readIORef stexture         newTexture <- initTexture         mapM_ SDL.destroyTexture $ EM.elems atlas+        mapM_ SDL.destroyTexture $ EM.elems monoAtlas+        SDL.destroyTexture oldBasicTexture         SDL.destroyTexture oldTexture+        writeIORef sbasicTexture newBasicTexture         writeIORef stexture newTexture+        -- To clear the margins in fullscreen:+        clearScreen+        -- To overwrite each char:         prevFrame <- readIORef spreviousFrame-        writeIORef spreviousFrame (blankSingleFrame coscreen)-          -- to overwrite each char-        drawFrame soptions sess prevFrame+        writeIORef spreviousFrame $ blankSingleFrame coscreen+        drawFrame coscreen soptions sess prevFrame       loopSDL :: IO ()       loopSDL = do         me <- SDL.pollEvent  -- events take precedence over frames@@ -181,17 +282,10 @@             mfr <- tryTakeMVar sframeQueue             case mfr of               Just fr -> do-                -- Don't present an unchanged backbuffer.-                -- This doesn't improve FPS; probably equal frames happen-                -- very rarely, if at all, which is actually very good.-                prevFrame <- readIORef spreviousFrame-                unless (prevFrame == fr) $ do-                  -- Some SDL2 (OpenGL) backends are very thread-unsafe,-                  -- so we need to ensure we draw on the same (bound) OS thread-                  -- that initialized SDL, hence we have to poll frames.-                  drawFrame soptions sess fr-                  -- We can't print screen in @display@ due to thread-unsafety.-                  when sprintEachScreen $ printScreen sess+                -- Some SDL2 (OpenGL) backends are very thread-unsafe,+                -- so we need to ensure we draw on the same (bound) OS thread+                -- that initialized SDL, hence we have to poll frames.+                drawFrame coscreen soptions sess fr                 putMVar sframeDrawn ()  -- signal that drawing ended               Nothing -> threadDelay $ if sbenchmark then 150 else 15000                            -- 60 polls per second, so keyboard snappy enough;@@ -201,7 +295,10 @@         if continueSdlLoop         then loopSDL         else do-          TTF.free sfont+          maybe (return ()) TTF.free spropFont+          maybe (return ()) TTF.free sboldFont+          maybe (return ()) TTF.free smonoFont+          TTF.free squareFont           TTF.quit           SDL.destroyRenderer srenderer           SDL.destroyWindow swindow@@ -221,6 +318,7 @@                 modifierNoShift = case modifier of  -- to prevent S-!, etc.                   K.Shift -> K.NoModifier                   K.ControlShift -> K.Control+                  K.AltShift -> K.Alt                   _ -> modifier             p <- SDL.getAbsoluteMouseLocation             when (key == K.Esc) $ resetChanKey (fchanKey rf)@@ -286,94 +384,223 @@       -- to avoid exiting via "thread blocked".       threadDelay 50000 -drawFrame :: ClientOptions    -- ^ client options+drawFrame :: ScreenContent    -- ^ e.g., game screen size+          -> ClientOptions    -- ^ client options           -> FrontendSession  -- ^ frontend session data           -> SingleFrame      -- ^ the screen frame to draw           -> IO ()-drawFrame ClientOptions{..} FrontendSession{..} curFrame = do-  let isBitmapFile = "fon" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                  || "fnt" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                  || "bdf" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                  || "FON" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                  || "FNT" `isSuffixOf` T.unpack (fromJust sdlFontFile)-                  || "BDF" `isSuffixOf` T.unpack (fromJust sdlFontFile)-      sdlSizeAdd = fromJust $ if isBitmapFile-                              then sdlBitmapSizeAdd-                              else sdlScalableSizeAdd-  boxSize <- (+ sdlSizeAdd) <$> TTF.height sfont-  let tt2 = Vect.V2 (toEnum boxSize) (toEnum boxSize)+drawFrame coscreen ClientOptions{..} sess@FrontendSession{..} curFrame = do+  prevFrame <- readIORef spreviousFrame+  let halfSize = squareFontSize `div` 2+      boxSize = 2 * halfSize       vp :: Int -> Int -> Vect.Point Vect.V2 CInt       vp x y = Vect.P $ Vect.V2 (toEnum x) (toEnum y)       drawHighlight !x !y !color = do         SDL.rendererDrawColor srenderer SDL.$= colorToRGBA color-        let rect = SDL.Rectangle (vp (x * boxSize) (y * boxSize)) tt2+        let tt2Square = Vect.V2 (toEnum boxSize) (toEnum boxSize)+            rect = SDL.Rectangle (vp (x * boxSize) (y * boxSize)) tt2Square         SDL.drawRect srenderer $ Just rect         SDL.rendererDrawColor srenderer SDL.$= colorToRGBA Color.Black           -- reset back to black       chooseAndDrawHighlight !x !y !bg = case bg of         Color.HighlightNone -> return ()+        Color.HighlightNoneCursor -> return ()         _ -> drawHighlight x y $ Color.highlightToColor bg-      setChar :: Int -> (Word32, Word32) -> IO Int-      setChar !i (!w, !wPrev) | w == wPrev = return $! i + 1-      setChar i (w, _) = do-        atlas <- readIORef satlas-        let Point{..} = toEnum i-            Color.AttrChar{acAttr=Color.Attr{fg=fgRaw,bg}, acChar=acCharRaw} =-              Color.attrCharFromW32 $ Color.AttrCharW32 w-            fg | py `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite+      -- This also frees the surface it gets.+      scaleSurfaceToTexture :: Int -> SDL.Surface -> IO SDL.Texture+      scaleSurfaceToTexture xsize textSurfaceRaw = do+        Vect.V2 sw sh <- SDL.surfaceDimensions textSurfaceRaw+        let width = min xsize $ fromEnum sw+            height = min boxSize $ fromEnum sh+            xsrc = max 0 (fromEnum sw - width) `div` 2+            ysrc = max 0 (fromEnum sh - height) `divUp` 2+            srcR = SDL.Rectangle (vp xsrc ysrc)+                                 (Vect.V2 (toEnum width) (toEnum height))+            xtgt = (xsize - width) `divUp` 2+            ytgt = (boxSize - height) `div` 2+            tgtR = vp xtgt ytgt+            tt2 = Vect.V2 (toEnum xsize) (toEnum boxSize)+        textSurface <- SDL.createRGBSurface tt2 SDL.ARGB8888+        SDL.surfaceFillRect textSurface Nothing (colorToRGBA Color.Black)+        -- We crop surface rather than texture to set the resulting+        -- texture as @TextureAccessStatic@ via @createTextureFromSurface@,+        -- which otherwise we wouldn't be able to do.+        void $ SDL.surfaceBlit textSurfaceRaw (Just srcR)+                               textSurface (Just tgtR)+        SDL.freeSurface textSurfaceRaw+        textTexture <- SDL.createTextureFromSurface srenderer textSurface+        SDL.freeSurface textSurface+        return textTexture+      -- This also frees the surface it gets.+      scaleSurfaceToTextureProp :: Int -> Int -> SDL.Surface+                                -> IO (Int, SDL.Texture)+      scaleSurfaceToTextureProp x row textSurfaceRaw = do+        Vect.V2 sw sh <- SDL.surfaceDimensions textSurfaceRaw+        let widthRaw = fromEnum sw+            width = if widthRaw > rwidth coscreen * boxSize - x+                    then (rwidth coscreen - 1) * boxSize - x+                    else widthRaw+            height = min boxSize $ fromEnum sh+            xsrc = 0+            ysrc = max 0 (fromEnum sh - height) `divUp` 2+            srcR = SDL.Rectangle (vp xsrc ysrc)+                                 (Vect.V2 (toEnum width) (toEnum height))+            xtgt = 0+            ytgt = (boxSize - height) `div` 2+            tgtR = vp xtgt ytgt+            tt2Prop = Vect.V2 (toEnum width) (toEnum boxSize)+        textSurface <- SDL.createRGBSurface tt2Prop SDL.ARGB8888+        SDL.surfaceFillRect textSurface Nothing (colorToRGBA Color.Black)+        -- We crop surface rather than texture to set the resulting+        -- texture as @TextureAccessStatic@ via @createTextureFromSurface@,+        -- which otherwise we wouldn't be able to do.+        -- This is not essential for proportional font, for which we have+        -- no texture atlas, but it's consistent with other fonts+        -- and the bottleneck is the square font, anyway.+        void $ SDL.surfaceBlit textSurfaceRaw (Just srcR)+                               textSurface (Just tgtR)+        SDL.freeSurface textSurfaceRaw+        textTexture <- SDL.createTextureFromSurface srenderer textSurface+        SDL.freeSurface textSurface+        when (width /= widthRaw) $ do+          let greyDollar = Color.trimmedLineAttrW32+          void $ setChar (fromEnum Point{px = rwidth coscreen - 1, py = row})+                         (Color.attrCharW32 greyDollar, 0)+        return (width, textTexture)+      -- <https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf_42.html#SEC42>+      setChar :: PointI -> (Word32, Word32) -> IO Int+      setChar !i (!w, !wPrev) =+        if w == wPrev+        then return $! i + 1+        else do+          let Point{..} = toEnum i+          atlas <- readIORef squareAtlas+          let Color.AttrChar{ acAttr=Color.Attr{fg=fgRaw, bg}+                            , acChar=acCharRaw } =+                Color.attrCharFromW32 $ Color.AttrCharW32 w+              fg | py `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite+                 | otherwise = fgRaw+              ac = Color.attrChar2ToW32 fg acCharRaw+          textTexture <- case EM.lookup ac atlas of+            Nothing -> do+              -- Make all visible floors bold (no bold fold variant for 16x16x,+              -- so only the dot can be bold).+              let acChar = if not (Color.isBright fg)+                              && acCharRaw == floorSymbol  -- '\x00B7'+                           then if mapFontIsBitmap+                                then '\x0007'+                                else '\x22C5'+                           else acCharRaw+              textSurfaceRaw <- TTF.shadedGlyph squareFont (colorToRGBA fg)+                                                (colorToRGBA Color.Black) acChar+              textTexture <- scaleSurfaceToTexture boxSize textSurfaceRaw+              writeIORef squareAtlas $ EM.insert ac textTexture atlas+              return textTexture+            Just textTexture -> return textTexture+          let tt2Square = Vect.V2 (toEnum boxSize) (toEnum boxSize)+              tgtR = SDL.Rectangle (vp (px * boxSize) (py * boxSize)) tt2Square+          SDL.copy srenderer textTexture Nothing (Just tgtR)+          -- Potentially overwrite a portion of the glyph.+          chooseAndDrawHighlight px py bg+          return $! i + 1+      drawMonoOverlay :: OverlaySpace -> IO ()+      drawMonoOverlay =+        mapM_ (\(PointUI x y, al) ->+                 let lineCut = take (2 * rwidth coscreen - x) al+                 in drawMonoLine (x * halfSize) y lineCut)+      drawMonoLine :: Int -> Int -> AttrString -> IO ()+      drawMonoLine _ _ [] = return ()+      drawMonoLine x row (w : rest) = do+        setMonoChar x row w+        drawMonoLine (x + halfSize) row rest+      setMonoChar :: Int -> Int -> Color.AttrCharW32 -> IO ()+      setMonoChar !x !row !w = do+        atlas <- readIORef smonoAtlas+        let Color.AttrChar{acAttr=Color.Attr{fg=fgRaw, bg}, acChar} =+              Color.attrCharFromW32 w+            fg | row `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite                | otherwise = fgRaw-            ac = Color.attrChar2ToW32 fg acCharRaw-        -- <https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf_42.html#SEC42>+            ac = Color.attrChar2ToW32 fg acChar+            !_A = assert (bg `elem` [ Color.HighlightNone+                                    , Color.HighlightNoneCursor ]) ()         textTexture <- case EM.lookup ac atlas of           Nothing -> do-            -- Make all visible floors bold (no bold fold variant for 16x16x,-            -- so only the dot can be bold).-            let acChar = if not (Color.isBright fg)-                            && acCharRaw == floorSymbol  -- 0xb7-                         then if isBitmapFile-                              then Char.chr 7   -- hack-                              else Char.chr 8901  -- 0x22c5-                         else acCharRaw-            textSurfaceRaw <- TTF.shadedGlyph sfont (colorToRGBA fg)-                                              (colorToRGBA Color.Black) acChar-            Vect.V2 sw sh <- SDL.surfaceDimensions textSurfaceRaw-            let width = min boxSize $ fromEnum sw-                height = min boxSize $ fromEnum sh-                xsrc = max 0 (fromEnum sw - width) `div` 2-                ysrc = max 0 (fromEnum sh - height) `div` 2-                srcR = SDL.Rectangle (vp xsrc ysrc)-                                     (Vect.V2 (toEnum width) (toEnum height))-                xtgt = (boxSize - width) `divUp` 2-                ytgt = (boxSize - height) `div` 2-                tgtR = vp xtgt ytgt-            textSurface <- SDL.createRGBSurface tt2 SDL.ARGB8888-            SDL.surfaceFillRect textSurface Nothing (colorToRGBA Color.Black)-            -- We resize surface rather than texture to set the resulting-            -- texture as @TextureAccessStatic@ via @createTextureFromSurface@,-            -- which otherwise we wouldn't be able to do.-            void $ SDL.surfaceBlit textSurfaceRaw (Just srcR)-                                   textSurface (Just tgtR)-            SDL.freeSurface textSurfaceRaw-            textTexture <- SDL.createTextureFromSurface srenderer textSurface-            SDL.freeSurface textSurface-            writeIORef satlas $ EM.insert ac textTexture atlas+            textSurfaceRaw <-+              TTF.shadedGlyph (fromJust smonoFont) (colorToRGBA fg)+                              (colorToRGBA Color.Black) acChar+            textTexture <- scaleSurfaceToTexture halfSize textSurfaceRaw+            writeIORef smonoAtlas $ EM.insert ac textTexture atlas             return textTexture           Just textTexture -> return textTexture-        let tgtR = SDL.Rectangle (vp (px * boxSize) (py * boxSize)) tt2+        let tt2Mono = Vect.V2 (toEnum halfSize) (toEnum boxSize)+            tgtR = SDL.Rectangle (vp x (row * boxSize)) tt2Mono         SDL.copy srenderer textTexture Nothing (Just tgtR)-        -- Potentially overwrite a portion of the glyph.-        chooseAndDrawHighlight px py bg-        return $! i + 1-  texture <- readIORef stexture-  prevFrame <- readIORef spreviousFrame-  writeIORef spreviousFrame curFrame-  SDL.rendererRenderTarget srenderer SDL.$= Just texture-  SDL.rendererDrawColor srenderer SDL.$= colorToRGBA Color.Black-  U.foldM'_ setChar 0 $ U.zip (PointArray.avector $ singleFrame curFrame)-                              (PointArray.avector $ singleFrame prevFrame)-  SDL.rendererRenderTarget srenderer SDL.$= Nothing-  SDL.copy srenderer texture Nothing Nothing  -- clear the backbuffer-  SDL.present srenderer+      drawPropOverlay :: OverlaySpace -> IO ()+      drawPropOverlay =+        mapM_ (\(PointUI x y, al) ->+                 drawPropLine (x * halfSize) y al)+      drawPropLine :: Int -> Int -> AttrString -> IO ()+      drawPropLine _ _ [] = return ()+      drawPropLine x _ _ | x >= (rwidth coscreen - 1) * boxSize =+        -- This chunk starts at $ sign or beyond so, for KISS, reject it.+        return ()+      drawPropLine x row (w : rest) = do+        let isSpace = (`elem` [Color.spaceAttrW32, Color.spaceCursorAttrW32])+            Color.AttrChar{acAttr=Color.Attr{fg=fgRaw, bg}} =+              Color.attrCharFromW32+              $ if isSpace w+                then case filter (not . isSpace) rest of+                  w2 : _ -> w2+                  [] -> w+                else w+            sameAttr ac = Color.fgFromW32 ac == fgRaw+                          || isSpace ac  -- matches all colours+            (sameRest, otherRest) = span sameAttr rest+            !_A = assert (bg `elem` [ Color.HighlightNone+                                    , Color.HighlightNoneCursor ]) ()+            fg | row `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite+               | otherwise = fgRaw+            t = T.pack $ map Color.charFromW32 $ w : sameRest+        width <- drawPropChunk x row fg t+        drawPropLine (x + width) row otherRest+      drawPropChunk :: Int -> Int -> Color.Color -> T.Text -> IO Int+      drawPropChunk x row fg t = do+        let font = if fg >= Color.White && fg /= Color.BrBlack+                   then spropFont+                   else sboldFont+        textSurfaceRaw <- TTF.shaded (fromJust font) (colorToRGBA fg)+                                     (colorToRGBA Color.Black) t+        (width, textTexture) <- scaleSurfaceToTextureProp x row textSurfaceRaw+        let tgtR = SDL.Rectangle (vp x (row * boxSize))+                                 (Vect.V2 (toEnum width) (toEnum boxSize))+        -- Potentially overwrite some of the screen.+        SDL.copy srenderer textTexture Nothing (Just tgtR)+        SDL.destroyTexture textTexture+        return width+  let arraysEqual = singleArray curFrame == singleArray prevFrame+      overlaysEqual =+        singleMonoOverlay curFrame == singleMonoOverlay prevFrame+        && singlePropOverlay curFrame == singlePropOverlay prevFrame+  basicTexture <- readIORef sbasicTexture  -- previous content still present+  unless arraysEqual $ do+    SDL.rendererRenderTarget srenderer SDL.$= Just basicTexture+    U.foldM'_ setChar 0 $ U.zip (PointArray.avector $ singleArray curFrame)+                                (PointArray.avector $ singleArray prevFrame)+  unless (arraysEqual && overlaysEqual) $ do+    texture <- readIORef stexture+    SDL.rendererRenderTarget srenderer SDL.$= Just texture+    SDL.copy srenderer basicTexture Nothing Nothing  -- overwrite last content+    -- Mono overlay rendered last, because more likely to come after+    -- the proportional one and so to have a warning message about overrun+    -- that needs to be overlaid on top of the proportional overlay.+    drawPropOverlay $ singlePropOverlay curFrame+    drawMonoOverlay $ singleMonoOverlay curFrame+    writeIORef spreviousFrame curFrame+    SDL.rendererRenderTarget srenderer SDL.$= Nothing+    SDL.copy srenderer texture Nothing Nothing  -- overwrite the backbuffer+    SDL.present srenderer+    -- We can't print screen in @display@ due to thread-unsafety.+    when sprintEachScreen $ printScreen sess  -- It can't seem to cope with SDL_PIXELFORMAT_INDEX8, so we are stuck -- with huge bitmaps.@@ -412,7 +639,9 @@     (SDL.keyModifierLeftShift m || SDL.keyModifierRightShift m)     (SDL.keyModifierLeftAlt m      || SDL.keyModifierRightAlt m-     || SDL.keyModifierAltGr m)+     || SDL.keyModifierAltGr m+     || SDL.keyModifierLeftGUI m+     || SDL.keyModifierRightGUI m)     False  keyTranslate :: Bool -> SDL.Keycode -> K.Key@@ -460,6 +689,9 @@   KeycodeCaret -> K.Char '^'   KeycodeUnderscore -> K.Char '_'   KeycodeBackquote -> if shiftPressed then K.Char '~' else K.Char '`'+  Keycode 167      -> if shiftPressed then K.Char '~' else K.Char '`'+    -- on some keyboards the key below ESC is paragraph and its scancode is 167+    -- and moreover SDL sometimes gives this code even on normal keyboards   KeycodeUp         -> K.Up   KeycodeDown       -> K.Down   KeycodeLeft       -> K.Left@@ -475,7 +707,7 @@   KeycodeKPClear -> K.Begin   KeycodeKPDivide   -> if shiftPressed then K.Char '?' else K.Char '/'                          -- KP and normal are merged here-  KeycodeKPMultiply -> K.KP '*'+  KeycodeKPMultiply -> K.Char '*'  -- KP and normal are merged here   KeycodeKPMinus    -> K.Char '-'  -- KP and normal are merged here   KeycodeKPPlus     -> K.Char '+'  -- KP and normal are merged here   KeycodeKPEnter    -> K.Return

engine-src/Game/LambdaHack/Client/UI/Frontend/Teletype.hs view

@@ -16,10 +16,10 @@ import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K-import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Common.Point+import           Game.LambdaHack.Client.UI.PointUI import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Content.TileKind (floorSymbol)+import qualified Game.LambdaHack.Definition.Color as Color  -- No session data maintained by this frontend @@ -38,7 +38,7 @@               [] -> '\n'  -- empty line counts as RET               hd : _ -> hd             K.KM{..} = keyTranslate c-        saveKMP rf modifier key originPoint+        saveKMP rf modifier key (PointUI 0 0)         storeKeys   void $ async storeKeys   return $! rf@@ -50,16 +50,18 @@ display :: ScreenContent         -> SingleFrame         -> IO ()-display coscreen SingleFrame{singleFrame} =+display coscreen SingleFrame{..} = do   let f w l =         let acCharRaw = Color.charFromW32 w             acChar = if acCharRaw == floorSymbol then '.' else acCharRaw         in acChar : l-      levelChar = chunk $ PointArray.foldrA f [] singleFrame+      levelChar = chunk $ PointArray.foldrA f [] singleArray       chunk [] = []       chunk l = let (ch, r) = splitAt (rwidth coscreen) l                 in ch : chunk r-  in SIO.hPutStrLn SIO.stderr $ unlines levelChar+  SIO.hPutStrLn SIO.stderr $ unlines levelChar+  mapM_ (SIO.hPutStrLn SIO.stderr) $+    map (map Color.charFromW32 . snd) singlePropOverlay  keyTranslate :: Char -> K.KM keyTranslate e = (\(key, modifier) -> K.KM modifier key) $

engine-src/Game/LambdaHack/Client/UI/Frontend/Vty.hs view

@@ -8,15 +8,15 @@ import Game.LambdaHack.Core.Prelude  import           Control.Concurrent.Async-import           Data.Ord (comparing) import           Graphics.Vty import qualified Graphics.Vty as Vty -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.PointUI+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Content.TileKind (floorSymbol)@@ -42,7 +42,7 @@         e <- nextEvent svty  -- blocks here, so no polling         case e of           EvKey n mods ->-            saveKMP rf (modTranslate mods) (keyTranslate n) originPoint+            saveKMP rf (modTranslate mods) (keyTranslate n) (PointUI 0 0)           _ -> return ()         storeKeys   void $ async storeKeys@@ -53,14 +53,14 @@         -> FrontendSession         -> SingleFrame         -> IO ()-display coscreen FrontendSession{svty} SingleFrame{singleFrame} = do+display coscreen FrontendSession{svty} SingleFrame{singleArray} = do   let img = foldr (<->) emptyImage             . map (foldr (<|>) emptyImage                      . map (\w -> char (setAttr $ Color.attrFromW32 w)                                        (squashChar $ Color.charFromW32 w)))-            $ chunk $ PointArray.toListA singleFrame+            $ chunk $ PointArray.toListA singleArray       pic1 = picForImage img-      Point{..} = PointArray.maxIndexByA (comparing Color.bgFromW32) singleFrame+      Point{..} = PointArray.maxIndexByA (comparing Color.bgFromW32) singleArray       pic2 = pic1 {picCursor = AbsoluteCursor px py}       chunk [] = []       chunk l = let (ch, r) = splitAt (rwidth coscreen) l@@ -123,12 +123,20 @@           if fg /= Color.Blue           then (fg, Color.Blue)           else (fg, Color.BrBlack)+        Color.HighlightBrown ->+          if fg /= Color.Blue+          then (fg, Color.Brown)+          else (fg, Color.BrBlack)+        Color.HighlightCyan ->+          if fg /= Color.Blue+          then (fg, Color.Cyan)+          else (fg, Color.BrBlack)         Color.HighlightGrey ->           if fg /= Color.BrBlack           then (fg, Color.BrBlack)           else (fg, Color.defFG)-        Color.HighlightWhite -> (fg, Color.Black)-        Color.HighlightMagenta -> (fg, Color.Black)+        Color.HighlightWhite -> (fg, Color.Magenta)+        Color.HighlightMagenta -> (fg, Color.Magenta)         Color.HighlightRed ->           if fg /= Color.Red           then (fg, Color.Red)

engine-src/Game/LambdaHack/Client/UI/HandleHelperM.hs view

@@ -1,14 +1,20 @@+{-# LANGUAGE TupleSections #-} -- | Helper functions for both inventory management and human commands. module Game.LambdaHack.Client.UI.HandleHelperM   ( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith   , failSer, failMsg, weaveJust-  , memberCycle, memberBack, partyAfterLeader, pickLeader, pickLeaderWithPointer-  , itemOverlay, skillsOverlay, placesFromState, placeParts, placesOverlay-  , pickNumber, lookAtItems, lookAtPosition-  , displayItemLore, viewLoreItems, cycleLore, spoilsBlurb+  , memberCycle, memberCycleLevel, partyAfterLeader+  , pickLeader, pickLeaderWithPointer+  , itemOverlay, skillsOverlay+  , placesFromState, placesOverlay+  , describeMode, modesOverlay+  , pickNumber, guardItemSize, lookAtItems, lookAtStash, lookAtPosition+  , displayItemLore, displayItemLorePointedAt+  , viewLoreItems, cycleLore, spoilsBlurb+  , ppContainerWownW, nxtGameMode #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , lookAtTile, lookAtActors+  , lookAtTile, lookAtActors, guardItemVerbs #endif   ) where @@ -19,10 +25,10 @@ import qualified Data.Char as Char import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES+import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified NLP.Miniutter.English as MU -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.CommonM import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.State@@ -30,6 +36,7 @@ import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.ContentClientUI import           Game.LambdaHack.Client.UI.EffectDescription+import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.ItemDescription import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K@@ -37,12 +44,15 @@ import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.MsgM import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.SessionUI import           Game.LambdaHack.Client.UI.Slideshow import           Game.LambdaHack.Client.UI.SlideshowM import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction+import qualified Game.LambdaHack.Common.HighScore as HighScore import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import           Game.LambdaHack.Common.Kind@@ -53,9 +63,11 @@ 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.Types import qualified Game.LambdaHack.Content.ItemKind as IK+import qualified Game.LambdaHack.Content.ModeKind as MK import qualified Game.LambdaHack.Content.PlaceKind as PK import qualified Game.LambdaHack.Content.TileKind as TK import qualified Game.LambdaHack.Definition.Ability as Ability@@ -64,7 +76,7 @@  -- | Message describing the cause of failure of human command. newtype FailError = FailError {failError :: Text}-  deriving Show+  deriving (Show, Eq)  showFailError :: FailError -> Text showFailError (FailError err) = "*" <> err <> "*"@@ -94,8 +106,9 @@ weaveJust (Right a) = Right a  -- | Switches current member to the next on the level, if any, wrapping.-memberCycle :: MonadClientUI m => Bool -> m MError-memberCycle verbose = do+memberCycleLevel :: (MonadClient m, MonadClientUI m)+                 => Bool -> Direction -> m MError+memberCycleLevel verbose direction = do   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD   lidV <- viewedLevelUI@@ -103,7 +116,10 @@   body <- getsState $ getActorBody leader   hs <- partyAfterLeader leader   let (autoDun, _) = autoDungeonLevel fact-  case filter (\(_, b, _) -> blid b == lidV) hs of+  let hsSort = case direction of+        Forward -> hs+        Backward -> reverse hs+  case filter (\(_, b, _) -> blid b == lidV) hsSort of     _ | autoDun && lidV /= blid body ->       failMsg $ showReqFailure NoChangeDunLeader     [] -> failMsg "cannot pick any other member on this level"@@ -114,14 +130,17 @@       return Nothing  -- | Switches current member to the previous in the whole dungeon, wrapping.-memberBack :: MonadClientUI m => Bool -> m MError-memberBack verbose = do+memberCycle :: (MonadClient m, MonadClientUI m) => Bool -> Direction -> m MError+memberCycle verbose direction = do   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD   leader <- getLeaderUI   hs <- partyAfterLeader leader   let (autoDun, _) = autoDungeonLevel fact-  case reverse hs of+  let hsSort = case direction of+        Forward -> hs+        Backward -> reverse hs+  case hsSort of     _ | autoDun -> failMsg $ showReqFailure NoChangeDunLeader     [] -> failMsg "no other member in the party"     (np, b, _) : _ -> do@@ -142,10 +161,9 @@   return $! gt ++ lt  -- | Select a faction leader. False, if nothing to do.-pickLeader :: MonadClientUI m => Bool -> ActorId -> m Bool+pickLeader :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> m Bool pickLeader verbose aid = do   leader <- getLeaderUI-  saimMode <- getsSession saimMode   if leader == aid     then return False -- already picked     else do@@ -157,20 +175,19 @@       -- Even if it's already the leader, give his proper name, not 'you'.       let subject = partActor bodyUI       when verbose $-        msgAdd MsgDone $ makeSentence [subject, "picked as a leader"]+        msgAdd MsgPointmanSwap $ makeSentence [subject, "picked as a pointman"]       -- Update client state.       updateClientLeader aid       -- Move the xhair, if active, to the new level.-      case saimMode of-        Nothing -> return ()-        Just _ ->-          modifySession $ \sess -> sess {saimMode = Just $ AimMode $ blid body}+      modifySession $ \sess -> sess {saimMode =+        (\aimMode -> aimMode {aimLevelId = blid body}) <$> saimMode sess}       -- Inform about items, etc.-      itemsBlurb <- lookAtItems True (bpos body) aid-      when verbose $ msgAdd MsgAtFeet itemsBlurb+      (itemsBlurb, _) <- lookAtItems True (bpos body) aid Nothing+      stashBlurb <- lookAtStash (blid body) (bpos body)+      when verbose $ msgAdd MsgAtFeetMinor $ stashBlurb <+> itemsBlurb       return True -pickLeaderWithPointer :: MonadClientUI m => m MError+pickLeaderWithPointer :: (MonadClient m, MonadClientUI m) => m MError pickLeaderWithPointer = do   CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui   lidV <- viewedLevelUI@@ -189,21 +206,24 @@            | otherwise -> do                void $ pickLeader True aid                return Nothing-  Point{..} <- getsSession spointer+  pUI <- getsSession spointer+  let p@(Point px py) = squareToMap $ uiToSquare pUI   -- Pick even if no space in status line for the actor's symbol.-  if | py == rheight - 1 && px == 0 -> memberBack True-     | py == rheight - 1 ->+  if | py == rheight - 2 && px == 0 -> memberCycle True Forward+     | py == rheight - 2 ->          case drop (px - 1) viewed of            [] -> return Nothing              -- relaxed, due to subtleties of display of selected actors            (aid, b, _) : _ -> pick (aid, b)      | otherwise ->-         case find (\(_, b, _) -> bpos b == Point px (py - mapStartY)) oursUI of+         case find (\(_, b, _) -> bpos b == p) oursUI of            Nothing -> failMsg "not pointing at an actor"            Just (aid, b, _) -> pick (aid, b) -itemOverlay :: MonadClientUI m => SingleItemSlots -> LevelId -> ItemBag -> m OKX-itemOverlay lSlots lid bag = do+itemOverlay :: MonadClientUI m+            => SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX+itemOverlay lSlots lid bag displayRanged = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui   localTime <- getsState $ getLocalTime lid   itemToF <- getsState $ flip itemToFull   side <- getsClient sside@@ -211,19 +231,18 @@   combGround <- getsState $ combinedGround side   combOrgan <- getsState $ combinedOrgan side   combEqp <- getsState $ combinedEqp side-  combInv <- getsState $ combinedInv side-  shaBag <- getsState $ \s -> gsha $ sfactionD s EM.! side+  stashBag <- getsState $ getFactionStashBag side   discoBenefit <- getsClient sdiscoBenefit-  let !_A = assert (all (`elem` EM.elems lSlots) (EM.keys bag)+  FontSetup{..} <- getFontSetup+  let !_A = assert (allB (`elem` EM.elems lSlots) (EM.keys bag)                     `blame` (lid, bag, lSlots)) ()       markEqp iid t =         if | (iid `EM.member` combOrgan              || iid `EM.member` combEqp)-             && iid `EM.notMember` combInv-             && iid `EM.notMember` shaBag+             && iid `EM.notMember` stashBag              && iid `EM.notMember` combGround -> T.snoc (T.init t) ']'                -- all ready to fight with-           | iid `EM.member` shaBag -> T.snoc (T.init t) '}'+           | iid `EM.member` stashBag -> T.snoc (T.init t) '}'                -- some spares in shared stash            | otherwise -> t       pr (l, iid) =@@ -231,8 +250,9 @@           Nothing -> Nothing           Just kit@(k, _) ->             let itemFull = itemToF iid+                arItem = aspectRecordFull itemFull                 colorSymbol =-                  if isJust $ lookup "condition" $ IK.ifreq $ itemKind itemFull+                  if IA.checkFlag Ability.Condition arItem                   then let color = if benInEqp (discoBenefit EM.! iid)                                    then Color.BrGreen                                    else Color.BrRed@@ -240,94 +260,261 @@                                                (IK.isymbol $ itemKind itemFull)                   else viewItem itemFull                 phrase = makePhrase-                  [partItemWsRanged side factionD k localTime itemFull kit]-                al = textToAL (markEqp iid $ slotLabel l)-                     <+:> [colorSymbol]-                     <+:> textToAL phrase-                kx = (Right l, (undefined, 0, length al))-            in Just ([al], kx)+                  [partItemWsRanged rwidth side factionD displayRanged+                                    DetailMedium 4 k localTime itemFull kit]+                al1 = attrStringToAL+                      $ textToAS (markEqp iid $ slotLabel l)+                        ++ [Color.spaceAttrW32 | isSquareFont propFont]+                        ++ [colorSymbol]+                xal2 = ( textSize squareFont $ attrLine al1+                       , attrStringToAL $ Color.spaceAttrW32 : textToAS phrase )+                kx = (Right l, ( PointUI 0 0+                               , ButtonWidth propFont (5 + T.length phrase) ))+            in Just ((al1, xal2), kx)       (ts, kxs) = unzip $ mapMaybe pr $ EM.assocs lSlots-      renumber y (km, (_, x1, x2)) = (km, (y, x1, x2))-  return (concat ts, zipWith renumber [0..] kxs)+      (tsLab, tsDesc) = unzip ts+      ovsLab = EM.singleton squareFont $ offsetOverlay tsLab+      ovsDesc = EM.singleton propFont $ offsetOverlayX tsDesc+      renumber y (km, (PointUI x _, len)) = (km, (PointUI x y, len))+  return (EM.unionWith (++) ovsLab ovsDesc, zipWith renumber [0..] kxs ) -skillsOverlay :: MonadClientRead m => ActorId -> m OKX+skillsOverlay :: MonadClientUI m => ActorId -> m OKX skillsOverlay aid = do   b <- getsState $ getActorBody aid   actorMaxSk <- getsState $ getActorMaxSkills aid-  let prSlot :: (Y, SlotChar) -> Ability.Skill -> (Text, KYX)+  FontSetup{..} <- getFontSetup+  let prSlot :: (Int, SlotChar) -> Ability.Skill+             -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)       prSlot (y, c) skill =-        let skName = skillName skill-            fullText t =-              makePhrase [ MU.Text $ slotLabel c-                         , MU.Text $ T.justifyLeft 22 ' ' skName-                         , MU.Text t ]+        let skName = " " <> skillName skill+            slotLab = slotLabel c+            lab = textToAL slotLab+            labLen = textSize squareFont $ attrLine lab+            indentation = if isSquareFont propFont then 42 else 20             valueText = skillToDecorator skill b                         $ Ability.getSk skill actorMaxSk-            ft = fullText valueText-        in (ft, (Right c, (y, 0, T.length ft)))+            triple = ( lab+                     , (labLen, textToAL skName)+                     , (labLen + indentation, textToAL valueText) )+        in (triple, (Right c, ( PointUI 0 y+                              , ButtonWidth propFont (28 + T.length slotLab) )))       (ts, kxs) = unzip $ zipWith prSlot (zip [0..] allSlots) skillSlots-  return (map textToAL ts, kxs)+      (skLab, skDescr, skValue) = unzip3 ts+      skillLab = EM.singleton squareFont $ offsetOverlay skLab+      skillDescr = EM.singleton propFont $ offsetOverlayX skDescr+      skillValue = EM.singleton monoFont $ offsetOverlayX skValue+  return (EM.unionsWith (++) [skillLab, skillDescr, skillValue], kxs)  placesFromState :: ContentData PK.PlaceKind -> ClientOptions -> State                 -> EM.EnumMap (ContentId PK.PlaceKind)                               (ES.EnumSet LevelId, Int, Int, Int)-placesFromState coplace ClientOptions{sexposePlaces} =-  let addEntries (es1, ne1, na1, nd1) (es2, ne2, na2, nd2) =-        (ES.union es1 es2, ne1 + ne2, na1 + na2, nd1 + nd2)-      insertZeros !em !pk _ = EM.insert pk (ES.empty, 0, 0, 0) em-      initialPlaces | not sexposePlaces = EM.empty-                    | otherwise = ofoldlWithKey' coplace insertZeros EM.empty+placesFromState coplace ClientOptions{sexposePlaces} s =+  let addEntries (!es1, !ne1, !na1, !nd1) (!es2, !ne2, !na2, !nd2) =+        let !es = ES.union es1 es2+            !ne = ne1 + ne2+            !na = na1 + na2+            !nd = nd1 + nd2+        in (es, ne, na, nd)       placesFromLevel :: (LevelId, Level)                       -> EM.EnumMap (ContentId PK.PlaceKind)                                     (ES.EnumSet LevelId, Int, Int, Int)-      placesFromLevel (lid, Level{lentry}) =+      placesFromLevel (!lid, Level{lentry}) =         let f (PK.PEntry pk) em =               EM.insertWith addEntries pk (ES.singleton lid, 1, 0, 0) em             f (PK.PAround pk) em =               EM.insertWith addEntries pk (ES.singleton lid, 0, 1, 0) em-            f (PK.PEnd pk) em =+            f (PK.PExists pk) em =               EM.insertWith addEntries pk (ES.singleton lid, 0, 0, 1) em-        in EM.foldr' f initialPlaces lentry-  in EM.unionsWith addEntries . map placesFromLevel . EM.assocs . sdungeon--placeParts :: (ES.EnumSet LevelId, Int, Int, Int) -> [MU.Part]-placeParts (_, ne, na, nd) =-  ["(" <> MU.CarWs ne "entrance" <> ")" | ne > 0]-  ++ ["(" <> MU.CarWs na "surrounding" <> ")" | na > 0]-  ++ ["(" <> MU.CarWs nd "end" <> ")" | nd > 0]+        in EM.foldr' f EM.empty lentry+      insertZeros !em !pk _ = EM.insert pk (ES.empty, 0, 0, 0) em+      initialPlaces | not sexposePlaces = EM.empty+                    | otherwise = ofoldlWithKey' coplace insertZeros EM.empty+  in EM.unionWith addEntries+       initialPlaces+       (EM.unionsWith addEntries $ map placesFromLevel $ EM.assocs $ sdungeon s) -placesOverlay :: MonadClientRead m => m OKX+placesOverlay :: MonadClientUI m => m OKX placesOverlay = do   COps{coplace} <- getsState scops   soptions <- getsClient soptions+  FontSetup{..} <- getFontSetup   places <- getsState $ placesFromState coplace soptions-  let prSlot :: (Y, SlotChar)+  let prSlot :: (Int, SlotChar)              -> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))-             -> (Text, KYX)-      prSlot (y, c) (pk, (es, ne, na, nd)) =+             -> (AttrLine, (Int, AttrLine), KYX)+      prSlot (y, c) (pk, (es, _, _, _)) =         let placeName = PK.pname $ okind coplace pk-            parts = placeParts (es, ne, na, nd)-            markPlace t = if ne + na + nd == 0+            markPlace t = if ES.null es                           then T.snoc (T.init t) '>'                           else t-            ft = makePhrase $ MU.Text (markPlace $ slotLabel c)-                 : MU.Text placeName-                 : parts-        in (ft, (Right c, (y, 0, T.length ft)))-      (ts, kxs) = unzip $ zipWith prSlot (zip [0..] allSlots) $ EM.assocs places-  return (map textToAL ts, kxs)+            !tSlot = markPlace $ slotLabel c  -- free @places@ as you go+            !lenSlot = 2 * T.length tSlot+            !tBlurb = " "+                      <> placeName+                      <+> if ES.null es+                          then ""+                          else "("+                               <> makePhrase [MU.CarWs (ES.size es) "level"]+                               <> ")"+            !lenButton = lenSlot + T.length tBlurb+            !pButton = PointUI 0 y+            !widthButton = ButtonWidth propFont lenButton+        in ( textToAL tSlot+           , (lenSlot, textToAL tBlurb)+           , (Right c, (pButton, widthButton)) )+      (plLab, plDesc, kxs) = unzip3 $ zipWith prSlot (zip [0..] allSlots)+                                    $ EM.assocs places+      placeLab = EM.singleton squareFont $ offsetOverlay plLab+      placeDesc = EM.singleton propFont $ offsetOverlayX plDesc+  return (EM.unionWith (++) placeLab placeDesc, kxs) -pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int)+describeMode :: MonadClientUI m+             => Bool -> ContentId MK.ModeKind+             -> m (EM.EnumMap DisplayFont Overlay)+describeMode addTitle gameModeId = do+  COps{comode} <- getsState scops+  CCUI{coscreen=ScreenContent{rwidth}}+    <- getsSession sccui+  FontSetup{..} <- getFontSetup+  scoreDict <- getsState shigh+  scampings <- getsClient scampings+  srestarts <- getsClient srestarts+  let gameMode = okind comode gameModeId+      duplicateEOL '\n' = "\n\n"+      duplicateEOL c = T.singleton c+      sections =+        [ ( textFgToAS Color.BrGreen "The story so far:"+          , T.concatMap duplicateEOL (MK.mdesc gameMode) )+        , ( textFgToAS Color.cMeta "Rules of the game:"+          , MK.mrules gameMode )+        , ( textFgToAS Color.BrCyan "Running commentary:"+          , T.concatMap duplicateEOL (MK.mreason gameMode) )+        , ( textFgToAS Color.cGreed "Hints, not needed unless stuck:"+          , T.concatMap duplicateEOL (MK.mhint gameMode) )+        ]+      renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]+      renderSection (header, desc) =+        if T.null desc+        then Nothing+        else Just [(monoFont, header), (propFont, textToAS desc)]+      title = if addTitle+              then "\nYou are surviving the '"+                   <> MK.mname gameMode+                   <> "' adventure.\n"+              else ""+      blurb = map (second $ splitAttrString (rwidth - 2) (rwidth - 2)) $+        (propFont, textToAS (title <> "\n"))+        : concat (intersperse [(monoFont, textToAS "\n")]+                              (mapMaybe renderSection sections))+      -- Colour is used to delimit the section when displayed in one+      -- column, when using square fonts only.+      blurbEnd = map (second $ splitAttrString (rwidth - 2) (rwidth - 2)) $+        ( propFont+        , textFgToAS Color.Brown+                     "\nThis adventure's endings experienced so far:\n\n" )+          : if null sectionsEndAS+            then [(monoFont, textToAS "*none*")]+            else sectionsEndAS+      sectionsEndAS = concat (intersperse [(monoFont, textToAS "\n")]+                                          (mapMaybe renderSection sectionsEnd))+      sectionsEnd = map outcomeSection [minBound..maxBound]+      outcomeSection :: MK.Outcome -> (AttrString, Text)+      outcomeSection outcome =+        ( renderOutcome outcome+        , if not (outcomeSeen outcome)+          then ""  -- a possible spoiler and lack of sense of progression+          else T.concatMap duplicateEOL+               $ fromMaybe "" $ lookup outcome+               $ MK.mendMsg gameMode ++ endMsgDefault  -- left-biased+        )+      -- These are not added to @mendMsg@, because they only fit here.+      endMsgDefault =+        [ (MK.Restart, "No shame there is in noble defeat and there is honour in perseverance. Sometimes there are ways and places to turn rout into victory.")+        , (MK.Camping, "Don't fear to take breaks. While you move, others move, even on distant floors, but while you stay still, the world stays still.")+        ]+      scoreRecords = maybe [] HighScore.unTable $ EM.lookup gameModeId scoreDict+      outcomeSeen :: MK.Outcome -> Bool+      outcomeSeen outcome = case outcome of+        MK.Camping -> gameModeId `ES.member` scampings+        MK.Restart -> gameModeId `ES.member` srestarts+        _ -> outcome `elem` map (stOutcome . HighScore.getStatus) scoreRecords+      -- Camping not taken into account.+      lastOutcome :: MK.Outcome+      lastOutcome = if null scoreRecords+                    then MK.Restart  -- only if nothing else+                    else stOutcome . HighScore.getStatus+                         $ maximumBy (comparing HighScore.getDate) scoreRecords+      renderOutcome :: MK.Outcome -> AttrString+      renderOutcome outcome =+        let color | outcome `elem` MK.deafeatOutcomes = Color.cVeryBadEvent+                  | outcome `elem` MK.victoryOutcomes = Color.cVeryGoodEvent+                  | otherwise = Color.cNeutralEvent+            lastRemark+              | outcome /= lastOutcome = ""+              | outcome `elem` MK.deafeatOutcomes = "(last suffered ending)"+              | outcome `elem` MK.victoryOutcomes = "(last achieved ending)"+              | otherwise = "(last seen ending)"+        in textToAS "Game over message when"+           <+:> (textFgToAS color (T.toTitle $ MK.nameOutcomePast outcome)+                 <+:> textToAS lastRemark)+           <> textToAS ":"+      shiftPointUI x (PointUI x0 y0) = PointUI (x0 + x) y0+  return $! if isSquareFont propFont+            then EM.singleton squareFont  -- single column, single font+                 $ offsetOverlayX+                 $ map (\t -> (2, t))+                 $ concatMap snd $ blurb ++ blurbEnd+            else EM.unionWith (++)+                 (EM.map (map (first $ shiftPointUI 1))+                  $ attrLinesToFontMap 0 blurb)+                 (EM.map (map (first $ shiftPointUI $ rwidth + 1))+                  $ attrLinesToFontMap 0 blurbEnd)++modesOverlay :: MonadClientUI m => m OKX+modesOverlay = do+  COps{comode} <- getsState scops+  FontSetup{..} <- getFontSetup+  svictories <- getsClient svictories+  nxtChal <- getsClient snxtChal  -- mark victories only for current difficulty+  let f !acc _p !i !a = (i, a) : acc+      campaignModes = ofoldlGroup' comode MK.CAMPAIGN_SCENARIO f []+      prSlot :: (Int, SlotChar)+             -> (ContentId MK.ModeKind, MK.ModeKind)+             -> (AttrLine, (Int, AttrLine), KYX)+      prSlot (y, c) (gameModeId, gameMode) =+        let modeName = MK.mname gameMode+            victories = case EM.lookup gameModeId svictories of+              Nothing -> 0+              Just cm -> fromMaybe 0 (M.lookup nxtChal cm)+            markMode t = if victories > 0+                         then T.snoc (T.init t) '>'+                         else t+            !tSlot = markMode $ slotLabel c+            !lenSlot = 2 * T.length tSlot+            !tBlurb = " " <> modeName+            !lenButton = lenSlot + T.length tBlurb+            !pButton = PointUI 0 y+            !widthButton = ButtonWidth propFont lenButton+        in ( textToAL tSlot+           , (lenSlot, textToAL tBlurb)+           , (Right c, (pButton, widthButton)) )+      (plLab, plDesc, kxs) =+        unzip3 $ zipWith prSlot (zip [0..] allSlots) campaignModes+      placeLab = EM.singleton squareFont $ offsetOverlay plLab+      placeDesc = EM.singleton propFont $ offsetOverlayX plDesc+  return (EM.unionWith (++) placeLab placeDesc, kxs)++pickNumber :: (MonadClient m, MonadClientUI m)+           => Bool -> Int -> m (Either MError Int) pickNumber askNumber kAll = assert (kAll >= 1) $ do   let shownKeys = [ K.returnKM, K.spaceKM, K.mkChar '+', K.mkChar '-'                   , K.backspaceKM, K.escKM ]       frontKeyKeys = shownKeys ++ map K.mkChar ['0'..'9']       gatherNumber kCur = assert (1 <= kCur && kCur <= kAll) $ do         let kprompt = "Choose number:" <+> tshow kCur-        promptAdd0 kprompt+        msgAdd MsgPromptGeneric kprompt         sli <- reportToSlideshow shownKeys-        ekkm <- displayChoiceScreen "" ColorFull False-                                    sli frontKeyKeys+        ekkm <- displayChoiceScreen "" ColorFull False sli frontKeyKeys         case ekkm of           Left kkm ->             case K.key kkm of@@ -355,225 +542,372 @@  -- | Produces a textual description of the tile at a position. lookAtTile :: MonadClientUI m-           => Bool       -- ^ can be seen right now?-           -> Point      -- ^ position to describe-           -> ActorId    -- ^ the actor that looks-           -> LevelId    -- ^ level the position is at-           -> m Text-lookAtTile canSee p aid lidV = do+           => Bool             -- ^ can be seen right now?+           -> Point            -- ^ position to describe+           -> ActorId          -- ^ the actor that looks+           -> LevelId          -- ^ level the position is at+           -> Maybe MU.Person  -- ^ grammatical person of the item(s), if any+           -> m (Text, Text, [(Int, MU.Part)])+lookAtTile canSee p aid lidV mperson = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui   cops@COps{cotile, coplace} <- getsState scops   side <- getsClient sside   factionD <- getsState sfactionD   b <- getsState $ getActorBody aid   lvl <- getLevel lidV+  saimMode <- getsSession saimMode   embeds <- getsState $ getEmbedBag lidV p   itemToF <- getsState $ flip itemToFull   seps <- getsClient seps-  mnewEps <- makeLine False b p seps   localTime <- getsState $ getLocalTime lidV   getKind <- getsState $ flip getIidKind-  let aims = isJust mnewEps+  let inhabitants = posToAidsLvl p lvl+      detail = maybe DetailAll detailLevel saimMode+      aims = isJust $ makeLine False b p seps cops lvl       tkid = lvl `at` p       tile = okind cotile tkid       vis | TK.tname tile == "unknown space" = "that is"+          | not (null inhabitants) && bpos b /= p = "the terrain here is"           | not canSee = "you remember"-          | not aims = "you are aware of"+          | not aims = "you are aware of"  -- walkable path a proxy for in LOS           | otherwise = "you see"+      vperson = case mperson of+        Nothing -> vis+        Just MU.Sg1st -> error "an item speaks in first person"+        Just MU.Sg3rd -> "It is laying on"+        Just MU.PlEtc -> "They lay on"       tilePart = MU.AW $ MU.Text $ TK.tname tile       entrySentence pk blurb =         makeSentence [blurb, MU.Text $ PK.pname $ okind coplace pk]-      elooks = case EM.lookup p $ lentry lvl of+      placeBlurb = case EM.lookup p $ lentry lvl of         Nothing -> ""         Just (PK.PEntry pk) -> entrySentence pk "it is an entrance to"         Just (PK.PAround pk) -> entrySentence pk "it surrounds"-        Just (PK.PEnd pk) -> entrySentence pk "it ends"-      itemLook (iid, kit@(k, _)) =+        Just (PK.PExists _) -> ""+      embedLook (iid, kit@(k, _)) =         let itemFull = itemToF iid-            arItem = aspectRecordFull itemFull-            nWs = partItemWs side factionD k localTime itemFull kit-            verb = if k == 1 || IA.checkFlag Ability.Condition arItem-                   then "is"-                   else "are"-            ik = itemKind itemFull-            desc = IK.idesc ik-        in makeSentence ["There", verb, nWs] <+> desc-      ilooks = T.intercalate " " $ map itemLook-                                 $ sortEmbeds cops getKind tkid embeds-  return $! makeSentence [vis, tilePart] <+> elooks <+> ilooks+            nWs = partItemWsDetail detail+                                   rwidth side factionD k localTime itemFull kit+        in (k, nWs)+      embedKindList =+        map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)+      embedList = map embedLook $ sortEmbeds cops tkid embedKindList+  return (makeSentence [vperson, tilePart], placeBlurb, embedList)  -- | Produces a textual description of actors at a position. lookAtActors :: MonadClientUI m              => Point      -- ^ position to describe              -> LevelId    -- ^ level the position is at-             -> m Text+             -> m (Text, Maybe (MU.Part, Bool), Text) lookAtActors p lidV = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui   side <- getsClient sside-  inhabitants <- getsState $ \s -> posToAidAssocs p lidV s-  sactorUI <- getsSession sactorUI-  let inhabitantsUI =-        map (\(aid2, b2) -> (aid2, b2, sactorUI EM.! aid2)) inhabitants+  inhabitants <- getsState $ posToAidAssocs p lidV   factionD <- getsState sfactionD   localTime <- getsState $ getLocalTime lidV-  s <- getState-  let actorsBlurb = case inhabitants of-        [] -> ""-        (_, body) : rest ->-          let itemFull = itemToFull (btrunk body) s-              bfact = factionD EM.! bfid body-              -- Even if it's the leader, give his proper name, not 'you'.-              subjects = map (\(_, _, bUI) -> partActor bUI)-                             inhabitantsUI-              -- No "a" prefix even if singular and inanimate, to distinguish-              -- from items lying on the floor (and to simplify code).-              (subject, person) = squashedWWandW subjects-              resideVerb = case bwatch body of-                WWatch -> "be here"-                WWait 0 -> "idle here"-                WWait _ -> "brace for impact"-                WSleep -> "sleep here"-                WWake -> "be waking up"-              guardVerbs = guardItemVerbs body bfact s-              verbs = resideVerb : guardVerbs-              projDesc | not $ bproj body = ""-                       | otherwise =-                let kit = beqp body EM.! btrunk body-                    ps = [partItemMediumAW side factionD localTime itemFull kit]-                    tailWords = tail . T.words . makePhrase-                in if tailWords ps == tailWords subjects-                   then ""-                   else makeSentence $ "this is" : ps-              factDesc = case jfid $ itemBase itemFull of-                Just tfid | tfid /= bfid body ->-                  let dominatedBy = if bfid body == side-                                    then "us"-                                    else gname bfact-                      tfact = factionD EM.! tfid-                  in "Originally of" <+> gname tfact-                     <> ", now fighting for" <+> dominatedBy <> "."-                _ | bfid body == side -> ""  -- just one of us-                _ | bproj body -> "Launched by" <+> gname bfact <> "."-                _ -> "One of" <+> gname bfact <> "."-              idesc = IK.idesc $ itemKind itemFull-              -- If many different actors, only list names.-              sameTrunks = all (\(_, b) -> btrunk b == btrunk body) rest-              desc = if sameTrunks then projDesc <+> factDesc <+> idesc else ""-              -- Both description and faction blurb may be empty.-              pdesc = if desc == "" then "" else "(" <> desc <> ")"-              onlyIs = bwatch body == WWatch && null guardVerbs-          in if | bhp body <= 0 && not (bproj body) ->-                  makeSentence-                    (MU.SubjectVerbSg (head subjects) "lie here"-                     : if null guardVerbs-                       then []-                       else [ MU.SubjectVVxV "and" MU.Sg3rd MU.No-                                             "and" guardVerbs-                            , "any more" ])-                  <+> case subjects of-                        _ : projs@(_ : _) ->-                          let (subjectProjs, personProjs) = squashedWWandW projs-                          in makeSentence-                               [MU.SubjectVerb personProjs MU.Yes-                                               subjectProjs "can be seen"]-                        _ -> ""-                | null rest || onlyIs ->-                  makeSentence-                    [MU.SubjectVVxV "and" person MU.Yes subject verbs]-                  <+> pdesc-                | otherwise ->-                  makeSentence [subject, "can be seen"]-                  <+> if onlyIs-                      then ""-                      else makeSentence [MU.SubjectVVxV "and" MU.Sg3rd MU.Yes-                                                        (head subjects) verbs]-  return $! actorsBlurb+  saimMode <- getsSession saimMode+  let detail = maybe DetailAll detailLevel saimMode+  case inhabitants of+    [] -> return ("", Nothing, "")+    (aid, body) : rest -> do+      actorPronoun <- partPronounLeader aid+      itemFull <- getsState $ itemToFull $ btrunk body+      guardVerbs <- getsState $ guardItemVerbs body+      subjects <- mapM (partActorLeader . fst) inhabitants+      let bfact = factionD EM.! bfid body+          -- No "a" prefix even if singular and inanimate, to distinguish+          -- from items lying on the floor (and to simplify code).+          (subject, person) = squashedWWandW subjects+          resideVerb = case bwatch body of+            WWatch -> "be here"+            WWait 0 -> "idle here"+            WWait _ -> "brace for impact"+            WSleep -> "sleep here"+            WWake -> "be waking up"+          flyVerb | bproj body = "zip through here"+                  | isJust $ btrajectory body = "move through here"+                  | otherwise = resideVerb+          verbs = flyVerb : guardVerbs+          projDesc | not (bproj body) || detail < DetailAll = ""+                   | otherwise =+            let kit = beqp body EM.! btrunk body+                ps = [partItemMediumAW rwidth side factionD localTime+                                       itemFull kit]+                tailWords = tail . T.words . makePhrase+            in if tailWords ps == tailWords subjects+               then ""+               else makeSentence $ "this is" : ps+          factDesc = case jfid $ itemBase itemFull of+            Just tfid | tfid /= bfid body ->+              let dominatedBy = if bfid body == side then "us" else gname bfact+                  tfact = factionD EM.! tfid+              in "Originally of" <+> gname tfact+                 <> ", now fighting for" <+> dominatedBy <> "."+            _ | detail < DetailAll -> ""  -- only domination worth spamming+            _ | bfid body == side -> ""  -- just one of us+            _ | bproj body -> "Launched by" <+> gname bfact <> "."+            _ -> "One of" <+> gname bfact <> "."+          idesc = if detail < DetailAll+                  then ""+                  else IK.idesc $ itemKind itemFull+          -- If many different actors, only list names.+          sameTrunks = all (\(_, b) -> btrunk b == btrunk body) rest+          desc = wrapInParens $ projDesc <+> factDesc <+> idesc+          onlyIs = bwatch body == WWatch && null guardVerbs+          allBlurb = makeSentence [MU.SubjectVVxV "and" person MU.Yes+                                                  subject verbs]+          headBlurb = makeSentence [MU.SubjectVVxV "and" MU.Sg3rd MU.Yes+                                                   (head subjects) verbs]+          andProjectiles = case subjects of+            _ : projs@(_ : _) ->+              let (subjectProjs, personProjs) =+                    squashedWWandW projs+              in makeSentence+                   [MU.SubjectVerb personProjs MU.Yes+                                   subjectProjs "can be seen"]+            _ -> ""+          actorAlive = bhp body >= 0+          mactorPronounAlive =+            if bproj body then Nothing else Just (actorPronoun, actorAlive)+      return $!+        if | not actorAlive && not (bproj body) ->+             ( makeSentence+                 (MU.SubjectVerbSg (head subjects) "lie here"+                  : if null guardVerbs+                    then []+                    else [ MU.SubjectVVxV "and" MU.Sg3rd MU.No+                                          "and" guardVerbs+                         , "any more" ])+             , mactorPronounAlive+             , wrapInParens desc <+> andProjectiles )+           | sameTrunks ->  -- only non-proj or several similar projectiles+             ( allBlurb+             , mactorPronounAlive+             , desc )+           | not (bproj body) && onlyIs ->+             ( headBlurb+             , mactorPronounAlive+             , desc <+> andProjectiles )+           | not (bproj body) ->+             ( makeSentence [subject, "can be seen"] <+> headBlurb+             , mactorPronounAlive+             , desc )+           | otherwise -> assert (bproj body && not (null rest))+             ( makeSentence [subject, "can be seen"]+             , Nothing+             , "" ) -guardItemVerbs :: Actor -> Faction -> State -> [MU.Part]-guardItemVerbs body _fact s =-  -- In reality, currently the client knows all the items-  -- in eqp and inv of the foe, but we may remove the knowledge+guardItemVerbs :: Actor -> State -> [MU.Part]+guardItemVerbs body s =+  -- We only hint while, in reality, currently the client knows+  -- all the items in eqp of the foe. But we may remove the knowledge   -- in the future and, anyway, it would require a dedicated   -- UI mode beyond a couple of items per actor.-  ---  -- OTOH, shares stash is currently secret for other factions, so that-  -- case would never be triggered except for our own actors.-  -- We may want to relax that secrecy, but there are technical hurdles.-  let toReport iid =-        let itemKind = getIidKind iid s-        in fromMaybe 0 (lookup "unreported inventory" (IK.ifreq itemKind)) <= 0-      itemsSize = length $ filter toReport-                  $ EM.keys (beqp body) ++ EM.keys (binv body)+  let itemsSize = guardItemSize body s       belongingsVerbs | itemsSize == 1 = ["fondle a trinket"]-                      | itemsSize > 1 = ["guard a hoard"]+                      | itemsSize > 1 = ["haul a hoard"]                       | otherwise = []-  in if bproj body-     then []-     else belongingsVerbs---        ++ ["defend a shared stash" | not $ EM.null $ gsha fact]+  in if bproj body then [] else belongingsVerbs +guardItemSize :: Actor -> State -> Int+guardItemSize body s =+  let toReport iid =+        let itemKind = getIidKind iid s+        in fromMaybe 0 (lookup IK.UNREPORTED_INVENTORY (IK.ifreq itemKind)) <= 0+  in length $ filter toReport $ EM.keys (beqp body)+ -- | Produces a textual description of items at a position. lookAtItems :: MonadClientUI m-            => Bool       -- ^ can be seen right now?-            -> Point      -- ^ position to describe-            -> ActorId    -- ^ the actor that looks-            -> m Text-lookAtItems canSee p aid = do+            => Bool     -- ^ can be seen right now?+            -> Point    -- ^ position to describe+            -> ActorId  -- ^ the actor that looks+            -> Maybe (MU.Part, Bool)+                        -- ^ pronoun for the big actor at the position, if any,+                        --   and whether the big actor is alive+            -> m (Text, Maybe MU.Person)+lookAtItems canSee p aid mactorPronounAlive = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  side <- getsClient sside   itemToF <- getsState $ flip itemToFull   b <- getsState $ getActorBody aid   -- Not using @viewedLevelUI@, because @aid@ may be temporarily not a leader.   saimMode <- getsSession saimMode   let lidV = maybe (blid b) aimLevelId saimMode+      standingOn = p == bpos b && lidV == blid b+      -- In exploration mode the detail level depends on whether the actor+      -- that looks stand over the items, because then he can check details+      -- with inventory commands (or look in aiming mode).+      detailExploration =+        if standingOn && bfid b == side then DetailMedium else DetailAll+      detail = maybe detailExploration detailLevel saimMode   localTime <- getsState $ getLocalTime lidV-  subject <- partActorLeader aid+  subjectAid <- partActorLeader aid   is <- getsState $ getFloorBag lidV p-  side <- getsClient sside   factionD <- getsState sfactionD-  let standingOn = p == bpos b && lidV == blid b-      verb = MU.Text $ if | standingOn -> if bhp b > 0-                                          then "stand on"-                                          else "fall over"-                          | canSee -> "notice"-                          | otherwise -> "remember"+  globalTime <- getsState stime+  getKind <- getsState $ flip getIidKindId+  leaderPronoun <- partPronounLeader aid+  let mLeader = if standingOn then Just (leaderPronoun, bhp b >= 0) else Nothing+      mactorPronounAliveLeader = maybe mLeader Just mactorPronounAlive+      (subject, verb) = case mactorPronounAliveLeader of+        Just (actorPronoun, actorAlive) ->+          (actorPronoun, if actorAlive then "stand over" else "fall over")+        Nothing -> (subjectAid, if canSee then "notice" else "remember")       nWs (iid, kit@(k, _)) =-        partItemWs side factionD k localTime (itemToF iid) kit-      object = case EM.assocs is of-        ii : _ : _ : _ | standingOn && bfid b == side ->-          MU.Phrase [nWs ii, "and other items"]-          -- the actor is ours, so can see details with inventory commands-        iis -> MU.WWandW $ map nWs iis+        partItemWsDetail detail+                         rwidth side factionD k localTime (itemToF iid) kit+      (object, person) = case EM.assocs is of+        [(_, (k, _))] | detail == DetailLow ->+          (if k == 1 then "an item" else "an item stack", MU.Sg3rd)+        _ | detail == DetailLow -> ("some items", MU.PlEtc)+        ii : _ : _ : _ | detail <= DetailMedium ->+          (MU.Phrase [nWs ii, "and other items"], MU.PlEtc)+        [ii@(_, (1, _))] -> (nWs ii, MU.Sg3rd)+        iis -> (MU.WWandW $ map nWs $ sortOn (getKind . fst) iis, MU.PlEtc)   -- Here @squashedWWandW@ is not needed, because identical items at the same   -- position are already merged in the floor item bag and multiple identical   -- messages concerning different positions are merged with <x7>   -- to distinguish from a stack of items at a single position.-  return $! if EM.null is-            then ""-            else makeSentence [MU.SubjectVerbSg subject verb, object]+  return ( if EM.null is || globalTime == timeZero+           then ""+           else makeSentence [MU.SubjectVerbSg subject (MU.Text verb), object]+         , if isNothing mactorPronounAlive then Just person else Nothing ) +lookAtStash :: MonadClientUI m => LevelId -> Point -> m Text+lookAtStash lidV p = do+  side <- getsClient sside+  factionD <- getsState sfactionD+  let locateStash (fid, fact) = case gstash fact of+        Just (lid, pos) | lid == lidV  && pos == p ->+          Just $ if fid == side+                 then "Here is the shared inventory stash of your team."+                 else gname fact+                      <+> "set up their shared inventory stash here."+        _ -> Nothing+  return $! T.intercalate " " $ mapMaybe locateStash $ EM.assocs factionD+ -- | Produces a textual description of everything at the requested -- level's position.-lookAtPosition :: MonadClientUI m => LevelId -> Point -> m Text+lookAtPosition :: MonadClientUI m+               => LevelId -> Point -> m [(MsgClassShow, Text)] lookAtPosition lidV p = do+  COps{cotile} <- getsState scops+  side <- getsClient sside   leader <- getLeaderUI   per <- getPerFid lidV   let canSee = ES.member p (totalVisible per)-  -- Show general info about current position.-  tileBlurb <- lookAtTile canSee p leader lidV-  actorsBlurb <- lookAtActors p lidV-  itemsBlurb <- lookAtItems canSee p leader-  Level{lsmell, ltime} <- getLevel lidV-  let smellBlurb = case EM.lookup p lsmell of+  (actorsBlurb, mactorPronounAlive, actorsDesc) <- lookAtActors p lidV+  (itemsBlurb, mperson) <- lookAtItems canSee p leader mactorPronounAlive+  let tperson = if T.null itemsBlurb then Nothing else mperson+  (tileBlurb, placeBlurb, embedsList) <- lookAtTile canSee p leader lidV tperson+  inhabitants <- getsState $ posToAidAssocs p lidV+  let actorMsgClass =+        if (bfid . snd <$> inhabitants) == [side]+        then MsgPromptGeneric  -- our single proj or non-proj; tame+        else MsgPromptActors+  stashBlurb <- lookAtStash lidV p+  lvl@Level{lsmell, ltime} <- getLevel lidV+  saimMode <- getsSession saimMode+  let detail = maybe DetailAll detailLevel saimMode+      smellBlurb = case EM.lookup p lsmell of         Just sml | sml > ltime ->           let Delta t = smellTimeout `timeDeltaSubtract`                           (sml `timeDeltaToFrom` ltime)               seconds = t `timeFitUp` timeSecond           in "A smelly body passed here around" <+> tshow seconds <> "s ago."         _ -> ""-  return $! tileBlurb <+> actorsBlurb <+> itemsBlurb <+> smellBlurb+  embeds <- getsState $ getEmbedBag lidV p+  getKind <- getsState $ flip getIidKind+  let ppEmbedName :: (Int, MU.Part) -> Text+      ppEmbedName (k, part) =+        let verb = if k == 1 then "is" else "are"+        in makeSentence ["There", verb, part]+      embedKindList = map (\(iid, kit) -> (getKind iid, (iid, kit)))+                          (EM.assocs embeds)+      feats = TK.tfeature $ okind cotile $ lvl `at` p+      tileActions = mapMaybe (Tile.parseTileAction False False embedKindList)+                             feats+      isEmbedAction Tile.EmbedAction{} = True+      isEmbedAction _ = False+      embedVerb = [ "activated"+                  | any isEmbedAction tileActions+                    && any (\(itemKind, _) -> not $ null $ IK.ieffects itemKind)+                           embedKindList ]+      isToAction Tile.ToAction{} = True+      isToAction _ = False+      isWithAction Tile.WithAction{} = True+      isWithAction _ = False+      isEmptyWithAction (Tile.WithAction [] _) = True+      isEmptyWithAction _ = False+      alterVerb | any isEmptyWithAction tileActions = ["very easily modified"]+                | any isToAction tileActions = ["easily modified"]+                | any isWithAction tileActions = ["potentially modified"]+                | otherwise = []+      verbs = embedVerb ++ alterVerb+      alterBlurb = if null verbs+                   then ""+                   else makeSentence ["can be", MU.WWandW verbs]+      toolFromAction (Tile.WithAction grps _) = Just grps+      toolFromAction _ = Nothing+      toolsToAlterWith = mapMaybe toolFromAction tileActions+      tItems = describeToolsAlternative toolsToAlterWith+      transformBlurb = if T.null tItems+                       then ""+                       else "The following items on the ground or in equipment enable special transformations:"+                            <+> tItems <> "."  -- not telling to what terrain+      modifyBlurb = alterBlurb <+> transformBlurb+      midEOL = if detail < DetailHigh+                  || T.null stashBlurb && T.null actorsDesc+                  || T.null smellBlurb && T.null itemsBlurb+                  || null embedsList && T.null modifyBlurb+               then ""+               else "\n"+      ms = [ (MsgPromptAction, stashBlurb)+           , (actorMsgClass, actorsBlurb)+           , (MsgPromptGeneric, actorsDesc <> midEOL) ]+           ++ [(MsgPromptGeneric, smellBlurb) | detail >= DetailHigh]+           ++ [(MsgPromptItems, itemsBlurb <> midEOL)]+           ++ [(MsgPromptFocus, tileBlurb) | detail >= DetailHigh+                                             || detail == DetailMedium+                                                && not (null embedsList)]+           ++ [(MsgPromptGeneric, placeBlurb) | detail >= DetailHigh]+           ++ case detail of+                DetailLow -> []  -- not to obscure aiming line+                DetailMedium ->+                  [(MsgPromptMention, case embedsList of+                    [] -> ""+                    [(k, _)] ->+                      ppEmbedName (1, if k == 1+                                      then "an embedded item"+                                      else "a stack of embedded items")+                    _ -> ppEmbedName (9, "some embedded items"))]+                _ -> let n = sum $ map fst embedsList+                         wWandW = MU.WWandW $ map snd embedsList+                     in [(MsgPromptMention, ppEmbedName (n, wWandW)) | n > 0]+           ++ [(MsgPromptModify, modifyBlurb) | detail == DetailAll]+  return $! if all (T.null . snd) ms && detail > DetailLow+            then [(MsgPromptFocus, tileBlurb)]+            else ms -displayItemLore :: MonadClientUI m+displayItemLore :: (MonadClient m, MonadClientUI m)                 => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int                 -> SingleItemSlots                 -> m Bool displayItemLore itemBag meleeSkill promptFun slotIndex lSlots = do+  km <- displayItemLorePointedAt itemBag meleeSkill promptFun slotIndex+                                 lSlots False+  case K.key km of+    K.Space -> return True+    K.Esc -> return False+    _ -> error $ "" `showFailure` km++displayItemLorePointedAt+  :: (MonadClient m, MonadClientUI m)+  => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int+  -> SingleItemSlots -> Bool+  -> m K.KM+displayItemLorePointedAt itemBag meleeSkill promptFun slotIndex+                         lSlots addTilde = do   CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui   side <- getsClient sside   arena <- getArenaUI@@ -586,36 +920,46 @@   factionD <- getsState sfactionD   -- The hacky level 0 marks items never seen, but sent by server at gameover.   jlid <- getsSession $ fromMaybe (toEnum 0) <$> EM.lookup iid2 . sitemUI-  let attrLine = itemDesc True side factionD meleeSkill-                          CGround localTime jlid itemFull2 kit2-      ov = splitAttrLine rwidth attrLine+  FontSetup{..} <- getFontSetup+  let descAl = itemDesc rwidth True side factionD meleeSkill+                        CGround localTime jlid itemFull2 kit2+      (descSymAl, descBlurbAl) = span (/= Color.spaceAttrW32) descAl+      descSym = offsetOverlay $ splitAttrString rwidth rwidth descSymAl+      descBlurb = offsetOverlayX $+        case splitAttrString rwidth rwidth $ stringToAS "xx" ++ descBlurbAl of+          [] -> error "splitting AttrString loses characters"+          al1 : rest ->+            (2, attrStringToAL $ drop 2 $ attrLine al1) : map (0,) rest+      ov = EM.insertWith (++) squareFont descSym+           $ EM.singleton propFont descBlurb       keys = [K.spaceKM, K.escKM]+             ++ [K.mkChar '~' | addTilde]              ++ [K.upKM | slotIndex /= 0]              ++ [K.downKM | slotIndex /= lSlotsBound]-  promptAdd0 $ promptFun iid2 itemFull2 k+  msgAdd MsgPromptGeneric $ promptFun iid2 itemFull2 k   slides <- overlayToSlideshow (rheight - 2) keys (ov, [])   km <- getConfirms ColorFull keys slides   case K.key km of-    K.Space -> return True     K.Up ->-      displayItemLore itemBag meleeSkill promptFun (slotIndex - 1) lSlots+      displayItemLorePointedAt itemBag meleeSkill promptFun (slotIndex - 1)+                               lSlots addTilde     K.Down ->-      displayItemLore itemBag meleeSkill promptFun (slotIndex + 1) lSlots-    K.Esc -> return False-    _ -> error $ "" `showFailure` km+      displayItemLorePointedAt itemBag meleeSkill promptFun (slotIndex + 1)+                               lSlots addTilde+    _ -> return km -viewLoreItems :: MonadClientUI m+viewLoreItems :: (MonadClient m, MonadClientUI m)               => String -> SingleItemSlots -> ItemBag -> Text-              -> (Int -> SingleItemSlots -> m Bool)+              -> (Int -> SingleItemSlots -> m Bool) -> Bool               -> m K.KM-viewLoreItems menuName lSlotsRaw trunkBag prompt examItem = do+viewLoreItems menuName lSlotsRaw trunkBag prompt examItem displayRanged = do   CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui   arena <- getArenaUI   itemToF <- getsState $ flip itemToFull-  let keysPre = [K.spaceKM, K.mkChar '/', K.mkChar '?', K.escKM]+  let keysPre = [K.spaceKM, K.mkChar '<', K.mkChar '>', K.escKM]       lSlots = sortSlotMap itemToF lSlotsRaw-  promptAdd0 prompt-  io <- itemOverlay lSlots arena trunkBag+  msgAdd MsgPromptGeneric prompt+  io <- itemOverlay lSlots arena trunkBag displayRanged   itemSlides <- overlayToSlideshow (rheight - 2) keysPre io   let keyOfEKM (Left km) = km       keyOfEKM (Right SlotChar{slotChar}) = [K.mkChar slotChar]@@ -626,14 +970,13 @@                             (findIndex (== slot) $ EM.keys lSlots)         go2 <- examItem ix0 lSlots         if go2-        then viewLoreItems menuName lSlots trunkBag prompt examItem+        then viewLoreItems menuName lSlots trunkBag prompt+                           examItem displayRanged         else return K.escKM   ekm <- displayChoiceScreen menuName ColorFull False itemSlides keysMain   case ekm of-    Left km | km == K.spaceKM -> return km-    Left km | km == K.mkChar '/' -> return km-    Left km | km == K.mkChar '?' -> return km-    Left km | km == K.escKM -> return km+    Left km | km `elem` [K.spaceKM, K.mkChar '<', K.mkChar '>', K.escKM] ->+      return km     Left K.KM{key=K.Char l} -> viewAtSlot $ SlotChar 0 l       -- other prefixes are not accessible via keys; tough luck; waste of effort     Left km -> error $ "" `showFailure` km@@ -644,10 +987,10 @@ cycleLore seen (m : rest) = do  -- @seen@ is needed for SPACE to end cycling   km <- m   if | km == K.spaceKM -> cycleLore (m : seen) rest-     | km == K.mkChar '/' -> if null rest+     | km == K.mkChar '>' -> if null rest                              then cycleLore [] (reverse $ m : seen)                              else cycleLore (m : seen) rest-     | km == K.mkChar '?' -> case seen of+     | km == K.mkChar '<' -> case seen of                                prev : ps -> cycleLore ps (prev : m : rest)                                [] -> case reverse (m : rest) of                                  prev : ps -> cycleLore ps [prev]@@ -657,10 +1000,37 @@  spoilsBlurb :: Text -> Int -> Int -> Text spoilsBlurb currencyName total dungeonTotal =-  if | dungeonTotal == 0 ->  "All your spoils are of the practical kind."-     | total == 0 -> "You haven't found any genuine treasure yet."+  if | dungeonTotal == 0 ->+         "All the spoils of your team are of the practical kind."+     | total == 0 -> "Your team haven't found any genuine treasure yet."      | otherwise -> makeSentence-         [ "your spoils are worth"+         [ "your team's spoils are worth"          , MU.CarAWs total $ MU.Text currencyName          , "out of the rumoured total"          , MU.Cardinal dungeonTotal ]++ppContainerWownW :: MonadClientUI m+                 => (ActorId -> m MU.Part) -> Bool -> Container -> m [MU.Part]+ppContainerWownW ownerFun addPrepositions c = case c of+  CFloor{} -> return ["nearby"]+  CEmbed{} -> return ["embedded nearby"]+  CActor aid store -> do+    side <- getsClient sside+    b <- getsState $ getActorBody aid+    owner <- ownerFun aid+    fidName <- getsState $ gname . (EM.! bfid b) . sfactionD+    let (preposition, noun) = ppCStore store+        prep = [MU.Text preposition | addPrepositions]+    return $! prep ++ case store of+      CGround -> MU.Text noun : if bproj b then [] else ["under", owner]+      CStash -> if bfid b /= side+                then [MU.WownW (MU.Text fidName) (MU.Text noun)]+                else [MU.Text noun]+      _ -> [MU.WownW owner (MU.Text noun)]+  CTrunk{} -> error $ "" `showFailure` c++nxtGameMode :: COps -> Int -> (ContentId MK.ModeKind, MK.ModeKind)+nxtGameMode COps{comode} snxtScenario =+  let f !acc _p !i !a = (i, a) : acc+      campaignModes = ofoldlGroup' comode MK.CAMPAIGN_SCENARIO f []+  in campaignModes !! (snxtScenario `mod` length campaignModes)

engine-src/Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs view

@@ -1,1637 +1,2042 @@--- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd"--- client commands that return server requests.--- A couple of them do not take time, the rest does.--- Here prompts and menus are displayed, but any feedback resulting--- from the commands (e.g., from inventory manipulation) is generated later on,--- by the server, for all clients that witness the results of the commands.-module Game.LambdaHack.Client.UI.HandleHumanGlobalM-  ( -- * Meta commands-    byAreaHuman, byAimModeHuman-  , composeIfLocalHuman, composeUnlessErrorHuman, compose2ndLocalHuman-  , loopOnNothingHuman, executeIfClearHuman-    -- * Global commands that usually take time-  , waitHuman, waitHuman10, yellHuman, moveRunHuman-  , runOnceAheadHuman, moveOnceToXhairHuman-  , runOnceToXhairHuman, continueToXhairHuman-  , moveItemHuman, projectHuman, applyHuman-  , alterDirHuman, alterWithPointerHuman-  , helpHuman, hintHuman, dashboardHuman, itemMenuHuman, chooseItemMenuHuman-  , mainMenuHuman, mainMenuAutoOnHuman, mainMenuAutoOffHuman-  , settingsMenuHuman, challengesMenuHuman-  , gameScenarioIncr, gameDifficultyIncr, gameWolfToggle, gameFishToggle-    -- * Global commands that never take time-  , gameRestartHuman, gameQuitHuman, gameDropHuman, gameExitHuman, gameSaveHuman-  , tacticHuman, automateHuman, automateToggleHuman, automateBackHuman-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , areaToRectangles, meleeAid, displaceAid, moveSearchAlter, goToXhair-  , multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems, projectItem-  , applyItem, alterTile, alterTileAtPos, verifyAlters, verifyEscape, guessAlter-  , artWithVersion, generateMenu, nxtGameMode-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Core.Prelude---- Cabal-import qualified Paths_LambdaHack as Self (version)--import qualified Data.EnumMap.Strict as EM-import qualified Data.EnumSet as ES-import qualified Data.Map.Strict as M-import qualified Data.Text as T-import           Data.Version-import qualified NLP.Miniutter.English as MU--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.Client.UI.ActorUI-import           Game.LambdaHack.Client.UI.Content.Input-import           Game.LambdaHack.Client.UI.Content.Screen-import           Game.LambdaHack.Client.UI.ContentClientUI-import           Game.LambdaHack.Client.UI.FrameM-import           Game.LambdaHack.Client.UI.Frontend (frontendName)-import           Game.LambdaHack.Client.UI.HandleHelperM-import           Game.LambdaHack.Client.UI.HandleHumanLocalM-import           Game.LambdaHack.Client.UI.HumanCmd-import           Game.LambdaHack.Client.UI.InventoryM-import           Game.LambdaHack.Client.UI.ItemDescription-import qualified Game.LambdaHack.Client.UI.Key as K-import           Game.LambdaHack.Client.UI.KeyBindings-import           Game.LambdaHack.Client.UI.MonadClientUI-import           Game.LambdaHack.Client.UI.Msg-import           Game.LambdaHack.Client.UI.MsgM-import           Game.LambdaHack.Client.UI.Overlay-import           Game.LambdaHack.Client.UI.RunM-import           Game.LambdaHack.Client.UI.SessionUI-import           Game.LambdaHack.Client.UI.Slideshow-import           Game.LambdaHack.Client.UI.SlideshowM-import           Game.LambdaHack.Client.UI.UIOptions-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Area-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.Types-import           Game.LambdaHack.Common.Vector-import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.ModeKind-import           Game.LambdaHack.Content.RuleKind-import           Game.LambdaHack.Content.TileKind (TileKind)-import qualified Game.LambdaHack.Content.TileKind as TK-import           Game.LambdaHack.Core.Random-import qualified Game.LambdaHack.Definition.Ability as Ability-import           Game.LambdaHack.Definition.Defs---- * ByArea---- | Pick command depending on area the mouse pointer is in.--- The first matching area is chosen. If none match, only interrupt.-byAreaHuman :: MonadClientUI m-            => (HumanCmd -> m (Either MError ReqUI))-            -> [(CmdArea, HumanCmd)]-            -> m (Either MError ReqUI)-byAreaHuman cmdAction l = do-  pointer <- getsSession spointer-  let pointerInArea a = do-        rs <- areaToRectangles a-        return $! any (inside pointer) $ catMaybes rs-  cmds <- filterM (pointerInArea . fst) l-  case cmds of-    [] -> do-      stopPlayBack-      return $ Left Nothing-    (_, cmd) : _ ->-      cmdAction cmd---- Many values here are shared with "Game.LambdaHack.Client.UI.DrawM".-areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area]-areaToRectangles ca = map toArea <$> do- CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui- case ca of-  CaMessage -> return [(0, 0, rwidth - 1, 0)]-  CaMapLeader -> do  -- takes preference over @CaMapParty@ and @CaMap@-    leader <- getLeaderUI-    b <- getsState $ getActorBody leader-    let Point{..} = bpos b-    return [(px, mapStartY + py, px, mapStartY + py)]-  CaMapParty -> do  -- takes preference over @CaMap@-    lidV <- viewedLevelUI-    side <- getsClient sside-    ours <- getsState $ filter (not . bproj) . map snd-                        . actorAssocs (== side) lidV-    let rectFromB Point{..} = (px, mapStartY + py, px, mapStartY + py)-    return $! map (rectFromB . bpos) ours-  CaMap -> return-    [( 0, mapStartY, rwidth - 1, mapStartY + rheight - 4 )]-  CaLevelNumber -> let y = rheight - 2-                   in return [(0, y, 1, y)]-  CaArenaName -> let y = rheight - 2-                     x = (rwidth - 1) `div` 2 - 11-                 in return [(3, y, x, y)]-  CaPercentSeen -> let y = rheight - 2-                       x = (rwidth - 1) `div` 2-                   in return [(x - 9, y, x, y)]-  CaXhairDesc -> let y = rheight - 2-                     x = (rwidth - 1) `div` 2 + 2-                 in return [(x, y, rwidth - 1, y)]-  CaSelected -> let y = rheight - 1-                    x = (rwidth - 1) `div` 2-                in return [(0, y, x - 24, y)]-  CaCalmGauge -> let y = rheight - 1-                     x = (rwidth - 1) `div` 2-                 in return [(x - 22, y, x - 18, y)]-  CaCalmValue -> let y = rheight - 1-                     x = (rwidth - 1) `div` 2-                 in return [(x - 17, y, x - 11, y)]-  CaHPGauge -> let y = rheight - 1-                   x = (rwidth - 1) `div` 2-               in return [(x - 9, y, x - 6, y)]-  CaHPValue -> let y = rheight - 1-                   x = (rwidth - 1) `div` 2-               in return [(x - 6, y, x, y)]-  CaLeaderDesc -> let y = rheight - 1-                      x = (rwidth - 1) `div` 2 + 2-                  in return [(x, y, rwidth - 1, y)]---- * ByAimMode--byAimModeHuman :: MonadClientUI m-               => m (Either MError ReqUI) -> m (Either MError ReqUI)-               -> m (Either MError ReqUI)-byAimModeHuman cmdNotAimingM cmdAimingM = do-  aimMode <- getsSession saimMode-  if isNothing aimMode then cmdNotAimingM else cmdAimingM---- * ComposeIfLocal--composeIfLocalHuman :: MonadClientUI m-                    => m (Either MError ReqUI) -> m (Either MError ReqUI)-                    -> m (Either MError ReqUI)-composeIfLocalHuman c1 c2 = do-  slideOrCmd1 <- c1-  case slideOrCmd1 of-    Left merr1 -> do-      slideOrCmd2 <- c2-      case slideOrCmd2 of-        Left merr2 -> return $ Left $ mergeMError merr1 merr2-        _ -> return slideOrCmd2-    _ -> return slideOrCmd1---- * ComposeUnlessError--composeUnlessErrorHuman :: MonadClientUI m-                        => m (Either MError ReqUI) -> m (Either MError ReqUI)-                        -> m (Either MError ReqUI)-composeUnlessErrorHuman c1 c2 = do-  slideOrCmd1 <- c1-  case slideOrCmd1 of-    Left Nothing -> c2-    _ -> return slideOrCmd1---- * Compose2ndLocal--compose2ndLocalHuman :: MonadClientUI m-                     => m (Either MError ReqUI) -> m (Either MError ReqUI)-                     -> m (Either MError ReqUI)-compose2ndLocalHuman c1 c2 = do-  slideOrCmd1 <- c1-  case slideOrCmd1 of-    Left merr1 -> do-      slideOrCmd2 <- c2-      case slideOrCmd2 of-        Left merr2 -> return $ Left $ mergeMError merr1 merr2-        _ -> return slideOrCmd1  -- ignore second request, keep effect-    req -> do-      void c2  -- ignore second request, keep effect-      return req---- * LoopOnNothing--loopOnNothingHuman :: MonadClientUI m-                   => m (Either MError ReqUI)-                   -> m (Either MError ReqUI)-loopOnNothingHuman cmd = do-  res <- cmd-  case res of-    Left Nothing -> loopOnNothingHuman cmd-    _ -> return res---- * ExecuteIfClear--executeIfClearHuman :: MonadClientUI m-                    => m (Either MError ReqUI)-                    -> m (Either MError ReqUI)-executeIfClearHuman c1 = do-  sreportNull <- getsSession sreportNull-  if sreportNull then c1 else return $ Left Nothing---- * Wait---- | Leader waits a turn (and blocks, etc.).-waitHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)-waitHuman = do-  actorSk <- leaderSkillsClientUI-  if Ability.getSk Ability.SkWait actorSk > 0 then do-    modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}-    return $ Right ReqWait-  else failSer WaitUnskilled---- * Wait10---- | Leader waits a 1/10th of a turn (and doesn't block, etc.).-waitHuman10 :: MonadClientUI m => m (FailOrCmd RequestTimed)-waitHuman10 = do-  actorSk <- leaderSkillsClientUI-  if Ability.getSk Ability.SkWait actorSk >= 4 then do-    modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}-    return $ Right ReqWait10-  else failSer WaitUnskilled---- * Yell---- | Leader yells or yawns, if sleeping.-yellHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)-yellHuman = do-  actorSk <- leaderSkillsClientUI-  if Ability.getSk Ability.SkWait actorSk > 0-     -- If waiting drained and really, potentially, no other possible action,-     -- still allow yelling.-     || Ability.getSk Ability.SkMove actorSk <= 0-     || Ability.getSk Ability.SkDisplace actorSk <= 0-     || Ability.getSk Ability.SkMelee actorSk <= 0-  then return $ Right ReqYell-  else failSer WaitUnskilled---- * MoveDir and RunDir--moveRunHuman :: (MonadClient m, MonadClientUI m)-             => Bool -> Bool -> Bool -> Bool -> Vector-             -> m (FailOrCmd RequestTimed)-moveRunHuman initialStep finalGoal run runAhead dir = do-  actorSk <- leaderSkillsClientUI-  arena <- getArenaUI-  leader <- getLeaderUI-  sb <- getsState $ getActorBody leader-  fact <- getsState $ (EM.! bfid sb) . sfactionD-  -- Start running in the given direction. The first turn of running-  -- succeeds much more often than subsequent turns, because we ignore-  -- most of the disturbances, since the player is mostly aware of them-  -- and still explicitly requests a run, knowing how it behaves.-  sel <- getsSession sselected-  let runMembers = if runAhead || noRunWithMulti fact-                   then [leader]-                   else ES.toList (ES.delete leader sel) ++ [leader]-      runParams = RunParams { runLeader = leader-                            , runMembers-                            , runInitial = True-                            , runStopMsg = Nothing-                            , runWaiting = 0 }-      macroRun25 = ["C-comma", "C-V"]-  when (initialStep && run) $ do-    modifySession $ \cli ->-      cli {srunning = Just runParams}-    when runAhead $-      modifySession $ \cli ->-        cli {slastPlay = map K.mkKM macroRun25 ++ slastPlay cli}-  -- When running, the invisible actor is hit (not displaced!),-  -- so that running in the presence of roving invisible-  -- actors is equivalent to moving (with visible actors-  -- this is not a problem, since runnning stops early enough).-  let tpos = bpos sb `shift` dir-  -- 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 $ posToAidAssocs tpos arena-  case tgts of-    [] -> do  -- move or search or alter-      runStopOrCmd <- moveSearchAlter run dir-      case runStopOrCmd of-        Left stopMsg -> return $ Left stopMsg-        Right runCmd ->-          -- Don't check @initialStep@ and @finalGoal@-          -- and don't stop going to target: door opening is mundane enough.-          return $ Right runCmd-    [(target, _)] | run-                    && initialStep-                    && Ability.getSk Ability.SkDisplace actorSk > 0 ->-      -- No @stopPlayBack@: initial displace is benign enough.-      -- Displacing requires accessibility, but it's checked later on.-      displaceAid target-    _ : _ : _ | run-                && initialStep-                && Ability.getSk Ability.SkDisplace actorSk > 0 ->-      failSer DisplaceMultiple-    (target, tb) : _ | not run-                       && initialStep && finalGoal-                       && bfid tb == bfid sb && not (bproj tb) -> do-      stopPlayBack  -- don't ever auto-repeat leader choice-      -- We always see actors from our own faction.-      -- Select one of adjacent actors by bumping into him. Takes no time.-      success <- pickLeader True target-      let !_A = assert (success `blame` "bump self"-                                `swith` (leader, target, tb)) ()-      failWith "by bumping"-    (target, tb) : _ | not run-                       && initialStep && finalGoal-                       && (bfid tb /= bfid sb || bproj tb)-                       && Ability.getSk Ability.SkMelee actorSk > 0 -> do-      stopPlayBack  -- don't ever auto-repeat melee-      -- No problem if there are many projectiles at the spot. We just-      -- attack the first one.-      meleeAid target-    _ : _ -> failWith "actor in the way"---- | Actor attacks an enemy actor or his own projectile.-meleeAid :: (MonadClient m, MonadClientUI m)-         => ActorId -> m (FailOrCmd RequestTimed)-meleeAid target = do-  leader <- getLeaderUI-  sb <- getsState $ getActorBody leader-  tb <- getsState $ getActorBody target-  sfact <- getsState $ (EM.! bfid sb) . sfactionD-  mel <- pickWeaponClient leader target-  case mel of-    Nothing -> failWith "nothing to melee with"-    Just wp -> do-      let returnCmd = do-            -- Set personal target to enemy, so that AI, if it takes over-            -- the actor, is likely to continue the fight even if the foe flees.-            modifyClient $ updateTarget leader $ const $ Just $ TEnemy target-            -- Also set xhair to see the foe's HP, because it's automatically-            -- set to any new spotted actor, so it needs to be reset-            -- and also it's not useful as permanent ranged target anyway.-            modifySession $ \sess -> sess {sxhair = Just $ TEnemy target}-            return $ Right wp-          res | bproj tb || isFoe (bfid sb) sfact (bfid tb) = returnCmd-              | isFriend (bfid sb) sfact (bfid tb) = do-                let !_A = assert (bfid sb /= bfid tb) ()-                go1 <- displayYesNo ColorBW-                         "You are bound by an alliance. Really attack?"-                if not go1 then failWith "attack canceled" else returnCmd-              | otherwise = do-                go2 <- displayYesNo ColorBW-                         "This attack will start a war. Are you sure?"-                if not go2 then failWith "attack canceled" else returnCmd-      res-  -- Seeing the actor prevents altering a tile under it, but that-  -- does not limit the player, he just doesn't waste a turn-  -- on a failed altering.---- | Actor swaps position with another.-displaceAid :: MonadClientUI m-            => ActorId -> m (FailOrCmd RequestTimed)-displaceAid target = do-  COps{coTileSpeedup} <- getsState scops-  leader <- getLeaderUI-  sb <- getsState $ getActorBody leader-  tb <- getsState $ getActorBody target-  let dozes = bwatch tb `elem` [WSleep, WWake]-  tfact <- getsState $ (EM.! bfid tb) . sfactionD-  actorMaxSk <- getsState $ getActorMaxSkills target-  dEnemy <- getsState $ dispEnemy leader target actorMaxSk-  let immobile = Ability.getSk Ability.SkMove actorMaxSk <= 0-      tpos = bpos tb-      adj = checkAdjacent sb tb-      atWar = isFoe (bfid tb) tfact (bfid sb)-  if | not adj -> failSer DisplaceDistant-     | not (bproj tb) && atWar-       && actorDying tb ->-       failSer DisplaceDying-     | not (bproj tb) && atWar-       && actorWaits tb ->-       failSer DisplaceBraced-     | not (bproj tb) && atWar-       && immobile && not dozes ->  -- roots weak if the tree sleeps-       failSer DisplaceImmobile-     | not dEnemy && atWar ->-       failSer DisplaceSupported-     | otherwise -> do-       let lid = blid sb-       lvl <- getLevel lid-       -- Displacing requires full access.-       if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then-         case posToAidsLvl tpos lvl of-           [] -> error $ "" `showFailure` (leader, sb, target, tb)-           [_] -> return $ Right $ ReqDisplace target-           _ -> failSer DisplaceMultiple-       else failSer DisplaceAccess---- | Leader moves or searches or alters. No visible actor at the position.-moveSearchAlter :: MonadClientUI m-                => Bool -> Vector -> m (FailOrCmd RequestTimed)-moveSearchAlter run dir = do-  COps{cotile, coTileSpeedup} <- getsState scops-  actorSk <- leaderSkillsClientUI-  leader <- getLeaderUI-  sb <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let calmE = calmEnough sb actorMaxSk-      moveSkill = Ability.getSk Ability.SkMove actorSk-      alterSkill = Ability.getSk Ability.SkAlter actorSk-      applySkill = Ability.getSk Ability.SkApply actorSk-      spos = bpos sb           -- source position-      tpos = spos `shift` dir  -- target position-  itemToF <- getsState $ flip itemToFull-  localTime <- getsState $ getLocalTime (blid sb)-  embeds <- getsState $ getEmbedBag (blid sb) tpos-  lvl <- getLevel $ blid sb-  blurb <- lookAtPosition (blid sb) tpos-  let t = lvl `at` tpos-      alterMinSkill = Tile.alterMinSkill coTileSpeedup t-      canApplyEmbeds = any canApplyEmbed $ EM.assocs embeds-      canApplyEmbed (iid, kit) =-        let itemFull = itemToF iid-            legal = permittedApply localTime applySkill calmE itemFull kit-        -- Let even completely unskilled actors trigger basic embeds.-        in either (const False) (const True) legal-      alterable = Tile.isModifiable coTileSpeedup t || not (EM.null embeds)-      underFeet = tpos == spos  -- if enter and alter, be more permissive-  runStopOrCmd <--    if -- Movement requires full access.-       | Tile.isWalkable coTileSpeedup t ->-           if moveSkill > 0 then-             -- A potential invisible actor is hit. War started without asking.-             return $ Right $ ReqMove dir-           else failSer MoveUnskilled-       -- Not walkable, so search and/or alter the tile.-       | run -> do-           -- Explicit request to examine the terrain.-           promptAdd0 blurb-           failWith $ if alterable-                      then "potentially alterable"-                      else "not alterable"-       | not alterable -> do-           let name = MU.Text $ TK.tname $ okind cotile t-           failWith $ makePhrase ["there is no point kicking", MU.AW name]-             -- misclick? related to AlterNothing but no searching possible;-             -- we don't show tile description, because it only comes from-             -- embedded items and here probably there are none (can be all-             -- charging, but that's rare)-       | not underFeet && alterSkill <= 1 -> failSer AlterUnskilled-       | not (Tile.isSuspect coTileSpeedup t)-         && not underFeet-         && alterSkill < alterMinSkill -> do-           -- Rather rare (requires high skill), so describe the tile.-           promptAdd0 blurb-           failSer AlterUnwalked-       | not $ Tile.isModifiable coTileSpeedup t || canApplyEmbeds -> do-           -- Rather rare (charging embeds or too low skill for embeds-           -- that are, e.g., `?`), so describe the tile.-           -- Unfortunately this includes cases when an actor can exploit-           -- signboard when hidden, but can't later on when revealed.-           promptAdd0 blurb-           failWith "unable to exploit the terrain"-       | EM.member tpos $ lfloor lvl -> failSer AlterBlockItem-       | occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl ->-           -- Don't mislead describing terrain, if other actor is to blame.-           failSer AlterBlockActor-       | otherwise -> do  -- promising-           verAlters <- verifyAlters (blid sb) tpos-           case verAlters of-             Right () -> return $ Right $ ReqAlter tpos-             Left err -> return $ Left err-           -- We don't use ReqMove, because we don't hit invisible actors,-           -- e.g., hidden in a wall. If server performed an attack for free-           -- on the invisible actor anyway, the player (or AI)-           -- would be tempted to repeatedly hit random walls-           -- in hopes of killing a monster residing within.-           -- If the action had a cost, misclicks would incur the cost, too.-           -- Right now the player may repeatedly alter tiles trying to learn-           -- about invisible pass-wall actors, but when an actor detected,-           -- it costs a turn and does not harm the invisible actors,-           -- so it's not so tempting.-  return $! runStopOrCmd---- * RunOnceAhead--runOnceAheadHuman :: MonadClientUI m => m (Either MError RequestTimed)-runOnceAheadHuman = do-  side <- getsClient sside-  fact <- getsState $ (EM.! side) . sfactionD-  leader <- getLeaderUI-  keyPressed <- anyKeyPressed-  srunning <- getsSession srunning-  -- When running, stop if disturbed. If not running, stop at once.-  case srunning of-    Nothing -> do-      stopPlayBack-      return $ Left Nothing-    Just RunParams{runMembers}-      | noRunWithMulti fact && runMembers /= [leader] -> do-      stopPlayBack-      msgAdd MsgRunStop "run stop: automatic leader change"-      return $ Left Nothing-    Just _runParams | keyPressed -> do-      discardPressedKey-      stopPlayBack-      msgAdd MsgRunStop "run stop: key pressed"-      weaveJust <$> failWith "interrupted"-    Just runParams -> do-      arena <- getArenaUI-      runOutcome <- continueRun arena runParams-      case runOutcome of-        Left stopMsg -> do-          stopPlayBack-          msgAdd MsgRunStop ("run stop:" <+> stopMsg)-          return $ Left Nothing-        Right runCmd ->-          return $ Right runCmd---- * MoveOnceToXhair--moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m)-                     => m (FailOrCmd RequestTimed)-moveOnceToXhairHuman = goToXhair True False--goToXhair :: (MonadClient m, MonadClientUI m)-          => Bool -> Bool -> m (FailOrCmd RequestTimed)-goToXhair initialStep run = do-  aimMode <- getsSession saimMode-  -- Movement is legal only outside aiming mode.-  if isJust aimMode then failWith "cannot move in aiming mode"-  else do-    leader <- getLeaderUI-    b <- getsState $ getActorBody leader-    xhairPos <- xhairToPos-    case xhairPos of-      Nothing -> failWith "crosshair position invalid"-      Just c | c == bpos b -> failWith "position reached"-      Just c -> do-        running <- getsSession srunning-        case running of-          -- Don't use running params from previous run or goto-xhair.-          Just paramOld | not initialStep -> do-            arena <- getArenaUI-            runOutcome <- multiActorGoTo arena c paramOld-            case runOutcome of-              Left stopMsg -> return $ Left stopMsg-              Right (finalGoal, dir) ->-                moveRunHuman initialStep finalGoal run False dir-          _ -> do-            let !_A = assert (initialStep || not run) ()-            (bfs, mpath) <- getCacheBfsAndPath leader c-            xhairMoused <- getsSession sxhairMoused-            case mpath of-              _ | xhairMoused && isNothing (accessBfs bfs c) ->-                failWith-                  "no route to crosshair (press again to go there anyway)"-              _ | initialStep && adjacent (bpos b) c -> do-                let dir = towards (bpos b) c-                moveRunHuman initialStep True run False dir-              Nothing -> failWith "no route to crosshair"-              Just AndPath{pathList=[]} -> failWith "almost there"-              Just AndPath{pathList = p1 : _} -> do-                let finalGoal = p1 == c-                    dir = towards (bpos b) p1-                moveRunHuman initialStep finalGoal run False dir--multiActorGoTo :: (MonadClient m, MonadClientUI m)-               => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))-multiActorGoTo arena c paramOld =-  case paramOld of-    RunParams{runMembers = []} -> failWith "selected actors no longer there"-    RunParams{runMembers = r : rs, runWaiting} -> do-      onLevel <- getsState $ memActor r arena-      if not onLevel then do-        let paramNew = paramOld {runMembers = rs}-        multiActorGoTo arena c paramNew-      else do-        sL <- getState-        modifyClient $ updateLeader r sL-        let runMembersNew = rs ++ [r]-            paramNew = paramOld { runMembers = runMembersNew-                                , runWaiting = 0}-        b <- getsState $ getActorBody r-        (bfs, mpath) <- getCacheBfsAndPath r c-        xhairMoused <- getsSession sxhairMoused-        case mpath of-          _ | xhairMoused && isNothing (accessBfs bfs c) ->-            failWith "no route to crosshair (press again to go there anyway)"-          Nothing -> failWith "no route to crosshair"-          Just AndPath{pathList=[]} -> failWith "almost there"-          Just AndPath{pathList = p1 : _} -> do-            let finalGoal = p1 == c-                dir = towards (bpos b) p1-            tgts <- getsState $ posToAids p1 arena-            case tgts of-              [] -> do-                modifySession $ \sess -> sess {srunning = Just paramNew}-                return $ Right (finalGoal, dir)-              [target] | target `elem` rs || runWaiting <= length rs ->-                -- Let r wait until all others move. Mark it in runWaiting-                -- to avoid cycles. When all wait for each other, fail.-                multiActorGoTo arena c paramNew{runWaiting=runWaiting + 1}-              _ ->-                failWith "actor in the way"---- * RunOnceToXhair--runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)-                    => m (FailOrCmd RequestTimed)-runOnceToXhairHuman = goToXhair True True---- * ContinueToXhair--continueToXhairHuman :: (MonadClient m, MonadClientUI m)-                     => m (FailOrCmd RequestTimed)-continueToXhairHuman = goToXhair False False{-irrelevant-}---- * MoveItem--moveItemHuman :: forall m. MonadClientUI m-              => [CStore] -> CStore -> Maybe MU.Part -> Bool-              -> m (FailOrCmd RequestTimed)-moveItemHuman cLegalRaw destCStore mverb auto = do-  actorSk <- leaderSkillsClientUI-  if Ability.getSk Ability.SkMoveItem actorSk > 0 then-    moveOrSelectItem cLegalRaw destCStore mverb auto-  else failSer MoveItemUnskilled---- This cannot be structured as projecting or applying, with @ByItemMode@--- and @ChooseItemToMove@, because at least in case of grabbing items,--- more than one item is chosen, which doesn't fit @sitemSel@. Separating--- grabbing of multiple items as a distinct command is too high a price.-moveOrSelectItem :: forall m. MonadClientUI m-                 => [CStore] -> CStore -> Maybe MU.Part -> Bool-                 -> m (FailOrCmd RequestTimed)-moveOrSelectItem cLegalRaw destCStore mverb auto = do-  itemSel <- getsSession sitemSel-  modifySession $ \sess -> sess {sitemSel = Nothing}  -- prevent surprise-  case itemSel of-    Just (iid, fromCStore, _) | fromCStore /= destCStore-                                && fromCStore `elem` cLegalRaw -> do-      leader <- getLeaderUI-      b <- getsState $ getActorBody leader-      bag <- getsState $ getBodyStoreBag b fromCStore-      case iid `EM.lookup` bag of-        Nothing ->  -- the case of old selection or selection from another actor-          moveItemHuman cLegalRaw destCStore mverb auto-        Just (k, it) -> assert (k > 0) $ do-          itemFull <- getsState $ itemToFull iid-          let eqpFree = eqpFreeN b-              kToPick | destCStore == CEqp = min eqpFree k-                      | otherwise = k-          if kToPick == 0-          then failWith "no more items can be equipped"-          else do-            socK <- pickNumber (not auto) kToPick-            case socK of-              Left Nothing -> moveItemHuman cLegalRaw destCStore mverb auto-              Left (Just err) -> return $ Left err-              Right kChosen ->-                let is = ( fromCStore-                         , [(iid, (itemFull, (kChosen, take kChosen it)))] )-                in moveItems cLegalRaw is destCStore-    _ -> do-      mis <- selectItemsToMove cLegalRaw destCStore mverb auto-      case mis of-        Left err -> return $ Left err-        Right (fromCStore, [(iid, _)]) | cLegalRaw /= [CGround] -> do-          modifySession $ \sess ->-            sess {sitemSel = Just (iid, fromCStore, False)}-          moveItemHuman cLegalRaw destCStore mverb auto-        Right is -> moveItems cLegalRaw is destCStore--selectItemsToMove :: forall m. MonadClientUI m-                  => [CStore] -> CStore -> Maybe MU.Part -> Bool-                  -> m (FailOrCmd (CStore, [(ItemId, ItemFullKit)]))-selectItemsToMove cLegalRaw destCStore mverb auto = do-  let !_A = assert (destCStore `notElem` cLegalRaw) ()-  let verb = fromMaybe (MU.Text $ verbCStore destCStore) mverb-  leader <- getLeaderUI-  b <- getsState $ getActorBody leader-  -- 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)-  actorMaxSk <- getsState $ getActorMaxSkills leader-  lastItemMove <- getsSession slastItemMove-  let calmE = calmEnough b actorMaxSk-      cLegalE | calmE = cLegalRaw-              | destCStore == CSha = []-              | otherwise = delete CSha cLegalRaw-      cLegal = case lastItemMove of-        Just (lastFrom, lastDest) | lastDest == destCStore-                                    && lastFrom `elem` cLegalE ->-          lastFrom : delete lastFrom cLegalE-        _ -> cLegalE-      prompt = makePhrase ["What to", verb]-      promptEqp = makePhrase ["What consumable to", verb]-      (promptGeneric, psuit) =-        -- We prune item list only for eqp, because other stores don't have-        -- so clear cut heuristics. So when picking up a stash, either grab-        -- it to auto-store things, or equip first using the pruning-        -- and then pack/stash the rest selectively or en masse.-        if destCStore == CEqp && cLegalRaw /= [CGround]-        then (promptEqp, return $ SuitsSomething $ \itemFull _kit ->-               IA.goesIntoEqp $ aspectRecordFull itemFull)-        else (prompt, return SuitsEverything)-  ggi <- getFull psuit-                 (\_ _ _ cCur _ -> prompt <+> ppItemDialogModeFrom cCur)-                 (\_ _ _ cCur _ -> promptGeneric <+> ppItemDialogModeFrom cCur)-                 cLegalRaw cLegal (not auto) True-  case ggi of-    Right (l, (MStore fromCStore, _)) -> do-      modifySession $ \sess ->-        sess {slastItemMove = Just (fromCStore, destCStore)}-      return $ Right (fromCStore, l)-    Left err -> failWith err-    _ -> error $ "" `showFailure` ggi--moveItems :: forall m. MonadClientUI m-          => [CStore] -> (CStore, [(ItemId, ItemFullKit)]) -> CStore-          -> m (FailOrCmd RequestTimed)-moveItems cLegalRaw (fromCStore, l) destCStore = do-  leader <- getLeaderUI-  b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  discoBenefit <- getsClient sdiscoBenefit-  let calmE = calmEnough b actorMaxSk-      ret4 :: [(ItemId, ItemFullKit)] -> Int-           -> m [(ItemId, Int, CStore, CStore)]-      ret4 [] _ = return []-      ret4 ((iid, (itemFull, (itemK, _))) : rest) oldN = do-        let k = itemK-            !_A = assert (k > 0) ()-            inEqp = benInEqp $ discoBenefit EM.! iid-            retRec toCStore = do-              let n = oldN + if toCStore == CEqp then k else 0-              l4 <- ret4 rest n-              return $ (iid, k, fromCStore, toCStore) : l4-            issueWarning = do-              let fullWarn = if eqpOverfull b (oldN + 1)-                             then EqpOverfull-                             else EqpStackFull-              msgAdd MsgWarning $ "Warning:" <+> showReqFailure fullWarn <> "."-        if cLegalRaw == [CGround]  -- normal pickup-        then case destCStore of  -- @CEqp@ is the implicit default; refine:-          CEqp | calmE && IA.goesIntoSha (aspectRecordFull itemFull) ->-            retRec CSha-          CEqp | inEqp && eqpOverfull b (oldN + k) -> do-            -- If this stack doesn't fit, we don't equip any part of it,-            -- but we may equip a smaller stack later in the same pickup.-            issueWarning-            retRec $ if calmE then CSha else CInv-          CEqp | inEqp ->-            retRec CEqp-          CEqp ->-            retRec CInv-          _ ->-            retRec destCStore-        else case destCStore of  -- player forces store, so @inEqp@ ignored-          CEqp | eqpOverfull b (oldN + k) -> do-            -- If the chosen number from the stack doesn't fit,-            -- we don't equip any part of it and we exit item manipulation.-            issueWarning-            -- No recursive call here:-            return []-          _ -> retRec destCStore-  if not calmE && CSha `elem` [fromCStore, destCStore]-  then failSer ItemNotCalm-  else do-    l4 <- ret4 l 0-    return $! if null l4-              then error $ "" `showFailure` l-              else Right $ ReqMoveItems l4---- * Project--projectHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)-projectHuman = do-  actorSk <- leaderSkillsClientUI-  if Ability.getSk Ability.SkProject actorSk <= 0 then  -- detailed check later-    failSer ProjectUnskilled-  else do-    itemSel <- getsSession sitemSel-    case itemSel of-      Just (iid, fromCStore, _) -> do-        leader <- getLeaderUI-        b <- getsState $ getActorBody leader-        bag <- getsState $ getBodyStoreBag b fromCStore-        case iid `EM.lookup` bag of-          Nothing -> failWith "no item to fling"-          Just _kit -> do-            itemFull <- getsState $ itemToFull iid-            let i = (fromCStore, (iid, itemFull))-            projectItem i-      Nothing -> failWith "no item to fling"--projectItem :: (MonadClient m, MonadClientUI m)-            => (CStore, (ItemId, ItemFull))-            -> m (FailOrCmd RequestTimed)-projectItem (fromCStore, (iid, itemFull)) = do-  leader <- getLeaderUI-  b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let calmE = calmEnough b actorMaxSk-  if not calmE && fromCStore == CSha then failSer ItemNotCalm-  else do-    mpsuitReq <- psuitReq-    case mpsuitReq of-      Left err -> failWith err-      Right psuitReqFun ->-        case psuitReqFun itemFull of-          Left reqFail -> failSer reqFail-          Right (pos, _) -> do-            Benefit{benFling} <- getsClient $ (EM.! iid) . sdiscoBenefit-            go <- if benFling > 0-                  then displayYesNo ColorFull-                         "The item appears beneficial. Do you really want to fling it?"-                  else return True-            if go then do-              -- Set personal target to enemy, so that AI, if it takes over-              -- the actor, is likely to continue the fight even if the foe-              -- flees. Similarly if the crosshair points at position, etc.-              sxhair <- getsSession sxhair-              modifyClient $ updateTarget leader (const sxhair)-              -- Project.-              eps <- getsClient seps-              return $ Right $ ReqProject pos eps iid fromCStore-            else do-              modifySession $ \sess -> sess {sitemSel = Nothing}-              failWith "never mind"---- * Apply--applyHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)-applyHuman = do-  actorSk <- leaderSkillsClientUI-  if Ability.getSk Ability.SkApply actorSk <= 0 then  -- detailed check later-    failSer ApplyUnskilled-  else do-    itemSel <- getsSession sitemSel-    case itemSel of-      Just (iid, fromCStore, _) -> do-        leader <- getLeaderUI-        b <- getsState $ getActorBody leader-        bag <- getsState $ getBodyStoreBag b fromCStore-        case iid `EM.lookup` bag of-          Nothing -> failWith "no item to apply"-          Just kit -> do-            itemFull <- getsState $ itemToFull iid-            applyItem (fromCStore, (iid, (itemFull, kit)))-      Nothing -> failWith "no item to apply"--applyItem :: MonadClientUI m-          => (CStore, (ItemId, ItemFullKit))-          -> m (FailOrCmd RequestTimed)-applyItem (fromCStore, (iid, (itemFull, kit))) = do-  leader <- getLeaderUI-  b <- getsState $ getActorBody leader-  localTime <- getsState $ getLocalTime (blid b)-  actorMaxSk <- getsState $ getActorMaxSkills leader-  actorSk <- leaderSkillsClientUI-  let skill = Ability.getSk Ability.SkApply actorSk-      calmE = calmEnough b actorMaxSk-      arItem = aspectRecordFull itemFull-  if not calmE && fromCStore == CSha-  then failSer ItemNotCalm-  else case permittedApply localTime skill calmE itemFull kit of-    Left reqFail -> failSer reqFail-    Right _ -> do-      Benefit{benApply} <- getsClient $ (EM.! iid) . sdiscoBenefit-      go <--        if | IA.checkFlag Ability.Periodic arItem-             && not (IA.checkFlag Ability.Durable arItem) ->-             -- No warning if item durable, because activation weak,-             -- but price low, due to no destruction.-             displayYesNo ColorFull-                          "Applying this periodic item will produce only the first of its effects and moreover, because it's not durable, will destroy it. Are you sure?"-           | benApply < 0 ->-             displayYesNo ColorFull-                          "The item appears harmful. Do you really want to apply it?"-           | otherwise -> return True-      if go-      then return $ Right $ ReqApply iid fromCStore-      else do-        modifySession $ \sess -> sess {sitemSel = Nothing}-        failWith "never mind"---- * AlterDir---- | Ask for a direction and alter a tile in the specified way, if possible.-alterDirHuman :: MonadClientUI m-              => [TriggerTile] -> m (FailOrCmd RequestTimed)-alterDirHuman ts = do-  UIOptions{uVi, uLaptop} <- getsSession sUIOptions-  let verb1 = case ts of-        [] -> "alter"-        tr : _ -> ttverb tr-      keys = K.escKM-             : K.leftButtonReleaseKM-             : map (K.KM K.NoModifier) (K.dirAllKey uVi uLaptop)-      prompt = makePhrase-        ["Where to", verb1 <> "? [movement key] [pointer]"]-  promptAdd0 prompt-  slides <- reportToSlideshow [K.escKM]-  km <- getConfirms ColorFull keys slides-  case K.key km of-    K.LeftButtonRelease -> do-      leader <- getLeaderUI-      b <- getsState $ getActorBody leader-      Point x y <- getsSession spointer-      let dir = Point x (y - mapStartY) `vectorToFrom` bpos b-      if isUnit dir-      then alterTile ts dir-      else failWith "never mind"-    _ ->-      case K.handleDir uVi uLaptop km of-        Nothing -> failWith "never mind"-        Just dir -> alterTile ts dir---- | Try to alter a tile using a feature in the given direction.-alterTile :: MonadClientUI m-          => [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)-alterTile ts dir = do-  leader <- getLeaderUI-  b <- getsState $ getActorBody leader-  let tpos = bpos b `shift` dir-      pText = compassText dir-  alterTileAtPos ts tpos pText---- | Try to alter a tile using a feature at the given position.------ We don't check if the tile is interesting, e.g., if any embedded--- item can be triggered, because the player explicitely requested--- the action. Consequently, even if all embedded items are recharching,--- the time will be wasted and the server will describe the failure in detail.-alterTileAtPos :: MonadClientUI m-               => [TriggerTile] -> Point -> Text-               -> m (FailOrCmd RequestTimed)-alterTileAtPos ts tpos pText = do-  cops@COps{cotile, coTileSpeedup} <- getsState scops-  leader <- getLeaderUI-  b <- getsState $ getActorBody leader-  actorSk <- leaderSkillsClientUI-  lvl <- getLevel $ blid b-  embeds <- getsState $ getEmbedBag (blid b) tpos-  let alterSkill = Ability.getSk Ability.SkAlter actorSk-      t = lvl `at` tpos-      alterMinSkill = Tile.alterMinSkill coTileSpeedup t-      hasFeat TriggerTile{ttfeature} = Tile.hasFeature cotile ttfeature t-  case filter hasFeat ts of-    [] | not $ null ts -> failWith $ guessAlter cops ts t-    _ | not (Tile.isModifiable coTileSpeedup t)-        && EM.null embeds -> failSer AlterNothing-    _ | chessDist tpos (bpos b) > 1 -> failSer AlterDistant-    _ | alterSkill <= 1 -> failSer AlterUnskilled-    _ | not (Tile.isSuspect coTileSpeedup t)-        && alterSkill < alterMinSkill -> failSer AlterUnwalked-    trs ->-      if EM.notMember tpos $ lfloor lvl then-        if not (occupiedBigLvl tpos lvl)-           && not (occupiedProjLvl tpos lvl) then do-          let v = case trs of-                [] -> "alter"-                tr : _ -> ttverb tr-          verAlters <- verifyAlters (blid b) tpos-          case verAlters of-            Right () -> do-              let msg = makeSentence ["you", v, MU.Text pText]-              msgAdd MsgDone msg-              return $ Right $ ReqAlter tpos-            Left err -> return $ Left err-        else failSer AlterBlockActor-      else failSer AlterBlockItem---- | Verify important effects, such as fleeing the dungeon.------ This is contrived for now, the embedded items are not analyzed,--- but only recognized by name.-verifyAlters :: MonadClientUI m => LevelId -> Point -> m (FailOrCmd ())-verifyAlters lid p = do-  COps{coTileSpeedup} <- getsState scops-  lvl <- getLevel lid-  let t = lvl `at` p-  bag <- getsState $ getEmbedBag lid p-  getKind <- getsState $ flip getIidKind-  let ks = map getKind $ EM.keys bag-  if | any (any IK.isEffEscape . IK.ieffects) ks -> verifyEscape-     | null ks && not (Tile.isModifiable coTileSpeedup t) ->-         failWith "never mind"-     | otherwise -> return $ Right ()--verifyEscape :: MonadClientUI m => m (FailOrCmd ())-verifyEscape = do-  side <- getsClient sside-  fact <- getsState $ (EM.! side) . sfactionD-  if not (fcanEscape $ gplayer fact)-  then failWith-         "This is the way out, but where would you go in this alien world?"-  else do-    (_, total) <- getsState $ calculateTotal side-    dungeonTotal <- getsState sgold-    let prompt | dungeonTotal == 0 =-                 "You finally reached the way out. Really leave now?"-               | total == 0 =-                 "Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?"-               | total < dungeonTotal =-                 "You finally found the way out, but still more valuables are rumoured to hide around here. Really leave already?"-               | otherwise =-                 "This is the way out and you collected all treasure there is to find. Really leave now?"-    -- The player can back off, but we never insist,-    -- because possibly the score formula doesn't reward treasure-    -- or he is focused on winning only.-    go <- displayYesNo ColorBW prompt-    if not go-    then failWith "here's your chance!"-    else return $ Right ()---- | Guess and report why the bump command failed.-guessAlter :: COps -> [TriggerTile] -> ContentId TileKind -> Text-guessAlter COps{cotile} (TriggerTile{ttfeature=TK.OpenTo _} : _) t-  | Tile.isClosable cotile t = "already open"-guessAlter _ (TriggerTile{ttfeature=TK.OpenTo _} : _) _ = "cannot be opened"-guessAlter COps{cotile} (TriggerTile{ttfeature=TK.CloseTo _} : _) t-  | Tile.isOpenable cotile t = "already closed"-guessAlter _ (TriggerTile{ttfeature=TK.CloseTo _} : _) _ = "cannot be closed"-guessAlter _ _ _ = "never mind"---- * AlterWithPointer---- | Try to alter a tile using a feature under the pointer.-alterWithPointerHuman :: MonadClientUI m-                      => [TriggerTile] -> m (FailOrCmd RequestTimed)-alterWithPointerHuman ts = do-  COps{corule=RuleContent{rXmax, rYmax}, cotile} <- getsState scops-  lidV <- viewedLevelUI-  -- Not @ScreenContent@, because not drawing here.-  lvl <- getLevel lidV-  Point{..} <- getsSession spointer-  let tpos = Point px (py - mapStartY)-      t = lvl `at` tpos-  if px >= 0 && py - mapStartY >= 0-     && px < rXmax && py - mapStartY < rYmax-  then alterTileAtPos ts tpos $ "the" <+> TK.tname (okind cotile t)-  else failWith "never mind"---- * Help---- | Display command help.-helpHuman :: MonadClientUI m-          => (HumanCmd -> m (Either MError ReqUI))-          -> m (Either MError ReqUI)-helpHuman cmdAction = do-  cops <- getsState scops-  ccui@CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}}-    <- getsSession sccui-  let keyH = keyHelp cops ccui 1-      splitHelp (t, okx) =-        splitOKX rwidth rheight (textToAL t) [K.spaceKM, K.escKM] okx-      sli = toSlideshow $ concat $ map splitHelp keyH-  -- Thus, the whole help menu corresponde to a single menu of item or lore,-  -- e.g., shared stash menu. This is especially clear when the shared stash-  -- menu contains many pages.-  ekm <- displayChoiceScreen "help" ColorFull True sli [K.spaceKM, K.escKM]-  case ekm of-    Left km -> case km `M.lookup` bcmdMap coinput of-      _ | km `elem` [K.escKM, K.spaceKM] -> return $ Left Nothing-      Just (_desc, _cats, cmd) -> cmdAction cmd-      Nothing -> weaveJust <$> failWith "never mind"-    Right _slot -> error $ "" `showFailure` ekm---- * Hint---- | Display hint or, if already displayed, display help.-hintHuman :: MonadClientUI m-          => (HumanCmd -> m (Either MError ReqUI))-          -> m (Either MError ReqUI)-hintHuman cmdAction = do-  hintMode <- getsSession shintMode-  if hintMode == HintWiped then-    helpHuman cmdAction-  else do-    modifySession $ \sess -> sess {shintMode = HintShown}-    promptMainKeys-    return $ Left Nothing---- * Dashboard---- | Display the dashboard.-dashboardHuman :: MonadClientUI m-               => (HumanCmd -> m (Either MError ReqUI))-               -> m (Either MError ReqUI)-dashboardHuman cmdAction = do-  CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui-  let keyL = 2-      (ov0, kxs0) = okxsN coinput 1 keyL (const False) False-                          CmdDashboard [] []-      al1 = textToAL "Dashboard"-      splitHelp (al, okx) = splitOKX rwidth (rheight - 2) al [K.escKM] okx-      sli = toSlideshow $ splitHelp (al1, (ov0, kxs0))-      extraKeys = [K.escKM]-  ekm <- displayChoiceScreen "dashboard" ColorFull False sli extraKeys-  case ekm of-    Left km -> case km `M.lookup` bcmdMap coinput of-      _ | km == K.escKM -> weaveJust <$> failWith "never mind"-      Just (_desc, _cats, cmd) -> cmdAction cmd-      Nothing -> weaveJust <$> failWith "never mind"-    Right _slot -> error $ "" `showFailure` ekm---- * ItemMenu--itemMenuHuman :: MonadClientUI m-              => (HumanCmd -> m (Either MError ReqUI))-              -> m (Either MError ReqUI)-itemMenuHuman cmdAction = do-  itemSel <- getsSession sitemSel-  case itemSel of-    Just (iid, fromCStore, _) -> do-      leader <- getLeaderUI-      b <- getsState $ getActorBody leader-      bUI <- getsSession $ getActorUI leader-      bag <- getsState $ getBodyStoreBag b fromCStore-      case iid `EM.lookup` bag of-        Nothing -> weaveJust <$> failWith "no item to open item menu for"-        Just kit -> do-          CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui-          actorMaxSk <- getsState $ getActorMaxSkills leader-          itemFull <- getsState $ itemToFull iid-          localTime <- getsState $ getLocalTime (blid b)-          found <- getsState $ findIid leader (bfid b) iid-          factionD <- getsState sfactionD-          sactorUI <- getsSession sactorUI-          jlid <- getsSession $ (EM.! iid) . sitemUI-          let !_A = assert (not (null found) || fromCStore == CGround-                            `blame` (iid, leader)) ()-              fAlt (aid, (_, store)) = aid /= leader || store /= fromCStore-              foundAlt = filter fAlt found-              foundUI = map (\(aid, bs) ->-                               (aid, bs, sactorUI EM.! aid)) foundAlt-              foundKeys = map (K.KM K.NoModifier . K.Fun)-                              [1 .. length foundUI]  -- starting from 1!-              ppLoc bUI2 store =-                let phr = makePhrase $ ppCStoreWownW False store-                                     $ partActor bUI2-                in "[" ++ T.unpack phr ++ "]"-              foundTexts = map (\(_, (_, store), bUI2) ->-                                  ppLoc bUI2 store) foundUI-              foundPrefix = textToAL $-                if null foundTexts then "" else "The item is also in:"-              markParagraphs = rheight >= 45-              desc = itemDesc markParagraphs (bfid b) factionD-                              (Ability.getSk Ability.SkHurtMelee actorMaxSk)-                              fromCStore localTime jlid itemFull kit-              alPrefix = splitAttrLine rwidth $ desc <+:> foundPrefix-              ystart = length alPrefix - 1-              xstart = length (last alPrefix) + 1-              ks = zip foundKeys $ map (\(_, (_, store), bUI2) ->-                                          ppLoc bUI2 store) foundUI-              (ovFoundRaw, kxsFound) = wrapOKX ystart xstart rwidth ks-              ovFound = glueLines alPrefix ovFoundRaw-          report <- getReportUI-          CCUI{coinput} <- getsSession sccui-          actorSk <- leaderSkillsClientUI-          let calmE = calmEnough b actorMaxSk-              greyedOut cmd = not calmE && fromCStore == CSha || case cmd of-                ByAimMode AimModeCmd{..} ->-                  greyedOut exploration || greyedOut aiming-                ComposeIfLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2-                ComposeUnlessError cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2-                Compose2ndLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2-                MoveItem stores destCStore _ _ ->-                  fromCStore `notElem` stores-                  || not calmE && CSha == destCStore-                  || destCStore == CEqp && eqpOverfull b 1-                Apply{} ->-                  let skill = Ability.getSk Ability.SkApply actorSk-                  in not $ either (const False) id-                     $ permittedApply localTime skill calmE itemFull kit-                Project{} ->-                  let skill = Ability.getSk Ability.SkProject actorSk-                  in not $ either (const False) id-                     $ permittedProject False skill calmE itemFull-                _ -> False-              fmt n k h = " " <> T.justifyLeft n ' ' k <+> h-              keyL = 11-              keyCaption = fmt keyL "keys" "command"-              offset = 1 + length ovFound-              (ov0, kxs0) = okxsN coinput offset keyL greyedOut True-                                  CmdItemMenu [keyCaption] []-              t0 = makeSentence [ MU.SubjectVerbSg (partActor bUI) "choose"-                                , "an item", MU.Text $ ppCStoreIn fromCStore ]-              al1 = renderReport report <+:> textToAL t0-              splitHelp (al, okx) =-                splitOKX rwidth (rheight - 2) al [K.spaceKM, K.escKM] okx-              sli = toSlideshow-                    $ splitHelp (al1, (ovFound ++ ov0, kxsFound ++ kxs0))-              extraKeys = [K.spaceKM, K.escKM] ++ foundKeys-          recordHistory  -- report shown (e.g., leader switch), save to history-          ekm <- displayChoiceScreen "item menu" ColorFull False sli extraKeys-          case ekm of-            Left km -> case km `M.lookup` bcmdMap coinput of-              _ | km == K.escKM -> weaveJust <$> failWith "never mind"-              _ | km == K.spaceKM -> return $ Left Nothing-              _ | km `elem` foundKeys -> case km of-                K.KM{key=K.Fun n} -> do-                  let (newAid, (bNew, newCStore)) = foundAlt !! (n - 1)-                  fact <- getsState $ (EM.! bfid bNew) . sfactionD-                  let (autoDun, _) = autoDungeonLevel fact-                  if | blid bNew /= blid b && autoDun ->-                       weaveJust <$> failSer NoChangeDunLeader-                     | otherwise -> do-                       void $ pickLeader True newAid-                       modifySession $ \sess ->-                         sess {sitemSel = Just (iid, newCStore, False)}-                       itemMenuHuman cmdAction-                _ -> error $ "" `showFailure` km-              Just (_desc, _cats, cmd) -> do-                modifySession $ \sess ->-                  sess {sitemSel = Just (iid, fromCStore, True)}-                res <- cmdAction cmd-                modifySession $ \sess ->-                  sess {sitemSel = Just (iid, fromCStore, False)}-                return res-              Nothing -> weaveJust <$> failWith "never mind"-            Right _slot -> error $ "" `showFailure` ekm-    Nothing -> weaveJust <$> failWith "no item to open item menu for"---- * ChooseItemMenu--chooseItemMenuHuman :: MonadClientUI m-                    => (HumanCmd -> m (Either MError ReqUI))-                    -> ItemDialogMode-                    -> m (Either MError ReqUI)-chooseItemMenuHuman cmdAction c = do-  res <- chooseItemDialogMode c-  case res of-    Right c2 -> do-      res2 <- itemMenuHuman cmdAction-      case res2 of-        Left Nothing -> chooseItemMenuHuman cmdAction c2-        _ -> return res2-    Left err -> return $ Left $ Just err---- * MainMenu--artAtSize :: MonadClientUI m => m [Text]-artAtSize = do-  CCUI{coscreen=ScreenContent{rwidth, rheight, rmainMenuArt}} <--    getsSession sccui-  let tlines = T.lines rmainMenuArt-      xoffset = (80 - rwidth) `div` 2-      yoffset = (length tlines - rheight) `div` 2-      f = T.take rwidth . T.drop xoffset-  return $! map f $ take rheight $ drop yoffset tlines---- We detect the place for the version string by searching for 'Version'--- in the last line of the picture. If it doesn't fit, we shift, if everything--- else fails, only then we crop. We don't assume any line length.-artWithVersion :: MonadClientUI m => m [String]-artWithVersion = do-  COps{corule} <- getsState scops-  let pasteVersion :: [Text] -> [String]-      pasteVersion art =-        let exeVersion = rexeVersion corule-            libVersion = Self.version-            version = " Version " ++ showVersion exeVersion-                      ++ " (frontend: " ++ frontendName-                      ++ ", engine: LambdaHack " ++ showVersion libVersion-                      ++ ") "-            versionLen = length version-            f line =-              let (prefix, versionSuffix) = T.breakOn "Version" line-              in if T.null versionSuffix then T.unpack line else-                let suffix = drop versionLen $ T.unpack versionSuffix-                    overfillLen = versionLen - T.length versionSuffix-                    prefixModified = T.unpack $ T.dropEnd overfillLen prefix-                in prefixModified ++ version ++ suffix-        in map f art-  mainMenuArt <- artAtSize-  return $! pasteVersion mainMenuArt--generateMenu :: MonadClientUI m-             => (HumanCmd -> m (Either MError ReqUI))-             -> [(K.KM, (Text, HumanCmd))] -> [String] -> String-             -> m (Either MError ReqUI)-generateMenu cmdAction kds gameInfo menuName = do-  art <- artWithVersion-  let bindingLen = 35-      emptyInfo = repeat $ replicate bindingLen ' '-      bindings =  -- key bindings to display-        let fmt (k, (d, _)) =-              ( Just k-              , T.unpack-                $ T.justifyLeft bindingLen ' '-                    $ " " <> T.justifyLeft 4 ' ' (T.pack $ K.showKM k)-                      <> " " <> d )-        in map fmt kds-      overwrite :: [(Int, String)] -> [(String, Maybe KYX)]-      overwrite =  -- overwrite the art with key bindings and other lines-        let over [] (_, line) = ([], (line, Nothing))-            over bs@((mkey, binding) : bsRest) (y, line) =-              let (prefix, lineRest) = break (=='{') line-                  (braces, suffix)   = span  (=='{') lineRest-              in if length braces >= bindingLen-                 then-                   let lenB = length binding-                       post = drop (lenB - length braces) suffix-                       len = length prefix-                       yxx key = (Left [key], (y, len, len + lenB))-                       myxx = yxx <$> mkey-                   in (bsRest, (prefix <> binding <> post, myxx))-                 else (bs, (line, Nothing))-        in snd . mapAccumL over (zip (repeat Nothing) gameInfo-                                 ++ bindings-                                 ++ zip (repeat Nothing) emptyInfo)-      menuOverwritten = overwrite $ zip [0..] art-      (menuOvLines, mkyxs) = unzip menuOverwritten-      kyxs = catMaybes mkyxs-      ov = map stringToAL menuOvLines-  ekm <- displayChoiceScreen menuName ColorFull True-                                      (menuToSlideshow (ov, kyxs)) [K.escKM]-  case ekm of-    Left km -> case km `lookup` kds of-      Just (_desc, cmd) -> cmdAction cmd-      Nothing -> weaveJust <$> failWith "never mind"-    Right _slot -> error $ "" `showFailure` ekm---- | Display the main menu.-mainMenuHuman :: MonadClientUI m-              => (HumanCmd -> m (Either MError ReqUI))-              -> m (Either MError ReqUI)-mainMenuHuman cmdAction = do-  cops <- getsState scops-  CCUI{coinput=InputContent{bcmdList}} <- getsSession sccui-  gameMode <- getGameMode-  snxtScenario <- getsClient snxtScenario-  let nxtGameName = mname $ nxtGameMode cops snxtScenario-      tnextScenario = "pick next:" <+> nxtGameName-      -- Key-description-command tuples.-      kds = (K.mkKM "p", (tnextScenario, GameScenarioIncr))-            : [ (km, (desc, cmd))-              | (km, ([CmdMainMenu], desc, cmd)) <- bcmdList ]-      bindingLen = 35-      gameName = mname gameMode-      gameInfo = map T.unpack-                   [ T.justifyLeft bindingLen ' ' ""-                   , T.justifyLeft bindingLen ' '-                     $ " Now playing:" <+> gameName-                   , T.justifyLeft bindingLen ' ' "" ]-  generateMenu cmdAction kds gameInfo "main"---- * MainMenuAutoOn---- | Display the main menu and set @swasAutomated@.-mainMenuAutoOnHuman :: MonadClientUI m-                    => (HumanCmd -> m (Either MError ReqUI))-                    -> m (Either MError ReqUI)-mainMenuAutoOnHuman cmdAction = do-  modifySession $ \sess -> sess {swasAutomated = True}-  mainMenuHuman cmdAction---- * MainMenuAutoOff---- | Display the main menu and unset @swasAutomated@.-mainMenuAutoOffHuman :: MonadClientUI m-                     => (HumanCmd -> m (Either MError ReqUI))-                     -> m (Either MError ReqUI)-mainMenuAutoOffHuman cmdAction = do-  modifySession $ \sess -> sess {swasAutomated = False}-  mainMenuHuman cmdAction---- * SettingsMenu---- | Display the settings menu.-settingsMenuHuman :: MonadClientUI m-                  => (HumanCmd -> m (Either MError ReqUI))-                  -> m (Either MError ReqUI)-settingsMenuHuman cmdAction = do-  markSuspect <- getsClient smarkSuspect-  markVision <- getsSession smarkVision-  markSmell <- getsSession smarkSmell-  side <- getsClient sside-  factTactic <- getsState $ ftactic . gplayer . (EM.! side) . sfactionD-  let offOn b = if b then "on" else "off"-      offOnAll n = case n of-        0 -> "none"-        1 -> "untried"-        2 -> "all"-        _ -> error $ "" `showFailure` n-      tsuspect = "mark suspect terrain:" <+> offOnAll markSuspect-      tvisible = "show visible zone:" <+> offOn markVision-      tsmell = "display smell clues:" <+> offOn markSmell-      thenchmen = "henchmen tactic:" <+> Ability.nameTactic factTactic-      -- Key-description-command tuples.-      kds = [ (K.mkKM "s", (tsuspect, MarkSuspect))-            , (K.mkKM "v", (tvisible, MarkVision))-            , (K.mkKM "c", (tsmell, MarkSmell))-            , (K.mkKM "t", (thenchmen, Tactic))-            , (K.mkKM "Escape", ("back to main menu", MainMenu)) ]-      bindingLen = 35-      gameInfo = map T.unpack-                   [ T.justifyLeft bindingLen ' ' ""-                   , T.justifyLeft bindingLen ' ' " Convenience settings:"-                   , T.justifyLeft bindingLen ' ' "" ]-  generateMenu cmdAction kds gameInfo "settings"---- * ChallengesMenu---- | Display the challenges menu.-challengesMenuHuman :: MonadClientUI m-                    => (HumanCmd -> m (Either MError ReqUI))-                    -> m (Either MError ReqUI)-challengesMenuHuman cmdAction = do-  curChal <- getsClient scurChal-  nxtChal <- getsClient snxtChal-  let offOn b = if b then "on" else "off"-      tcurDiff = " *   difficulty:" <+> tshow (cdiff curChal)-      tnextDiff = "difficulty (lower easier):" <+> tshow (cdiff nxtChal)-      tcurWolf = " *   lone wolf:"-                 <+> offOn (cwolf curChal)-      tnextWolf = "lone wolf (very hard):"-                  <+> offOn (cwolf nxtChal)-      tcurFish = " *   cold fish:"-                 <+> offOn (cfish curChal)-      tnextFish = "cold fish (hard):"-                  <+> offOn (cfish nxtChal)-      -- Key-description-command tuples.-      kds = [ (K.mkKM "d", (tnextDiff, GameDifficultyIncr))-            , (K.mkKM "w", (tnextWolf, GameWolfToggle))-            , (K.mkKM "f", (tnextFish, GameFishToggle))-            , (K.mkKM "Escape", ("back to main menu", MainMenu)) ]-      bindingLen = 35-      gameInfo = map T.unpack-                   [ T.justifyLeft bindingLen ' ' " Current challenges:"-                   , T.justifyLeft bindingLen ' ' ""-                   , T.justifyLeft bindingLen ' ' tcurDiff-                   , T.justifyLeft bindingLen ' ' tcurWolf-                   , T.justifyLeft bindingLen ' ' tcurFish-                   , T.justifyLeft bindingLen ' ' ""-                   , T.justifyLeft bindingLen ' ' " Next game challenges:"-                   , T.justifyLeft bindingLen ' ' "" ]-  generateMenu cmdAction kds gameInfo "challenge"---- * GameScenarioIncr--gameScenarioIncr :: MonadClient m => m ()-gameScenarioIncr =-  modifyClient $ \cli -> cli {snxtScenario = snxtScenario cli + 1}---- * GameDifficultyIncr--gameDifficultyIncr :: MonadClient m => m ()-gameDifficultyIncr = do-  nxtDiff <- getsClient $ cdiff . snxtChal-  let delta = -1-      d | nxtDiff + delta > difficultyBound = 1-        | nxtDiff + delta < 1 = difficultyBound-        | otherwise = nxtDiff + delta-  modifyClient $ \cli -> cli {snxtChal = (snxtChal cli) {cdiff = d} }---- * GameWolfToggle--gameWolfToggle :: MonadClient m => m ()-gameWolfToggle =-  modifyClient $ \cli ->-    cli {snxtChal = (snxtChal cli) {cwolf = not (cwolf (snxtChal cli))} }---- * GameFishToggle--gameFishToggle :: MonadClient m => m ()-gameFishToggle =-  modifyClient $ \cli ->-    cli {snxtChal = (snxtChal cli) {cfish = not (cfish (snxtChal cli))} }---- * GameRestart--gameRestartHuman :: MonadClientUI m => m (FailOrCmd ReqUI)-gameRestartHuman = do-  cops <- getsState scops-  isNoConfirms <- isNoConfirmsGame-  gameMode <- getGameMode-  snxtScenario <- getsClient snxtScenario-  let nxtGameName = mname $ nxtGameMode cops snxtScenario-  b <- if isNoConfirms-       then return True-       else displayYesNo ColorBW-            $ "You just requested a new" <+> nxtGameName-              <+> "game. The progress of the ongoing" <+> mname gameMode-              <+> "game will be lost! Are you sure?"-  if b-  then do-    snxtChal <- getsClient snxtChal-    -- This ignores all but the first word of game mode names picked-    -- via main menu and assumes the fist word of such game modes-    -- is present in their frequencies.-    let nxtGameGroup = toGroupName $ head $ T.words nxtGameName-    return $ Right $ ReqUIGameRestart nxtGameGroup snxtChal-  else do-    msg2 <- rndToActionForget $ oneOf-              [ "yea, would be a pity to leave them to die"-              , "yea, a shame to get your team stranded" ]-    failWith msg2--nxtGameMode :: COps -> Int -> ModeKind-nxtGameMode COps{comode} snxtScenario =-  let f !acc _p _i !a = a : acc-      campaignModes = ofoldlGroup' comode "campaign scenario" f []-  in campaignModes !! (snxtScenario `mod` length campaignModes)---- * GameQuit---- TODO: deduplicate with gameRestartHuman-gameQuitHuman :: MonadClientUI m => m (FailOrCmd ReqUI)-gameQuitHuman = do-  isNoConfirms <- isNoConfirmsGame-  gameMode <- getGameMode-  b <- if isNoConfirms-       then return True-       else displayYesNo ColorBW-            $ "If you quit, the progress of the ongoing" <+> mname gameMode-              <+> "game will be lost! Are you sure?"-  if b-  then do-    snxtChal <- getsClient snxtChal-    return $ Right $ ReqUIGameRestart "insert coin" snxtChal-  else do-    msg2 <- rndToActionForget $ oneOf-              [ "yea, would be a pity to leave them to die"-              , "yea, a shame to get your team stranded" ]-    failWith msg2---- * GameDrop--gameDropHuman :: MonadClientUI m => m ReqUI-gameDropHuman = do-  modifySession $ \sess -> sess {sallNframes = -1}  -- hack, but we crash anyway-  promptAdd0 "Interrupt! Trashing the unsaved game. The program exits now."-  clientPrintUI "Interrupt! Trashing the unsaved game. The program exits now."-    -- this is not shown by vty frontend, but at least shown by sdl2 one-  return ReqUIGameDropAndExit---- * GameExit--gameExitHuman :: MonadClientUI m => m ReqUI-gameExitHuman = do-  -- Announce before the saving started, since it can take a while.-  promptAdd0 "Saving game. The program stops now."-  return ReqUIGameSaveAndExit---- * GameSave--gameSaveHuman :: MonadClientUI m => m ReqUI-gameSaveHuman = do-  -- Announce before the saving started, since it can take a while.-  promptAdd0 "Saving game backup."-  return ReqUIGameSave---- * Tactic---- Note that the difference between seek-target and follow-the-leader tactic--- can influence even a faction with passive actors. E.g., if a passive actor--- has an extra active skill from equipment, he moves every turn.-tacticHuman :: MonadClientUI m => m (FailOrCmd ReqUI)-tacticHuman = do-  fid <- getsClient sside-  fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD-  let toT = if fromT == maxBound then minBound else succ fromT-  go <- displaySpaceEsc ColorFull-        $ "(Beware, work in progress!)"-          <+> "Current henchmen tactic is" <+> Ability.nameTactic fromT-          <+> "(" <> Ability.describeTactic fromT <> ")."-          <+> "Switching tactic to" <+> Ability.nameTactic toT-          <+> "(" <> Ability.describeTactic toT <> ")."-          <+> "This clears targets of all henchmen (non-leader teammates)."-          <+> "New targets will be picked according to new tactic."-  if not go-  then failWith "tactic change canceled"-  else return $ Right $ ReqUITactic toT---- * Automate--automateHuman :: MonadClientUI m => m (FailOrCmd ReqUI)-automateHuman = do-  clearAimMode-  go <- displaySpaceEsc ColorBW-          "Ceding control to AI (press SPACE to confirm, ESC to cancel)."-  if not go-  then failWith "automation canceled"-  else return $ Right ReqUIAutomate---- * AutomateToggle--automateToggleHuman :: MonadClientUI m => m (FailOrCmd ReqUI)+{-# LANGUAGE TupleSections #-}+-- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd"+-- client commands that return server requests.+-- A couple of them do not take time, the rest does.+-- Here prompts and menus are displayed, but any feedback resulting+-- from the commands (e.g., from inventory manipulation) is generated later on,+-- by the server, for all clients that witness the results of the commands.+module Game.LambdaHack.Client.UI.HandleHumanGlobalM+  ( -- * Meta commands+    byAreaHuman, byAimModeHuman+  , composeIfLocalHuman, composeUnlessErrorHuman, compose2ndLocalHuman+  , loopOnNothingHuman, executeIfClearHuman+    -- * Global commands that usually take time+  , waitHuman, waitHuman10, yellHuman, moveRunHuman+  , runOnceAheadHuman, moveOnceToXhairHuman+  , runOnceToXhairHuman, continueToXhairHuman+  , moveItemHuman, projectHuman, applyHuman+  , alterDirHuman, alterWithPointerHuman, closeDirHuman+  , helpHuman, hintHuman, dashboardHuman, itemMenuHuman, chooseItemMenuHuman+  , mainMenuHuman, mainMenuAutoOnHuman, mainMenuAutoOffHuman+  , settingsMenuHuman, challengeMenuHuman+  , gameTutorialToggle, gameDifficultyIncr+  , gameFishToggle, gameGoodsToggle, gameWolfToggle, gameKeeperToggle+  , gameScenarioIncr+    -- * Global commands that never take time+  , gameRestartHuman, gameQuitHuman, gameDropHuman, gameExitHuman, gameSaveHuman+  , doctrineHuman, automateHuman, automateToggleHuman, automateBackHuman+#ifdef EXPOSE_INTERNAL+    -- * Internal operations+  , areaToRectangles, meleeAid, displaceAid, moveSearchAlter, alterCommon+  , goToXhair, goToXhairExplorationMode, goToXhairGoTo+  , multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems+  , projectItem, applyItem, alterTileAtPos, verifyAlters, processTileActions+  , verifyEscape, verifyToolEffect, closeTileAtPos, msgAddDone, pickPoint+  , generateMenu+#endif+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import qualified Data.Char as Char+import           Data.Either (isLeft)+import qualified Data.EnumMap.Strict as EM+import qualified Data.EnumSet as ES+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import           Data.Version+import qualified NLP.Miniutter.English as MU++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.Client.UI.ActorUI+import           Game.LambdaHack.Client.UI.Content.Input+import           Game.LambdaHack.Client.UI.Content.Screen+import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.Frame+import           Game.LambdaHack.Client.UI.FrameM+import           Game.LambdaHack.Client.UI.HandleHelperM+import           Game.LambdaHack.Client.UI.HandleHumanLocalM+import           Game.LambdaHack.Client.UI.HumanCmd+import           Game.LambdaHack.Client.UI.InventoryM+import           Game.LambdaHack.Client.UI.ItemDescription+import           Game.LambdaHack.Client.UI.ItemSlot (SlotChar (SlotChar))+import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.KeyBindings+import           Game.LambdaHack.Client.UI.MonadClientUI+import           Game.LambdaHack.Client.UI.Msg+import           Game.LambdaHack.Client.UI.MsgM+import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI+import           Game.LambdaHack.Client.UI.RunM+import           Game.LambdaHack.Client.UI.SessionUI+import           Game.LambdaHack.Client.UI.Slideshow+import           Game.LambdaHack.Client.UI.SlideshowM+import           Game.LambdaHack.Client.UI.UIOptions+import           Game.LambdaHack.Common.Actor+import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.Area+import           Game.LambdaHack.Common.ClientOptions+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.Types+import           Game.LambdaHack.Common.Vector+import qualified Game.LambdaHack.Content.ItemKind as IK+import qualified Game.LambdaHack.Content.ModeKind as MK+import           Game.LambdaHack.Content.RuleKind+import qualified Game.LambdaHack.Content.TileKind as TK+import qualified Game.LambdaHack.Core.Dice as Dice+import           Game.LambdaHack.Core.Random+import qualified Game.LambdaHack.Definition.Ability as Ability+import qualified Game.LambdaHack.Definition.Color as Color+import           Game.LambdaHack.Definition.Defs++-- * ByArea++-- | Pick command depending on area the mouse pointer is in.+-- The first matching area is chosen. If none match, only interrupt.+byAreaHuman :: (MonadClient m, MonadClientUI m)+            => (K.KM -> HumanCmd -> m (Either MError ReqUI))+            -> [(CmdArea, HumanCmd)]+            -> m (Either MError ReqUI)+byAreaHuman cmdSemInCxtOfKM l = do+  CCUI{coinput=InputContent{brevMap}} <- getsSession sccui+  pUI <- getsSession spointer+  let PointSquare px py = uiToSquare pUI+      p = Point {..}  -- abuse of convention: @Point@, not @PointSquare@ used+                      -- for the whole UI screen in square font coordinates+      pointerInArea a = do+        rs <- areaToRectangles a+        return $! any (inside p) $ catMaybes rs+  cmds <- filterM (pointerInArea . fst) l+  case cmds of+    [] -> do+      stopPlayBack+      return $ Left Nothing+    (_, cmd) : _ -> do+      let kmFound = case M.lookup cmd brevMap of+            Just (km : _) -> km+            _ -> K.escKM+      cmdSemInCxtOfKM kmFound cmd++-- Many values here are shared with "Game.LambdaHack.Client.UI.DrawM".+areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area]+areaToRectangles ca = map toArea <$> do+ CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui+ case ca of+  CaMessage -> return [(0, 0, rwidth - 1, 0)]+  CaMapLeader -> do  -- takes preference over @CaMapParty@ and @CaMap@+    leader <- getLeaderUI+    b <- getsState $ getActorBody leader+    let PointSquare x y = mapToSquare $ bpos b+    return [(x, y, x, y)]+  CaMapParty -> do  -- takes preference over @CaMap@+    lidV <- viewedLevelUI+    side <- getsClient sside+    ours <- getsState $ filter (not . bproj) . map snd+                        . actorAssocs (== side) lidV+    let rectFromB p =+          let PointSquare x y = mapToSquare p+          in (x, y, x, y)+    return $! map (rectFromB . bpos) ours+  CaMap ->+    let PointSquare xo yo = mapToSquare originPoint+        PointSquare xe ye = mapToSquare $ Point (rwidth - 1) (rheight - 4)+    in return [(xo, yo, xe, ye)]+  CaLevelNumber -> let y = rheight - 2+                   in return [(0, y, 1, y)]+  CaArenaName -> let y = rheight - 2+                     x = (rwidth - 1) `div` 2 - 11+                 in return [(3, y, x, y)]+  CaPercentSeen -> let y = rheight - 2+                       x = (rwidth - 1) `div` 2+                   in return [(x - 9, y, x, y)]+  CaXhairDesc -> let y = rheight - 2+                     x = (rwidth - 1) `div` 2 + 2+                 in return [(x, y, rwidth - 1, y)]+  CaSelected -> let y = rheight - 1+                    x = (rwidth - 1) `div` 2+                in return [(0, y, x - 24, y)]+  CaCalmGauge -> let y = rheight - 1+                     x = (rwidth - 1) `div` 2+                 in return [(x - 22, y, x - 18, y)]+  CaCalmValue -> let y = rheight - 1+                     x = (rwidth - 1) `div` 2+                 in return [(x - 17, y, x - 11, y)]+  CaHPGauge -> let y = rheight - 1+                   x = (rwidth - 1) `div` 2+               in return [(x - 9, y, x - 6, y)]+  CaHPValue -> let y = rheight - 1+                   x = (rwidth - 1) `div` 2+               in return [(x - 6, y, x, y)]+  CaLeaderDesc -> let y = rheight - 1+                      x = (rwidth - 1) `div` 2 + 2+                  in return [(x, y, rwidth - 1, y)]++-- * ByAimMode++byAimModeHuman :: MonadClientUI m+               => m (Either MError ReqUI) -> m (Either MError ReqUI)+               -> m (Either MError ReqUI)+byAimModeHuman cmdNotAimingM cmdAimingM = do+  aimMode <- getsSession saimMode+  if isNothing aimMode then cmdNotAimingM else cmdAimingM++-- * ComposeIfLocal++composeIfLocalHuman :: MonadClientUI m+                    => m (Either MError ReqUI) -> m (Either MError ReqUI)+                    -> m (Either MError ReqUI)+composeIfLocalHuman c1 c2 = do+  slideOrCmd1 <- c1+  case slideOrCmd1 of+    Left merr1 -> do+      slideOrCmd2 <- c2+      case slideOrCmd2 of+        Left merr2 -> return $ Left $ mergeMError merr1 merr2+        _ -> return slideOrCmd2+    _ -> return slideOrCmd1++-- * ComposeUnlessError++composeUnlessErrorHuman :: MonadClientUI m+                        => m (Either MError ReqUI) -> m (Either MError ReqUI)+                        -> m (Either MError ReqUI)+composeUnlessErrorHuman c1 c2 = do+  slideOrCmd1 <- c1+  case slideOrCmd1 of+    Left Nothing -> c2+    _ -> return slideOrCmd1++-- * Compose2ndLocal++compose2ndLocalHuman :: MonadClientUI m+                     => m (Either MError ReqUI) -> m (Either MError ReqUI)+                     -> m (Either MError ReqUI)+compose2ndLocalHuman c1 c2 = do+  slideOrCmd1 <- c1+  case slideOrCmd1 of+    Left merr1 -> do+      slideOrCmd2 <- c2+      case slideOrCmd2 of+        Left merr2 -> return $ Left $ mergeMError merr1 merr2+        _ -> return slideOrCmd1  -- ignore second request, keep effect+    req -> do+      void c2  -- ignore second request, keep effect+      return req++-- * LoopOnNothing++loopOnNothingHuman :: MonadClientUI m+                   => m (Either MError ReqUI)+                   -> m (Either MError ReqUI)+loopOnNothingHuman cmd = do+  res <- cmd+  case res of+    Left Nothing -> loopOnNothingHuman cmd+    _ -> return res++-- * ExecuteIfClear++executeIfClearHuman :: MonadClientUI m+                    => m (Either MError ReqUI)+                    -> m (Either MError ReqUI)+executeIfClearHuman c1 = do+  sreportNull <- getsSession sreportNull+  if sreportNull then c1 else return $ Left Nothing++-- * Wait++-- | Leader waits a turn (and blocks, etc.).+waitHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)+waitHuman = do+  actorCurAndMaxSk <- leaderSkillsClientUI+  if Ability.getSk Ability.SkWait actorCurAndMaxSk > 0 then do+    modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}+    return $ Right ReqWait+  else failSer WaitUnskilled++-- * Wait10++-- | Leader waits a 1/10th of a turn (and doesn't block, etc.).+waitHuman10 :: MonadClientUI m => m (FailOrCmd RequestTimed)+waitHuman10 = do+  actorCurAndMaxSk <- leaderSkillsClientUI+  if Ability.getSk Ability.SkWait actorCurAndMaxSk >= 4 then do+    modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}+    return $ Right ReqWait10+  else failSer WaitUnskilled++-- * Yell++-- | Leader yells or yawns, if sleeping.+yellHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)+yellHuman = do+  actorCurAndMaxSk <- leaderSkillsClientUI+  if Ability.getSk Ability.SkWait actorCurAndMaxSk > 0+     -- If waiting drained and really, potentially, no other possible action,+     -- still allow yelling.+     || Ability.getSk Ability.SkMove actorCurAndMaxSk <= 0+     || Ability.getSk Ability.SkDisplace actorCurAndMaxSk <= 0+     || Ability.getSk Ability.SkMelee actorCurAndMaxSk <= 0+  then return $ Right ReqYell+  else failSer WaitUnskilled++-- * MoveDir and RunDir++moveRunHuman :: (MonadClient m, MonadClientUI m)+             => Bool -> Bool -> Bool -> Bool -> Vector+             -> m (FailOrCmd RequestTimed)+moveRunHuman initialStep finalGoal run runAhead dir = do+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  arena <- getArenaUI+  sb <- getsState $ getActorBody leader+  fact <- getsState $ (EM.! bfid sb) . sfactionD+  -- Start running in the given direction. The first turn of running+  -- succeeds much more often than subsequent turns, because we ignore+  -- most of the disturbances, since the player is mostly aware of them+  -- and still explicitly requests a run, knowing how it behaves.+  sel <- getsSession sselected+  let runMembers = if runAhead || noRunWithMulti fact+                   then [leader]+                   else ES.elems (ES.delete leader sel) ++ [leader]+      runParams = RunParams { runLeader = leader+                            , runMembers+                            , runInitial = True+                            , runStopMsg = Nothing+                            , runWaiting = 0 }+      initRunning = when (initialStep && run) $ do+        modifySession $ \sess ->+          sess {srunning = Just runParams}+        when runAhead $ macroHuman macroRun25+  -- When running, the invisible actor is hit (not displaced!),+  -- so that running in the presence of roving invisible+  -- actors is equivalent to moving (with visible actors+  -- this is not a problem, since runnning stops early enough).+  let tpos = bpos sb `shift` dir+  -- 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 $ posToAidAssocs tpos arena+  case tgts of+    [] -> do  -- move or search or alter+      runStopOrCmd <- moveSearchAlter run dir+      case runStopOrCmd of+        Left stopMsg -> return $ Left stopMsg+        Right runCmd -> do+          -- Don't check @initialStep@ and @finalGoal@+          -- and don't stop going to target: door opening is mundane enough.+          initRunning+          return $ Right runCmd+    [(target, _)] | run+                    && initialStep+                    && Ability.getSk Ability.SkDisplace actorCurAndMaxSk > 0 ->+      -- No @stopPlayBack@: initial displace is benign enough.+      -- Displacing requires accessibility, but it's checked later on.+      displaceAid target+    _ : _ : _ | run+                && initialStep+                && Ability.getSk Ability.SkDisplace actorCurAndMaxSk > 0 ->+      failSer DisplaceMultiple+    (target, tb) : _ | not run+                       && initialStep && finalGoal+                       && bfid tb == bfid sb && not (bproj tb) -> do+      stopPlayBack  -- don't ever auto-repeat leader choice+      -- We always see actors from our own faction.+      -- Select one of adjacent actors by bumping into him. Takes no time.+      success <- pickLeader True target+      let !_A = assert (success `blame` "bump self"+                                `swith` (leader, target, tb)) ()+      failWith "the pointman switched by bumping"+    (target, tb) : _ | not run+                       && initialStep && finalGoal+                       && (bfid tb /= bfid sb || bproj tb) -> do+      stopPlayBack  -- don't ever auto-repeat melee+      if Ability.getSk Ability.SkMelee actorCurAndMaxSk > 0+      then -- No problem if there are many projectiles at the spot. We just+           -- attack the first one.+           meleeAid target+      else failSer MeleeUnskilled+    _ : _ -> failWith "actor in the way"++-- | Actor attacks an enemy actor or his own projectile.+meleeAid :: (MonadClient m, MonadClientUI m)+         => ActorId -> m (FailOrCmd RequestTimed)+meleeAid target = do+  leader <- getLeaderUI+  side <- getsClient sside+  tb <- getsState $ getActorBody target+  sfact <- getsState $ (EM.! side) . sfactionD+  mel <- pickWeaponClient leader target+  case mel of+    Nothing -> failWith "nothing to melee with"+    Just wp -> do+      let returnCmd = do+            -- Set personal target to enemy, so that AI, if it takes over+            -- the actor, is likely to continue the fight even if the foe flees.+            modifyClient $ updateTarget leader $ const $ Just $ TEnemy target+            -- Also set xhair to see the foe's HP, because it's automatically+            -- set to any new spotted actor, so it needs to be reset+            -- and also it's not useful as permanent ranged target anyway.+            modifySession $ \sess -> sess {sxhair = Just $ TEnemy target}+            return $ Right wp+          res | bproj tb || isFoe side sfact (bfid tb) = returnCmd+              | isFriend side sfact (bfid tb) = do+                let !_A = assert (side /= bfid tb) ()+                go1 <- displayYesNo ColorBW+                         "You are bound by an alliance. Really attack?"+                if not go1 then failWith "attack canceled" else returnCmd+              | otherwise = do+                go2 <- displayYesNo ColorBW+                         "This attack will start a war. Are you sure?"+                if not go2 then failWith "attack canceled" else returnCmd+      res+  -- Seeing the actor prevents altering a tile under it, but that+  -- does not limit the player, he just doesn't waste a turn+  -- on a failed altering.++-- | Actor swaps position with another.+displaceAid :: MonadClientUI m+            => ActorId -> m (FailOrCmd RequestTimed)+displaceAid target = do+  COps{coTileSpeedup} <- getsState scops+  leader <- getLeaderUI+  sb <- getsState $ getActorBody leader+  tb <- getsState $ getActorBody target+  tfact <- getsState $ (EM.! bfid tb) . sfactionD+  actorMaxSk <- getsState $ getActorMaxSkills target+  dEnemy <- getsState $ dispEnemy leader target actorMaxSk+  let immobile = Ability.getSk Ability.SkMove actorMaxSk <= 0+      tpos = bpos tb+      adj = checkAdjacent sb tb+      atWar = isFoe (bfid tb) tfact (bfid sb)+  if | not adj -> failSer DisplaceDistant+     | not (bproj tb) && atWar+       && actorDying tb ->  -- checked separately for a better message+       failSer DisplaceDying+     | not (bproj tb) && atWar+       && actorWaits tb ->  -- checked separately for a better message+       failSer DisplaceBraced+     | not (bproj tb) && atWar+       && immobile ->  -- checked separately for a better message+       failSer DisplaceImmobile+     | not dEnemy && atWar ->+       failSer DisplaceSupported+     | otherwise -> do+       let lid = blid sb+       lvl <- getLevel lid+       -- Displacing requires full access.+       if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then+         case posToAidsLvl tpos lvl of+           [] -> error $ "" `showFailure` (leader, sb, target, tb)+           [_] -> return $ Right $ ReqDisplace target+           _ -> failSer DisplaceMultiple+       else failSer DisplaceAccess++-- | Leader moves or searches or alters. No visible actor at the position.+moveSearchAlter :: (MonadClient m, MonadClientUI m)+                => Bool -> Vector -> m (FailOrCmd RequestTimed)+moveSearchAlter run dir = do+  COps{coTileSpeedup} <- getsState scops+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  sb <- getsState $ getActorBody leader+  let moveSkill = Ability.getSk Ability.SkMove actorCurAndMaxSk+      spos = bpos sb           -- source position+      tpos = spos `shift` dir  -- target position+  alterable <- getsState $ tileAlterable (blid sb) tpos+  lvl <- getLevel $ blid sb+  let t = lvl `at` tpos+  runStopOrCmd <-+    if Tile.isWalkable coTileSpeedup t then  -- Movement requires full access.+      if | moveSkill > 0 ->+             -- A potential invisible actor is hit. War started without asking.+             return $ Right $ ReqMove dir+         | bwatch sb == WSleep -> failSer MoveUnskilledAsleep+         | otherwise -> failSer MoveUnskilled+    else do  -- Not walkable, so search and/or alter the tile.+      let sxhair = Just $ TPoint TUnknown (blid sb) tpos+      -- Point xhair to see details with `~`.+      setXHairFromGUI sxhair+      if run then do+        -- Explicit request to examine the terrain.+        blurb <- lookAtPosition (blid sb) tpos+        mapM_ (uncurry msgAdd) blurb+        failWith $ "the terrain is" <+>+          if | Tile.isModifiable coTileSpeedup t -> "potentially modifiable"+             | alterable -> "potentially triggerable"+             | otherwise -> "completely inert"+      else alterCommon True tpos+  return $! runStopOrCmd++alterCommon :: (MonadClient m, MonadClientUI m)+            => Bool -> Point -> m (FailOrCmd RequestTimed)+alterCommon bumping tpos = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  cops@COps{cotile, coTileSpeedup} <- getsState scops+  side <- getsClient sside+  factionD <- getsState sfactionD+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  sb <- getsState $ getActorBody leader+  let alterSkill = Ability.getSk Ability.SkAlter actorCurAndMaxSk+      spos = bpos sb+  alterable <- getsState $ tileAlterable (blid sb) tpos+  lvl <- getLevel $ blid sb+  localTime <- getsState $ getLocalTime (blid sb)+  embeds <- getsState $ getEmbedBag (blid sb) tpos+  itemToF <- getsState $ flip itemToFull+  getKind <- getsState $ flip getIidKind+  let t = lvl `at` tpos+      underFeet = tpos == spos  -- if enter and alter, be more permissive+      modificationFailureHint = msgAdd MsgTutorialHint "Some doors can be opened, stairs unbarred, treasures recovered, only if you find tools that increase your terrain modification ability and act as keys to the puzzle. To gather clues about the keys, listen to what's around you, examine items, inspect terrain, trigger, bump and harass. Once you uncover a likely tool, wield it, return and try to break through again."+  if | not alterable -> do+         let name = MU.Text $ TK.tname $ okind cotile t+             itemLook (iid, kit@(k, _)) =+               let itemFull = itemToF iid+               in partItemWsShort rwidth side factionD k localTime itemFull kit+             embedKindList =+               map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)+             ilooks = map itemLook $ sortEmbeds cops t embedKindList+         failWith $ makePhrase $+           ["there is no point kicking", MU.AW name]+           ++ if EM.null embeds+              then []+              else ["with", MU.WWandW ilooks]+           -- misclick? related to AlterNothing but no searching possible;+           -- this also rules out activating embeds that only cause+           -- raw damage, with no chance of altering the tile+     | Tile.isSuspect coTileSpeedup t+       && not underFeet+       && alterSkill <= 1 -> do+         modificationFailureHint+         failSer AlterUnskilled+     | not (Tile.isSuspect coTileSpeedup t)+       && not underFeet+       && alterSkill < Tile.alterMinSkill coTileSpeedup t -> do+         -- Rather rare (requires high skill), so describe the tile.+         blurb <- lookAtPosition (blid sb) tpos+         mapM_ (uncurry msgAdd) blurb+         modificationFailureHint+         failSer AlterUnwalked+     | chessDist tpos (bpos sb) > 1 ->+         -- Checked late to give useful info about distant tiles.+         failSer AlterDistant+     | not underFeet+       && (occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl) ->+         -- Don't mislead describing terrain, if other actor is to blame.+         failSer AlterBlockActor+     | otherwise -> do  -- promising+         verAlters <- verifyAlters bumping leader tpos+         case verAlters of+           Right () ->+             if bumping then+               return $ Right $ ReqMove $ vectorToFrom tpos spos+             else do+               msgAddDone tpos "modify"+               return $ Right $ ReqAlter tpos+           Left err -> return $ Left err+         -- Even when bumping, we don't use ReqMove, because we don't want+         -- to hit invisible actors, e.g., hidden in a wall.+         -- If server performed an attack for free+         -- on the invisible actor anyway, the player (or AI)+         -- would be tempted to repeatedly hit random walls+         -- in hopes of killing a monster residing within.+         -- If the action had a cost, misclicks would incur the cost, too.+         -- Right now the player may repeatedly alter tiles trying to learn+         -- about invisible pass-wall actors, but when an actor detected,+         -- it costs a turn and does not harm the invisible actors,+         -- so it's not so tempting.++-- * RunOnceAhead++runOnceAheadHuman :: (MonadClient m, MonadClientUI m)+                  => m (Either MError RequestTimed)+runOnceAheadHuman = do+  side <- getsClient sside+  fact <- getsState $ (EM.! side) . sfactionD+  leader <- getLeaderUI+  keyPressed <- anyKeyPressed+  srunning <- getsSession srunning+  -- When running, stop if disturbed. If not running, stop at once.+  case srunning of+    Nothing -> do+      msgAdd MsgRunStopReason "run stop: nothing to do"+      return $ Left Nothing+    Just RunParams{runMembers}+      | noRunWithMulti fact && runMembers /= [leader] -> do+      msgAdd MsgRunStopReason "run stop: automatic pointman change"+      return $ Left Nothing+    Just _runParams | keyPressed -> do+      discardPressedKey+      msgAdd MsgRunStopReason "run stop: key pressed"+      weaveJust <$> failWith "interrupted"+    Just runParams -> do+      arena <- getArenaUI+      runOutcome <- continueRun arena runParams+      case runOutcome of+        Left stopMsg -> do+          msgAdd MsgRunStopReason ("run stop:" <+> stopMsg)+          return $ Left Nothing+        Right runCmd ->+          return $ Right runCmd++-- * MoveOnceToXhair++moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m)+                     => m (FailOrCmd RequestTimed)+moveOnceToXhairHuman = goToXhair True False++goToXhair :: (MonadClient m, MonadClientUI m)+          => Bool -> Bool -> m (FailOrCmd RequestTimed)+goToXhair initialStep run = do+  aimMode <- getsSession saimMode+  -- Movement is legal only outside aiming mode.+  if isJust aimMode+  then failWith "cannot move in aiming mode"+  else goToXhairExplorationMode initialStep run++goToXhairExplorationMode :: (MonadClient m, MonadClientUI m)+                         => Bool -> Bool -> m (FailOrCmd RequestTimed)+goToXhairExplorationMode initialStep run = do+  xhair <- getsSession sxhair+  xhairGoTo <- getsSession sxhairGoTo+  mfail <-+    if not (isNothing xhairGoTo) && xhairGoTo /= xhair+    then failWith "crosshair position changed"+    else do+      when (isNothing xhairGoTo) $  -- set it up for next steps+        modifySession $ \sess -> sess {sxhairGoTo = xhair}+      goToXhairGoTo initialStep run+  when (isLeft mfail) $+    modifySession $ \sess -> sess {sxhairGoTo = Nothing}+  return mfail++goToXhairGoTo :: (MonadClient m, MonadClientUI m)+              => Bool -> Bool -> m (FailOrCmd RequestTimed)+goToXhairGoTo initialStep run = do+  leader <- getLeaderUI+  b <- getsState $ getActorBody leader+  xhairPos <- xhairToPos+  case xhairPos of+    Nothing -> failWith "crosshair position invalid"+    Just c -> do+      running <- getsSession srunning+      case running of+        -- Don't use running params from previous run or goto-xhair.+        Just paramOld | not initialStep -> do+          arena <- getArenaUI+          runOutcome <- multiActorGoTo arena c paramOld+          case runOutcome of+            Left stopMsg -> return $ Left stopMsg+            Right (finalGoal, dir) ->+              moveRunHuman initialStep finalGoal run False dir+        _ | c == bpos b -> failWith "position reached"+        _ -> do+          let !_A = assert (initialStep || not run) ()+          (bfs, mpath) <- getCacheBfsAndPath leader c+          xhairMoused <- getsSession sxhairMoused+          case mpath of+            _ | xhairMoused && isNothing (accessBfs bfs c) ->+              failWith+                "no route to crosshair (press again to go there anyway)"+            _ | initialStep && adjacent (bpos b) c -> do+              let dir = towards (bpos b) c+              moveRunHuman initialStep True run False dir+            Nothing -> failWith "no route to crosshair"+            Just AndPath{pathList=[]} -> failWith "almost there"+            Just AndPath{pathList = p1 : _} -> do+              let finalGoal = p1 == c+                  dir = towards (bpos b) p1+              moveRunHuman initialStep finalGoal run False dir++multiActorGoTo :: (MonadClient m, MonadClientUI m)+               => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))+multiActorGoTo arena c paramOld =+  case paramOld of+    RunParams{runMembers = []} -> failWith "selected actors no longer there"+    RunParams{runMembers = r : rs, runWaiting} -> do+      onLevel <- getsState $ memActor r arena+      b <- getsState $ getActorBody r+      xhairPos <- xhairToPos+      if not onLevel || xhairPos == Just (bpos b) then do+        let paramNew = paramOld {runMembers = rs}+        multiActorGoTo arena c paramNew+      else do+        sL <- getState+        modifyClient $ updateLeader r sL+        let runMembersNew = rs ++ [r]+            paramNew = paramOld { runMembers = runMembersNew+                                , runWaiting = 0}+        (bfs, mpath) <- getCacheBfsAndPath r c+        xhairMoused <- getsSession sxhairMoused+        case mpath of+          _ | xhairMoused && isNothing (accessBfs bfs c) ->+            failWith "no route to crosshair (press again to go there anyway)"+          Nothing -> failWith "no route to crosshair"+          Just AndPath{pathList=[]} -> failWith "almost there"+          Just AndPath{pathList = p1 : _} -> do+            let finalGoal = p1 == c+                dir = towards (bpos b) p1+            tgts <- getsState $ posToAids p1 arena+            case tgts of+              [] -> do+                modifySession $ \sess -> sess {srunning = Just paramNew}+                return $ Right (finalGoal, dir)+              [target] | target `elem` rs || runWaiting <= length rs ->+                -- Let r wait until all others move. Mark it in runWaiting+                -- to avoid cycles. When all wait for each other, fail.+                multiActorGoTo arena c paramNew{runWaiting=runWaiting + 1}+              _ ->+                failWith "collective running finished"  -- usually OK++-- * RunOnceToXhair++runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)+                    => m (FailOrCmd RequestTimed)+runOnceToXhairHuman = goToXhair True True++-- * ContinueToXhair++continueToXhairHuman :: (MonadClient m, MonadClientUI m)+                     => m (FailOrCmd RequestTimed)+continueToXhairHuman = goToXhair False False{-irrelevant-}++-- * MoveItem++moveItemHuman :: forall m. (MonadClient m, MonadClientUI m)+              => [CStore] -> CStore -> Maybe Text -> Bool+              -> m (FailOrCmd RequestTimed)+moveItemHuman stores destCStore mverb auto = do+  let !_A = assert (destCStore `notElem` stores) ()+  actorCurAndMaxSk <- leaderSkillsClientUI+  if Ability.getSk Ability.SkMoveItem actorCurAndMaxSk > 0+  then moveOrSelectItem stores destCStore mverb auto+  else failSer MoveItemUnskilled++-- This cannot be structured as projecting or applying, with @ByItemMode@+-- and @ChooseItemToMove@, because at least in case of grabbing items,+-- more than one item is chosen, which doesn't fit @sitemSel@. Separating+-- grabbing of multiple items as a distinct command is too high a price.+moveOrSelectItem :: forall m. (MonadClient m, MonadClientUI m)+                 => [CStore] -> CStore -> Maybe Text -> Bool+                 -> m (FailOrCmd RequestTimed)+moveOrSelectItem storesRaw destCStore mverb auto = do+  leader <- getLeaderUI+  b <- getsState $ getActorBody leader+  actorCurAndMaxSk <- leaderSkillsClientUI+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+  let calmE = calmEnough b actorCurAndMaxSk+      overStash = mstash == Just (blid b, bpos b)+      stores = case storesRaw of+        CEqp : rest@(_ : _) | not calmE -> rest ++ [CEqp]+        CGround : rest@(_ : _) | overStash -> rest ++ [CGround]+        _ -> storesRaw+  itemSel <- getsSession sitemSel+  modifySession $ \sess -> sess {sitemSel = Nothing}  -- prevent surprise+  case itemSel of+    _ | stores == [CGround] && overStash ->+      failWith "you can't loot items from your own stash"+    Just (_, fromCStore@CEqp, _) | fromCStore /= destCStore+                                   && fromCStore `elem` stores+                                   && not calmE ->+      failWith "neither the selected item nor any other can be unequipped"+    Just (_, fromCStore@CGround, _) | fromCStore /= destCStore+                                      && fromCStore `elem` stores+                                      && overStash ->+      failWith "you vainly paw through your own hoard"+    Just (iid, fromCStore, _) | fromCStore /= destCStore+                                && fromCStore `elem` stores -> do+      bag <- getsState $ getBodyStoreBag b fromCStore+      case iid `EM.lookup` bag of+        Nothing ->  -- the case of old selection or selection from another actor+          moveOrSelectItem stores destCStore mverb auto+        Just (k, it) -> assert (k > 0) $ do+          let eqpFree = eqpFreeN b+              kToPick | destCStore == CEqp = min eqpFree k+                      | otherwise = k+          if | destCStore == CEqp && not calmE -> failSer ItemNotCalm+             | destCStore == CGround && overStash -> failSer ItemOverStash+             | kToPick == 0 -> failWith "no more items can be equipped"+             | otherwise -> do+               socK <- pickNumber (not auto) kToPick+               case socK of+                 Left Nothing -> moveOrSelectItem stores destCStore mverb auto+                 Left (Just err) -> return $ Left err+                 Right kChosen ->+                   let is = (fromCStore, [(iid, (kChosen, take kChosen it))])+                   in Right <$> moveItems stores is destCStore+    _ -> do+      mis <- selectItemsToMove stores destCStore mverb auto+      case mis of+        Left err -> return $ Left err+        Right (fromCStore, [(iid, _)]) | stores /= [CGround] -> do+          modifySession $ \sess ->+            sess {sitemSel = Just (iid, fromCStore, False)}+          moveOrSelectItem stores destCStore mverb auto+        Right is@(fromCStore, _) ->+          if | fromCStore == CEqp && not calmE -> failSer ItemNotCalm+             | fromCStore == CGround && overStash -> failSer ItemOverStash+             | otherwise -> Right <$> moveItems stores is destCStore++selectItemsToMove :: forall m. (MonadClient m, MonadClientUI m)+                  => [CStore] -> CStore -> Maybe Text -> Bool+                  -> m (FailOrCmd (CStore, [(ItemId, ItemQuant)]))+selectItemsToMove stores destCStore mverb auto = do+  let verb = fromMaybe (verbCStore destCStore) mverb+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  b <- getsState $ getActorBody leader+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+  lastItemMove <- getsSession slastItemMove+  -- 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)+  let calmE = calmEnough b actorCurAndMaxSk+      overStash = mstash == Just (blid b, bpos b)+  if | destCStore == CEqp && not calmE -> failSer ItemNotCalm+     | destCStore == CGround && overStash -> failSer ItemOverStash+     | destCStore == CEqp && eqpOverfull b 1 -> failSer EqpOverfull+     | otherwise -> do+       let storesLast = case lastItemMove of+             Just (lastFrom, lastDest) | lastDest == destCStore+                                         && lastFrom `elem` stores ->+               lastFrom : delete lastFrom stores+             _ -> stores+           prompt = "What to"+           promptEqp = "What consumable to"+           eqpItemsN body =+             let n = sum $ map fst $ EM.elems $ beqp body+             in "(" <> makePhrase [MU.CarWs n "item"]+           ppItemDialogBody body actorSk cCur = case cCur of+             MStore CEqp | not $ calmEnough body actorSk ->+               "distractedly paw at" <+> ppItemDialogModeIn cCur+             MStore CGround | mstash == Just (blid body, bpos body) ->+               "greedily fondle" <+> ppItemDialogModeIn cCur+             _ -> case destCStore of+               CEqp | not $ calmEnough body actorSk ->+                 "distractedly attempt to" <+> verb+                 <+> ppItemDialogModeFrom cCur+               CEqp | eqpOverfull body 1 ->+                 "attempt to fit into equipment" <+> ppItemDialogModeFrom cCur+               CGround | mstash == Just (blid body, bpos body) ->+                 "greedily attempt to" <+> verb <+> ppItemDialogModeFrom cCur+               CEqp -> verb+                       <+> eqpItemsN body <+> "so far)"+                       <+> ppItemDialogModeFrom cCur+               _ -> verb <+> ppItemDialogModeFrom cCur+                    <+> if cCur == MStore CEqp+                        then eqpItemsN body <+> "now)"+                        else ""+           (promptGeneric, psuit) =+             -- We prune item list only for eqp, because other stores don't have+             -- so clear cut heuristics. So when picking up a stash, either grab+             -- it to auto-store things, or equip first using the pruning+             -- and then stash the rest selectively or en masse.+             if destCStore == CEqp+             then (promptEqp, return $ SuitsSomething $ \_ itemFull _kit ->+                    IA.goesIntoEqp $ aspectRecordFull itemFull)+             else (prompt, return SuitsEverything)+       ggi <-+         getFull psuit+                 (\body _ actorSk cCur _ ->+                    prompt <+> ppItemDialogBody body actorSk cCur)+                 (\body _ actorSk cCur _ ->+                    promptGeneric <+> ppItemDialogBody body actorSk cCur)+                 storesLast (not auto) True+       case ggi of+         Right (fromCStore, l) -> do+           modifySession $ \sess ->+             sess {slastItemMove = Just (fromCStore, destCStore)}+           return $ Right (fromCStore, l)+         Left err -> failWith err++moveItems :: forall m. (MonadClient m, MonadClientUI m)+          => [CStore] -> (CStore, [(ItemId, ItemQuant)]) -> CStore+          -> m RequestTimed+moveItems stores (fromCStore, l) destCStore = do+  let !_A = assert (fromCStore /= destCStore && fromCStore `elem` stores) ()+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  b <- getsState $ getActorBody leader+  discoBenefit <- getsClient sdiscoBenefit+  let calmE = calmEnough b actorCurAndMaxSk+      ret4 :: [(ItemId, ItemQuant)] -> Int -> m [(ItemId, Int, CStore, CStore)]+      ret4 [] _ = return []+      ret4 ((iid, (k, _)) : rest) oldN = do+        let !_A = assert (k > 0) ()+            retRec toCStore = do+              let n = oldN + if toCStore == CEqp then k else 0+              l4 <- ret4 rest n+              return $ (iid, k, fromCStore, toCStore) : l4+        if stores == [CGround] && destCStore == CStash  -- normal pickup+        then -- @CStash@ is the implicit default; refine:+             if | not $ benInEqp $ discoBenefit EM.! iid -> retRec CStash+                | eqpOverfull b (oldN + 1) -> do+                  -- Action goes through, but changed, so keep in history.+                  msgAdd MsgActionWarning $+                    "Warning:" <+> showReqFailure EqpOverfull <> "."+                  retRec CStash+                | eqpOverfull b (oldN + k) -> do+                  -- If this stack doesn't fit, we don't equip any part of it,+                  -- but we may equip a smaller stack later of other items+                  -- in the same pickup.+                  msgAdd MsgActionWarning $+                    "Warning:" <+> showReqFailure EqpStackFull <> "."+                  retRec CStash+                | not calmE -> do+                  msgAdd MsgActionWarning $+                    "Warning:" <+> showReqFailure ItemNotCalm <> "."+                  retRec CStash+                | otherwise ->+                  -- Prefer @CEqp@ if all conditions hold:+                  retRec CEqp+        else case destCStore of  -- player forces store, so @benInEqp@ ignored+          CEqp | eqpOverfull b (oldN + 1) -> do+            -- Action aborted, so different colour and not in history.+            msgAdd MsgPromptItems $+              "Failure:" <+> showReqFailure EqpOverfull <> "."+            -- No recursive call here, we exit item manipulation,+            -- but something is moved or else outer functions would not call us.+            return []+          CEqp | eqpOverfull b (oldN + k) -> do+            msgAdd MsgPromptItems $+              "Failure:" <+> showReqFailure EqpStackFull <> "."+            return []+          _ -> retRec destCStore+  l4 <- ret4 l 0+  if null l4+  then error $ "" `showFailure` (stores, fromCStore, l, destCStore)+  else return $! ReqMoveItems l4++-- * Project++projectHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)+projectHuman = do+  curChal <- getsClient scurChal+  actorCurAndMaxSk <- leaderSkillsClientUI+  if | ckeeper curChal ->+       failSer ProjectFinderKeeper+     | Ability.getSk Ability.SkProject actorCurAndMaxSk <= 0 ->+       -- Detailed are check later.+       failSer ProjectUnskilled+     | otherwise -> do+       itemSel <- getsSession sitemSel+       case itemSel of+         Just (_, COrgan, _) -> failWith "can't fling an organ"+         Just (iid, fromCStore, _) -> do+           leader <- getLeaderUI+           b <- getsState $ getActorBody leader+           bag <- getsState $ getBodyStoreBag b fromCStore+           case iid `EM.lookup` bag of+             Nothing -> failWith "no item to fling"+             Just _kit -> do+               itemFull <- getsState $ itemToFull iid+               let i = (fromCStore, (iid, itemFull))+               projectItem i+         Nothing -> failWith "no item to fling"++projectItem :: (MonadClient m, MonadClientUI m)+            => (CStore, (ItemId, ItemFull))+            -> m (FailOrCmd RequestTimed)+projectItem (fromCStore, (iid, itemFull)) = do+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  b <- getsState $ getActorBody leader+  let calmE = calmEnough b actorCurAndMaxSk+  if fromCStore == CEqp && not calmE then failSer ItemNotCalm+  else do+    mpsuitReq <- psuitReq+    case mpsuitReq of+      Left err -> failWith err+      Right psuitReqFun ->+        case psuitReqFun itemFull of+          Left reqFail -> failSer reqFail+          Right (pos, _) -> do+            Benefit{benFling} <- getsClient $ (EM.! iid) . sdiscoBenefit+            go <- if benFling >= 0+                  then displayYesNo ColorFull+                         "The item may be beneficial. Do you really want to fling it?"+                  else return True+            if go then do+              -- Set personal target to enemy, so that AI, if it takes over+              -- the actor, is likely to continue the fight even if the foe+              -- flees. Similarly if the crosshair points at position, etc.+              sxhair <- getsSession sxhair+              modifyClient $ updateTarget leader (const sxhair)+              -- Project.+              eps <- getsClient seps+              return $ Right $ ReqProject pos eps iid fromCStore+            else do+              modifySession $ \sess -> sess {sitemSel = Nothing}+              failWith "never mind"++-- * Apply++applyHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)+applyHuman = do+  actorCurAndMaxSk <- leaderSkillsClientUI+  if Ability.getSk Ability.SkApply+                   actorCurAndMaxSk <= 0 then  -- detailed check later+    failSer ApplyUnskilled+  else do+    itemSel <- getsSession sitemSel+    case itemSel of+      Just (iid, fromCStore, _) -> do+        leader <- getLeaderUI+        b <- getsState $ getActorBody leader+        bag <- getsState $ getBodyStoreBag b fromCStore+        case iid `EM.lookup` bag of+          Nothing -> failWith "no item to trigger"+          Just kit -> do+            itemFull <- getsState $ itemToFull iid+            applyItem (fromCStore, (iid, (itemFull, kit)))+      Nothing -> failWith "no item to trigger"++applyItem :: (MonadClient m, MonadClientUI m)+          => (CStore, (ItemId, ItemFullKit))+          -> m (FailOrCmd RequestTimed)+applyItem (fromCStore, (iid, (itemFull, kit))) = do+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  b <- getsState $ getActorBody leader+  localTime <- getsState $ getLocalTime (blid b)+  let skill = Ability.getSk Ability.SkApply actorCurAndMaxSk+      calmE = calmEnough b actorCurAndMaxSk+      arItem = aspectRecordFull itemFull+  if fromCStore == CEqp && not calmE then failSer ItemNotCalm+  else case permittedApply localTime skill calmE (Just fromCStore)+                           itemFull kit of+    Left reqFail -> failSer reqFail+    Right _ -> do+      Benefit{benApply} <- getsClient $ (EM.! iid) . sdiscoBenefit+      go <-+        if | IA.checkFlag Ability.Periodic arItem+             && not (IA.checkFlag Ability.Durable arItem) ->+             -- No warning if item durable, because activation weak,+             -- but price low, due to no destruction.+             displayYesNo ColorFull+                          "Triggering this periodic item may not produce all its effects (check item description) and moreover, because it's not durable, will destroy it. Are you sure?"+           | benApply < 0 ->+             displayYesNo ColorFull+                          "The item appears harmful. Do you really want to trigger it?"+           | otherwise -> return True+      if go+      then return $ Right $ ReqApply iid fromCStore+      else do+        modifySession $ \sess -> sess {sitemSel = Nothing}+        failWith "never mind"++-- * AlterDir++-- | Ask for a direction and alter a tile, if possible.+alterDirHuman :: (MonadClient m, MonadClientUI m)+              => m (FailOrCmd RequestTimed)+alterDirHuman = pickPoint "modify" >>= \case+  Just p -> alterTileAtPos p+  Nothing -> failWith "never mind"++-- | Try to alter a tile using a feature at the given position.+--+-- We don't check if the tile is interesting, e.g., if any embedded+-- item can be triggered, because the player explicitely requested+-- the action. Consequently, even if all embedded items are recharching,+-- the time will be wasted and the server will describe the failure in detail.+alterTileAtPos :: (MonadClient m, MonadClientUI m)+               => Point+               -> m (FailOrCmd RequestTimed)+alterTileAtPos pos = do+  leader <- getLeaderUI+  sb <- getsState $ getActorBody leader+  let sxhair = Just $ TPoint TUnknown (blid sb) pos+  -- Point xhair to see details with `~`.+  setXHairFromGUI sxhair+  alterCommon False pos++-- | Verify that the tile can be transformed or any embedded item effect+-- triggered and the player is aware if the effect is dangerous or grave,+-- such as ending the game.+verifyAlters :: forall m. (MonadClient m, MonadClientUI m)+             => Bool -> ActorId -> Point -> m (FailOrCmd ())+verifyAlters bumping source tpos = do+  COps{cotile, coTileSpeedup} <- getsState scops+  sb <- getsState $ getActorBody source+  arItem <- getsState $ aspectRecordFromIid $ btrunk sb+  embeds <- getsState $ getEmbedBag (blid sb) tpos+  lvl <- getLevel $ blid sb+  getKind <- getsState $ flip getIidKind+  let embedKindList =+        if IA.checkFlag Ability.Blast arItem+        then []  -- prevent embeds triggering each other in a loop+        else map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)+      underFeet = tpos == bpos sb  -- if enter and alter, be more permissive+      blockedByItem = EM.member tpos (lfloor lvl)+      tile = lvl `at` tpos+      feats = TK.tfeature $ okind cotile tile+      tileActions =+        mapMaybe (Tile.parseTileAction+                    (bproj sb)+                    (underFeet || blockedByItem)  -- avoids AlterBlockItem+                    embedKindList)+                 feats+  if null tileActions+     && blockedByItem+     && not underFeet+     && Tile.isModifiable coTileSpeedup tile+  then failSer AlterBlockItem+  else processTileActions bumping source tpos tileActions++processTileActions :: forall m. (MonadClient m, MonadClientUI m)+                   => Bool -> ActorId -> Point -> [Tile.TileAction]+                   -> m (FailOrCmd ())+processTileActions bumping source tpos tas = do+  COps{coTileSpeedup} <- getsState scops+  getKind <- getsState $ flip getIidKind+  sb <- getsState $ getActorBody source+  lvl <- getLevel $ blid sb+  sar <- getsState $ aspectRecordFromIid $ btrunk sb+  let sourceIsMist = IA.checkFlag Ability.Blast sar+                     && Dice.infDice (IK.idamage $ getKind $ btrunk sb) <= 0+      tileMinSkill = Tile.alterMinSkill coTileSpeedup $ lvl `at` tpos+      processTA :: Maybe Bool -> [Tile.TileAction] -> Bool+                -> m (FailOrCmd (Maybe (Bool, Bool)))+      processTA museResult [] bumpFailed = do+        let useResult = fromMaybe False museResult+        -- No warning will be generated if during explicit modification+        -- an embed is activated but there is not enough tools+        -- for a subsequent transformation. This is fine. Bumping would+        -- produce the warning and S-dir also displays the tool info.+        -- We can't rule out the embed is the main feature and the tool+        -- transformation is not important despite following it.+        -- We don't want spam in such a case.+        return $ Right $ if Tile.isSuspect coTileSpeedup (lvl `at` tpos)+                            || useResult && not bumpFailed+                         then Nothing  -- success of some kind+                         else Just (useResult, bumpFailed)  -- not quite+      processTA museResult (ta : rest) bumpFailed = case ta of+        Tile.EmbedAction (iid, _) -> do+          -- Embeds are activated in the order in tile definition+          -- and never after the tile is changed.+          -- We assume the item would trigger and we let the player+          -- take the risk of wasted turn to verify the assumption.+          -- If the item recharges, the wasted turns let the player wait.+          let useResult = fromMaybe False museResult+          if | sourceIsMist+               || bproj sb && tileMinSkill > 0 ->  -- local skill check+               processTA (Just useResult) rest bumpFailed+                 -- embed won't fire; try others+             | all (not . IK.isEffEscape) (IK.ieffects $ getKind iid) ->+               processTA (Just True) rest False+                 -- no escape checking needed, effect found;+                 -- also bumpFailed reset, because must have been+                 -- marginal if an embed was following it+             | otherwise -> do+               mfail <- verifyEscape+               case mfail of+                 Left err -> return $ Left err+                 Right () -> processTA (Just True) rest False+                   -- effect found, bumpFailed reset+        Tile.ToAction{} ->+          if fromMaybe True museResult+             && not (bproj sb && tileMinSkill > 0)  -- local skill check+          then return $ Right Nothing  -- tile changed, no more activations+          else processTA museResult rest bumpFailed+                 -- failed, but not due to bumping+        Tile.WithAction tools0 _ ->+          if not bumping || null tools0 then+            if fromMaybe True museResult then do+              -- UI requested, so this is voluntary, so item loss is fine.+              kitAssG <- getsState $ kitAssocs source [CGround]+              kitAssE <- getsState $ kitAssocs source [CEqp]+              let kitAss = listToolsToConsume kitAssG kitAssE+                  grps0 = map (\(x, y) -> (False, x, y)) tools0+                    -- apply if durable+                  (_, iidsToApply, grps) =+                    foldl' subtractIidfromGrps (EM.empty, [], grps0) kitAss+              if null grps then do+                let hasEffectOrDmg (_, (_, ItemFull{itemKind})) =+                      IK.idamage itemKind /= 0+                      || any IK.forApplyEffect (IK.ieffects itemKind)+                mfail <- case filter hasEffectOrDmg iidsToApply of+                  [] -> return $ Right ()+                  (store, (_, itemFull)) : _ ->+                    verifyToolEffect (blid sb) store itemFull+                case mfail of+                  Left err -> return $ Left err+                  Right () -> return $ Right Nothing  -- tile changed, done+              else processTA museResult rest bumpFailed  -- not enough tools+            else processTA museResult rest bumpFailed  -- embeds failed+          else processTA museResult rest True  -- failed due to bumping+  mfail <- processTA Nothing tas False+  case mfail of+    Left err -> return $ Left err+    Right Nothing -> return $ Right ()+    Right (Just (useResult, bumpFailed)) -> do+      let !_A = assert (not useResult || bumpFailed) ()+      blurb <- lookAtPosition (blid sb) tpos+      mapM_ (uncurry msgAdd) blurb+      if bumpFailed then do+        revCmd <- revCmdMap+        let km = revCmd AlterDir+            msg = "bumping is not enough to transform this terrain; modify with the '"+                  <> T.pack (K.showKM km)+                  <> "' command instead"+        if useResult then do+          merr <- failMsg msg+          msgAdd MsgPromptAction $ showFailError $ fromJust merr+          return $ Right ()  -- effect the embed activation, though+        else failWith msg+      else failWith "unable to activate nor modify at this time"+        -- related to, among others, @SfxNoItemsForTile@ on the server++verifyEscape :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ())+verifyEscape = do+  side <- getsClient sside+  fact <- getsState $ (EM.! side) . sfactionD+  if not (MK.fcanEscape $ gplayer fact)+  then failWith+         "This is the way out, but where would you go in this alien world?"+           -- exceptionally a full sentence, because a real question+  else do+    (_, total) <- getsState $ calculateTotal side+    dungeonTotal <- getsState sgold+    let prompt | dungeonTotal == 0 =+                 "You finally reached the way out. Really leave now?"+               | total == 0 =+                 "Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?"+               | total < dungeonTotal =+                 "You've finally found the way out, but you didn't gather all valuables rumoured to be laying around. Really leave already?"+               | otherwise =+                 "This is the way out and you collected all treasure there is to find. Really leave now?"+    -- The player can back off, but we never insist,+    -- because possibly the score formula doesn't reward treasure+    -- or he is focused on winning only.+    go <- displayYesNo ColorBW prompt+    if not go+    then failWith "here's your chance"+    else return $ Right ()++verifyToolEffect :: (MonadClient m, MonadClientUI m)+                 => LevelId -> CStore -> ItemFull -> m (FailOrCmd ())+verifyToolEffect lid store itemFull = do+  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui+  side <- getsClient sside+  localTime <- getsState $ getLocalTime lid+  factionD <- getsState sfactionD+  let (name1, powers) = partItemShort rwidth side factionD localTime+                                      itemFull quantSingle+      objectA = makePhrase [MU.AW name1, powers]+      prompt = "Do you really want to transform the terrain using"+               <+> objectA <+> ppCStoreIn store+               <+> "that may cause substantial side-effects?"+      objectThe = makePhrase ["the", name1]+  go <- displayYesNo ColorBW prompt+  if not go+  then failWith $ "replace" <+> objectThe <+> "and try again"+         -- question capitalized and ended with a dot, answer neither+  else return $ Right ()++-- * AlterWithPointer++-- | Try to alter a tile using a feature under the pointer.+alterWithPointerHuman :: (MonadClient m, MonadClientUI m)+                      => m (FailOrCmd RequestTimed)+alterWithPointerHuman = do+  COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops+  pUI <- getsSession spointer+  let p@(Point px py) = squareToMap $ uiToSquare pUI+  if px >= 0 && py >= 0 && px < rXmax && py < rYmax+  then alterTileAtPos p+  else failWith "never mind"++-- * CloseDir++-- | Close nearby open tile; ask for direction, if there is more than one.+closeDirHuman :: (MonadClient m, MonadClientUI m)+              => m (FailOrCmd RequestTimed)+closeDirHuman = do+  COps{coTileSpeedup} <- getsState scops+  leader <- getLeaderUI+  b <- getsState $ getActorBody leader+  lvl <- getLevel $ blid b+  let vPts = vicinityUnsafe $ bpos b+      openPts = filter (Tile.isClosable coTileSpeedup . at lvl) vPts+  case openPts of+    []  -> failSer CloseNothing+    [o] -> closeTileAtPos o+    _   -> pickPoint "close" >>= \case+      Nothing -> failWith "never mind"+      Just p -> closeTileAtPos p++-- | Close tile at given position.+closeTileAtPos :: (MonadClient m, MonadClientUI m)+               => Point -> m (FailOrCmd RequestTimed)+closeTileAtPos tpos = do+  COps{coTileSpeedup} <- getsState scops+  leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI+  b <- getsState $ getActorBody leader+  alterable <- getsState $ tileAlterable (blid b) tpos+  lvl <- getLevel $ blid b+  let alterSkill = Ability.getSk Ability.SkAlter actorCurAndMaxSk+      t = lvl `at` tpos+      isOpen = Tile.isClosable coTileSpeedup t+      isClosed = Tile.isOpenable coTileSpeedup t+  case (alterable, isClosed, isOpen) of+    (False, _, _) -> failSer CloseNothing+    (True, False, False) -> failSer CloseNonClosable+    (True, True,  False) -> failSer CloseClosed+    (True, True,  True) -> error "TileKind content validation"+    (True, False, True) ->+      if | tpos `chessDist` bpos b > 1+          -> failSer CloseDistant+         | alterSkill <= 1+          -> failSer AlterUnskilled+         | EM.member tpos $ lfloor lvl+          -> failSer AlterBlockItem+         | occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl+          -> failSer AlterBlockActor+         | otherwise+          -> do+             msgAddDone tpos "close"+             return $ Right (ReqAlter tpos)++-- | Adds message with proper names.+msgAddDone :: (MonadClient m, MonadClientUI m) => Point -> Text -> m ()+msgAddDone p verb = do+  COps{cotile} <- getsState scops+  leader <- getLeaderUI+  b <- getsState $ getActorBody leader+  lvl <- getLevel $ blid b+  let tname = TK.tname $ okind cotile $ lvl `at` p+      s = case T.words tname of+            [] -> "thing"+            ("open" : xs) -> T.unwords xs+            _ -> tname+      v = p `vectorToFrom` bpos b+      dir | v == Vector 0 0 = "underneath"+          | otherwise = compassText v+  msgAdd MsgActionComplete $ "You" <+> verb <+> "the" <+> s <+> dir <> "."++-- | Prompts user to pick a point.+pickPoint :: (MonadClient m, MonadClientUI m) => Text -> m (Maybe Point)+pickPoint verb = do+  leader <- getLeaderUI+  b <- getsState $ getActorBody leader+  UIOptions{uVi, uLeftHand} <- getsSession sUIOptions+  let dirKeys = K.dirAllKey uVi uLeftHand+      keys = K.escKM+           : K.leftButtonReleaseKM+           : map (K.KM K.NoModifier) dirKeys+  msgAdd MsgPromptGeneric $ "Where to" <+> verb <> "? [movement key] [pointer]"+  slides <- reportToSlideshow [K.escKM]+  km <- getConfirms ColorFull keys slides+  case K.key km of+    K.LeftButtonRelease -> do+      pUI <- getsSession spointer+      let p = squareToMap $ uiToSquare pUI+      return $ Just p+    _ -> return $ shift (bpos b) <$> K.handleDir dirKeys km++-- * Help++-- | Display command help.+helpHuman :: (MonadClient m, MonadClientUI m)+          => (K.KM -> HumanCmd -> m (Either MError ReqUI))+          -> m (Either MError ReqUI)+helpHuman cmdSemInCxtOfKM = do+  ccui@CCUI{coinput, coscreen=ScreenContent{rwidth, rheight, rintroScreen}}+    <- getsSession sccui+  fontSetup@FontSetup{..} <- getFontSetup+  gameModeId <- getsState sgameModeId+  modeOv <- describeMode True gameModeId+  let modeH = ( "Press SPACE or PGDN to advance or ESC to see the map again."+              , (modeOv, []) )+      keyH = keyHelp ccui fontSetup+      -- This takes a list of paragraphs and returns a list of screens.+      -- Both paragraph and screen is a list of lines.+      --+      -- This would be faster, but less clear, if paragraphs were stored+      -- reversed in content. Not worth it, until we have huge manuals+      -- or run on weak mobiles. Even then, precomputation during+      -- compilation may be better.+      --+      -- Empty lines may appear at the end of pages, but it's fine,+      -- it means there is a new section on the next page.+      packIntoScreens :: [[String]] -> [[String]] -> Int -> [[String]]+      packIntoScreens [] acc _ = [intercalate [""] (reverse acc)]+      packIntoScreens ([] : ls) [] _  =+        -- Ignore empty paragraphs at the start of screen.+        packIntoScreens ls [] 0+      packIntoScreens (l : ls) [] h = assert (h == 0) $+        -- If a paragraph, even alone, is longer than screen height, it's split.+        if length l <= rheight - 3+        then packIntoScreens ls [l] (length l)+        else let (screen, rest) = splitAt (rheight - 3) l+             in screen : packIntoScreens (rest : ls) [] 0+      packIntoScreens (l : ls) acc h =+        -- The extra @+ 1@ comes from the empty line separating paragraphs,+        -- as added in @intercalate@.+        if length l + 1 + h <= rheight - 3+        then packIntoScreens ls (l : acc) (length l + 1 + h)+        else intercalate [""] (reverse acc) : packIntoScreens (l : ls) [] 0+      manualScreens = packIntoScreens (snd rintroScreen) [] 0+      shiftPointUI x (PointUI x0 y0) = PointUI (x0 + x) y0+      sideBySide =+        if isSquareFont monoFont+        then \(screen1, screen2) ->  -- single column, two screens+          map offsetOverlay $ filter (not . null) [screen1, screen2]+        else \(screen1, screen2) ->  -- two columns, single screen+          [offsetOverlay screen1+           ++ map (first $ shiftPointUI rwidth) (offsetOverlay screen2)]+      listPairs (a : b : rest) = (a, b) : listPairs rest+      listPairs [a] = [(a, [])]+      listPairs [] = []+      -- Each screen begins with an empty line, to separate the header.+      manualOvs = map (EM.singleton monoFont)+                  $ concatMap sideBySide $ listPairs+                  $ map ((emptyAttrLine :) . map stringToAL) manualScreens+      addMnualHeader ov =+        ( "Showing PLAYING.md (best viewed in the browser)."+        , (ov, []) )+      manualH = map addMnualHeader manualOvs+      splitHelp (t, okx) = splitOKX fontSetup True rwidth rheight rwidth+                                    (textToAS t) [K.spaceKM, K.escKM] okx+      sli = toSlideshow fontSetup $ concat $ map splitHelp+            $ modeH : keyH ++ manualH+  -- Thus, the whole help menu corresponds to a single menu of item or lore,+  -- e.g., shared stash menu. This is especially clear when the shared stash+  -- menu contains many pages.+  ekm <- displayChoiceScreen "help" ColorFull True sli [K.spaceKM, K.escKM]+  case ekm of+    Left km | km `elem` [K.escKM, K.spaceKM] -> return $ Left Nothing+    Left km -> case km `M.lookup` bcmdMap coinput of+      Just (_desc, _cats, cmd) -> cmdSemInCxtOfKM km cmd+      Nothing -> weaveJust <$> failWith "never mind"+    Right _slot -> error $ "" `showFailure` ekm++-- * Hint++-- | Display hint or, if already displayed, display help.+hintHuman :: (MonadClient m, MonadClientUI m)+          => (K.KM -> HumanCmd -> m (Either MError ReqUI))+          -> m (Either MError ReqUI)+hintHuman cmdSemInCxtOfKM = do+  sreportNull <- getsSession sreportNull+  if sreportNull then do+    promptMainKeys+    return $ Left Nothing+  else+    helpHuman cmdSemInCxtOfKM++-- * Dashboard++-- | Display the dashboard.+dashboardHuman :: (MonadClient m, MonadClientUI m)+               => (K.KM -> HumanCmd -> m (Either MError ReqUI))+               -> m (Either MError ReqUI)+dashboardHuman cmdSemInCxtOfKM = do+  CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui+  fontSetup@FontSetup{..} <- getFontSetup+  let offsetCol2 = 2+      (ov0, kxs0) = okxsN coinput monoFont propFont 0 offsetCol2 (const False)+                          False CmdDashboard ([], [], []) ([], [])+      al1 = textToAS "Dashboard"+  let splitHelp (al, okx) = splitOKX fontSetup False rwidth (rheight - 2) rwidth+                                     al [K.escKM] okx+      sli = toSlideshow fontSetup $ splitHelp (al1, (ov0, kxs0))+      extraKeys = [K.escKM]+  ekm <- displayChoiceScreen "dashboard" ColorFull False sli extraKeys+  case ekm of+    Left km -> case km `M.lookup` bcmdMap coinput of+      _ | km == K.escKM -> weaveJust <$> failWith "never mind"+      Just (_desc, _cats, cmd) -> cmdSemInCxtOfKM km cmd+      Nothing -> weaveJust <$> failWith "never mind"+    Right _slot -> error $ "" `showFailure` ekm++-- * ItemMenu++itemMenuHuman :: (MonadClient m, MonadClientUI m)+              => (K.KM -> HumanCmd -> m (Either MError ReqUI))+              -> m (Either MError ReqUI)+itemMenuHuman cmdSemInCxtOfKM = do+  itemSel <- getsSession sitemSel+  fontSetup@FontSetup{..} <- getFontSetup+  case itemSel of+    Just (iid, fromCStore, _) -> do+      leader <- getLeaderUI+      b <- getsState $ getActorBody leader+      bUI <- getsSession $ getActorUI leader+      bag <- getsState $ getBodyStoreBag b fromCStore+      case iid `EM.lookup` bag of+        Nothing -> weaveJust <$> failWith "no item to open item menu for"+        Just kit -> do+          CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui+          actorCurAndMaxSk <- leaderSkillsClientUI+          itemFull <- getsState $ itemToFull iid+          localTime <- getsState $ getLocalTime (blid b)+          found <- getsState $ findIid leader (bfid b) iid+          factionD <- getsState sfactionD+          jlid <- getsSession $ (EM.! iid) . sitemUI+          let !_A = assert (not (null found) || fromCStore == CGround+                            `blame` (iid, leader)) ()+              fAlt (aid, (_, store)) = aid /= leader || store /= fromCStore+              foundAlt = filter fAlt found+              partRawActor aid = getsSession (partActor . getActorUI aid)+              ppLoc aid store = do+                parts <- ppContainerWownW partRawActor+                                          False+                                          (CActor aid store)+                return $! "[" ++ T.unpack (makePhrase parts) ++ "]"+          foundTexts <- mapM (\(aid, (_, store)) -> ppLoc aid store) foundAlt+          let foundPrefix = textToAS $+                if null foundTexts then "" else "The item is also in:"+              markParagraphs = rheight >= 45+              descAl = itemDesc rwidth markParagraphs (bfid b) factionD+                                (Ability.getSk Ability.SkHurtMelee+                                               actorCurAndMaxSk)+                                fromCStore localTime jlid itemFull kit+              (descSymAl, descBlurbAl) = span (/= Color.spaceAttrW32) descAl+              descSym = offsetOverlay $ splitAttrString rwidth rwidth descSymAl+              descBlurb = offsetOverlayX $+                case splitAttrString rwidth rwidth+                     $ stringToAS "xx" ++ descBlurbAl of+                  [] -> error "splitting AttrString loses characters"+                  al1 : rest ->+                    (2, attrStringToAL $ drop 2 $ attrLine al1) : map (0,) rest+              alPrefix = map (\(PointUI x y, al) ->+                                (PointUI x (y + length descBlurb), al))+                         $ offsetOverlay+                         $ splitAttrString rwidth rwidth foundPrefix+              ystart = length descBlurb + length alPrefix - 1+              xstart = textSize monoFont (Color.spaceAttrW32+                                          : attrLine (snd $ last alPrefix))+              foundKeys = map (K.KM K.NoModifier . K.Fun)+                              [1 .. length foundAlt]  -- starting from 1!+          let ks = zip foundKeys foundTexts+              width = if isSquareFont monoFont then 2 * rwidth else rwidth+              (ovFoundRaw, kxsFound) = wrapOKX monoFont ystart xstart width ks+              ovFound = alPrefix ++ ovFoundRaw+          report <- getReportUI True+          CCUI{coinput} <- getsSession sccui+          mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+          let calmE = calmEnough b actorCurAndMaxSk+              greyedOut cmd = not calmE && fromCStore == CEqp+                              || mstash == Just (blid b, bpos b)+                                 && fromCStore == CGround+                              || case cmd of+                ByAimMode AimModeCmd{..} ->+                  greyedOut exploration || greyedOut aiming+                ComposeIfLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2+                ComposeUnlessError cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2+                Compose2ndLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2+                MoveItem stores destCStore _ _ ->+                  fromCStore `notElem` stores+                  || destCStore == CEqp && (not calmE || eqpOverfull b 1)+                  || destCStore == CGround && mstash == Just (blid b, bpos b)+                Apply{} ->+                  let skill = Ability.getSk Ability.SkApply actorCurAndMaxSk+                  in not $ either (const False) id+                     $ permittedApply localTime skill calmE (Just fromCStore)+                                      itemFull kit+                Project{} ->+                  let skill = Ability.getSk Ability.SkProject actorCurAndMaxSk+                  in not $ either (const False) id+                     $ permittedProject False skill calmE itemFull+                _ -> False+              fmt n k h = " " <> T.justifyLeft n ' ' k <> " " <> h+              offsetCol2 = 11+              keyCaption = fmt offsetCol2 "keys" "command"+              offset = 1 + maxYofOverlay (descBlurb ++ ovFound)+              (ov0, kxs0) = okxsN coinput monoFont propFont offset offsetCol2+                                  greyedOut True CmdItemMenu+                                  ([], [], ["", keyCaption]) ([], [])+              t0 = makeSentence [ MU.SubjectVerbSg (partActor bUI) "choose"+                                , "an item", MU.Text $ ppCStoreIn fromCStore ]+              alRep = foldr (<+:>) [] $ renderReport True report+              al1 | null alRep = textToAS t0+                  | otherwise = alRep ++ stringToAS "\n" ++ textToAS t0+              splitHelp (al, okx) =+                splitOKX fontSetup False rwidth (rheight - 2) rwidth al+                         [K.spaceKM, K.escKM] okx+              sli = toSlideshow fontSetup+                    $ splitHelp ( al1+                                , ( EM.insertWith (++) squareFont descSym+                                    $ EM.insertWith (++) propFont descBlurb+                                    $ EM.insertWith (++) monoFont ovFound ov0+                                        -- mono font, because there are buttons+                                  , kxsFound ++ kxs0 ))+              extraKeys = [K.spaceKM, K.escKM] ++ foundKeys+          recordHistory  -- report shown (e.g., leader switch), save to history+          ekm <- displayChoiceScreen "item menu" ColorFull False sli extraKeys+          case ekm of+            Left km -> case km `M.lookup` bcmdMap coinput of+              _ | km == K.escKM -> weaveJust <$> failWith "never mind"+              _ | km == K.spaceKM -> weaveJust <$> failWith "back to list"+              _ | km `elem` foundKeys -> case km of+                K.KM{key=K.Fun n} -> do+                  let (newAid, (bNew, newCStore)) = foundAlt !! (n - 1)+                  fact <- getsState $ (EM.! bfid bNew) . sfactionD+                  let (autoDun, _) = autoDungeonLevel fact+                  if | blid bNew /= blid b && autoDun ->+                       weaveJust <$> failSer NoChangeDunLeader+                     | otherwise -> do+                       void $ pickLeader True newAid+                       modifySession $ \sess ->+                         sess {sitemSel = Just (iid, newCStore, False)}+                       itemMenuHuman cmdSemInCxtOfKM+                _ -> error $ "" `showFailure` km+              Just (_desc, _cats, cmd) -> do+                modifySession $ \sess ->+                  sess {sitemSel = Just (iid, fromCStore, True)}+                cmdSemInCxtOfKM km cmd+              Nothing -> weaveJust <$> failWith "never mind"+            Right _slot -> error $ "" `showFailure` ekm+    Nothing -> weaveJust <$> failWith "no item to open item menu for"++-- * ChooseItemMenu++chooseItemMenuHuman :: (MonadClient m, MonadClientUI m)+                    => (K.KM -> HumanCmd -> m (Either MError ReqUI))+                    -> ItemDialogMode+                    -> m (Either MError ReqUI)+chooseItemMenuHuman cmdSemInCxtOfKM c0 = do+  let chooseItemMenu c1 = do+        res <- chooseItemDialogMode True c1+        case res of+          Right c2 -> do+            res2 <- itemMenuHuman cmdSemInCxtOfKM+            backToList <- failMsg "back to list"+            case res2 of+              Left err | err == backToList -> chooseItemMenu c2+              _ -> return res2+          Left err -> return $ Left $ Just err+  chooseItemMenu c0++-- * MainMenu++generateMenu :: (MonadClient m, MonadClientUI m)+             => (K.KM -> HumanCmd -> m (Either MError ReqUI))+             -> [(DisplayFont, [AttrLine])]+             -> [(K.KM, (Text, HumanCmd))]+             -> [String]+             -> String+             -> m (Either MError ReqUI)+generateMenu cmdSemInCxtOfKM blurb kds gameInfo menuName = do+  COps{corule} <- getsState scops+  CCUI{coscreen=ScreenContent{rwidth, rheight, rwebAddress}} <-+    getsSession sccui+  FontSetup{..} <- getFontSetup+  let bindings =  -- key bindings to display+        let fmt (k, (d, _)) =+              ( Just k+              , T.unpack+                $  T.justifyLeft 3 ' ' (T.pack $ K.showKM k) <> " " <> d )+        in map fmt kds+      generate :: Int -> (Maybe K.KM, String) -> ((Int, AttrLine), Maybe KYX)+      generate y (mkey, binding) =+        let lenB = length binding+            yxx key = (Left [key], ( PointUI 2 y+                                   , ButtonWidth squareFont lenB ))+            myxx = yxx <$> mkey+        in ((2, stringToAL binding), myxx)+      titleLine = rtitle corule ++ " "+                  ++ showVersion (rexeVersion corule) ++ " "+      rawLines = zip (repeat Nothing)+                     (["", titleLine ++ "[" ++ rwebAddress ++ "]", ""]+                      ++ gameInfo)+                 ++ bindings+      (menuOvLines, mkyxs) = unzip $ zipWith generate [0..] rawLines+      browserKey = ( Right $ SlotChar 1042 'a'+                   , ( PointUI (2 + 2 * length titleLine) 1+                     , ButtonWidth squareFont (2 + length rwebAddress) ) )+      kyxs = browserKey : catMaybes mkyxs+      introLen = sum $ map (length . snd) blurb+      start0 = max 0 (rheight - introLen+                      - if isSquareFont propFont then 1 else 2)+      shiftPointUI (PointUI x0 y0) = PointUI (x0 + rwidth) y0+      ov0 = EM.map (map (first shiftPointUI)) $ attrLinesToFontMap start0 blurb+      ov = EM.insertWith (++) squareFont (offsetOverlayX menuOvLines) ov0+  menuIxMap <- getsSession smenuIxMap+  unless (menuName `M.member` menuIxMap) $+    modifySession $ \sess -> sess {smenuIxMap = M.insert menuName 1 menuIxMap}+  ekm <- displayChoiceScreen menuName ColorFull True+                             (menuToSlideshow (ov, kyxs)) [K.escKM]+  case ekm of+    Left km -> case km `lookup` kds of+      Just (_desc, cmd) -> cmdSemInCxtOfKM km cmd+      Nothing -> weaveJust <$> failWith "never mind"+    Right (SlotChar 1042 'a') -> do+      success <- tryOpenBrowser rwebAddress+      if success+      then generateMenu cmdSemInCxtOfKM blurb kds gameInfo menuName+      else weaveJust <$> failWith "failed to open web browser"+    Right _slot -> error $ "" `showFailure` ekm++-- | Display the main menu.+mainMenuHuman :: (MonadClient m, MonadClientUI m)+              => (K.KM -> HumanCmd -> m (Either MError ReqUI))+              -> m (Either MError ReqUI)+mainMenuHuman cmdSemInCxtOfKM = do+  CCUI{ coinput=InputContent{bcmdList}+      , coscreen=ScreenContent{rintroScreen} } <- getsSession sccui+  FontSetup{propFont} <- getFontSetup+  gameMode <- getGameMode+  curChal <- getsClient scurChal+  let offOn b = if b then "on" else "off"+      tcurDiff   = "   with difficulty:" <+> tshow (cdiff curChal)+      tcurFish   = "       cold fish:" <+> offOn (cfish curChal)+      tcurGoods  = "     ready goods:" <+> offOn (cgoods curChal)+      tcurWolf   = "       lone wolf:" <+> offOn (cwolf curChal)+      tcurKeeper = "   finder keeper:" <+> offOn (ckeeper curChal)+      -- Key-description-command tuples.+      kds = [(km, (desc, cmd)) | (km, ([CmdMainMenu], desc, cmd)) <- bcmdList]+      gameName = MK.mname gameMode+      gameInfo = map T.unpack+                   [ "Now playing:" <+> gameName+                   , ""+                   , tcurDiff+                   , tcurFish+                   , tcurGoods+                   , tcurWolf+                   , tcurKeeper+                   , "" ]+      glueLines (l1 : l2 : rest) =+        if | null l1 -> l1 : glueLines (l2 : rest)+           | null l2 -> l1 : l2 : glueLines rest+           | otherwise -> (l1 ++ l2) : glueLines rest+      glueLines ll = ll+      backstory | isSquareFont propFont = fst rintroScreen+                | otherwise = glueLines $ fst rintroScreen+      backstoryAL = map stringToAL $ map (dropWhile (== ' ')) backstory+  generateMenu cmdSemInCxtOfKM [(propFont, backstoryAL)] kds gameInfo "main"++-- * MainMenuAutoOn++-- | Display the main menu and set @swasAutomated@.+mainMenuAutoOnHuman :: (MonadClient m, MonadClientUI m)+                    => (K.KM -> HumanCmd -> m (Either MError ReqUI))+                    -> m (Either MError ReqUI)+mainMenuAutoOnHuman cmdSemInCxtOfKM = do+  modifySession $ \sess -> sess {swasAutomated = True}+  mainMenuHuman cmdSemInCxtOfKM++-- * MainMenuAutoOff++-- | Display the main menu and unset @swasAutomated@.+mainMenuAutoOffHuman :: (MonadClient m, MonadClientUI m)+                     => (K.KM -> HumanCmd -> m (Either MError ReqUI))+                     -> m (Either MError ReqUI)+mainMenuAutoOffHuman cmdSemInCxtOfKM = do+  modifySession $ \sess -> sess {swasAutomated = False}+  mainMenuHuman cmdSemInCxtOfKM++-- * SettingsMenu++-- | Display the settings menu.+settingsMenuHuman :: (MonadClient m, MonadClientUI m)+                  => (K.KM -> HumanCmd -> m (Either MError ReqUI))+                  -> m (Either MError ReqUI)+settingsMenuHuman cmdSemInCxtOfKM = do+  markSuspect <- getsClient smarkSuspect+  markVision <- getsSession smarkVision+  markSmell <- getsSession smarkSmell+  noAnim <- getsClient $ fromMaybe False . snoAnim . soptions+  side <- getsClient sside+  factDoctrine <- getsState $ MK.fdoctrine . gplayer . (EM.! side) . sfactionD+  overrideTut <- getsSession soverrideTut+  let offOn b = if b then "on" else "off"+      offOnUnset mb = case mb of+        Nothing -> "no override"+        Just b -> if b then "force on" else "force off"+      offOnAll n = case n of+        0 -> "none"+        1 -> "untried"+        2 -> "all"+        _ -> error $ "" `showFailure` n+      tsuspect = "mark suspect terrain:" <+> offOnAll markSuspect+      tvisible = "show visible zone:" <+> offOn markVision+      tsmell = "display smell clues:" <+> offOn markSmell+      tanim = "play animations:" <+> offOn (not noAnim)+      tdoctrine = "squad doctrine:" <+> Ability.nameDoctrine factDoctrine+      toverride = "override tutorial hints:" <+> offOnUnset overrideTut+      -- Key-description-command tuples.+      kds = [ (K.mkKM "s", (tsuspect, MarkSuspect))+            , (K.mkKM "v", (tvisible, MarkVision))+            , (K.mkKM "c", (tsmell, MarkSmell))+            , (K.mkKM "a", (tanim, MarkAnim))+            , (K.mkKM "t", (tdoctrine, Doctrine))+            , (K.mkKM "o", (toverride, OverrideTut))+            , (K.mkKM "Escape", ("back to main menu", MainMenu)) ]+      gameInfo = map T.unpack+                   [ "Tweak convenience settings:"+                   , "" ]+  generateMenu cmdSemInCxtOfKM [] kds gameInfo "settings"++-- * ChallengeMenu++-- | Display the challenge menu.+challengeMenuHuman :: (MonadClient m, MonadClientUI m)+                    => (K.KM -> HumanCmd -> m (Either MError ReqUI))+                    -> m (Either MError ReqUI)+challengeMenuHuman cmdSemInCxtOfKM = do+  cops <- getsState scops+  CCUI{coscreen=ScreenContent{rwidth, rwrap}} <- getsSession sccui+  FontSetup{..} <- getFontSetup+  svictories <- getsClient svictories+  snxtScenario <- getsSession snxtScenario+  nxtTutorial <- getsSession snxtTutorial+  overrideTut <- getsSession soverrideTut+  nxtChal <- getsClient snxtChal+  let (gameModeId, gameMode) = nxtGameMode cops snxtScenario+      victories = case EM.lookup gameModeId svictories of+        Nothing -> 0+        Just cm -> fromMaybe 0 (M.lookup nxtChal cm)+      star t = if victories > 0 then "*" <> t else t+      tnextScenario = "adventure:" <+> star (MK.mname gameMode)+      offOn b = if b then "on" else "off"+      starTut t = if isJust overrideTut then "*" <> t else t+      displayTutorialHints = fromMaybe nxtTutorial overrideTut+      tnextTutorial = "tutorial hints (in pink):"+                      <+> starTut (offOn displayTutorialHints)+      tnextDiff = "difficulty (lower easier):" <+> tshow (cdiff nxtChal)+      tnextFish   = "cold fish (rather hard):"+                    <+> offOn (cfish nxtChal)+      tnextGoods  = "ready goods (hard):"+                    <+> offOn (cgoods nxtChal)+      tnextWolf   = "lone wolf (very hard):"+                    <+> offOn (cwolf nxtChal)+      tnextKeeper = "finder keeper (hard):"+                    <+> offOn (ckeeper nxtChal)+      -- Key-description-command tuples.+      kds = [ (K.mkKM "s", (tnextScenario, GameScenarioIncr))+            , (K.mkKM "t", (tnextTutorial, GameTutorialToggle))+            , (K.mkKM "d", (tnextDiff, GameDifficultyIncr))+            , (K.mkKM "f", (tnextFish, GameFishToggle))+            , (K.mkKM "r", (tnextGoods, GameGoodsToggle))+            , (K.mkKM "w", (tnextWolf, GameWolfToggle))+            , (K.mkKM "k", (tnextKeeper, GameKeeperToggle))+            , (K.mkKM "g", ("start new game", GameRestart))+            , (K.mkKM "Escape", ("back to main menu", MainMenu)) ]+      gameInfo = map T.unpack [ "Setup and start new game:"+                              , "" ]+      widthProp = if isSquareFont propFont+                  then rwidth `div` 2+                  else min rwrap (rwidth - 2)+      widthMono = if isSquareFont propFont+                  then rwidth `div` 2+                  else rwidth - 2+      duplicateEOL '\n' = "\n\n"+      duplicateEOL c = T.singleton c+      blurb =+        [ ( propFont+          , splitAttrString widthProp widthProp+            $ textFgToAS Color.BrBlack+            $ T.concatMap duplicateEOL (MK.mdesc gameMode)+              <> "\n\n" )+        , ( monoFont+          , splitAttrString widthMono widthMono+            $ textToAS+            $ MK.mrules gameMode+              <> "\n\n" )+        , ( propFont+          , splitAttrString widthProp widthProp+            $ textToAS+            $ T.concatMap duplicateEOL (MK.mreason gameMode) )+        ]+  generateMenu cmdSemInCxtOfKM blurb kds gameInfo "challenge"++-- * GameTutorialToggle++gameTutorialToggle :: MonadClientUI m  => m ()+gameTutorialToggle = do+  nxtTutorial <- getsSession snxtTutorial+  overrideTut <- getsSession soverrideTut+  let displayTutorialHints = fromMaybe nxtTutorial overrideTut+  modifySession $ \sess -> sess { snxtTutorial = not displayTutorialHints+                                , soverrideTut = Nothing }++-- * GameDifficultyIncr++gameDifficultyIncr :: MonadClient m => m ()+gameDifficultyIncr = do+  nxtDiff <- getsClient $ cdiff . snxtChal+  let delta = -1+      d | nxtDiff + delta > difficultyBound = 1+        | nxtDiff + delta < 1 = difficultyBound+        | otherwise = nxtDiff + delta+  modifyClient $ \cli -> cli {snxtChal = (snxtChal cli) {cdiff = d} }++-- * GameFishToggle++gameFishToggle :: MonadClient m => m ()+gameFishToggle =+  modifyClient $ \cli ->+    cli {snxtChal = (snxtChal cli) {cfish = not (cfish (snxtChal cli))} }++-- * GameGoodsToggle++gameGoodsToggle :: MonadClient m => m ()+gameGoodsToggle =+  modifyClient $ \cli ->+    cli {snxtChal = (snxtChal cli) {cgoods = not (cgoods (snxtChal cli))} }++-- * GameWolfToggle++gameWolfToggle :: MonadClient m => m ()+gameWolfToggle =+  modifyClient $ \cli ->+    cli {snxtChal = (snxtChal cli) {cwolf = not (cwolf (snxtChal cli))} }++-- * GameKeeperToggle++gameKeeperToggle :: MonadClient m => m ()+gameKeeperToggle =+  modifyClient $ \cli ->+    cli {snxtChal = (snxtChal cli) {ckeeper = not (ckeeper (snxtChal cli))} }++-- * GameScenarioIncr++gameScenarioIncr :: (MonadClient m, MonadClientUI m) => m ()+gameScenarioIncr = do+  cops <- getsState scops+  oldScenario <- getsSession snxtScenario+  let snxtScenario = oldScenario + 1+      snxtTutorial = MK.mtutorial $ snd $ nxtGameMode cops snxtScenario+  modifySession $ \sess -> sess {snxtScenario, snxtTutorial}++-- * GameRestart++gameRestartHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)+gameRestartHuman = do+  cops <- getsState scops+  noConfirmsGame <- isNoConfirmsGame+  gameMode <- getGameMode+  snxtScenario <- getsSession snxtScenario+  let nxtGameName = MK.mname $ snd $ nxtGameMode cops snxtScenario+  b <- if noConfirmsGame+       then return True+       else displayYesNo ColorBW+            $ "You just requested a new" <+> nxtGameName+              <+> "game. The progress of the ongoing" <+> MK.mname gameMode+              <+> "game will be lost! Are you sure?"+  if b+  then do+    snxtChal <- getsClient snxtChal+    -- This ignores all but the first word of game mode names picked+    -- via main menu and assumes the fist word of such game modes+    -- is present in their frequencies.+    let (mainName, _) = T.span (\c -> Char.isAlpha c || c == ' ') nxtGameName+        nxtGameGroup = GroupName $ T.intercalate " " $ take 2 $ T.words mainName+    return $ Right $ ReqUIGameRestart nxtGameGroup snxtChal+  else do+    msg2 <- rndToActionUI $ oneOf+              [ "yea, would be a pity to leave them to die"+              , "yea, a shame to get your team stranded" ]+    failWith msg2++-- * GameQuit++-- TODO: deduplicate with gameRestartHuman+gameQuitHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)+gameQuitHuman = do+  noConfirmsGame <- isNoConfirmsGame+  gameMode <- getGameMode+  b <- if noConfirmsGame+       then return True+       else displayYesNo ColorBW+            $ "If you quit, the progress of the ongoing" <+> MK.mname gameMode+              <+> "game will be lost! Are you sure?"+  if b+  then do+    snxtChal <- getsClient snxtChal+    return $ Right $ ReqUIGameRestart MK.INSERT_COIN snxtChal+  else do+    msg2 <- rndToActionUI $ oneOf+              [ "yea, would be a pity to leave them to die"+              , "yea, a shame to get your team stranded" ]+    failWith msg2++-- * GameDrop++gameDropHuman :: (MonadClient m, MonadClientUI m) => m ReqUI+gameDropHuman = do+  modifySession $ \sess -> sess {sallNframes = -1}  -- hack, but we crash anyway+  msgAdd MsgPromptGeneric "Interrupt! Trashing the unsaved game. The program exits now."+  clientPrintUI "Interrupt! Trashing the unsaved game. The program exits now."+    -- this is not shown by vty frontend, but at least shown by sdl2 one+  return ReqUIGameDropAndExit++-- * GameExit++gameExitHuman :: Monad m => m ReqUI+gameExitHuman =+  return ReqUIGameSaveAndExit++-- * GameSave++gameSaveHuman :: (MonadClient m, MonadClientUI m) => m ReqUI+gameSaveHuman = do+  -- Announce before the saving started, since it can take a while.+  msgAdd MsgInnerWorkSpam "Saving game backup."+  return ReqUIGameSave++-- * Doctrine++-- Note that the difference between seek-target and follow-the-leader doctrine+-- can influence even a faction with passive actors. E.g., if a passive actor+-- has an extra active skill from equipment, he moves every turn.+doctrineHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)+doctrineHuman = do+  fid <- getsClient sside+  fromT <- getsState $ MK.fdoctrine . gplayer . (EM.! fid) . sfactionD+  let toT = if fromT == maxBound then minBound else succ fromT+  go <- displaySpaceEsc ColorFull+        $ "(Beware, work in progress!)"+          <+> "Current squad doctrine is" <+> Ability.nameDoctrine fromT+          <+> "(" <> Ability.describeDoctrine fromT <> ")."+          <+> "Switching doctrine to" <+> Ability.nameDoctrine toT+          <+> "(" <> Ability.describeDoctrine toT <> ")."+          <+> "This clears targets of all non-pointmen teammates."+          <+> "New targets will be picked according to new doctrine."+  if not go+  then failWith "squad doctrine change canceled"+  else return $ Right $ ReqUIDoctrine toT++-- * Automate++automateHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)+automateHuman = do+  clearAimMode+  proceed <- displayYesNo ColorBW "Do you really want to cede control to AI?"+  if not proceed+  then failWith "automation canceled"+  else return $ Right ReqUIAutomate++-- * AutomateToggle++automateToggleHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI) automateToggleHuman = do   swasAutomated <- getsSession swasAutomated   if swasAutomated

engine-src/Game/LambdaHack/Client/UI/HandleHumanLocalM.hs view

@@ -1,28 +1,36 @@+{-# LANGUAGE TupleSections #-} -- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd" -- client commands that do not return server requests,, -- but only change internal client state. -- None of such commands takes game time. module Game.LambdaHack.Client.UI.HandleHumanLocalM   ( -- * Meta commands-    macroHuman+    macroHuman, macroHumanTransition     -- * Local commands   , chooseItemHuman, chooseItemDialogMode   , chooseItemProjectHuman, chooseItemApplyHuman   , psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman-  , memberCycleHuman, memberBackHuman+  , memberCycleHuman, memberCycleLevelHuman   , selectActorHuman, selectNoneHuman, selectWithPointerHuman-  , repeatHuman, recordHuman, allHistoryHuman, lastHistoryHuman-  , markVisionHuman, markSmellHuman, markSuspectHuman, printScreenHuman+  , repeatHuman, repeatHumanTransition+  , repeatLastHuman, repeatLastHumanTransition+  , recordHuman, recordHumanTransition+  , allHistoryHuman, lastHistoryHuman+  , markVisionHuman, markSmellHuman, markSuspectHuman, markAnimHuman+  , overrideTutHuman+  , printScreenHuman     -- * Commands specific to aiming-  , cancelHuman, acceptHuman, clearTargetIfItemClearHuman, itemClearHuman+  , cancelHuman, acceptHuman, detailCycleHuman+  , clearTargetIfItemClearHuman, itemClearHuman   , moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman   , aimAscendHuman, epsIncrHuman   , xhairUnknownHuman, xhairItemHuman, xhairStairHuman-  , xhairPointerFloorHuman, xhairPointerEnemyHuman+  , xhairPointerFloorHuman, xhairPointerMuteHuman, xhairPointerEnemyHuman   , aimPointerFloorHuman, aimPointerEnemyHuman #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , permittedProjectClient, projectCheck, xhairLegalEps, posFromXhair+  , chooseItemDialogModeLore, permittedProjectClient, projectCheck+  , xhairLegalEps, posFromXhair   , permittedApplyClient, selectAid, eitherHistory, endAiming, endAimingMsg   , doLook, flashAiming #endif@@ -32,14 +40,14 @@  import Game.LambdaHack.Core.Prelude +import           Data.Either (fromRight) import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES-import           Data.Ord+import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified NLP.Miniutter.English as MU  import           Game.LambdaHack.Client.BfsM-import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.CommonM import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.State@@ -49,9 +57,10 @@ import           Game.LambdaHack.Client.UI.ContentClientUI import           Game.LambdaHack.Client.UI.DrawM import           Game.LambdaHack.Client.UI.EffectDescription+import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.FrameM import           Game.LambdaHack.Client.UI.HandleHelperM-import           Game.LambdaHack.Client.UI.HumanCmd+import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd import           Game.LambdaHack.Client.UI.InventoryM import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K@@ -59,10 +68,14 @@ import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.MsgM import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.SessionUI+import           Game.LambdaHack.Client.UI.Slideshow import           Game.LambdaHack.Client.UI.SlideshowM+import           Game.LambdaHack.Client.UI.UIOptions import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA@@ -78,191 +91,186 @@ import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK-import           Game.LambdaHack.Content.ModeKind (fhasGender)+import qualified Game.LambdaHack.Content.ModeKind as MK import qualified Game.LambdaHack.Content.PlaceKind as PK import           Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Definition.Ability as Ability+import qualified Game.LambdaHack.Definition.Color as Color import           Game.LambdaHack.Definition.Defs  -- * Macro -macroHuman :: MonadClientUI m => [String] -> m ()-macroHuman kms = do-  modifySession $ \sess -> sess {slastPlay = map K.mkKM kms ++ slastPlay sess}-  msgAdd MsgMacro $ "Macro activated:" <+> T.pack (intercalate " " kms)+macroHuman :: (MonadClient m, MonadClientUI m) => [String] -> m ()+macroHuman ks = do+  modifySession $ \sess ->+    let kms = K.mkKM <$> ks+        (smacroFrameNew, smacroStackMew) =+           macroHumanTransition kms (smacroFrame sess) (smacroStack sess)+    in sess { smacroFrame = smacroFrameNew+            , smacroStack = smacroStackMew }+  msgAdd MsgMacroOperation $ "Macro activated:" <+> T.pack (intercalate " " ks) +-- | Push a new macro frame to the stack whenever repeating a macro.+macroHumanTransition :: [K.KM] -> KeyMacroFrame -> [KeyMacroFrame]+                     -> (KeyMacroFrame, [KeyMacroFrame])+macroHumanTransition kms macroFrame macroFrames =+  let smacroFrameNew = emptyMacroFrame {keyPending = KeyMacro kms}+  in (smacroFrameNew, macroFrame : macroFrames)+ -- * ChooseItem  -- | Display items from a given container store and possibly let the user -- chose one.-chooseItemHuman :: MonadClientUI m => ItemDialogMode -> m MError-chooseItemHuman c = either Just (const Nothing) <$> chooseItemDialogMode c+chooseItemHuman :: (MonadClient m, MonadClientUI m)+                => ItemDialogMode -> m MError+chooseItemHuman c = either Just (const Nothing) <$> chooseItemDialogMode False c -chooseItemDialogMode :: MonadClientUI m-                     => ItemDialogMode -> m (FailOrCmd ItemDialogMode)-chooseItemDialogMode c = do+chooseItemDialogModeLore :: (MonadClient m, MonadClientUI m)+                         => m (Maybe ResultItemDialogMode)+chooseItemDialogModeLore = do+  schosenLore <- getsSession schosenLore+  (inhabitants, embeds) <- case schosenLore of+    ChosenLore inh emb -> return (inh, emb)+    ChosenNothing -> computeChosenLore+  bagAll <- getsState $ EM.map (const quantSingle) . sitemD+  case inhabitants of+    (_, b) : rest -> do+      let iid = btrunk b+      arItem <- getsState $ aspectRecordFromIid iid+      let slore | not $ bproj b = STrunk+                | IA.checkFlag Ability.Blast arItem = SBlast+                | otherwise = SItem+      lSlots <- slotsOfItemDialogMode $ MLore slore+      modifySession $ \sess -> sess {schosenLore = ChosenLore rest embeds}+      return $ Just $ RLore slore iid bagAll lSlots+    [] ->+      case embeds of+        (iid, _) : rest -> do+          let slore = SEmbed+          lSlots <- slotsOfItemDialogMode $ MLore slore+          modifySession $ \sess ->+            sess {schosenLore = ChosenLore inhabitants rest}+          return $ Just $ RLore slore iid bagAll lSlots+        [] -> do+          modifySession $ \sess -> sess {schosenLore = ChosenNothing}+          return Nothing++chooseItemDialogMode :: (MonadClient m, MonadClientUI m)+                     => Bool -> ItemDialogMode -> m (FailOrCmd ItemDialogMode)+chooseItemDialogMode permitLoreCycle c = do   CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui-  COps{coitem} <- getsState scops+  FontSetup{..} <- getFontSetup   side <- getsClient sside-  let prompt :: Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State-             -> Text-      prompt body bodyUI actorMaxSk c2 s =-        let (tIn, t) = ppItemDialogMode c2-            subject = partActor bodyUI-            f (k, _) acc = k + acc-            countItems store = EM.foldr' f 0 $ getBodyStoreBag body store s-        in case c2 of-        MStore CGround ->-          let n = countItems CGround-              nItems = MU.CarAWs n "item"-          in makePhrase-               [ MU.Capitalize $ MU.SubjectVerbSg subject "notice"-               , nItems, "at"-               , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text "feet" ]-        MStore CSha ->-          -- We assume "gold grain", not "grain" with label "of gold":-          let currencyName = IK.iname $ okind coitem-                             $ ouniqGroup coitem "currency"-              dungeonTotal = sgold s-              (_, total) = calculateTotal side s-              n = countItems CSha-              verbSha = if | n == 0 -> "find nothing"-                           | calmEnough body actorMaxSk -> "notice"-                           | otherwise -> "paw distractedly"-          in makePhrase-               [ MU.Text $ spoilsBlurb currencyName total dungeonTotal-               , MU.Capitalize $ MU.SubjectVerbSg subject verbSha-               , MU.Text tIn-               , MU.Text t ]-        MStore cstore ->-          let n = countItems cstore-              nItems = MU.CarAWs n "item"-          in makePhrase-               [ MU.Capitalize $ MU.SubjectVerbSg subject "see"-               , nItems, MU.Text tIn-               , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]-        MOrgans ->-          makePhrase-            [ MU.Capitalize $ MU.SubjectVerbSg subject "feel"-            , MU.Text tIn-            , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]-        MOwned ->-          makePhrase-            [ MU.Capitalize $ MU.SubjectVerbSg subject "recall"-            , MU.Text tIn-            , MU.Text t ]-        MSkills ->-          makePhrase-            [ MU.Capitalize $ MU.SubjectVerbSg subject "estimate"-            , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]-        MLore{} ->-          makePhrase-            [ MU.Capitalize $ MU.SubjectVerbSg subject "recall"-            , MU.Text t ]-        MPlaces ->-          makePhrase-            [ MU.Capitalize $ MU.SubjectVerbSg subject "recall"-            , MU.Text t ]-  ggi <- getStoreItem prompt c+  fact <- getsState $ (EM.! side) . sfactionD+  (ggi, loreFound) <- do+    mggiLore <- if permitLoreCycle && c == MLore SItem+                then chooseItemDialogModeLore+                else return Nothing+    case mggiLore of+      Just rlore -> return (Right rlore, True)+      Nothing -> do+        ggi <- getStoreItem c+        return (ggi, False)   recordHistory  -- item chosen, wipe out already shown msgs   leader <- getLeaderUI-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let meleeSkill = Ability.getSk Ability.SkHurtMelee actorMaxSk+  actorCurAndMaxSk <- leaderSkillsClientUI+  let meleeSkill = Ability.getSk Ability.SkHurtMelee actorCurAndMaxSk   bUI <- getsSession $ getActorUI leader   case ggi of-    (Right (iid, itemBag, lSlots), (c2, _)) ->-      case c2 of-        MStore fromCStore -> do-          modifySession $ \sess ->-            sess {sitemSel = Just (iid, fromCStore, False)}-          return $ Right c2-        MOrgans -> do-          let blurb itemFull =-                if IA.checkFlag Ability.Condition $ aspectRecordFull itemFull-                then "condition"-                else "organ"-              promptFun _ itemFull _ =-                makeSentence [ partActor bUI, "can't remove"-                             , MU.AW $ blurb itemFull ]-              ix0 = fromMaybe (error $ show iid)-                    $ findIndex (== iid) $ EM.elems lSlots-          go <- displayItemLore itemBag meleeSkill promptFun ix0 lSlots-          if go then chooseItemDialogMode c2 else failWith "never mind"-        MOwned -> do-          found <- getsState $ findIid leader side iid-          let (newAid, bestStore) = case leader `lookup` found of-                Just (_, store) -> (leader, store)-                Nothing -> case found of-                  (aid, (_, store)) : _ -> (aid, store)-                  [] -> error $ "" `showFailure` iid-          modifySession $ \sess ->-            sess {sitemSel = Just (iid, bestStore, False)}-          arena <- getArenaUI-          b2 <- getsState $ getActorBody newAid-          fact <- getsState $ (EM.! side) . sfactionD-          let (autoDun, _) = autoDungeonLevel fact-          if | newAid == leader -> return $ Right c2-             | blid b2 /= arena && autoDun ->-               failSer NoChangeDunLeader-             | otherwise -> do-               -- We switch leader only here, not in lore screens, because-               -- lore is only about inspecting items, no activation submenu.-               void $ pickLeader True newAid-               return $ Right c2-        MSkills -> error $ "" `showFailure` ggi-        MLore slore -> do-          let ix0 = fromMaybe (error $ show iid)-                    $ findIndex (== iid) $ EM.elems lSlots-              promptFun _ _ _ =-                makeSentence [ MU.SubjectVerbSg (partActor bUI) "remember"-                             , MU.AW $ MU.Text (headingSLore slore) ]-          go <- displayItemLore itemBag meleeSkill promptFun ix0 lSlots-          if go then chooseItemDialogMode c2 else failWith "never mind"-        MPlaces -> error $ "" `showFailure` ggi-    (Left err, (MSkills, ekm)) -> case ekm of-      Right slot0 -> assert (err == "skills") $ do+    Right result -> case result of+      RStore fromCStore [iid] -> do+        modifySession $ \sess ->+          sess {sitemSel = Just (iid, fromCStore, False)}+        return $ Right $ MStore fromCStore+      RStore{} -> error $ "" `showFailure` result+      ROrgans iid itemBag lSlots -> do+        let blurb itemFull =+              if IA.checkFlag Ability.Condition $ aspectRecordFull itemFull+              then "condition"+              else "organ"+            promptFun _ itemFull _ =+              makeSentence [ partActor bUI, "is aware of"+                           , MU.AW $ blurb itemFull ]+            ix0 = fromMaybe (error $ "" `showFailure` result)+                  $ findIndex (== iid) $ EM.elems lSlots+        go <- displayItemLore itemBag meleeSkill promptFun ix0 lSlots+        if go then chooseItemDialogMode False MOrgans else failWith "never mind"+      ROwned iid -> do+        found <- getsState $ findIid leader side iid+        let (newAid, bestStore) = case leader `lookup` found of+              Just (_, store) -> (leader, store)+              Nothing -> case found of+                (aid, (_, store)) : _ -> (aid, store)+                [] -> error $ "" `showFailure` result+        modifySession $ \sess ->+          sess {sitemSel = Just (iid, bestStore, False)}+        arena <- getArenaUI+        b2 <- getsState $ getActorBody newAid+        let (autoDun, _) = autoDungeonLevel fact+        if | newAid == leader -> return $ Right MOwned+           | blid b2 /= arena && autoDun ->+             failSer NoChangeDunLeader+           | otherwise -> do+             -- We switch leader only here, not in lore screens, because+             -- lore is only about inspecting items, no activation submenu.+             void $ pickLeader True newAid+             return $ Right MOwned+      RSkills slotIndex0 -> do         let slotListBound = length skillSlots - 1             displayOneSlot slotIndex = do               b <- getsState $ getActorBody leader-              let slot = allSlots !! slotIndex-                  skill = skillSlots !! fromMaybe (error $ show slot)-                                                  (elemIndex slot allSlots)-                  valueText =-                    skillToDecorator skill b $ Ability.getSk skill actorMaxSk+              let skill = skillSlots !! slotIndex+                  valueText = skillToDecorator skill b+                              $ Ability.getSk skill actorCurAndMaxSk                   prompt2 = makeSentence                     [ MU.WownW (partActor bUI) (MU.Text $ skillName skill)                     , "is", MU.Text valueText ]-                  ov0 = indentSplitAttrLine rwidth $ textToAL-                        $ skillDesc skill+                  ov0 = EM.singleton propFont+                        $ offsetOverlay+                        $ indentSplitAttrString rwidth+                        $ textToAS $ skillDesc skill                   keys = [K.spaceKM, K.escKM]                          ++ [K.upKM | slotIndex /= 0]                          ++ [K.downKM | slotIndex /= slotListBound]-              promptAdd0 prompt2+              msgAdd MsgPromptGeneric prompt2               slides <- overlayToSlideshow (rheight - 2) keys (ov0, [])               km <- getConfirms ColorFull keys slides               case K.key km of-                K.Space -> chooseItemDialogMode MSkills+                K.Space -> chooseItemDialogMode False MSkills                 K.Up -> displayOneSlot $ slotIndex - 1                 K.Down -> displayOneSlot $ slotIndex + 1                 K.Esc -> failWith "never mind"                 _ -> error $ "" `showFailure` km-            slotIndex0 = fromMaybe (error "displayOneSlot: illegal slot")-                         $ elemIndex slot0 allSlots         displayOneSlot slotIndex0-      Left _ -> failWith "never mind"-    (Left err, (MPlaces, ekm)) -> case ekm of-      Right slot0 -> assert (err == "places") $ do+      RLore slore iid itemBag lSlots -> do+        let ix0 = fromMaybe (error $ "" `showFailure` result)+                  $ findIndex (== iid) $ EM.elems lSlots+            promptFun _ _ _ =+              makeSentence [ MU.SubjectVerbSg (partActor bUI) "remember"+                           , MU.AW $ MU.Text (headingSLore slore) ]+        schosenLore <- getsSession schosenLore+        let lorePending = loreFound && case schosenLore of+              ChosenLore [] [] -> False+              _ -> True+        km <- displayItemLorePointedAt itemBag meleeSkill promptFun ix0+                                       lSlots lorePending+        case K.key km of+          K.Space -> do+            modifySession $ \sess -> sess {schosenLore = ChosenNothing}+            chooseItemDialogMode False (MLore slore)+          K.Char '~' -> chooseItemDialogMode True c+          K.Esc -> do+            modifySession $ \sess -> sess {schosenLore = ChosenNothing}+            failWith "never mind"+          _ -> error $ "" `showFailure` km+      RPlaces slotIndex0 -> do         COps{coplace} <- getsState scops         soptions <- getsClient soptions         places <- getsState $ EM.assocs . placesFromState coplace soptions         let slotListBound = length places - 1             displayOneSlot slotIndex = do-              let slot = allSlots !! slotIndex-                  (pk, figures@(es, _, _, _)) =-                    places !! fromMaybe (error $ show slot)-                                        (elemIndex slot allSlots)+              let (pk, (es, ne, na, _)) = places !! slotIndex                   pkind = okind coplace pk-                  partsPhrase = makePhrase $ placeParts figures                   prompt2 = makeSentence                     [ MU.SubjectVerbSg (partActor bUI) "remember"                     , MU.Text $ PK.pname pkind ]@@ -277,46 +285,86 @@                        , MU.CarWs (ES.size es) "level" <> ":"                        , MU.WWandW $ map MU.Car $ sort                                    $ map (abs . fromEnum) $ ES.elems es ]]-                  ov0 = indentSplitAttrLine rwidth $ textToAL $ T.unlines $-                          (if sexposePlaces soptions-                           then [ "", partsPhrase-                                , "", freqsText-                                , "" ] ++ PK.ptopLeft pkind-                           else [])+                  placeParts = ["it has" | ne > 0 || na > 0]+                               ++ [MU.CarWs ne "entrance" | ne > 0]+                               ++ ["and" | ne > 0 && na > 0]+                               ++ [MU.CarWs na "surrounding" | na > 0]+                  partsSentence | null placeParts = ""+                                | otherwise = makeSentence placeParts+                  -- Ideally, place layout would be in SquareFont and the rest+                  -- in PropFont, but this is mostly a debug screen, so KISS.+                  ov0 = EM.singleton monoFont+                        $ offsetOverlay+                        $ concatMap (indentSplitAttrString rwidth . textToAS)+                        $ ["", partsSentence]+                          ++ (if sexposePlaces soptions+                              then [ "", freqsText+                                   , "" ] ++ PK.ptopLeft pkind+                              else [])                           ++ [""] ++ onLevels                   keys = [K.spaceKM, K.escKM]                          ++ [K.upKM | slotIndex /= 0]                          ++ [K.downKM | slotIndex /= slotListBound]-              promptAdd0 prompt2+              msgAdd MsgPromptGeneric prompt2               slides <- overlayToSlideshow (rheight - 2) keys (ov0, [])               km <- getConfirms ColorFull keys slides               case K.key km of-                K.Space -> chooseItemDialogMode MPlaces+                K.Space -> chooseItemDialogMode False MPlaces                 K.Up -> displayOneSlot $ slotIndex - 1                 K.Down -> displayOneSlot $ slotIndex + 1                 K.Esc -> failWith "never mind"                 _ -> error $ "" `showFailure` km-            slotIndex0 = fromMaybe (error "displayOneSlot: illegal slot")-                         $ elemIndex slot0 allSlots         displayOneSlot slotIndex0-      Left _ -> failWith "never mind"-    (Left err, _) -> failWith err+      RModes slotIndex0 -> do+        COps{comode} <- getsState scops+        svictories <- getsClient svictories+        nxtChal <- getsClient snxtChal+          -- mark victories only for current difficulty+        let f !acc _p !i !a = (i, a) : acc+            campaignModes = ofoldlGroup' comode MK.CAMPAIGN_SCENARIO f []+            slotListBound = length campaignModes - 1+            displayOneSlot slotIndex = do+              let (gameModeId, gameMode) = campaignModes !! slotIndex+              modeOKX <- describeMode False gameModeId+              let victories = case EM.lookup gameModeId svictories of+                    Nothing -> 0+                    Just cm -> fromMaybe 0 (M.lookup nxtChal cm)+                  verb = if victories > 0 then "remember" else "forsee"+                  prompt2 = makeSentence+                    [ MU.SubjectVerbSg (partActor bUI) verb+                    , MU.Text $ "the '" <> MK.mname gameMode <> "' adventure" ]+                  keys = [K.spaceKM, K.escKM]+                         ++ [K.upKM | slotIndex /= 0]+                         ++ [K.downKM | slotIndex /= slotListBound]+              msgAdd MsgPromptGeneric prompt2+              slides <- overlayToSlideshow rheight keys (modeOKX, [])+              ekm2 <- displayChoiceScreen "" ColorFull True slides keys+              let km = either id (error $ "" `showFailure` ekm2) ekm2+              case K.key km of+                K.Space -> chooseItemDialogMode False MModes+                K.Up -> displayOneSlot $ slotIndex - 1+                K.Down -> displayOneSlot $ slotIndex + 1+                K.Esc -> failWith "never mind"+                _ -> error $ "" `showFailure` km+        displayOneSlot slotIndex0+    Left err -> failWith err  -- * ChooseItemProject  chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)-                       => [TriggerItem] -> m MError+                       => [HumanCmd.TriggerItem] -> m MError chooseItemProjectHuman ts = do   leader <- getLeaderUI   b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let calmE = calmEnough b actorMaxSk-      cLegalRaw = [CGround, CInv, CSha, CEqp]-      cLegal | calmE = cLegalRaw-             | otherwise = delete CSha cLegalRaw+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+  let overStash = mstash == Just (blid b, bpos b)+      storesBase = [CStash, CEqp]+      stores | overStash = storesBase ++ [CGround]+             | otherwise = CGround : storesBase       (verb1, object1) = case ts of         [] -> ("aim", "item")-        tr : _ -> (tiverb tr, tiobject tr)+        tr : _ -> (HumanCmd.tiverb tr, HumanCmd.tiobject tr)+      verb = makePhrase [verb1]       triggerSyms = triggerSymbols ts   mpsuitReq <- psuitReq   case mpsuitReq of@@ -339,30 +387,28 @@               chooseItemProjectHuman ts         Nothing -> do           let psuit =-                return $ SuitsSomething $ \itemFull _kit ->+                return $ SuitsSomething $ \_ itemFull _kit ->                   either (const False) snd (psuitReqFun itemFull)                   && (null triggerSyms                       || IK.isymbol (itemKind itemFull) `elem` triggerSyms)-              prompt = makePhrase ["What", object1, "to", verb1]-              promptGeneric = "What to fling"-          ggi <- getGroupItem psuit prompt promptGeneric cLegalRaw cLegal+              prompt = makePhrase ["What", object1, "to"]+              promptGeneric = "What to"+          ggi <- getGroupItem psuit prompt promptGeneric verb "fling" stores           case ggi of-            Right ((iid, _itemFull), (MStore fromCStore, _)) -> do+            Right (fromCStore, iid) -> do               modifySession $ \sess ->                 sess {sitemSel = Just (iid, fromCStore, False)}               return Nothing             Left err -> failMsg err-            _ -> error $ "" `showFailure` ggi  permittedProjectClient :: MonadClientUI m                        => m (ItemFull -> Either ReqFailure Bool) permittedProjectClient = do   leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI   b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  actorSk <- leaderSkillsClientUI-  let skill = Ability.getSk Ability.SkProject actorSk-      calmE = calmEnough b actorMaxSk+  let skill = Ability.getSk Ability.SkProject actorCurAndMaxSk+      calmE = calmEnough b actorCurAndMaxSk   return $ permittedProject False skill calmE  projectCheck :: MonadClientUI m => Point -> m (Maybe ReqFailure)@@ -397,14 +443,15 @@ -- e.g., because the target actor can be obscured by a glass wall. xhairLegalEps :: MonadClientUI m => m (Either Text Int) xhairLegalEps = do+  cops@COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops   leader <- getLeaderUI   b <- getsState $ getActorBody leader   lidV <- viewedLevelUI   let !_A = assert (lidV == blid b) ()       findNewEps onlyFirst pos = do+        lvl <- getLevel (blid b)         oldEps <- getsClient seps-        mnewEps <- makeLine onlyFirst b pos oldEps-        return $! case mnewEps of+        return $! case makeLine onlyFirst b pos oldEps cops lvl of           Just newEps -> Right newEps           Nothing -> Left $ if onlyFirst                             then "aiming blocked at the first step"@@ -432,7 +479,6 @@       else return $ Left "can't fling at a target on remote level"     Just (TVector v) -> do       -- Not @ScreenContent@, because not drawing here.-      COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops       let shifted = shiftBounded rXmax rYmax (bpos b) v       if shifted == bpos b && v /= Vector 0 0       then return $ Left "selected translation is void"@@ -476,30 +522,33 @@           Right False -> Right (pos, False)           Right True ->             let arItem = aspectRecordFull itemFull-            in Right (pos, IA.totalRange arItem (itemKind itemFull)+            in Right (pos, 1 + IA.totalRange arItem (itemKind itemFull)                            >= chessDist (bpos b) pos) -triggerSymbols :: [TriggerItem] -> [Char]+triggerSymbols :: [HumanCmd.TriggerItem] -> [Char] triggerSymbols [] = []-triggerSymbols (TriggerItem{tisymbols} : ts) = tisymbols ++ triggerSymbols ts+triggerSymbols (HumanCmd.TriggerItem{tisymbols} : ts) =+  tisymbols ++ triggerSymbols ts  -- * ChooseItemApply -chooseItemApplyHuman :: forall m. MonadClientUI m => [TriggerItem] -> m MError+chooseItemApplyHuman :: forall m. (MonadClient m, MonadClientUI m)+                     => [HumanCmd.TriggerItem] -> m MError chooseItemApplyHuman ts = do   leader <- getLeaderUI   b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let calmE = calmEnough b actorMaxSk-      cLegalRaw = [CGround, CInv, CSha, CEqp]-      cLegal | calmE = cLegalRaw-             | otherwise = delete CSha cLegalRaw+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+  let overStash = mstash == Just (blid b, bpos b)+      storesBase = [CStash, CEqp, COrgan]+      stores | overStash = storesBase ++ [CGround]+             | otherwise = CGround : storesBase       (verb1, object1) = case ts of-        [] -> ("apply", "item")-        tr : _ -> (tiverb tr, tiobject tr)+        [] -> ("trigger", "item")+        tr : _ -> (HumanCmd.tiverb tr, HumanCmd.tiobject tr)+      verb = makePhrase [verb1]       triggerSyms = triggerSymbols ts-      prompt = makePhrase ["What", object1, "to", verb1]-      promptGeneric = "What to apply"+      prompt = makePhrase ["What", object1, "to"]+      promptGeneric = "What to"   itemSel <- getsSession sitemSel   case itemSel of     Just (_, _, True) -> return Nothing@@ -510,7 +559,8 @@       bag <- getsState $ getBodyStoreBag b fromCStore       mp <- permittedApplyClient       case iid `EM.lookup` bag of-        Just kit | either (const False) id (mp itemFull kit) ->+        Just kit | either (const False) id+                          (mp (Just fromCStore) itemFull kit) ->           return Nothing         _ -> do           modifySession $ \sess -> sess {sitemSel = Nothing}@@ -519,34 +569,33 @@       let psuit :: m Suitability           psuit = do             mp <- permittedApplyClient-            return $ SuitsSomething $ \itemFull kit ->-              either (const False) id (mp itemFull kit)+            return $ SuitsSomething $ \cstore itemFull kit ->+              either (const False) id (mp cstore itemFull kit)               && (null triggerSyms                   || IK.isymbol (itemKind itemFull) `elem` triggerSyms)-      ggi <- getGroupItem psuit prompt promptGeneric cLegalRaw cLegal+      ggi <- getGroupItem psuit prompt promptGeneric verb "trigger" stores       case ggi of-        Right ((iid, _itemFull), (MStore fromCStore, _)) -> do+        Right (fromCStore, iid) -> do           modifySession $ \sess ->             sess {sitemSel = Just (iid, fromCStore, False)}           return Nothing         Left err -> failMsg err-        _ -> error $ "" `showFailure` ggi  permittedApplyClient :: MonadClientUI m-                     => m (ItemFull -> ItemQuant -> Either ReqFailure Bool)+                     => m (Maybe CStore -> ItemFull -> ItemQuant+                           -> Either ReqFailure Bool) permittedApplyClient = do   leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI   b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  actorSk <- leaderSkillsClientUI-  let skill = Ability.getSk Ability.SkApply actorSk-      calmE = calmEnough b actorMaxSk+  let skill = Ability.getSk Ability.SkApply actorCurAndMaxSk+      calmE = calmEnough b actorCurAndMaxSk   localTime <- getsState $ getLocalTime (blid b)   return $ permittedApply localTime skill calmE  -- * PickLeader -pickLeaderHuman :: MonadClientUI m => Int -> m MError+pickLeaderHuman :: (MonadClient m, MonadClientUI m) => Int -> m MError pickLeaderHuman k = do   side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD@@ -559,7 +608,7 @@       mactor = case drop k hs of                  [] -> Nothing                  (aid, b, _) : _ -> Just (aid, b)-      mchoice = if fhasGender (gplayer fact) then mhero else mactor+      mchoice = if MK.fhasGender (gplayer fact) then mhero else mactor       (autoDun, _) = autoDungeonLevel fact   case mchoice of     Nothing -> failMsg "no such member of the party"@@ -572,29 +621,30 @@  -- * PickLeaderWithPointer -pickLeaderWithPointerHuman :: MonadClientUI m => m MError+pickLeaderWithPointerHuman :: (MonadClient m, MonadClientUI m) => m MError pickLeaderWithPointerHuman = pickLeaderWithPointer  -- * MemberCycle  -- | Switch current member to the next on the viewed level, if any, wrapping.-memberCycleHuman :: MonadClientUI m => m MError-memberCycleHuman = memberCycle True+memberCycleLevelHuman :: (MonadClient m, MonadClientUI m)+                      => Direction -> m MError+memberCycleLevelHuman = memberCycleLevel True  -- * MemberBack  -- | Switch current member to the previous in the whole dungeon, wrapping.-memberBackHuman :: MonadClientUI m => m MError-memberBackHuman = memberBack True+memberCycleHuman :: (MonadClient m, MonadClientUI m) => Direction -> m MError+memberCycleHuman = memberCycle True  -- * SelectActor -selectActorHuman :: MonadClientUI m => m ()+selectActorHuman :: (MonadClient m, MonadClientUI m) => m () selectActorHuman = do   leader <- getLeaderUI   selectAid leader -selectAid :: MonadClientUI m => ActorId -> m ()+selectAid :: (MonadClient m, MonadClientUI m) => ActorId -> m () selectAid leader = do   bodyUI <- getsSession $ getActorUI leader   wasMemeber <- getsSession $ ES.member leader . sselected@@ -603,13 +653,13 @@             else ES.insert leader   modifySession $ \sess -> sess {sselected = upd $ sselected sess}   let subject = partActor bodyUI-  promptAdd $ makeSentence [subject, if wasMemeber-                                     then "deselected"-                                     else "selected"]+  msgAdd MsgActionAlert $ makeSentence [subject, if wasMemeber+                                                 then "deselected"+                                                 else "selected"]  -- * SelectNone -selectNoneHuman :: MonadClientUI m => m ()+selectNoneHuman :: (MonadClient m, MonadClientUI m) => m () selectNoneHuman = do   side <- getsClient sside   lidV <- viewedLevelUI@@ -622,13 +672,13 @@             else ES.difference   modifySession $ \sess -> sess {sselected = upd (sselected sess) ours}   let subject = "all party members on the level"-  promptAdd $ makeSentence [subject, if wasNone-                                     then "selected"-                                     else "deselected"]+  msgAdd MsgActionAlert $ makeSentence [subject, if wasNone+                                                 then "selected"+                                                 else "deselected"]  -- * SelectWithPointer -selectWithPointerHuman :: MonadClientUI m => m MError+selectWithPointerHuman :: (MonadClient m, MonadClientUI m) => m MError selectWithPointerHuman = do   COps{corule=RuleContent{rYmax}} <- getsState scops   lidV <- viewedLevelUI@@ -639,15 +689,16 @@   sactorUI <- getsSession sactorUI   let oursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) ours       viewed = sortOn keySelected oursUI-  Point{..} <- getsSession spointer+  pUI <- getsSession spointer+  let p@(Point px py) = squareToMap $ uiToSquare pUI   -- Select even if no space in status line for the actor's symbol.-  if | py == rYmax + 2 && px == 0 -> selectNoneHuman >> return Nothing-     | py == rYmax + 2 ->+  if | py == rYmax + 1 && px == 0 -> selectNoneHuman >> return Nothing+     | py == rYmax + 1 ->          case drop (px - 1) viewed of            [] -> failMsg "not pointing at an actor"            (aid, _, _) : _ -> selectAid aid >> return Nothing      | otherwise ->-         case find (\(_, b) -> bpos b == Point px (py - mapStartY)) ours of+         case find (\(_, b) -> bpos b == p) ours of            Nothing -> failMsg "not pointing at an actor"            Just (aid, _) -> selectAid aid >> return Nothing @@ -657,52 +708,91 @@ -- because the player can really use a command that does not stop -- at terrain change or when walking over items. repeatHuman :: MonadClientUI m => Int -> m ()-repeatHuman n = do-  LastRecord _ seqPrevious k <- getsSession slastRecord-  let macro = concat $ replicate n $ reverse seqPrevious-  modifySession $ \sess -> sess {slastPlay = macro ++ slastPlay sess}-  let slastRecord = LastRecord [] [] (if k == 0 then 0 else maxK)-  modifySession $ \sess -> sess {slastRecord}+repeatHuman n =+  modifySession $ \sess ->+    let (smacroFrameNew, smacroStackMew) =+           repeatHumanTransition n (smacroFrame sess) (smacroStack sess)+    in sess { smacroFrame = smacroFrameNew+            , smacroStack = smacroStackMew } -maxK :: Int-maxK = 100+repeatHumanTransition :: Int -> KeyMacroFrame -> [KeyMacroFrame]+                      -> (KeyMacroFrame, [KeyMacroFrame])+repeatHumanTransition n macroFrame macroFrames =+  let kms = concat . replicate n . unKeyMacro . fromRight mempty+            $ keyMacroBuffer macroFrame+  in macroHumanTransition kms macroFrame macroFrames +-- * RepeatLast++-- Note that walk followed by repeat should not be equivalent to run,+-- because the player can really use a command that does not stop+-- at terrain change or when walking over items.+repeatLastHuman :: MonadClientUI m => Int -> m ()+repeatLastHuman n = modifySession $ \sess ->+  sess {smacroFrame = repeatLastHumanTransition n (smacroFrame sess) }++repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame+repeatLastHumanTransition n macroFrame =+  let macro = KeyMacro . concat . replicate n . maybeToList $ keyLast macroFrame+  in macroFrame { keyPending = macro <> keyPending macroFrame }+ -- * Record -recordHuman :: MonadClientUI m => m ()+-- | Starts and stops recording of macros.+recordHuman :: (MonadClient m, MonadClientUI m) => m () recordHuman = do-  lastPlayOld <- getsSession slastPlay-  LastRecord _seqCurrent seqPrevious k <- getsSession slastRecord-  case k of-    0 -> do-      let slastRecord = LastRecord [] [] maxK-      modifySession $ \sess -> sess {slastRecord}-      when (null lastPlayOld) $-        -- Don't spam if recording is a part of playing back a macro.-        promptAdd0 $ "Macro will be recorded for up to"-                     <+> tshow maxK-                     <+> "actions. Stop recording with the same key."-    _ -> do-      let slastRecord = LastRecord seqPrevious [] 0-      modifySession $ \sess -> sess {slastRecord}-      when (null lastPlayOld) $-        -- Don't spam if recording is a part of playing back a macro.-        promptAdd0 $ "Macro recording stopped after"-                     <+> tshow (maxK - k - 1) <+> "actions."+  smacroFrameOld <- getsSession smacroFrame+  let (smacroFrameNew, msg) = recordHumanTransition smacroFrameOld+  modifySession $ \sess -> sess {smacroFrame = smacroFrameNew}+  macroStack <- getsSession smacroStack+  unless (T.null msg || not (null macroStack)) $ msgAdd MsgPromptGeneric msg +recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)+recordHumanTransition macroFrame =+  let (buffer, msg) = case keyMacroBuffer macroFrame of+        Right _ ->+          -- Start recording in-game macro.+          (Left [], "Recording a macro. Stop recording with the same key.")+        Left xs ->+          -- Stop recording in-game macro.+          (Right . KeyMacro . reverse $ xs, "Macro recording stopped.")+      smacroFrameNew = macroFrame {keyMacroBuffer = buffer}+  in (smacroFrameNew, msg)+ -- * AllHistory -allHistoryHuman :: MonadClientUI m => m ()+allHistoryHuman :: (MonadClient m, MonadClientUI m) => m () allHistoryHuman = eitherHistory True -eitherHistory :: forall m. MonadClientUI m => Bool -> m ()+eitherHistory :: forall m. (MonadClient m, MonadClientUI m) => Bool -> m () eitherHistory showAll = do   CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui+  UIOptions{uHistory1PerLine} <- getsSession sUIOptions   history <- getsSession shistory   arena <- getArenaUI   localTime <- getsState $ getLocalTime arena   global <- getsState stime-  let rh = renderHistory history+  FontSetup{..} <- getFontSetup+  let renderedHistoryRaw = renderHistory uHistory1PerLine history+      histBoundRaw = length renderedHistoryRaw+      placeholderLine = textFgToAS Color.BrBlack+        "Newest_messages_are_at_the_bottom._Press_END_to_get_there."+      placeholderCount =+        (- histBoundRaw `mod` (rheight - 4)) `mod` (rheight - 4)+      renderedHistory = replicate placeholderCount placeholderLine+                        ++ renderedHistoryRaw+      histBound = placeholderCount + histBoundRaw+      splitRow as =+        let (spNo, spYes) = span (/= Color.spaceAttrW32) as+            par1 = case filter (/= emptyAttrLine) $ linesAttr spYes of+              [] -> emptyAttrLine+              [l] -> l+              ls -> attrStringToAL $ intercalate [Color.spaceAttrW32]+                                   $ map attrLine ls+        in (attrStringToAL spNo, (textSize monoFont spNo, par1))+      (histLab, histDesc) = unzip $ map splitRow renderedHistory+      rhLab = EM.singleton monoFont $ offsetOverlay histLab+      rhDesc = EM.singleton propFont $ offsetOverlayX histDesc       turnsGlobal = global `timeFitUp` timeTurn       turnsLocal = localTime `timeFitUp` timeTurn       msg = makeSentence@@ -710,47 +800,77 @@         , MU.CarWs turnsGlobal "half-second turn"         , "(this level:"         , MU.Car turnsLocal <> ")" ]-      kxs = [ (Right sn, (slotPrefix sn, 0, rwidth))-            | sn <- take (length rh) intSlots ]-  promptAdd0 msg-  okxs <- overlayToSlideshow rheight [K.escKM] (rh, kxs)+      kxs = [ (Right sn, ( PointUI 0 (slotPrefix sn)+                         , ButtonWidth propFont 1000 ))+            | sn <- take histBound intSlots ]+  msgAdd MsgPromptGeneric msg+  let keysAllHistory =+        K.returnKM+#ifndef USE_JSFILE+        : K.mkChar '.'+#endif+        : [K.escKM]+  okxs <- overlayToSlideshow (rheight - 2) keysAllHistory+                             (EM.unionWith (++) rhLab rhDesc, kxs)+  let maxIx = length (concatMap snd $ slideshow okxs) - 1+      menuName = "history"+  modifySession $ \sess ->+    sess {smenuIxMap = M.insert menuName maxIx $ smenuIxMap sess}   let displayAllHistory = do-        ekm <- displayChoiceScreen "history" ColorFull True okxs-                                   [K.spaceKM, K.escKM]+        ekm <- displayChoiceScreen menuName ColorFull False okxs keysAllHistory         case ekm of+          Left km | km == K.mkChar '.' -> do+            let t = T.unlines $ map (T.pack . map Color.charFromW32)+                                    renderedHistoryRaw+            path <- dumpTextFile t "history.txt"+            msgAdd MsgPromptGeneric $ "All of history dumped to file" <+> T.pack path <> "."           Left km | km == K.escKM ->-            promptAdd0 "Try to survive a few seconds more, if you can."+            msgAdd MsgPromptGeneric "Try to survive a few seconds more, if you can."           Left km | km == K.spaceKM ->  -- click in any unused space-            promptAdd0 "Steady on."+            msgAdd MsgPromptGeneric "Steady on."           Right SlotChar{..} | slotChar == 'a' ->-            displayOneReport slotPrefix+            displayOneReport $ max 0 $ slotPrefix - placeholderCount           _ -> error $ "" `showFailure` ekm-      histBound = lengthHistory history - 1       displayOneReport :: Int -> m ()       displayOneReport histSlot = do-        let timeReport = case drop histSlot rh of+        let timeReport = case drop histSlot renderedHistoryRaw of               [] -> error $ "" `showFailure` histSlot               tR : _ -> tR-            ov0 = indentSplitAttrLine rwidth timeReport+            ov0 =+              let (spNo, spYes) = span (/= Color.spaceAttrW32) timeReport+                  lenNo = textSize monoFont spNo+                  spYesX = case splitAttrString (rwidth - lenNo - 1) rwidth+                                                spYes of+                    [] -> []+                    l : ls ->+                      ( lenNo+                      , firstParagraph $ Color.spaceAttrW32 : attrLine l )+                      : map (0,) ls+              in EM.insertWith (++) monoFont+                               (offsetOverlay [attrStringToAL spNo])+                 $ EM.singleton propFont $ offsetOverlayX spYesX             prompt = makeSentence               [ "the", MU.Ordinal $ histSlot + 1-              , "record of all history follows" ]-            keys = [K.spaceKM, K.escKM] ++ [K.upKM | histSlot /= 0]-                                        ++ [K.downKM | histSlot /= histBound]-        promptAdd0 prompt+              , "most recent record follows" ]+            keys = [K.spaceKM, K.escKM]+                   ++ [K.upKM | histSlot /= 0]+                   ++ [K.downKM | histSlot /= histBoundRaw - 1]+        msgAdd MsgPromptGeneric prompt         slides <- overlayToSlideshow (rheight - 2) keys (ov0, [])         km <- getConfirms ColorFull keys slides         case K.key km of           K.Space -> displayAllHistory           K.Up -> displayOneReport $ histSlot - 1           K.Down -> displayOneReport $ histSlot + 1-          K.Esc -> promptAdd0 "Try to learn from your previous mistakes."+          K.Esc -> msgAdd MsgPromptGeneric "Try to learn from your previous mistakes."           _ -> error $ "" `showFailure` km-  if showAll then displayAllHistory else displayOneReport (length rh - 1)+  if showAll+  then displayAllHistory+  else displayOneReport (histBoundRaw - 1)  -- * LastHistory -lastHistoryHuman :: MonadClientUI m => m ()+lastHistoryHuman :: (MonadClient m, MonadClientUI m) => m () lastHistoryHuman = eitherHistory False  -- * MarkVision@@ -771,10 +891,24 @@   invalidateBfsAll   modifyClient cycleMarkSuspect +-- * MarkAnim++markAnimHuman :: MonadClient m => m ()+markAnimHuman = do+  noAnim <- getsClient $ fromMaybe False . snoAnim . soptions+  modifyClient $ \cli ->+    cli {soptions = (soptions cli) {snoAnim = Just $ not noAnim}}++-- * OverrideTut++overrideTutHuman :: MonadClientUI m => m ()+overrideTutHuman = modifySession cycleOverrideTut+ -- * PrintScreen-printScreenHuman :: MonadClientUI m => m ()++printScreenHuman :: (MonadClient m, MonadClientUI m) => m () printScreenHuman = do-  promptAdd "Screenshot printed."+  msgAdd MsgActionAlert "Screenshot printed."   printScreen  -- * Cancel@@ -787,7 +921,7 @@  -- * Accept --- | Accept the current x-hair position as target, ending+-- | Accept the current crosshair position as target, ending -- aiming mode, if active. acceptHuman :: (MonadClient m, MonadClientUI m) => m () acceptHuman = do@@ -802,32 +936,45 @@   sxhair <- getsSession sxhair   modifyClient $ updateTarget leader $ const sxhair -endAimingMsg :: MonadClientUI m => m ()+endAimingMsg :: (MonadClient m, MonadClientUI m) => m () endAimingMsg = do   leader <- getLeaderUI   subject <- partActorLeader leader   tgt <- getsClient $ getTarget leader   (mtargetMsg, _) <- targetDesc tgt-  promptAdd $ case mtargetMsg of+  msgAdd MsgActionAlert $ case mtargetMsg of     Nothing ->       makeSentence [MU.SubjectVerbSg subject "clear target"]     Just targetMsg ->       makeSentence [MU.SubjectVerbSg subject "target", MU.Text targetMsg] +-- * DetailCycle++-- | Cycle detail level of aiming mode descriptions, starting up.+detailCycleHuman :: (MonadClient m, MonadClientUI m) => m ()+detailCycleHuman = do+  modifySession $ \sess -> sess {saimMode =+    (\aimMode -> aimMode {detailLevel = detailCycle $ detailLevel aimMode})+                 <$> saimMode sess}+  doLook++detailCycle :: DetailLevel -> DetailLevel+detailCycle detail = if detail == maxBound then minBound else succ detail+ -- * ClearTargetIfItemClear  clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m) => m () clearTargetIfItemClearHuman = do   itemSel <- getsSession sitemSel   when (isNothing itemSel) $ do-    modifySession $ \sess -> sess {sxhair = Nothing}+    setXHairFromGUI Nothing     leader <- getLeaderUI     modifyClient $ updateTarget leader (const Nothing)     doLook  -- | Perform look around in the current position of the xhair. -- Does nothing outside aiming mode.-doLook :: MonadClientUI m => m ()+doLook :: (MonadClient m, MonadClientUI m) => m () doLook = do   saimMode <- getsSession saimMode   case saimMode of@@ -839,7 +986,7 @@       b <- getsState $ getActorBody leader       let xhairPos = fromMaybe (bpos b) mxhairPos       blurb <- lookAtPosition lidV xhairPos-      promptAdd0 blurb+      mapM_ (uncurry msgAdd) blurb  -- * ItemClear @@ -849,7 +996,7 @@ -- * MoveXhair  -- | Move the xhair. Assumes aiming mode.-moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError+moveXhairHuman :: (MonadClient m, MonadClientUI m) => Vector -> Int -> m MError moveXhairHuman dir n = do   COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops   leader <- getLeaderUI@@ -867,26 +1014,28 @@     let sxhair = case xhair of           Just TVector{} -> Just $ TVector $ newPos `vectorToFrom` lpos           _ -> Just $ TPoint TKnown lidV newPos-    modifySession $ \sess -> sess {sxhair}+    setXHairFromGUI sxhair     doLook     return Nothing  -- * AimTgt  -- | Start aiming.-aimTgtHuman :: MonadClientUI m => m MError+aimTgtHuman :: (MonadClient m, MonadClientUI m) => m () aimTgtHuman = do   -- (Re)start aiming at the current level.   lidV <- viewedLevelUI-  modifySession $ \sess -> sess {saimMode = Just $ AimMode lidV}+  modifySession $ \sess -> sess {saimMode =+    let newDetail = maybe defaultDetailLevel detailLevel (saimMode sess)+    in Just $ AimMode lidV newDetail}   doLook-  failMsg "aiming started"+  msgAdd MsgPromptAction "*flinging started; press again to project*"  -- * AimFloor  -- | Cycle aiming mode. Do not change position of the xhair, -- switch among things at that position.-aimFloorHuman :: MonadClientUI m => m ()+aimFloorHuman :: (MonadClient m, MonadClientUI m) => m () aimFloorHuman = do   lidV <- viewedLevelUI   leader <- getLeaderUI@@ -908,7 +1057,7 @@         Just TVector{} ->           -- If many actors, we pick here the first that would be picked           -- by '*', so that all other projectiles on the tile come next,-          -- when pressing "*", without any intervening actors from other tiles.+          -- when pressing '*', without any intervening actors from other tiles.           -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.           case find (\(_, b) -> Just (bpos b) == mxhairPos) bsAll of             Just (aid, b) -> Just $ if isFoe side fact (bfid b)@@ -916,13 +1065,15 @@                                     else TNonEnemy aid             Nothing -> Just $ TPoint TUnknown lidV xhairPos         _ -> xhair-  modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV-                                , sxhair }+  modifySession $ \sess -> sess {saimMode =+    let newDetail = maybe defaultDetailLevel detailLevel saimMode+    in Just $ AimMode lidV newDetail}+  setXHairFromGUI sxhair   doLook  -- * AimEnemy -aimEnemyHuman :: MonadClientUI m => m ()+aimEnemyHuman :: (MonadClient m, MonadClientUI m) => m () aimEnemyHuman = do   lidV <- viewedLevelUI   leader <- getLeaderUI@@ -958,22 +1109,31 @@         (a, _) : _ -> Just $ if pickEnemies then TEnemy a else TNonEnemy a         [] -> xhair  -- no seen foes in sight, stick to last target   -- Register the chosen enemy, to pick another on next invocation.-  modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV-                                , sxhair }+  modifySession $ \sess -> sess {saimMode =+    let newDetail = maybe defaultDetailLevel detailLevel saimMode+    in Just $ AimMode lidV newDetail}+  setXHairFromGUI sxhair   doLook  -- * AimItem -aimItemHuman :: MonadClientUI m => m ()+aimItemHuman :: (MonadClient m, MonadClientUI m) => m () aimItemHuman = do+  side <- getsClient sside   lidV <- viewedLevelUI   leader <- getLeaderUI   lpos <- getsState $ bpos . getActorBody leader   mxhairPos <- xhairToPos   xhair <- getsSession sxhair   saimMode <- getsSession saimMode-  bsAll <- getsState $ EM.keys . lfloor . (EM.! lidV) . sdungeon-  let ordPos p = (chessDist lpos p, p)+  Level{lfloor} <- getLevel lidV+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! side+  -- Don't consider own stash an ordinary pile of items.+  let lfloorBarStash = case mstash of+        Just (lid, pos) | lid == lidV -> EM.delete pos lfloor+        _ -> lfloor+      bsAll = EM.keys lfloorBarStash+      ordPos p = (chessDist lpos p, p)       dbs = sortOn ordPos bsAll       pickUnderXhair =  -- switch to the item under xhair, if any         let i = fromMaybe (-1)@@ -994,15 +1154,17 @@         p : _ -> Just $ TPoint TKnown lidV p  -- don't force AI to collect it         [] -> xhair  -- no items remembered, stick to last target   -- Register the chosen enemy, to pick another on next invocation.-  modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV-                                , sxhair }+  modifySession $ \sess -> sess {saimMode =+    let newDetail = maybe defaultDetailLevel detailLevel saimMode+    in Just $ AimMode lidV newDetail}+  setXHairFromGUI sxhair   doLook  -- * AimAscend  -- | Change the displayed level in aiming mode to (at most) -- k levels shallower. Enters aiming mode, if not already in one.-aimAscendHuman :: MonadClientUI m => Int -> m MError+aimAscendHuman :: (MonadClient m, MonadClientUI m) => Int -> m MError aimAscendHuman k = do   dungeon <- getsState sdungeon   lidV <- viewedLevelUI@@ -1019,23 +1181,36 @@       mxhairPos <- xhairToPos       let xhairPos = fromMaybe lpos mxhairPos           sxhair = Just $ TPoint TKnown lidK xhairPos-      modifySession $ \sess -> sess { saimMode = Just (AimMode lidK)-                                    , sxhair }+      modifySession $ \sess -> sess {saimMode =+        let newDetail = maybe defaultDetailLevel detailLevel (saimMode sess)+        in Just $ AimMode lidK newDetail}+      setXHairFromGUI sxhair       doLook       return Nothing  -- * EpsIncr  -- | Tweak the @eps@ parameter of the aiming digital line.-epsIncrHuman :: (MonadClient m, MonadClientUI m) => Bool -> m ()-epsIncrHuman b = do+epsIncrHuman :: (MonadClient m, MonadClientUI m) => Direction -> m ()+epsIncrHuman d = do+  -- Perform the change:+  let sepsDelta = case d of+        Forward -> 1+        Backward -> -1+  modifyClient $ \cli -> cli {seps = seps cli + sepsDelta}+  invalidateBfsPathAll+  -- Provide UI feedback:+  -- Hack @sreportNull@ to display the new line even if no earlier messages.+  modifySession $ \sess -> sess {sreportNull = False}   saimMode <- getsSession saimMode   lidV <- viewedLevelUI-  modifySession $ \sess -> sess {saimMode = Just $ AimMode lidV}-  modifyClient $ \cli -> cli {seps = seps cli + if b then 1 else -1}-  invalidateBfsPathAll+  modifySession $ \sess -> sess {saimMode =+    let newDetail = maybe DetailLow detailLevel saimMode+    in Just $ AimMode lidV newDetail}   flashAiming   modifySession $ \sess -> sess {saimMode}+  -- The change may not affect the line shape, hence 'possibly'.+  msgAdd MsgPromptAction "Aiming line (possibly) modified."  -- Flash the aiming line and path. flashAiming :: MonadClientUI m => m ()@@ -1054,7 +1229,7 @@     Nothing -> failMsg "no more unknown spots left"     Just p -> do       let sxhair = Just $ TPoint TUnknown (blid b) p-      modifySession $ \sess -> sess {sxhair}+      setXHairFromGUI sxhair       doLook       return Nothing @@ -1070,7 +1245,7 @@     _ -> do       let (_, (p, bag)) = maximumBy (comparing fst) items           sxhair = Just $ TPoint (TItem bag) (blid b) p-      modifySession $ \sess -> sess {sxhair}+      setXHairFromGUI sxhair       doLook       return Nothing @@ -1086,77 +1261,102 @@     _ -> do       let (_, (p, (p0, bag))) = maximumBy (comparing fst) stairs           sxhair = Just $ TPoint (TEmbed bag p0) (blid b) p-      modifySession $ \sess -> sess {sxhair}+      setXHairFromGUI sxhair       doLook       return Nothing  -- * XhairPointerFloor -xhairPointerFloorHuman :: MonadClientUI m => m ()+xhairPointerFloorHuman :: (MonadClient m, MonadClientUI m) => m () xhairPointerFloorHuman = do   saimMode <- getsSession saimMode   aimPointerFloorHuman-  modifySession $ \sess -> sess {saimMode}+  when (isNothing saimMode) $+    modifySession $ \sess -> sess {saimMode} +-- * XhairPointerMute++xhairPointerMuteHuman :: (MonadClient m, MonadClientUI m) => m ()+xhairPointerMuteHuman = do+  saimMode <- getsSession saimMode+  aimPointerFloorLoud False+  when (isNothing saimMode) $+    modifySession $ \sess -> sess {saimMode}+ -- * XhairPointerEnemy -xhairPointerEnemyHuman :: MonadClientUI m => m ()+xhairPointerEnemyHuman :: (MonadClient m, MonadClientUI m) => m () xhairPointerEnemyHuman = do   saimMode <- getsSession saimMode   aimPointerEnemyHuman-  modifySession $ \sess -> sess {saimMode}+  when (isNothing saimMode) $+    modifySession $ \sess -> sess {saimMode}  -- * AimPointerFloor -aimPointerFloorHuman :: MonadClientUI m => m ()-aimPointerFloorHuman = do+aimPointerFloorHuman :: (MonadClient m, MonadClientUI m) => m ()+aimPointerFloorHuman = aimPointerFloorLoud True++aimPointerFloorLoud :: (MonadClient m, MonadClientUI m) => Bool -> m ()+aimPointerFloorLoud loud = do   COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops   lidV <- viewedLevelUI   -- Not @ScreenContent@, because not drawing here.-  Point{..} <- getsSession spointer-  if px >= 0 && py - mapStartY >= 0-     && px < rXmax && py - mapStartY < rYmax+  pUI <- getsSession spointer+  let p@(Point px py) = squareToMap $ uiToSquare pUI+  if px >= 0 && py >= 0 && px < rXmax && py < rYmax   then do     oldXhair <- getsSession sxhair-    let sxhair = Just $ TPoint TUnknown lidV $ Point px (py - mapStartY)+    let sxhair = Just $ TPoint TUnknown lidV p         sxhairMoused = sxhair /= oldXhair+        detailSucc = if sxhairMoused+                     then detailLevel+                     else detailCycle . detailLevel     modifySession $ \sess ->-      sess { saimMode = Just $ AimMode lidV-           , sxhair+      sess { saimMode =+               let newDetail = maybe defaultDetailLevel detailSucc+                                     (saimMode sess)+               in Just $ AimMode lidV newDetail            , sxhairMoused }-    doLook+    setXHairFromGUI sxhair+    when loud doLook   else stopPlayBack  -- * AimPointerEnemy -aimPointerEnemyHuman :: MonadClientUI m => m ()+aimPointerEnemyHuman :: (MonadClient m, MonadClientUI m) => m () aimPointerEnemyHuman = do   COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops   lidV <- viewedLevelUI   -- Not @ScreenContent@, because not drawing here.-  Point{..} <- getsSession spointer-  if px >= 0 && py - mapStartY >= 0-     && px < rXmax && py - mapStartY < rYmax+  pUI <- getsSession spointer+  let p@(Point px py) = squareToMap $ uiToSquare pUI+  if px >= 0 && py >= 0 && px < rXmax && py < rYmax   then do     bsAll <- getsState $ actorAssocs (const True) lidV     oldXhair <- getsSession sxhair     side <- getsClient sside     fact <- getsState $ (EM.! side) . sfactionD-    let newPos = Point px (py - mapStartY)-        sxhair =+    let sxhair =           -- If many actors, we pick here the first that would be picked           -- by '*', so that all other projectiles on the tile come next,-          -- when pressing "*", without any intervening actors from other tiles.+          -- when pressing '*', without any intervening actors from other tiles.           -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.-          case find (\(_, b) -> bpos b == newPos) bsAll of+          case find (\(_, b) -> bpos b == p) bsAll of             Just (aid, b) -> Just $ if isFoe side fact (bfid b)                                     then TEnemy aid                                     else TNonEnemy aid-            Nothing -> Just $ TPoint TUnknown lidV newPos+            Nothing -> Just $ TPoint TUnknown lidV p         sxhairMoused = sxhair /= oldXhair+        detailSucc = if sxhairMoused+                     then detailLevel+                     else detailCycle . detailLevel     modifySession $ \sess ->-      sess { saimMode = Just $ AimMode lidV-           , sxhairMoused-           , sxhair }+      sess { saimMode =+               let newDetail = maybe defaultDetailLevel detailSucc+                                     (saimMode sess)+               in Just $ AimMode lidV newDetail+           , sxhairMoused }+    setXHairFromGUI sxhair     doLook   else stopPlayBack

engine-src/Game/LambdaHack/Client/UI/HandleHumanM.hs view

@@ -1,9 +1,9 @@ -- | Semantics of human player commands. module Game.LambdaHack.Client.UI.HandleHumanM-  ( cmdHumanSem+  ( restrictedCmdSemInCxtOfKM, updateKeyLast #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , noRemoteHumanCmd, cmdAction, addNoError+  , noRemoteHumanCmd, cmdSemInCxtOfKM, cmdSemantics, addNoError #endif   ) where @@ -11,22 +11,25 @@  import Game.LambdaHack.Core.Prelude -import Game.LambdaHack.Client.MonadClient-import Game.LambdaHack.Client.Request-import Game.LambdaHack.Client.UI.HandleHelperM-import Game.LambdaHack.Client.UI.HandleHumanGlobalM-import Game.LambdaHack.Client.UI.HandleHumanLocalM-import Game.LambdaHack.Client.UI.HumanCmd-import Game.LambdaHack.Client.UI.MonadClientUI+import           Game.LambdaHack.Client.MonadClient+import           Game.LambdaHack.Client.Request+import           Game.LambdaHack.Client.UI.HandleHelperM+import           Game.LambdaHack.Client.UI.HandleHumanGlobalM+import           Game.LambdaHack.Client.UI.HandleHumanLocalM+import           Game.LambdaHack.Client.UI.HumanCmd+import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.MonadClientUI+import           Game.LambdaHack.Client.UI.SessionUI --- | The semantics of human player commands in terms of the client monad.+-- | The semantics of human player commands in terms of the client monad,+-- in context of the given @km@ as the last action. -- -- Some time cosuming commands are enabled even in aiming mode, but cannot be -- invoked in aiming mode on a remote level (level different than -- the level of the leader), which is caught here.-cmdHumanSem :: (MonadClient m, MonadClientUI m)-            => HumanCmd -> m (Either MError ReqUI)-cmdHumanSem cmd =+restrictedCmdSemInCxtOfKM :: (MonadClient m, MonadClientUI m)+                          => K.KM -> HumanCmd -> m (Either MError ReqUI)+restrictedCmdSemInCxtOfKM km cmd =   if noRemoteHumanCmd cmd then do     -- If in aiming mode, check if the current level is the same     -- as player level and refuse performing the action otherwise.@@ -35,8 +38,8 @@     if arena /= lidV then       weaveJust <$> failWith         "command disabled on a remote level, press ESC to switch back"-    else cmdAction cmd-  else cmdAction cmd+    else cmdSemInCxtOfKM km cmd+  else cmdSemInCxtOfKM km cmd  -- | Commands that are forbidden on a remote level, because they -- would usually take time when invoked on one, but not necessarily do@@ -56,21 +59,35 @@   ContinueToXhair -> True   _ -> False -cmdAction :: (MonadClient m, MonadClientUI m)-          => HumanCmd -> m (Either MError ReqUI)-cmdAction cmd = case cmd of+updateKeyLast :: K.KM -> HumanCmd -> KeyMacroFrame -> KeyMacroFrame+updateKeyLast km cmd macroFrame = case cmd of+  RepeatLast{} -> macroFrame+  Record{} -> macroFrame+  _ -> macroFrame {keyLast = Just km}++-- Semantics of the command in context of the given @km@ as the last action.+cmdSemInCxtOfKM :: (MonadClient m, MonadClientUI m)+                => K.KM -> HumanCmd -> m (Either MError ReqUI)+cmdSemInCxtOfKM km cmd = do+  modifySession $ \sess ->+    sess {smacroFrame = updateKeyLast km cmd $ smacroFrame sess}+  cmdSemantics cmd++cmdSemantics :: (MonadClient m, MonadClientUI m)+             => HumanCmd -> m (Either MError ReqUI)+cmdSemantics cmd = case cmd of   Macro kms -> addNoError $ macroHuman kms-  ByArea l -> byAreaHuman cmdAction l+  ByArea l -> byAreaHuman cmdSemInCxtOfKM l   ByAimMode AimModeCmd{..} ->-    byAimModeHuman (cmdAction exploration) (cmdAction aiming)+    byAimModeHuman (cmdSemantics exploration) (cmdSemantics aiming)   ComposeIfLocal cmd1 cmd2 ->-    composeIfLocalHuman (cmdAction cmd1) (cmdAction cmd2)+    composeIfLocalHuman (cmdSemantics cmd1) (cmdSemantics cmd2)   ComposeUnlessError cmd1 cmd2 ->-    composeUnlessErrorHuman (cmdAction cmd1) (cmdAction cmd2)+    composeUnlessErrorHuman (cmdSemantics cmd1) (cmdSemantics cmd2)   Compose2ndLocal cmd1 cmd2 ->-    compose2ndLocalHuman (cmdAction cmd1) (cmdAction cmd2)-  LoopOnNothing cmd1 -> loopOnNothingHuman (cmdAction cmd1)-  ExecuteIfClear cmd1 -> executeIfClearHuman (cmdAction cmd1)+    compose2ndLocalHuman (cmdSemantics cmd1) (cmdSemantics cmd2)+  LoopOnNothing cmd1 -> loopOnNothingHuman (cmdSemantics cmd1)+  ExecuteIfClear cmd1 -> executeIfClearHuman (cmdSemantics cmd1)    Wait -> weaveJust <$> (ReqUITimed <$$> waitHuman)   Wait10 -> weaveJust <$> (ReqUITimed <$$> waitHuman10)@@ -82,33 +99,37 @@   MoveOnceToXhair -> weaveJust <$> (ReqUITimed <$$> moveOnceToXhairHuman)   RunOnceToXhair  -> weaveJust <$> (ReqUITimed <$$> runOnceToXhairHuman)   ContinueToXhair -> weaveJust <$> (ReqUITimed <$$> continueToXhairHuman)-  MoveItem cLegalRaw toCStore mverb auto ->-    weaveJust-    <$> (ReqUITimed <$$> moveItemHuman cLegalRaw toCStore mverb auto)+  MoveItem stores toCStore mverb auto ->+    weaveJust <$> (ReqUITimed <$$> moveItemHuman stores toCStore mverb auto)   Project -> weaveJust <$> (ReqUITimed <$$> projectHuman)   Apply -> weaveJust <$> (ReqUITimed <$$> applyHuman)-  AlterDir ts -> weaveJust <$> (ReqUITimed <$$> alterDirHuman ts)-  AlterWithPointer ts -> weaveJust-                         <$> (ReqUITimed <$$> alterWithPointerHuman ts)-  Help -> helpHuman cmdAction-  Hint -> hintHuman cmdAction-  ItemMenu -> itemMenuHuman cmdAction-  ChooseItemMenu dialogMode -> chooseItemMenuHuman cmdAction dialogMode-  MainMenu -> mainMenuHuman cmdAction-  MainMenuAutoOn -> mainMenuAutoOnHuman cmdAction-  MainMenuAutoOff -> mainMenuAutoOffHuman cmdAction-  Dashboard -> dashboardHuman cmdAction-  GameDifficultyIncr -> gameDifficultyIncr >> challengesMenuHuman cmdAction-  GameWolfToggle -> gameWolfToggle >> challengesMenuHuman cmdAction-  GameFishToggle -> gameFishToggle >> challengesMenuHuman cmdAction-  GameScenarioIncr -> gameScenarioIncr >> mainMenuHuman cmdAction+  AlterDir -> weaveJust <$> (ReqUITimed <$$> alterDirHuman)+  AlterWithPointer -> weaveJust <$> (ReqUITimed <$$> alterWithPointerHuman)+  CloseDir -> weaveJust <$> (ReqUITimed <$$> closeDirHuman)+  Help -> helpHuman cmdSemInCxtOfKM+  Hint -> hintHuman cmdSemInCxtOfKM+  ItemMenu -> itemMenuHuman cmdSemInCxtOfKM+  ChooseItemMenu dialogMode -> chooseItemMenuHuman cmdSemInCxtOfKM dialogMode+  MainMenu -> mainMenuHuman cmdSemInCxtOfKM+  MainMenuAutoOn -> mainMenuAutoOnHuman cmdSemInCxtOfKM+  MainMenuAutoOff -> mainMenuAutoOffHuman cmdSemInCxtOfKM+  Dashboard -> dashboardHuman cmdSemInCxtOfKM+  GameTutorialToggle -> gameTutorialToggle+                        >> challengeMenuHuman cmdSemInCxtOfKM+  GameDifficultyIncr -> gameDifficultyIncr+                        >> challengeMenuHuman cmdSemInCxtOfKM+  GameFishToggle -> gameFishToggle >> challengeMenuHuman cmdSemInCxtOfKM+  GameGoodsToggle -> gameGoodsToggle >> challengeMenuHuman cmdSemInCxtOfKM+  GameWolfToggle -> gameWolfToggle >> challengeMenuHuman cmdSemInCxtOfKM+  GameKeeperToggle -> gameKeeperToggle >> challengeMenuHuman cmdSemInCxtOfKM+  GameScenarioIncr -> gameScenarioIncr >> challengeMenuHuman cmdSemInCxtOfKM    GameRestart -> weaveJust <$> gameRestartHuman   GameQuit -> weaveJust <$> gameQuitHuman   GameDrop -> weaveJust <$> fmap Right gameDropHuman   GameExit -> weaveJust <$> fmap Right gameExitHuman   GameSave -> weaveJust <$> fmap Right gameSaveHuman-  Tactic -> weaveJust <$> tacticHuman+  Doctrine -> weaveJust <$> doctrineHuman   Automate -> weaveJust <$> automateHuman   AutomateToggle -> weaveJust <$> automateToggleHuman   AutomateBack -> automateBackHuman@@ -118,28 +139,32 @@   ChooseItemApply ts -> Left <$> chooseItemApplyHuman ts   PickLeader k -> Left <$> pickLeaderHuman k   PickLeaderWithPointer -> Left <$> pickLeaderWithPointerHuman-  MemberCycle -> Left <$> memberCycleHuman-  MemberBack -> Left <$> memberBackHuman+  MemberCycle direction -> Left <$> memberCycleHuman direction+  MemberCycleLevel direction -> Left <$> memberCycleLevelHuman direction   SelectActor -> addNoError selectActorHuman   SelectNone -> addNoError selectNoneHuman   SelectWithPointer -> Left <$> selectWithPointerHuman   Repeat n -> addNoError $ repeatHuman n+  RepeatLast n -> addNoError $ repeatLastHuman n   Record -> addNoError recordHuman   AllHistory -> addNoError allHistoryHuman   LastHistory -> addNoError lastHistoryHuman-  MarkVision -> markVisionHuman >> settingsMenuHuman cmdAction-  MarkSmell -> markSmellHuman >> settingsMenuHuman cmdAction-  MarkSuspect -> markSuspectHuman >> settingsMenuHuman cmdAction-  SettingsMenu -> settingsMenuHuman cmdAction-  ChallengesMenu -> challengesMenuHuman cmdAction+  MarkVision -> markVisionHuman >> settingsMenuHuman cmdSemInCxtOfKM+  MarkSmell -> markSmellHuman >> settingsMenuHuman cmdSemInCxtOfKM+  MarkSuspect -> markSuspectHuman >> settingsMenuHuman cmdSemInCxtOfKM+  MarkAnim -> markAnimHuman >> settingsMenuHuman cmdSemInCxtOfKM+  OverrideTut -> overrideTutHuman >> settingsMenuHuman cmdSemInCxtOfKM+  SettingsMenu -> settingsMenuHuman cmdSemInCxtOfKM+  ChallengeMenu -> challengeMenuHuman cmdSemInCxtOfKM   PrintScreen -> addNoError printScreenHuman    Cancel -> addNoError cancelHuman   Accept -> addNoError acceptHuman+  DetailCycle -> addNoError detailCycleHuman   ClearTargetIfItemClear -> addNoError clearTargetIfItemClearHuman   ItemClear -> addNoError itemClearHuman   MoveXhair v k -> Left <$> moveXhairHuman v k-  AimTgt -> Left <$> aimTgtHuman+  AimTgt -> addNoError aimTgtHuman   AimFloor -> addNoError aimFloorHuman   AimEnemy -> addNoError aimEnemyHuman   AimItem -> addNoError aimItemHuman@@ -149,6 +174,7 @@   XhairItem -> Left <$> xhairItemHuman   XhairStair up -> Left <$> xhairStairHuman up   XhairPointerFloor -> addNoError xhairPointerFloorHuman+  XhairPointerMute -> addNoError xhairPointerMuteHuman   XhairPointerEnemy -> addNoError xhairPointerEnemyHuman   AimPointerFloor -> addNoError aimPointerFloorHuman   AimPointerEnemy -> addNoError aimPointerEnemyHuman

engine-src/Game/LambdaHack/Client/UI/HumanCmd.hs view

@@ -4,7 +4,7 @@   ( CmdCategory(..), categoryDescription   , CmdArea(..), areaDescription   , CmdTriple, AimModeCmd(..), HumanCmd(..)-  , TriggerItem(..), TriggerTile(..)+  , TriggerItem(..)   ) where  import Prelude ()@@ -16,14 +16,13 @@ import           GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU -import           Game.LambdaHack.Common.Vector-import qualified Game.LambdaHack.Content.TileKind as TK-import           Game.LambdaHack.Definition.Defs+import Game.LambdaHack.Common.Vector+import Game.LambdaHack.Definition.Defs  data CmdCategory =     CmdMainMenu | CmdDashboard | CmdItemMenu   | CmdMove | CmdItem | CmdAim | CmdMeta | CmdMouse-  | CmdInternal | CmdNoHelp | CmdDebug | CmdMinimal+  | CmdInternal | CmdDebug | CmdMinimal   deriving (Show, Read, Eq, Generic)  instance NFData CmdCategory@@ -34,13 +33,12 @@ categoryDescription CmdMainMenu = "Main menu" categoryDescription CmdDashboard = "Dashboard" categoryDescription CmdItemMenu = "Item menu commands"-categoryDescription CmdMove = "Terrain exploration and alteration"-categoryDescription CmdItem = "Remaining item-related commands"-categoryDescription CmdAim = "Aiming commands"+categoryDescription CmdMove = "Terrain exploration and modification commands"+categoryDescription CmdItem = "All item-related commands"+categoryDescription CmdAim = "All aiming commands" categoryDescription CmdMeta = "Assorted commands" categoryDescription CmdMouse = "Mouse" categoryDescription CmdInternal = "Internal"-categoryDescription CmdNoHelp = "Ignored in help" categoryDescription CmdDebug = "Debug" categoryDescription CmdMinimal = "The minimal command set" @@ -72,19 +70,19 @@ areaDescription :: CmdArea -> Text areaDescription ca = case ca of   CaMessage ->      "message line"-  CaMapLeader ->    "leader on map"+  CaMapLeader ->    "pointman tile"   CaMapParty ->     "party on map"   CaMap ->          "the map area"   CaLevelNumber ->  "level number"   CaArenaName ->    "level caption"   CaPercentSeen ->  "percent seen"-  CaXhairDesc ->    "x-hair info"+  CaXhairDesc ->    "crosshair info"   CaSelected ->     "party roster"   CaCalmGauge ->    "Calm gauge"   CaCalmValue ->    "Calm value"   CaHPGauge ->      "HP gauge"-  CaHPValue ->      "HP Value"-  CaLeaderDesc ->   "leader info"+  CaHPValue ->      "HP value"+  CaLeaderDesc ->   "pointman info"   --                 1234567890123  -- | This triple of command categories, description and the command term itself@@ -121,11 +119,12 @@   | MoveOnceToXhair   | RunOnceToXhair   | ContinueToXhair-  | MoveItem [CStore] CStore (Maybe MU.Part) Bool+  | MoveItem [CStore] CStore (Maybe Text) Bool   | Project   | Apply-  | AlterDir [TriggerTile]-  | AlterWithPointer [TriggerTile]+  | AlterDir+  | AlterWithPointer+  | CloseDir   | Help   | Hint   | ItemMenu@@ -134,16 +133,19 @@   | MainMenuAutoOff   | Dashboard     -- Below this line, commands do not take time.+  | GameTutorialToggle   | GameDifficultyIncr-  | GameWolfToggle   | GameFishToggle+  | GameGoodsToggle+  | GameWolfToggle+  | GameKeeperToggle   | GameScenarioIncr   | GameRestart   | GameQuit   | GameDrop   | GameExit   | GameSave-  | Tactic+  | Doctrine   | Automate   | AutomateToggle   | AutomateBack@@ -154,24 +156,28 @@   | ChooseItemApply [TriggerItem]   | PickLeader Int   | PickLeaderWithPointer-  | MemberCycle-  | MemberBack+  | MemberCycle Direction+  | MemberCycleLevel Direction   | SelectActor   | SelectNone   | SelectWithPointer   | Repeat Int+  | RepeatLast Int   | Record   | AllHistory   | LastHistory   | MarkVision   | MarkSmell   | MarkSuspect+  | MarkAnim+  | OverrideTut   | SettingsMenu-  | ChallengesMenu+  | ChallengeMenu   | PrintScreen     -- These are mostly related to aiming.   | Cancel   | Accept+  | DetailCycle   | ClearTargetIfItemClear   | ItemClear   | MoveXhair Vector Int@@ -180,11 +186,12 @@   | AimEnemy   | AimItem   | AimAscend Int-  | EpsIncr Bool+  | EpsIncr Direction   | XhairUnknown   | XhairItem   | XhairStair Bool   | XhairPointerFloor+  | XhairPointerMute   | XhairPointerEnemy   | AimPointerFloor   | AimPointerEnemy@@ -206,16 +213,3 @@ instance NFData TriggerItem  instance Binary TriggerItem---- | Description of how tile altering is triggered and communicated--- to the player.-data TriggerTile =-  TriggerTile {ttverb :: MU.Part, ttobject :: MU.Part, ttfeature :: TK.Feature}-  deriving (Show, Eq, Ord, Generic)--instance Read TriggerTile where-  readsPrec = error $ "parsing of TriggerTile not implemented" `showFailure` ()--instance NFData TriggerTile--instance Binary TriggerTile

engine-src/Game/LambdaHack/Client/UI/InventoryM.hs view

@@ -1,7 +1,12 @@ -- | UI of inventory management. module Game.LambdaHack.Client.UI.InventoryM-  ( Suitability(..)-  , getFull, getGroupItem, getStoreItem+  ( Suitability(..), ResultItemDialogMode(..)+  , slotsOfItemDialogMode, getFull, getGroupItem, getStoreItem+#ifdef EXPOSE_INTERNAL+    -- * Internal operations+  , ItemDialogState(..), accessModeBag, storeItemPrompt, getItem+  , DefItemKey(..), transition, keyOfEKM, runDefItemKey+#endif   ) where  import Prelude ()@@ -12,7 +17,6 @@ import           Data.Either import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T-import           Data.Tuple (swap) import qualified NLP.Miniutter.English as MU  import           Game.LambdaHack.Client.MonadClient@@ -20,13 +24,14 @@ import           Game.LambdaHack.Client.UI.ActorUI import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.HandleHelperM import           Game.LambdaHack.Client.UI.HumanCmd import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.MonadClientUI+import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.MsgM-import           Game.LambdaHack.Client.UI.Overlay import           Game.LambdaHack.Client.UI.SessionUI import           Game.LambdaHack.Client.UI.Slideshow import           Game.LambdaHack.Client.UI.SlideshowM@@ -35,17 +40,28 @@ 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.Misc import           Game.LambdaHack.Common.MonadStateRead-import           Game.LambdaHack.Common.ReqFailure import           Game.LambdaHack.Common.State import           Game.LambdaHack.Common.Types+import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs  data ItemDialogState = ISuitable | IAll   deriving (Show, Eq) +data ResultItemDialogMode =+    RStore CStore [ItemId]+  | ROrgans ItemId ItemBag SingleItemSlots+  | ROwned ItemId+  | RSkills Int+  | RLore SLore ItemId ItemBag SingleItemSlots+  | RPlaces Int+  | RModes Int+  deriving Show+ accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag accessModeBag leader s (MStore cstore) = let b = getActorBody leader s                                          in getBodyStoreBag b cstore s@@ -54,197 +70,286 @@ accessModeBag leader s MOwned = let fid = bfid $ getActorBody leader s                                 in combinedItems fid s accessModeBag _ _ MSkills = EM.empty-accessModeBag _ s MLore{} = EM.map (const (1, [])) $ sitemD s+accessModeBag _ s MLore{} = EM.map (const quantSingle) $ sitemD s accessModeBag _ _ MPlaces = EM.empty+accessModeBag _ _ MModes = EM.empty +-- This is the only place slots are sorted. As a side-effect,+-- slots in inventories always agree with slots of item lore.+-- Not so for organ menu, because many lore maps point there.+-- Sorting in @updateItemSlot@ would not be enough, because, e.g.,+-- identifying an item should change its slot position.+slotsOfItemDialogMode :: MonadClientUI m => ItemDialogMode -> m SingleItemSlots+slotsOfItemDialogMode cCur = do+  itemToF <- getsState $ flip itemToFull+  ItemSlots itemSlotsPre <- getsSession sslots+  case cCur of+    MOrgans -> do+      let newSlots = EM.adjust (sortSlotMap itemToF) SOrgan+                     $ EM.adjust (sortSlotMap itemToF) STrunk+                     $ EM.adjust (sortSlotMap itemToF) SCondition itemSlotsPre+      modifySession $ \sess -> sess {sslots = ItemSlots newSlots}+      return $! mergeItemSlots itemToF [ newSlots EM.! SOrgan+                                       , newSlots EM.! STrunk+                                       , newSlots EM.! SCondition ]+    MSkills -> return EM.empty+    MPlaces -> return EM.empty+    MModes -> return EM.empty+    _ -> do+      let slore = IA.loreFromMode cCur+          newSlots = EM.adjust (sortSlotMap itemToF) slore itemSlotsPre+      modifySession $ \sess -> sess {sslots = ItemSlots newSlots}+      return $! newSlots EM.! slore+ -- | Let a human player choose any item from a given group. -- Note that this does not guarantee the chosen item belongs to the group, -- as the player can override the choice. -- Used e.g., for applying and projecting.-getGroupItem :: MonadClientUI m+getGroupItem :: (MonadClient m, MonadClientUI m)              => m Suitability                           -- ^ which items to consider suitable              -> Text      -- ^ specific prompt for only suitable items              -> Text      -- ^ generic prompt-             -> [CStore]  -- ^ initial legal modes-             -> [CStore]  -- ^ legal modes after Calm taken into account-             -> m (Either Text ( (ItemId, ItemFull)-                               , (ItemDialogMode, Either K.KM SlotChar) ))-getGroupItem psuit prompt promptGeneric-             cLegalRaw cLegalAfterCalm = do+             -> Text      -- ^ the verb to use+             -> Text      -- ^ the generic verb to use+             -> [CStore]  -- ^ stores to cycle through+             -> m (Either Text (CStore, ItemId))+getGroupItem psuit prompt promptGeneric verb verbGeneric stores = do+  side <- getsClient sside+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! side+  let ppItemDialogBody v body actorSk cCur = case cCur of+        MStore CEqp | not $ calmEnough body actorSk ->+          "distractedly attempt to" <+> v <+> ppItemDialogModeIn cCur+        MStore CGround | mstash == Just (blid body, bpos body) ->+          "greedily attempt to" <+> v <+> ppItemDialogModeIn cCur+        _ -> v <+> ppItemDialogModeFrom cCur   soc <- getFull psuit-                 (\_ _ _ cCur _ -> prompt <+> ppItemDialogModeFrom cCur)-                 (\_ _ _ cCur _ -> promptGeneric <+> ppItemDialogModeFrom cCur)-                 cLegalRaw cLegalAfterCalm True False+                 (\body _ actorSk cCur _ ->+                    prompt <+> ppItemDialogBody verb body actorSk cCur)+                 (\body _ actorSk cCur _ ->+                    promptGeneric+                    <+> ppItemDialogBody verbGeneric body actorSk cCur)+                 stores True False   case soc of     Left err -> return $ Left err-    Right ([(iid, (itemFull, _))], cekm) ->-      return $ Right ((iid, itemFull), cekm)+    Right (rstore, [(iid, _)]) -> return $ Right (rstore, iid)     Right _ -> error $ "" `showFailure` soc  -- | Display all items from a store and let the human player choose any -- or switch to any other store. -- Used, e.g., for viewing inventory and item descriptions.-getStoreItem :: MonadClientUI m-             => (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State-                 -> Text)        -- ^ how to describe suitable items-             -> ItemDialogMode   -- ^ initial mode-             -> m ( Either Text (ItemId, ItemBag, SingleItemSlots)-                  , (ItemDialogMode, Either K.KM SlotChar) )-getStoreItem prompt cInitial = do-  let itemCs = map MStore [CEqp, CInv, CGround, CSha]-      loreCs = map MLore [minBound..maxBound] ++ [MPlaces]+getStoreItem :: (MonadClient m, MonadClientUI m)+             => ItemDialogMode   -- ^ initial mode+             -> m (Either Text ResultItemDialogMode)+getStoreItem cInitial = do+  side <- getsClient sside+  let itemCs = map MStore [CStash, CEqp, CGround]+        -- No @COrgan@, because triggerable organs are rare and,+        -- if really needed, accessible directly from the trigger menu.+      loreCs = map MLore [minBound..maxBound] ++ [MPlaces, MModes]       allCs = case cInitial of         MLore{} -> loreCs         MPlaces -> loreCs+        MModes -> loreCs         _ -> itemCs ++ [MOwned, MOrgans, MSkills]       (pre, rest) = break (== cInitial) allCs       post = dropWhile (== cInitial) rest       remCs = post ++ pre-  soc <- getItem (return SuitsEverything)-                 prompt prompt cInitial remCs-                 True False (cInitial : remCs)-  case soc of-    (Left err, cekm) -> return (Left err, cekm)-    (Right ([iid], itemBag, lSlots), cekm) ->-      return (Right (iid, itemBag, lSlots), cekm)-    (Right{}, _) -> error $ "" `showFailure` soc+      prompt = storeItemPrompt side+  getItem (return SuitsEverything) prompt prompt cInitial remCs True False +storeItemPrompt :: FactionId+                -> Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State+                -> Text+storeItemPrompt side body bodyUI actorCurAndMaxSk c2 s =+  let COps{coitem} = scops s+      fact = sfactionD s EM.! side+      (tIn, t) = ppItemDialogMode c2+      subject = partActor bodyUI+      f (k, _) acc = k + acc+      countItems store = EM.foldr' f 0 $ getBodyStoreBag body store s+  in case c2 of+    MStore CGround ->+      let n = countItems CGround+          nItems = MU.CarAWs n "item"+          verbGround = if gstash fact == Just (blid body, bpos body)+                       then "fondle greedily"+                       else "notice"+      in makePhrase+           [ MU.Capitalize $ MU.SubjectVerbSg subject verbGround+           , nItems, "at"+           , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text "feet" ]+    MStore CEqp ->+      let n = countItems CEqp+          (verbEqp, nItems) =+            if | n == 0 -> ("find nothing", "")+               | calmEnough body actorCurAndMaxSk ->+                   ("find", MU.CarAWs n "item")+               | otherwise -> ("paw distractedly at", MU.CarAWs n "item")+      in makePhrase+           [ MU.Capitalize $ MU.SubjectVerbSg subject verbEqp+           , nItems, MU.Text tIn+           , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]+    MStore cstore ->+      let n = countItems cstore+          nItems = MU.CarAWs n "item"+          (verb, onLevel) = case cstore of+            COrgan -> ("feel", [])+            CStash ->+              ( "notice"+              , case gstash fact of+                  Just (lid, _) ->+                    map MU.Text ["on level", tshow $ abs $ fromEnum lid]+                  Nothing -> [] )+            _ -> ("see", [])+          ownObject = case cstore of+            CStash -> ["our", MU.Text t]+            _ -> [MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t]+      in makePhrase $+           [ MU.Capitalize $ MU.SubjectVerbSg subject verb+           , nItems, MU.Text tIn ] ++ ownObject ++ onLevel+    MOrgans ->+      makePhrase+        [ MU.Capitalize $ MU.SubjectVerbSg subject "feel"+        , MU.Text tIn+        , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]+    MOwned ->+      -- We assume "gold grain", not "grain" with label "of gold":+      let currencyName = IK.iname $ okind coitem+                         $ ouniqGroup coitem IK.S_CURRENCY+          dungeonTotal = sgold s+          (_, total) = calculateTotal side s+          n = countItems CStash+          verbOwned = if | n == 0 -> "find nothing among"+                         | otherwise -> "review"+      in makePhrase+           [ MU.Text $ spoilsBlurb currencyName total dungeonTotal+           , MU.Capitalize $ MU.SubjectVerbSg subject verbOwned+           , MU.Text t ]+    MSkills ->+      makePhrase+        [ MU.Capitalize $ MU.SubjectVerbSg subject "estimate"+        , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]+    MLore slore ->+      makePhrase+        [ MU.Capitalize $ MU.Text $+            if slore == SEmbed+            then "terrain (including crafting recipes)"+            else t ]+    MPlaces ->+      makePhrase+        [ MU.Capitalize $ MU.Text t ]+    MModes ->+      makePhrase+        [ MU.Capitalize $ MU.Text t ]+ -- | Let the human player choose a single, preferably suitable, -- item from a list of items. Don't display stores empty for all actors. -- Start with a non-empty store.-getFull :: MonadClientUI m+getFull :: (MonadClient m, MonadClientUI m)         => m Suitability    -- ^ which items to consider suitable         -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State             -> Text)        -- ^ specific prompt for only suitable items         -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State             -> Text)        -- ^ generic prompt-        -> [CStore]         -- ^ initial legal modes-        -> [CStore]         -- ^ legal modes with Calm taken into account+        -> [CStore]         -- ^ stores to cycle through         -> Bool             -- ^ whether to ask, when the only item                             --   in the starting mode is suitable         -> Bool             -- ^ whether to permit multiple items as a result-        -> m (Either Text ( [(ItemId, ItemFullKit)]-                          , (ItemDialogMode, Either K.KM SlotChar) ))-getFull psuit prompt promptGeneric cLegalRaw cLegalAfterCalm-        askWhenLone permitMulitple = do-  side <- getsClient sside+        -> m (Either Text (CStore, [(ItemId, ItemQuant)]))+getFull psuit prompt promptGeneric stores askWhenLone permitMulitple = do   leader <- getLeaderUI-  let aidNotEmpty store aid = do-        body <- getsState $ getActorBody aid-        bag <- getsState $ getBodyStoreBag body store-        return $! not $ EM.null bag-      partyNotEmpty store = do-        as <- getsState $ fidActorNotProjGlobalAssocs side-        bs <- mapM (aidNotEmpty store . fst) as-        return $! or bs   mpsuit <- psuit   let psuitFun = case mpsuit of-        SuitsEverything -> \_ _ -> True+        SuitsEverything -> \_ _ _ -> True         SuitsSomething f -> f   -- Move the first store that is non-empty for suitable items for this actor   -- to the front, if any.   b <- getsState $ getActorBody leader   getCStoreBag <- getsState $ \s cstore -> getBodyStoreBag b cstore s   let hasThisActor = not . EM.null . getCStoreBag-  case filter hasThisActor cLegalAfterCalm of-    [] ->-      if isNothing (find hasThisActor cLegalRaw) then do-        let contLegalRaw = map MStore cLegalRaw-            tLegal = map (MU.Text . ppItemDialogModeIn) contLegalRaw-            ppLegal = makePhrase [MU.WWxW "nor" tLegal]-        return $ Left $ "no items" <+> ppLegal-      else return $ Left $ showReqFailure ItemNotCalm+  case filter hasThisActor stores of+    [] -> do+      let dialogModes = map MStore stores+          ts = map (MU.Text . ppItemDialogModeIn) dialogModes+      return $ Left $ "no items" <+> makePhrase [MU.WWxW "nor" ts]     haveThis@(headThisActor : _) -> do       itemToF <- getsState $ flip itemToFull       let suitsThisActor store =             let bag = getCStoreBag store-            in any (\(iid, kit) -> psuitFun (itemToF iid) kit) $ EM.assocs bag+            in any (\(iid, kit) -> psuitFun (Just store) (itemToF iid) kit)+                   (EM.assocs bag)           firstStore = fromMaybe headThisActor $ find suitsThisActor haveThis-      -- Don't display stores totally empty for all actors.-      cLegal <- filterM partyNotEmpty cLegalRaw-      let breakStores cInit =-            let (pre, rest) = break (== cInit) cLegal+          -- Don't display stores totally empty for all actors.+          breakStores cInit =+            let (pre, rest) = break (== cInit) stores                 post = dropWhile (== cInit) rest             in (MStore cInit, map MStore $ post ++ pre)-      let (modeFirst, modeRest) = breakStores firstStore+          (modeFirst, modeRest) = breakStores firstStore       res <- getItem psuit prompt promptGeneric modeFirst modeRest-                     askWhenLone permitMulitple (map MStore cLegal)+                     askWhenLone permitMulitple       case res of-        (Left t, _) -> return $ Left t-        (Right (iids, itemBag, _lSlots), cekm) -> do-          let f iid = (iid, (itemToF iid, itemBag EM.! iid))-          return $ Right (map f iids, cekm)+        Left t -> return $ Left t+        Right (RStore fromCStore iids) -> do+          let bagAll = getCStoreBag fromCStore+              f iid = (iid, bagAll EM.! iid)+          return $ Right (fromCStore, map f iids)+        Right _ -> error $ "" `showFailure` res  -- | Let the human player choose a single, preferably suitable, -- item from a list of items.-getItem :: MonadClientUI m-        => m Suitability-                            -- ^ which items to consider suitable+getItem :: (MonadClient m, MonadClientUI m)+        => m Suitability    -- ^ which items to consider suitable         -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State             -> Text)        -- ^ specific prompt for only suitable items         -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State             -> Text)        -- ^ generic prompt-        -> ItemDialogMode   -- ^ first mode, legal or not-        -> [ItemDialogMode] -- ^ the (rest of) legal modes+        -> ItemDialogMode   -- ^ first mode to display+        -> [ItemDialogMode] -- ^ the (rest of) modes         -> Bool             -- ^ whether to ask, when the only item                             --   in the starting mode is suitable         -> Bool             -- ^ whether to permit multiple items as a result-        -> [ItemDialogMode] -- ^ all legal modes-        -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)-             , (ItemDialogMode, Either K.KM SlotChar) )-getItem psuit prompt promptGeneric cCur cRest askWhenLone permitMulitple-        cLegal = do+        -> m (Either Text ResultItemDialogMode)+getItem psuit prompt promptGeneric cCur cRest askWhenLone permitMulitple = do   leader <- getLeaderUI   accessCBag <- getsState $ accessModeBag leader   let storeAssocs = EM.assocs . accessCBag       allAssocs = concatMap storeAssocs (cCur : cRest)-  case allAssocs of-    [(iid, k)] | null cRest && not askWhenLone -> do-      ItemSlots itemSlots <- getsSession sslots-      let lSlots = itemSlots EM.! IA.loreFromMode cCur-          slotChar = fromMaybe (error $ "" `showFailure` (iid, lSlots))-                     $ lookup iid $ map swap $ EM.assocs lSlots-      return ( Right ([iid], EM.singleton iid k, EM.singleton slotChar iid)-             , (cCur, Right slotChar) )-    _ ->-      transition psuit prompt promptGeneric permitMulitple cLegal-                 0 cCur cRest ISuitable+  case (allAssocs, cCur) of+    ([(iid, _)], MStore rstore) | null cRest && not askWhenLone ->+      return $ Right $ RStore rstore [iid]+    _ -> transition psuit prompt promptGeneric permitMulitple+                    0 cCur cRest ISuitable  data DefItemKey m = DefItemKey   { defLabel  :: Either Text K.KM   , defCond   :: Bool-  , defAction :: Either K.KM SlotChar-              -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)-                   , (ItemDialogMode, Either K.KM SlotChar) )+  , defAction :: Either K.KM SlotChar -> m (Either Text ResultItemDialogMode)   }  data Suitability =     SuitsEverything-  | SuitsSomething (ItemFull -> ItemQuant -> Bool)+  | SuitsSomething (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -transition :: forall m. MonadClientUI m+transition :: forall m. (MonadClient m, MonadClientUI m)            => m Suitability            -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State                -> Text)            -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State                -> Text)            -> Bool-           -> [ItemDialogMode]            -> Int            -> ItemDialogMode            -> [ItemDialogMode]            -> ItemDialogState-           -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)-                , (ItemDialogMode, Either K.KM SlotChar) )-transition psuit prompt promptGeneric permitMulitple cLegal+           -> m (Either Text ResultItemDialogMode)+transition psuit prompt promptGeneric permitMulitple            numPrefix cCur cRest itemDialogState = do-  let recCall = transition psuit prompt promptGeneric permitMulitple cLegal-  ItemSlots itemSlotsPre <- getsSession sslots+  let recCall = transition psuit prompt promptGeneric permitMulitple   leader <- getLeaderUI+  actorCurAndMaxSk <- leaderSkillsClientUI   body <- getsState $ getActorBody leader   bodyUI <- getsSession $ getActorUI leader-  actorMaxSk <- getsState $ getActorMaxSkills leader   fact <- getsState $ (EM.! bfid body) . sfactionD   hs <- partyAfterLeader leader   bagAll <- getsState $ \s -> accessModeBag leader s cCur@@ -252,35 +357,29 @@   revCmd <- revCmdMap   mpsuit <- psuit  -- when throwing, this sets eps and checks xhair validity   psuitFun <- case mpsuit of-    SuitsEverything -> return $ \_ _ -> True+    SuitsEverything -> return $ \_ _ _ -> True     SuitsSomething f -> return f  -- When throwing, this function takes                                   -- missile range into accout.-  -- This is the only place slots are sorted. As a side-effect,-  -- slots in inventories always agree with slots of item lore.-  -- Not so for organ menu, because many lore maps point there.-  -- Sorting in @updateItemSlot@ would not be enough, because, e.g.,-  -- identifying an item should change its slot position.-  lSlots <- case cCur of-    MOrgans -> do-      let newSlots = EM.adjust (sortSlotMap itemToF) SOrgan-                     $ EM.adjust (sortSlotMap itemToF) STrunk-                     $ EM.adjust (sortSlotMap itemToF) SCondition itemSlotsPre-      modifySession $ \sess -> sess {sslots = ItemSlots newSlots}-      return $! mergeItemSlots itemToF [ newSlots EM.! SOrgan-                                       , newSlots EM.! STrunk-                                       , newSlots EM.! SCondition ]-    MSkills -> return EM.empty-    MPlaces -> return EM.empty-    _ -> do-      let slore = IA.loreFromMode cCur-          newSlots = EM.adjust (sortSlotMap itemToF) slore itemSlotsPre-      modifySession $ \sess -> sess {sslots = ItemSlots newSlots}-      return $! newSlots EM.! slore-  let getResult :: Either K.KM SlotChar -> [ItemId]-                -> ( Either Text ([ItemId], ItemBag, SingleItemSlots)-                   , (ItemDialogMode, Either K.KM SlotChar) )-      getResult ekm iids = (Right (iids, bagAll, bagItemSlotsAll), (cCur, ekm))-      filterP iid = psuitFun (itemToF iid)+  lSlots <- slotsOfItemDialogMode cCur+  let getResult :: [ItemId] -> Either Text ResultItemDialogMode+      getResult iids = Right $ case cCur of+        MStore rstore -> RStore rstore iids+        MOrgans -> case iids of+          [iid] -> ROrgans iid bagAll bagItemSlotsAll+          _ -> error $ "" `showFailure` (cCur, iids)+        MOwned -> case iids of+          [iid] -> ROwned iid+          _ -> error $ "" `showFailure` (cCur, iids)+        MSkills -> error $ "" `showFailure` cCur+        MLore rlore -> case iids of+          [iid] -> RLore rlore iid bagAll bagItemSlotsAll+          _ -> error $ "" `showFailure` (cCur, iids)+        MPlaces ->  error $ "" `showFailure` cCur+        MModes -> error $ "" `showFailure` cCur+      mstore = case cCur of+        MStore store -> Just store+        _ -> Nothing+      filterP iid = psuitFun mstore (itemToF iid)       bagAllSuit = EM.filterWithKey filterP bagAll       bagItemSlotsAll = EM.filter (`EM.member` bagAll) lSlots       -- Predicate for slot matching the current prefix, unless the prefix@@ -298,10 +397,17 @@         EM.filterWithKey hasPrefixOpen suitableItemSlotsAll       bagSuit = EM.fromList $ map (\iid -> (iid, bagAllSuit EM.! iid))                                   (EM.elems suitableItemSlotsOpen)+      nextContainers direction = case direction of+        Forward -> case cRest ++ [cCur] of+          c1 : rest -> (c1, rest)+          [] -> error $ "" `showFailure` cRest+        Backward -> case reverse $ cCur : cRest of+          c1 : rest -> (c1, reverse rest)+          [] -> error $ "" `showFailure` cRest   (bagFiltered, promptChosen) <- getsState $ \s ->     case itemDialogState of-      ISuitable -> (bagSuit, prompt body bodyUI actorMaxSk cCur s <> ":")-      IAll      -> (bag, promptGeneric body bodyUI actorMaxSk cCur s <> ":")+      ISuitable -> (bagSuit, prompt body bodyUI actorCurAndMaxSk cCur s <> ":")+      IAll -> (bag, promptGeneric body bodyUI actorCurAndMaxSk cCur s <> ":")   let (autoDun, _) = autoDungeonLevel fact       multipleSlots = if itemDialogState == IAll                       then bagItemSlotsAll@@ -309,15 +415,35 @@       maySwitchLeader MOwned = False       maySwitchLeader MLore{} = False       maySwitchLeader MPlaces = False+      maySwitchLeader MModes = False       maySwitchLeader _ = True+      cycleKeyDef direction =+        let km = revCmd $ MemberCycle direction+        in (km, DefItemKey+               { defLabel = if direction == Forward then Right km else Left ""+               , defCond = maySwitchLeader cCur && not (autoDun || null hs)+               , defAction = \_ -> do+                   err <- memberCycle False direction+                   let !_A = assert (isNothing err `blame` err) ()+                   recCall numPrefix cCur cRest itemDialogState+               })+      cycleLevelKeyDef direction =+        let km = revCmd $ MemberCycleLevel direction+        in (km, DefItemKey+                { defLabel = Left ""+                , defCond = maySwitchLeader cCur+                            && any (\(_, b, _) -> blid b == blid body) hs+                , defAction = \_ -> do+                    err <- memberCycleLevel False direction+                    let !_A = assert (isNothing err `blame` err) ()+                    recCall numPrefix cCur cRest itemDialogState+                })       keyDefs :: [(K.KM, DefItemKey m)]       keyDefs = filter (defCond . snd) $-        [ let km = K.mkChar '/'-          in (km, changeContainerDef True $ Right km)-        , (K.mkKP '/', changeContainerDef True $ Left "")-        , let km = K.mkChar '?'-          in (km, changeContainerDef False $ Right km)-        , (K.mkKP '?', changeContainerDef False $ Left "")+        [ let km = K.mkChar '<'+          in (km, changeContainerDef Backward $ Right km)+        , let km = K.mkChar '>'+          in (km, changeContainerDef Forward $ Right km)         , let km = K.mkChar '+'           in (km, DefItemKey            { defLabel = Right km@@ -327,77 +453,45 @@                                    ISuitable -> IAll                                    IAll -> ISuitable            })-        , let km = K.mkChar '!'+        , let km = K.mkChar '*'           in (km, useMultipleDef $ Right km)-        , (K.mkKP '*', useMultipleDef $ Left "")-        , let km = revCmd (K.KM K.NoModifier K.Tab) MemberCycle-          in (km, DefItemKey-           { defLabel = Right km-           , defCond = maySwitchLeader cCur-                       && any (\(_, b, _) -> blid b == blid body) hs-           , defAction = \_ -> do-               err <- memberCycle False-               let !_A = assert (isNothing err `blame` err) ()-               (cCurUpd, cRestUpd) <- legalWithUpdatedLeader cCur cRest-               recCall numPrefix cCurUpd cRestUpd itemDialogState-           })-        , let km = revCmd (K.KM K.NoModifier K.BackTab) MemberBack-          in (km, DefItemKey-           { defLabel = Right km-           , defCond = maySwitchLeader cCur && not (autoDun || null hs)-           , defAction = \_ -> do-               err <- memberBack False-               let !_A = assert (isNothing err `blame` err) ()-               (cCurUpd, cRestUpd) <- legalWithUpdatedLeader cCur cRest-               recCall numPrefix cCurUpd cRestUpd itemDialogState-           })+        , let km = K.mkChar '!'+          in (km, useMultipleDef $ Left "")  -- alias close to 'g'+        , cycleKeyDef Forward+        , cycleKeyDef Backward+        , cycleLevelKeyDef Forward+        , cycleLevelKeyDef Backward         , (K.KM K.NoModifier K.LeftButtonRelease, DefItemKey            { defLabel = Left ""            , defCond = maySwitchLeader cCur && not (null hs)-           , defAction = \ekm -> do+           , defAction = \_ -> do                merror <- pickLeaderWithPointer                case merror of-                 Nothing -> do-                   (cCurUpd, cRestUpd) <- legalWithUpdatedLeader cCur cRest-                   recCall numPrefix cCurUpd cRestUpd itemDialogState-                 Just{} -> return (Left "not a teammate", (cCur, ekm))+                 Nothing -> recCall numPrefix cCur cRest itemDialogState+                 Just{} -> return $ Left "not a menu item nor teammate position"                              -- don't inspect the error, it's expected            })         , (K.escKM, DefItemKey            { defLabel = Right K.escKM            , defCond = True-           , defAction = \ekm -> return (Left "never mind", (cCur, ekm))+           , defAction = \_ -> return $ Left "never mind"            })         ]         ++ numberPrefixes-      changeContainerDef forward defLabel = DefItemKey-        { defLabel-        , defCond = True  -- even if single screen, just reset it-        , defAction = \_ -> do-            let calmE = calmEnough body actorMaxSk-                mcCur = filter (`elem` cLegal) [cCur]-                (cCurAfterCalm, cRestAfterCalm) =-                  if forward-                  then case cRest ++ mcCur of-                    c1@(MStore CSha) : c2 : rest | not calmE ->-                      (c2, c1 : rest)-                    [MStore CSha] | not calmE -> error $ "" `showFailure` cRest-                    c1 : rest -> (c1, rest)-                    [] -> error $ "" `showFailure` cRest-                  else case reverse $ mcCur ++ cRest of-                    c1@(MStore CSha) : c2 : rest | not calmE ->-                      (c2, reverse $ c1 : rest)-                    [MStore CSha] | not calmE -> error $ "" `showFailure` cRest-                    c1 : rest -> (c1, reverse rest)-                    [] -> error $ "" `showFailure` cRest-            recCall numPrefix cCurAfterCalm cRestAfterCalm itemDialogState-        }+      changeContainerDef direction defLabel =+        let (cCurAfterCalm, cRestAfterCalm) = nextContainers direction+        in DefItemKey+          { defLabel+          , defCond = cCurAfterCalm /= cCur+          , defAction = \_ ->+              recCall numPrefix cCurAfterCalm cRestAfterCalm itemDialogState+          }       useMultipleDef defLabel = DefItemKey         { defLabel         , defCond = permitMulitple && not (EM.null multipleSlots)-        , defAction = \ekm ->+        , defAction = \_ ->             let eslots = EM.elems multipleSlots-            in return $ getResult ekm eslots+            in return $! getResult eslots         }       prefixCmdDef d =         (K.mkChar $ Char.intToDigit d, DefItemKey@@ -420,47 +514,43 @@             in case EM.lookup slot bagItemSlotsAll of               Nothing -> error $ "unexpected slot"                                  `showFailure` (slot, bagItemSlots)-              Just iid -> return $! getResult (Right slot) [iid]+              Just iid -> return $! getResult [iid]         }+      processSpecialOverlay :: OKX -> (Int -> ResultItemDialogMode)+                            -> m (Either Text ResultItemDialogMode)+      processSpecialOverlay io resultConstructor = do+        let slotLabels = map fst $ snd io+            slotKeys = mapMaybe (keyOfEKM numPrefix) slotLabels+            skillsDef :: DefItemKey m+            skillsDef = DefItemKey+              { defLabel = Left ""+              , defCond = True+              , defAction = \ekm ->+                  let slot = case ekm of+                        Left K.KM{key} -> case key of+                          K.Char l -> SlotChar numPrefix l+                          _ -> error $ "unexpected key:"+                                       `showFailure` K.showKey key+                        Right sl -> sl+                      slotIndex = fromMaybe (error "illegal slot")+                                  $ elemIndex slot allSlots+                  in return (Right (resultConstructor slotIndex))+              }+        runDefItemKey keyDefs skillsDef io slotKeys promptChosen cCur   case cCur of     MSkills -> do       io <- skillsOverlay leader-      let slotLabels = map fst $ snd io-          slotKeys = mapMaybe (keyOfEKM numPrefix) slotLabels-          skillsDef :: DefItemKey m-          skillsDef = DefItemKey-            { defLabel = Left ""-            , defCond = True-            , defAction = \ekm ->-                let slot = case ekm of-                      Left K.KM{key} -> case key of-                        K.Char l -> SlotChar numPrefix l-                        _ -> error $ "unexpected key:"-                                     `showFailure` K.showKey key-                      Right sl -> sl-                in return (Left "skills", (MSkills, Right slot))-            }-      runDefItemKey keyDefs skillsDef io slotKeys promptChosen cCur+      processSpecialOverlay io RSkills     MPlaces -> do       io <- placesOverlay-      let slotLabels = map fst $ snd io-          slotKeys = mapMaybe (keyOfEKM numPrefix) slotLabels-          placesDef :: DefItemKey m-          placesDef = DefItemKey-            { defLabel = Left ""-            , defCond = True-            , defAction = \ekm ->-                let slot = case ekm of-                      Left K.KM{key} -> case key of-                        K.Char l -> SlotChar numPrefix l-                        _ -> error $ "unexpected key:"-                                     `showFailure` K.showKey key-                      Right sl -> sl-                in return (Left "places", (MPlaces, Right slot))-            }-      runDefItemKey keyDefs placesDef io slotKeys promptChosen cCur+      processSpecialOverlay io RPlaces+    MModes -> do+      io <- modesOverlay+      processSpecialOverlay io RModes     _ -> do-      io <- itemOverlay lSlots (blid body) bagFiltered+      let displayRanged =+            cCur `notElem` [MStore COrgan, MOrgans, MLore SOrgan, MLore STrunk]+      io <- itemOverlay lSlots (blid body) bagFiltered displayRanged       let slotKeys = mapMaybe (keyOfEKM numPrefix . Right)                      $ EM.keys bagItemSlots       runDefItemKey keyDefs lettersDef io slotKeys promptChosen cCur@@ -471,34 +561,16 @@   Just $ K.mkChar slotChar keyOfEKM _ _ = Nothing -legalWithUpdatedLeader :: MonadClientUI m-                       => ItemDialogMode-                       -> [ItemDialogMode]-                       -> m (ItemDialogMode, [ItemDialogMode])-legalWithUpdatedLeader cCur cRest = do-  leader <- getLeaderUI-  let newLegal = cCur : cRest  -- not updated in any way yet-  b <- getsState $ getActorBody leader-  actorMaxSk <- getsState $ getActorMaxSkills leader-  let calmE = calmEnough b actorMaxSk-      legalAfterCalm = case newLegal of-        c1@(MStore CSha) : c2 : rest | not calmE -> (c2, c1 : rest)-        [MStore CSha] | not calmE -> (MStore CGround, newLegal)-        c1 : rest -> (c1, rest)-        [] -> error $ "" `showFailure` (cCur, cRest)-  return legalAfterCalm- -- We don't create keys from slots in @okx@, so they have to be -- exolicitly given in @slotKeys@.-runDefItemKey :: MonadClientUI m+runDefItemKey :: (MonadClient m, MonadClientUI m)               => [(K.KM, DefItemKey m)]               -> DefItemKey m               -> OKX               -> [K.KM]               -> Text               -> ItemDialogMode-              -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)-                   , (ItemDialogMode, Either K.KM SlotChar) )+              -> m (Either Text ResultItemDialogMode) runDefItemKey keyDefs lettersDef okx slotKeys prompt cCur = do   let itemKeys = slotKeys ++ map fst keyDefs       wrapB s = "[" <> s <> "]"@@ -506,7 +578,7 @@       keyLabels = filter (not . T.null) keyLabelsRaw       choice = T.intercalate " " $ map wrapB $ nub keyLabels         -- switch to Data.Containers.ListUtils.nubOrd when we drop GHC 8.4.4-  promptAdd0 $ prompt <+> choice+  msgAdd MsgPromptGeneric $ prompt <+> choice   CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui   ekm <- do     okxs <- overlayToSlideshow (rheight - 2) keys okx

engine-src/Game/LambdaHack/Client/UI/ItemDescription.hs view

@@ -1,11 +1,13 @@ -- | Descriptions of items. module Game.LambdaHack.Client.UI.ItemDescription-  ( partItem, partItemShort, partItemShortest, partItemHigh, partItemWs-  , partItemWsRanged, partItemShortAW, partItemMediumAW, partItemShortWownW+  ( partItem, partItemShort, partItemShortest, partItemHigh+  , partItemWsDetail, partItemWs, partItemWsShortest, partItemWsShort+  , partItemWsLong, partItemWsRanged+  , partItemShortAW, partItemMediumAW, partItemShortWownW   , viewItem, itemDesc #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , partItemN, textAllPowers, partItemWsR+  , partItemN, textAllPowers #endif   ) where @@ -13,6 +15,7 @@  import Game.LambdaHack.Core.Prelude +import           Data.Char (isAlpha, isAlphaNum) import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import qualified NLP.Miniutter.English as MU@@ -32,51 +35,80 @@ import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Definition.Flavour --- | The part of speech describing the item parameterized by the number--- of effects/aspects to show.-partItemN :: FactionId -> FactionDict -> Bool -> DetailLevel -> Int+partItemN :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel -> Int           -> Time -> ItemFull -> ItemQuant           -> (MU.Part, MU.Part)-partItemN side factionD ranged detailLevel maxWordsToShow localTime-          itemFull@ItemFull{itemBase, itemKind, itemSuspect}-          (itemK, itemTimer) =+partItemN width side factionD ranged detailLevel maxWordsToShow localTime+          itemFull kit =+  let (_, r2, r3) =+        partItemN3 width side factionD ranged detailLevel maxWordsToShow+                   localTime itemFull kit+  in (r2, r3)++-- | The part of speech describing the item parameterized by the number+-- of effects/aspects to show.+partItemN3 :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel -> Int+           -> Time -> ItemFull -> ItemQuant+           -> ([Text], MU.Part, MU.Part)+partItemN3 width side factionD ranged detailLevel maxWordsToShow localTime+           itemFull@ItemFull{itemBase, itemKind, itemSuspect}+           (itemK, itemTimers) =   let flav = flavourToName $ jflavour itemBase       arItem = aspectRecordFull itemFull       timeout = IA.aTimeout arItem       temporary = IA.checkFlag Ability.Fragile arItem                   && IA.checkFlag Ability.Periodic arItem-      lenCh = itemK - ncharges localTime itemFull (itemK, itemTimer)-      charges | lenCh == 0 || temporary = ""+      lenCh = itemK - ncharges localTime (itemK, itemTimers)+      charges | temporary = case itemTimers of+                  [] -> if lenCh == 0+                        then ""+                        else error $ "partItemN3: charges with null timer"+                                     `showFailure`+                                     (side, itemFull, itemK, itemTimers)+                  t : _ -> if lenCh == 0+                           then "(ready to expire)"+                           else let total = deltaOfItemTimer localTime t+                                in "for" <+> timeDeltaInSecondsText total+              | lenCh == 0 = ""               | itemK == 1 && lenCh == 1 = "(charging)"               | itemK == lenCh = "(all charging)"               | otherwise = "(" <> tshow lenCh <+> "charging)"       skipRecharging = detailLevel <= DetailLow && lenCh >= itemK-      (powerTsRaw, rangedDamage) =-        textAllPowers detailLevel skipRecharging itemFull-      powerTs = powerTsRaw ++ if ranged then rangedDamage else []+      (orTs, powerTs, rangedDamage) =+        textAllPowers width detailLevel skipRecharging itemFull       lsource = case jfid itemBase of         Just fid | IK.iname itemKind `elem` ["impressed"] ->           ["by" <+> if fid == side                     then "us"                     else gname (factionD EM.! fid)]         _ -> []+      powerTsBeginsWithAlphaOrNum = case map T.unpack powerTs of+        (c : _) : _ -> isAlpha c || isAlphaNum c+        _ -> False+      -- Ranged damage displayed even if lack of space, to prevent confusion+      -- and ... when only ranged damage is missing from the description.+      displayPowers = maxWordsToShow > 1+                      || powerTsBeginsWithAlphaOrNum && length powerTs == 1       ts = lsource-           ++ take maxWordsToShow powerTs-           ++ ["(...)" | length powerTs > maxWordsToShow && maxWordsToShow > 0]+           ++ (if displayPowers+               then take maxWordsToShow powerTs+               else [])+           ++ ["(...)" | displayPowers && length powerTs > maxWordsToShow]+           ++ (if displayPowers && ranged then rangedDamage else [])            ++ [charges | maxWordsToShow > 1]       name | temporary =              let adj = if timeout == 0 then "temporarily" else "impermanent"              in adj <+> IK.iname itemKind            | itemSuspect = flav <+> IK.iname itemKind            | otherwise = IK.iname itemKind-      capName = if IA.checkFlag Ability.Unique arItem-                then MU.Capitalize $ MU.Text name-                else MU.Text name-  in (capName, MU.Phrase $ map MU.Text ts)+  in (orTs, MU.Text name, if displayPowers+                          then MU.Phrase $ map MU.Text ts+                          else MU.Text $ IA.aELabel arItem)  -- TODO: simplify the code a lot-textAllPowers :: DetailLevel -> Bool -> ItemFull -> ([Text], [Text])-textAllPowers detailLevel skipRecharging+textAllPowers :: Int -> DetailLevel -> Bool -> ItemFull+              -> ([Text], [Text], [Text])+textAllPowers width detailLevel skipRecharging               itemFull@ItemFull{itemKind, itemDisco} =   let arItem = aspectRecordFull itemFull       -- To handle both the cases of item identified and not, we represent@@ -100,7 +132,7 @@       hurtMeleeAspect (IK.AddSkill Ability.SkHurtMelee _) = True       hurtMeleeAspect _ = False       active = IA.goesIntoEqp arItem-      splitA :: DetailLevel -> [IK.Aspect] -> [Text]+      splitA :: DetailLevel -> [IK.Aspect] -> ([Text], [Text])       splitA detLev aspects =         let ppA = kindAspectToSuffix             ppE = effectToSuffix detLev@@ -114,9 +146,36 @@             unSmash eff = eff             onSmashTs = T.intercalate " " $ filter (not . T.null)                         $ map (ppE . unSmash) smashEffs+            unCombine (IK.OnCombine eff) = eff+            unCombine eff = eff+            (combineEffsRaw, noSmashCombineEffsRaw) =+              partition IK.onCombineEffect noSmashEffs+            onCombineRawTs = T.intercalate " " $ filter (not . T.null)+                             $ map (ppE . unCombine) combineEffsRaw+            onCombineRawTsTooLarge =+              detailLevel >= DetailAll && T.length onCombineRawTs > 120+            (combineEffs, noSmashCombineEffs) =+              if onCombineRawTsTooLarge+              then (combineEffsRaw, noSmashCombineEffsRaw)+              else ([], noSmashEffs)+            unOr (IK.OrEffect eff1 eff2) = unOr eff1 ++ unOr eff2+            unOr eff = [eff]+            ppAnd (IK.AndEffect (IK.ConsumeItems tools raw) eff) =+              let (tcraft, traw, ttools) = describeCrafting tools raw eff+              in if T.length tcraft + T.length traw + T.length ttools+                    <= width - 4+                 then tcraft <+> traw <+> ttools+                 else tcraft <> "\n---" <+> traw <> "\n---" <+> ttools+            ppAnd eff = ppE eff+            ppOr eff = "*" <+> T.intercalate "\n* "+                               (nub $ filter (not . T.null)+                                    $ map ppAnd $ unOr eff)+            onCombineTs =+              filter (not . T.null) $ map ppOr $ map unCombine combineEffs             rechargingTs = T.intercalate " "                            $ [damageText | IK.idamage itemKind /= 0]-                             ++ filter (not . T.null) (map ppE noSmashEffs)+                             ++ filter (not . T.null)+                                       (map ppE noSmashCombineEffs)             fragile = IA.checkFlag Ability.Fragile arItem             periodicText =               if periodic && not skipRecharging && not (T.null rechargingTs)@@ -134,12 +193,17 @@                        "(every" <+> reduce_a t <> ":" <+> rechargingTs <> ")"                      _ -> error $ "" `showFailure` mtimeout               else ""-            ppERestEs = if periodic then [periodicText] else map ppE noSmashEffs+            ppERestEs = if periodic+                        then [periodicText]+                        else map ppE noSmashCombineEffs             aes = if active                   then map ppA aspects ++ ppERestEs                   else ppERestEs ++ map ppA aspects             onSmash = if T.null onSmashTs then ""                       else "(on smash:" <+> onSmashTs <> ")"+            onCombine = if null combineEffs && not (T.null onCombineRawTs)+                        then "(on combine:" <+> onCombineRawTs <> ")"+                        else ""             -- Either exact value or dice of @SkHurtMelee@ needed,             -- never the average, so @arItem@ not consulted directly.             -- If item not known fully and @SkHurtMelee@ under @Odds@,@@ -158,68 +222,79 @@               Just (IK.Timeout t) -> "(cooldown" <+> reduce_a t <> ")"                                        -- timeout is called "cooldown" in UI               _ -> error $ "" `showFailure` mtimeout-       in [ damageText-          | detLev > DetailNone && (not periodic || IK.idamage itemKind == 0) ]-          ++ [timeoutText | detLev > DetailNone && not periodic]-          ++ if detLev >= DetailMedium-             then aes ++ [onSmash | detLev >= DetailAll]-             else []+       in ( onCombineTs+          , [damageText]+            ++ [timeoutText | detLev > DetailLow && not periodic]+            ++ aes+            ++ if detLev >= DetailAll+               then [onCombine, onSmash]+               else [onCombineRawTs] )       hurtMult = armorHurtCalculation True (IA.aSkills arItem)                                            Ability.zeroSkills       dmg = Dice.meanDice $ IK.idamage itemKind-      rawDeltaHP = ceiling $ fromIntegral hurtMult * xD dmg / 100+      rawDeltaHP = ceiling $ intToDouble hurtMult * xD dmg / 100       IK.ThrowMod{IK.throwVelocity} = IA.aToThrow arItem       speed = speedFromWeight (IK.iweight itemKind) throwVelocity       pdeltaHP = modifyDamageBySpeed rawDeltaHP speed-      rangedDamageDesc = if pdeltaHP == 0-                         then []-                         else ["{avg" <+> show64With2 pdeltaHP <+> "ranged}"]+      rangedDamageDesc = [ "{avg" <+> show64With2 pdeltaHP <+> "ranged}"+                         | pdeltaHP > 0 ]         -- Note that avg melee damage would be too complex to display here,         -- because in case of @MOwned@ the owner is different than leader,         -- so the value would be different than when viewing the item.       splitTry ass =         let splits = map (`splitA` ass) [minBound..maxBound]             splitsToTry = drop (fromEnum detailLevel) splits-            splitsValid | T.null elab = filter (/= []) splitsToTry+            splitsValid | T.null elab = filter (/= ([], [])) splitsToTry                         | otherwise = splitsToTry-        in concat $ take 1 splitsValid-      aspectDescs =+        in case splitsValid of+          (onCombineTsSplit, tsSplit) : _ -> (onCombineTsSplit, tsSplit)+          [] -> ([], [])+      (onCombineTsAss, aspectDescs) =         let aMain IK.AddSkill{} = True             aMain _ = False             (aspectsMain, aspectsAux) = partition aMain aspectsFull-        in filter (/= "")-           $ elab-             : splitTry aspectsMain-             ++ if detailLevel >= DetailAll-                then map kindAspectToSuffix aspectsAux-                else []-  in (aspectDescs, rangedDamageDesc)+            (onCombineTsSplit, tsSplit) = splitTry aspectsMain+        in ( onCombineTsSplit+           , filter (/= "")+             $ elab+               : tsSplit+               ++ if detailLevel >= DetailAll+                  then map kindAspectToSuffix aspectsAux+                  else [] )+  in (onCombineTsAss, aspectDescs, rangedDamageDesc)  -- | The part of speech describing the item.-partItem :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant+partItem :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant          -> (MU.Part, MU.Part)-partItem side factionD = partItemN side factionD False DetailMedium 4+partItem width side factionD =+  partItemN width side factionD False DetailMedium 4 -partItemShort :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant+partItemShort :: Int -> FactionId -> FactionDict -> Time -> ItemFull+              -> ItemQuant               -> (MU.Part, MU.Part)-partItemShort side factionD = partItemN side factionD False DetailLow 4+partItemShort width side factionD =+  partItemN width side factionD False DetailLow 4 -partItemShortest :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant+partItemShortest :: Int -> FactionId -> FactionDict -> Time -> ItemFull+                 -> ItemQuant                  -> (MU.Part, MU.Part)-partItemShortest side factionD = partItemN side factionD False DetailNone 1+partItemShortest width side factionD =+  partItemN width side factionD False DetailLow 1 -partItemHigh :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant-             -> (MU.Part, MU.Part)-partItemHigh side factionD = partItemN side factionD False DetailAll 100+partItemHigh :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant+             -> ([Text], MU.Part, MU.Part)+partItemHigh width side factionD =+  partItemN3 width side factionD False DetailAll 100  -- The @count@ can be different than @itemK@ in @ItemFull@, e.g., when picking -- a subset of items to drop.-partItemWsR :: FactionId -> FactionDict -> Bool -> Int -> Time -> ItemFull-            -> ItemQuant-            -> MU.Part-partItemWsR side factionD ranged count localTime itemFull kit =-  let (name, powers) =-        partItemN side factionD ranged DetailMedium 4 localTime itemFull kit+partItemWsRanged :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel+                 -> Int -> Int -> Time -> ItemFull -> ItemQuant+                 -> MU.Part+partItemWsRanged width side factionD ranged detail+                 maxWordsToShow count localTime itemFull kit =+  let (name, powers) = partItemN width side factionD ranged detail+                                 maxWordsToShow localTime itemFull kit       arItem = aspectRecordFull itemFull       periodic = IA.checkFlag Ability.Periodic arItem       condition = IA.checkFlag Ability.Condition arItem@@ -232,43 +307,69 @@             in MU.Phrase [MU.Text amount, name, powers]         | condition ->             MU.Phrase [MU.Text $ tshow count <> "-fold", name, powers]-        | IA.checkFlag Ability.Unique arItem && count == 1 ->-            MU.Phrase ["the", name, powers]+        | IA.checkFlag Ability.Unique arItem -> case count of+            0 -> MU.Phrase ["none of", name, powers]+            1 -> MU.Phrase [name, powers]+            _ -> MU.Phrase [MU.Car count, "of", MU.Ws name, powers]         | otherwise -> MU.Phrase [MU.CarAWs count name, powers] -partItemWs :: FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant-           -> MU.Part-partItemWs side factionD = partItemWsR side factionD False--partItemWsRanged :: FactionId -> FactionDict -> Int -> Time -> ItemFull+partItemWsDetail :: DetailLevel+                 -> Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull                  -> ItemQuant                  -> MU.Part-partItemWsRanged side factionD = partItemWsR side factionD True+partItemWsDetail DetailLow = \_ _ _ _ _ _ _ -> ""+partItemWsDetail DetailMedium = partItemWsShortest+partItemWsDetail DetailHigh = partItemWs+partItemWsDetail DetailAll = partItemWsLong -partItemShortAW :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant+partItemWs :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull+           -> ItemQuant+           -> MU.Part+partItemWs width side factionD =+  partItemWsRanged width side factionD False DetailMedium 4++partItemWsShortest :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull+                   -> ItemQuant+                   -> MU.Part+partItemWsShortest width side factionD =+  partItemWsRanged width side factionD False DetailLow 1++partItemWsShort :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull+                -> ItemQuant                 -> MU.Part-partItemShortAW side factionD localTime itemFull kit =-  let (name, _) = partItemShort side factionD localTime itemFull kit+partItemWsShort width side factionD =+  partItemWsRanged width side factionD False DetailLow 4++partItemWsLong :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull+               -> ItemQuant+               -> MU.Part+partItemWsLong width side factionD =+  partItemWsRanged width side factionD False DetailHigh 100++partItemShortAW :: Int -> FactionId -> FactionDict -> Time -> ItemFull+                -> ItemQuant+                -> MU.Part+partItemShortAW width side factionD localTime itemFull kit =+  let (name, _) = partItemShort width side factionD localTime itemFull kit       arItem = aspectRecordFull itemFull-  in if IA.checkFlag Ability.Unique arItem-     then MU.Phrase ["the", name]-     else MU.AW name+  in if IA.checkFlag Ability.Unique arItem then name else MU.AW name -partItemMediumAW :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant+partItemMediumAW :: Int -> FactionId -> FactionDict -> Time -> ItemFull+                 -> ItemQuant                  -> MU.Part-partItemMediumAW side factionD localTime itemFull kit =+partItemMediumAW width side factionD localTime itemFull kit =   let (name, powers) =-        partItemN side factionD False DetailMedium 100 localTime itemFull kit+        partItemN width side factionD False DetailMedium 100 localTime+                  itemFull kit       arItem = aspectRecordFull itemFull-  in if IA.checkFlag Ability.Unique arItem-     then MU.Phrase ["the", name, powers]-     else MU.AW $ MU.Phrase [name, powers]+      phrase = MU.Phrase [name, powers]+  in if IA.checkFlag Ability.Unique arItem then phrase else MU.AW phrase -partItemShortWownW :: FactionId -> FactionDict -> MU.Part -> Time -> ItemFull-                   -> ItemQuant+partItemShortWownW :: Int -> FactionId -> FactionDict -> MU.Part -> Time+                   -> ItemFull -> ItemQuant                    -> MU.Part-partItemShortWownW side factionD partA localTime itemFull kit =-  let (name, _) = partItemShort side factionD localTime itemFull kit+partItemShortWownW width side factionD partA localTime itemFull kit =+  let (name, _) = partItemShort width side factionD localTime itemFull kit   in MU.WownW partA name  viewItem :: ItemFull -> Color.AttrCharW32@@ -277,12 +378,14 @@   Color.attrChar2ToW32 (flavourToColor $ jflavour $ itemBase itemFull)                        (IK.isymbol $ itemKind itemFull) -itemDesc :: Bool -> FactionId -> FactionDict -> Int -> CStore -> Time -> LevelId-         -> ItemFull -> ItemQuant-         -> AttrLine-itemDesc markParagraphs side factionD aHurtMeleeOfOwner store localTime jlid-         itemFull@ItemFull{itemBase, itemKind, itemDisco, itemSuspect} kit =-  let (name, powers) = partItemHigh side factionD localTime itemFull kit+itemDesc :: Int -> Bool -> FactionId -> FactionDict -> Int -> CStore -> Time+         -> LevelId -> ItemFull -> ItemQuant+         -> AttrString+itemDesc width markParagraphs side factionD aHurtMeleeOfOwner store localTime+         jlid itemFull@ItemFull{itemBase, itemKind, itemDisco, itemSuspect}+         kit =+  let (orTs, name, powers) =+        partItemHigh width side factionD localTime itemFull kit       arItem = aspectRecordFull itemFull       npowers = makePhrase [name, powers]       IK.ThrowMod{IK.throwVelocity, IK.throwLinger} = IA.aToThrow arItem@@ -315,36 +418,40 @@                             + if store `elem` [CEqp, COrgan]                               then 0                               else aHurtMeleeOfItem-                  mult = 100 + min 99 (max (-99) multRaw)-                  minDeltaHP = xM meanDmg `divUp` 100-                  rawDeltaHP = fromIntegral mult * minDeltaHP-                  pmult = 100 + min 99 (max (-99) aHurtMeleeOfItem)-                  prawDeltaHP = fromIntegral pmult * minDeltaHP+                  mult = 100 + min 100 (max (-95) multRaw)+                  percentDeltaHP = xM meanDmg `divUp` 100+                  rawDeltaHP = intCast mult * percentDeltaHP+                  pmult = 100 + min 100 (max (-95) aHurtMeleeOfItem)+                  prawDeltaHP = intCast pmult * percentDeltaHP                   pdeltaHP = modifyDamageBySpeed prawDeltaHP speed+                  minDeltaHP = 5 * percentDeltaHP                   mDeltaHP = modifyDamageBySpeed minDeltaHP speed-              in "Against defenceless foes you'd inflict around"-                   -- rounding and non-id items-                 <+> tshow meanDmg-                 <> "*" <> tshow mult <> "%"-                 <> "=" <> show64With2 rawDeltaHP-                 <+> "melee damage (min" <+> show64With2 minDeltaHP-                 <> ") and"-                 <+> tshow meanDmg-                 <> "*" <> tshow pmult <> "%"-                 <> "*" <> "speed^2"-                 <> "/" <> tshow (fromSpeed speedThrust `divUp` 10) <> "^2"-                 <> "=" <> show64With2 pdeltaHP-                 <+> "ranged damage (min" <+> show64With2 mDeltaHP-                 <> ") with it"-                 <> if Dice.infDice (IK.idamage itemKind)-                       == Dice.supDice (IK.idamage itemKind)-                    then "."-                    else "on average."+              in+                "Against defenceless foes you'd inflict around"+                  -- rounding and non-id items+                <+> tshow meanDmg+                <> "*" <> tshow mult <> "%"+                <> "=" <> show64With2 rawDeltaHP+                <+> "melee damage (min" <+> show64With2 minDeltaHP <> ")"+                <+> (if pdeltaHP <= 0 then "" else+                       "and"+                       <+> tshow meanDmg+                       <> "*" <> tshow pmult <> "%"+                       <> "*" <> "speed^2"+                       <> "/" <> tshow (fromSpeed speedThrust+                                        `divUp` 10) <> "^2"+                       <> "=" <> show64With2 pdeltaHP+                       <+> "ranged damage (min" <+> show64With2 mDeltaHP <> ")")+                <+> "with it"+                <> if Dice.infDice (IK.idamage itemKind)+                      == Dice.supDice (IK.idamage itemKind)+                   then "."+                   else "on average."         in (IK.idesc itemKind, T.intercalate " " sentences, tspeed <+> dmgAn)       weight = IK.iweight itemKind       (scaledWeight, unitWeight)         | weight > 1000 =-          (tshow $ fromIntegral weight / (1000 :: Double), "kg")+          (tshow $ intToDouble weight / 1000, "kg")         | otherwise = (tshow weight, "g")       onLevel = "on level" <+> tshow (abs $ fromEnum jlid) <> "."       discoFirst = (if IA.checkFlag Ability.Unique arItem@@ -361,26 +468,43 @@             "Coming from" <+> whose fid             <> "." <+> discoFirst           _ -> discoFirst-      ikitNames = map (fromGroupName . fst) $ filter ((== COrgan) . snd)-                                            $ IK.ikit itemKind-      ikitDesc | null ikitNames = ""-               | otherwise = makeSentence-        [ "the actor also has organs of this kind:"-        , MU.Text $ T.intercalate ", " ikitNames ]+      -- Organs are almost always either empty or more than singular,+      -- so the "organs" below is fine. Also, some organs come in pairs+      -- or more, so we don't know the number without much more work,+      -- so @squashedWWandW@ would be out of place. Also, mentioning+      -- two hands and two legs is not that enlightening and the number+      -- is not shown in organ lore, so this should wait until we add+      -- proper hyperlinks both ways instead of relying of names.+      ikitToPart = MU.Text . T.intercalate ", " . map (fromGroupName . fst)+      (ikitOrganNames, ikitOtherNames) =+        partition ((== COrgan) . snd) $ IK.ikit itemKind+      ikitDesc | null ikitOrganNames = ""+               | otherwise =+        makeSentence+          [ "the actor has organs of this kind:"+          , ikitToPart ikitOrganNames ]+        <> if null ikitOtherNames+           then ""+           else "\n\n"+                <> makeSentence+                     [ "the actor starts in possession of the following:"+                     , ikitToPart ikitOtherNames ]       colorSymbol = viewItem itemFull       blurb =-        ((" "+       (((" "           <> npowers-          <> (if markParagraphs then ":\n\n" else ": ")+          <> (if markParagraphs then "\n\n" else " ")+          <> T.intercalate "\n\n" orTs+          <> (if markParagraphs && not (null orTs) then "\n\n" else "")           <> desc           <> (if markParagraphs && not (T.null desc) then "\n\n" else ""))-         <+> (if weight > 0-              then makeSentence-                     ["Weighs around", MU.Text scaledWeight <> unitWeight]-              else ""))+        <+> (if weight > 0+             then makeSentence+                    ["Weighs around", MU.Text scaledWeight <> unitWeight]+             else ""))         <+> aspectSentences         <+> sourceDesc-        <+> damageAnalysis-        <> (if markParagraphs && not (T.null ikitDesc) then "\n\n" else "\n")-        <> ikitDesc-  in colorSymbol : textToAL blurb+        <+> damageAnalysis)+       <> (if markParagraphs && not (T.null ikitDesc) then "\n\n" else "\n")+       <> ikitDesc+  in colorSymbol : textToAS blurb

engine-src/Game/LambdaHack/Client/UI/ItemSlot.hs view

@@ -3,7 +3,7 @@ module Game.LambdaHack.Client.UI.ItemSlot   ( SlotChar(..), ItemSlots(..), SingleItemSlots   , allSlots, intSlots, slotLabel-  , assignSlot, partyItemSet, sortSlotMap, mergeItemSlots+  , assignSlot, sortSlotMap, mergeItemSlots   ) where  import Prelude ()@@ -14,15 +14,9 @@ import           Data.Bits (unsafeShiftL, unsafeShiftR) import           Data.Char import qualified Data.EnumMap.Strict as EM-import qualified Data.EnumSet as ES-import           Data.Function-import           Data.Ord (comparing) import qualified Data.Text as T -import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Item-import           Game.LambdaHack.Common.State import           Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Definition.Defs@@ -60,7 +54,7 @@ allSlots = concatMap (\n -> map (SlotChar n) allChars) [0..]  intSlots :: [SlotChar]-intSlots = map (flip SlotChar 'a') [0..]+intSlots = map (`SlotChar` 'a') [0..]  slotLabel :: SlotChar -> Text slotLabel x =@@ -68,7 +62,7 @@          (slotChar x)   <> ")" --- | Assigns a slot to an item, e.g., for inclusion in the inventory of a hero.+-- | Assigns a slot to an item, e.g., for inclusion in equipment of a hero. -- At first, e.g., when item is spotted on the floor, the slot is -- not user-friendly. After any player's item manipulation action, -- slots are sorted and a fully human-readable slot is then assigned.@@ -80,28 +74,15 @@         Nothing -> 0   in SlotChar (maxPrefix + 1) 'x' -partyItemSet :: SLore -> FactionId -> Maybe Actor -> State -> ES.EnumSet ItemId-partyItemSet slore fid mbody s =-  let onPersons = combinedFromLore slore fid s-      onGround = maybe EM.empty  -- consider floor only under the acting actor-                   (\b -> getFloorBag (blid b) (bpos b) s)-                   mbody-  in ES.unions $ map EM.keysSet $ onPersons : [onGround | slore == SItem]---- If appearance and aspects the same, keep the order from before sort.-compareItemFull :: ItemFull -> ItemFull -> Ordering-compareItemFull itemFull1 itemFull2 =-  let kindAndAppearance ItemFull{itemBase=Item{..}, ..} =-        ( not itemSuspect, itemKindId, itemDisco-        , IK.isymbol itemKind, IK.iname itemKind-        , jflavour, jfid )-  in comparing kindAndAppearance itemFull1 itemFull2- sortSlotMap :: (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots sortSlotMap itemToF em =-  let f iid = (iid, itemToF iid)-      sortItemIds l = map fst $ sortBy (compareItemFull `on` snd)-                      $ map f l+  -- If appearance and aspects the same, keep the order from before sort.+  let kindAndAppearance iid =+        let ItemFull{itemBase=Item{..}, ..} = itemToF iid+        in ( not itemSuspect, itemKindId, itemDisco+           , IK.isymbol itemKind, IK.iname itemKind+           , jflavour, jfid )+      sortItemIds = sortOn kindAndAppearance   in EM.fromDistinctAscList $ zip allSlots $ sortItemIds $ EM.elems em  mergeItemSlots :: (ItemId -> ItemFull) -> [SingleItemSlots] -> SingleItemSlots

engine-src/Game/LambdaHack/Client/UI/Key.hs view

@@ -8,14 +8,14 @@   , upKM, downKM, leftKM, rightKM   , homeKM, endKM, backspaceKM, controlP   , leftButtonReleaseKM, middleButtonReleaseKM, rightButtonReleaseKM-  , dirAllKey, handleDir, moveBinding, mkKM, mkChar, mkKP+  , dirAllKey, handleDir, moveBinding, mkKM, mkChar   , keyTranslate, keyTranslateWeb+  , dirMoveNoModifier, dirRunNoModifier, dirRunControl, dirRunShift #ifdef EXPOSE_INTERNAL     -- * Internal operations   , dirKeypadKey, dirKeypadShiftChar, dirKeypadShiftKey-  , dirLaptopKey, dirLaptopShiftKey+  , dirLeftHandKey, dirLeftHandShiftKey   , dirViChar, dirViKey, dirViShiftKey-  , dirMoveNoModifier, dirRunNoModifier, dirRunControl, dirRunShift #endif   ) where @@ -28,7 +28,7 @@ import qualified Data.Char as Char import           GHC.Generics (Generic) -import Game.LambdaHack.Common.Point+import Game.LambdaHack.Client.UI.PointUI import Game.LambdaHack.Common.Vector  -- | Frontend-independent datatype to represent keys.@@ -74,6 +74,7 @@ data Modifier =     NoModifier   | ControlShift+  | AltShift   | Shift   | Control   | Alt@@ -97,7 +98,7 @@  -- | Key, modifier and position of mouse pointer. data KMP = KMP { kmpKeyMod  :: KM-               , kmpPointer :: Point }+               , kmpPointer :: PointUI }  -- | Common and terse names for keys. showKey :: Key -> String@@ -137,6 +138,7 @@ showKM :: KM -> String showKM KM{modifier=NoModifier, key} = showKey key showKM KM{modifier=ControlShift, key} = "C-S-" ++ showKey key+showKM KM{modifier=AltShift, key} = "A-S-" ++ showKey key showKM KM{modifier=Shift, key} = "S-" ++ showKey key showKM KM{modifier=Control, key} = "C-" ++ showKey key showKM KM{modifier=Alt, key} = "A-" ++ showKey key@@ -213,11 +215,11 @@ dirKeypadShiftKey :: [Key] dirKeypadShiftKey = map KP dirKeypadShiftChar -dirLaptopKey :: [Key]-dirLaptopKey = map Char ['7', '8', '9', 'o', 'l', 'k', 'j', 'u']+dirLeftHandKey :: [Key]+dirLeftHandKey = map Char ['q', 'w', 'e', 'd', 'c', 'x', 'z', 'a'] -dirLaptopShiftKey :: [Key]-dirLaptopShiftKey = map Char ['&', '*', '(', 'O', 'L', 'K', 'J', 'U']+dirLeftHandShiftKey :: [Key]+dirLeftHandShiftKey = map Char ['Q', 'W', 'E', 'D', 'C', 'X', 'Z', 'A']  dirViChar :: [Char] dirViChar = ['y', 'k', 'u', 'l', 'n', 'j', 'b', 'h']@@ -229,16 +231,14 @@ dirViShiftKey = map (Char . Char.toUpper) dirViChar  dirMoveNoModifier :: Bool -> Bool -> [Key]-dirMoveNoModifier uVi uLaptop =-  dirKeypadKey ++ if | uVi -> dirViKey-                     | uLaptop -> dirLaptopKey-                     | otherwise -> []+dirMoveNoModifier uVi uLeftHand =+  dirKeypadKey ++ (if uVi then dirViKey else [])+               ++ (if uLeftHand then dirLeftHandKey else [])  dirRunNoModifier :: Bool -> Bool -> [Key]-dirRunNoModifier uVi uLaptop =-  dirKeypadShiftKey ++ if | uVi -> dirViShiftKey-                          | uLaptop -> dirLaptopShiftKey-                          | otherwise -> []+dirRunNoModifier uVi uLeftHand =+  dirKeypadShiftKey ++ (if uVi then dirViShiftKey else [])+                    ++ (if uLeftHand then dirLeftHandShiftKey else [])  dirRunControl :: [Key] dirRunControl = dirKeypadKey@@ -249,30 +249,30 @@ dirRunShift = dirRunControl  dirAllKey :: Bool -> Bool -> [Key]-dirAllKey uVi uLaptop =-  dirMoveNoModifier uVi uLaptop-  ++ dirRunNoModifier uVi uLaptop+dirAllKey uVi uLeftHand =+  dirMoveNoModifier uVi uLeftHand+  ++ dirRunNoModifier uVi uLeftHand   ++ dirRunControl  -- | Configurable event handler for the direction keys. -- Used for directed commands such as close door.-handleDir :: Bool -> Bool -> KM -> Maybe Vector-handleDir uVi uLaptop KM{modifier=NoModifier, key} =-  let assocs = zip (dirAllKey uVi uLaptop) $ cycle moves+handleDir :: [Key] -> KM -> Maybe Vector+handleDir dirKeys KM{modifier=NoModifier, key} =+  let assocs = zip dirKeys $ cycle moves   in lookup key assocs-handleDir _ _ _ = Nothing+handleDir _ _ = Nothing  -- | Binding of both sets of movement keys, vi and laptop. moveBinding :: Bool -> Bool -> (Vector -> a) -> (Vector -> a)             -> [(KM, a)]-moveBinding uVi uLaptop move run =+moveBinding uVi uLeftHand move run =   let assign f (km, dir) = (km, f dir)       mapMove modifier keys =         map (assign move) (zip (map (KM modifier) keys) $ cycle moves)       mapRun modifier keys =         map (assign run) (zip (map (KM modifier) keys) $ cycle moves)-  in mapMove NoModifier (dirMoveNoModifier uVi uLaptop)-     ++ mapRun NoModifier (dirRunNoModifier uVi uLaptop)+  in mapMove NoModifier (dirMoveNoModifier uVi uLeftHand)+     ++ mapRun NoModifier (dirRunNoModifier uVi uLeftHand)      ++ mapRun Control dirRunControl      ++ mapRun Shift dirRunShift @@ -284,6 +284,8 @@          in case s of            'C':'-':'S':'-':rest -> KM ControlShift (mkKey rest)            'S':'-':'C':'-':rest -> KM ControlShift (mkKey rest)+           'A':'-':'S':'-':rest -> KM AltShift (mkKey rest)+           'S':'-':'A':'-':rest -> KM AltShift (mkKey rest)            'S':'-':rest -> KM Shift (mkKey rest)            'C':'-':rest -> KM Control (mkKey rest)            'A':'-':rest -> KM Alt (mkKey rest)@@ -292,9 +294,6 @@ mkChar :: Char -> KM mkChar c = KM NoModifier $ Char c -mkKP :: Char -> KM-mkKP c = KM NoModifier $ KP c- -- | Translate key from a GTK string description to our internal key type. -- To be used, in particular, for the command bindings and macros -- in the config file.@@ -312,10 +311,10 @@ keyTranslate "dollar"        = Char '$' keyTranslate "parenleft"     = Char '(' keyTranslate "parenright"    = Char ')'-keyTranslate "asterisk"      = Char '*'  -- for latop movement keys-keyTranslate "KP_Multiply"   = KP '*'    -- for keypad aiming+keyTranslate "asterisk"      = Char '*'  -- KP and normal are merged here+keyTranslate "KP_Multiply"   = Char '*' keyTranslate "slash"         = Char '/'-keyTranslate "KP_Divide"     = KP '/'+keyTranslate "KP_Divide"     = Char '/' keyTranslate "bar"           = Char '|' keyTranslate "backslash"     = Char '\\' keyTranslate "asciicircum"   = Char '^'@@ -496,13 +495,13 @@ keyTranslateWeb "Insert"     _ = Insert keyTranslateWeb "space"      _ = Space keyTranslateWeb "Equals"     _ = Char '='-keyTranslateWeb "Multiply"   True = Char '*'  -- for laptop movement keys-keyTranslateWeb "Multiply"   False = KP '*'     -- for keypad aiming-keyTranslateWeb "*"          False = KP '*'     -- for keypad aiming+keyTranslateWeb "Multiply"   _ = Char '*'  -- KP and normal are merged here+keyTranslateWeb "*"          _ = Char '*' keyTranslateWeb "Add"        _ = Char '+'  -- KP and normal are merged here keyTranslateWeb "Subtract"   _ = Char '-'  -- KP and normal are merged here keyTranslateWeb "Divide"     True = Char '?' keyTranslateWeb "Divide"     False = Char '/' -- KP and normal are merged here+keyTranslateWeb "/"          True = Char '?' keyTranslateWeb "/"          False = Char '/' -- KP and normal are merged here keyTranslateWeb "Decimal"    _ = Char '.'  -- dot and comma are merged here keyTranslateWeb "Separator"  _ = Char '.'  -- to sidestep national standards

engine-src/Game/LambdaHack/Client/UI/KeyBindings.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes, TupleSections #-}+{-# LANGUAGE RankNTypes #-} -- | Verifying, aggregating and displaying binding of keys to commands. module Game.LambdaHack.Client.UI.KeyBindings   ( keyHelp, okxsN@@ -8,6 +8,7 @@  import Game.LambdaHack.Core.Prelude +import qualified Data.EnumMap.Strict as EM import qualified Data.Map.Strict as M import qualified Data.Text as T @@ -18,9 +19,8 @@ import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.Slideshow-import           Game.LambdaHack.Common.Kind-import           Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Definition.Color as Color  -- | Produce a set of help/menu screens from the key bindings.@@ -28,120 +28,94 @@ -- When the intro screen mentions KP_5, this really is KP_Begin, -- but since that is harder to understand we assume a different, non-default -- state of NumLock in the help text than in the code that handles keys.-keyHelp :: COps -> CCUI -> Int -> [(Text, OKX)]-keyHelp COps{corule}-        CCUI{ coinput=coinput@InputContent{..}-            , coscreen=ScreenContent{rheight, rintroScreen, rmoveKeysScreen} }-        offset = assert (offset > 0) $+keyHelp :: CCUI -> FontSetup -> [(Text, OKX)]+keyHelp CCUI{ coinput=coinput@InputContent{..}+            , coscreen=ScreenContent{rwidth, rheight} } FontSetup{..} =   let-    introBlurb =-      ""-      : map T.pack rintroScreen-      ++-      [ ""-      , "Press SPACE or PGDN for help and ESC to see the map again."-      ]-    movBlurb = map T.pack rmoveKeysScreen-    movBlurbEnd =-      [ "Press SPACE or scroll the mouse wheel to see the minimal command set."-      ]-    minimalBlurb =-      [ "The following commands, joined with the basic set above,"-      , "let you accomplish anything in the game, though"-      , "not necessarily with the fewest keystrokes. You can also"-      , "play the game exclusively with a mouse, or both mouse"-      , "and keyboard. (See the ending help screens for mouse commands.)"-      , "Lastly, you can select a command with arrows or mouse directly"-      , "from the help screen or the dashboard and execute it on the spot."-      , ""-      ]-    casualEnding =-      [ ""-      , "Press SPACE to see the detailed descriptions of all commands."+    movBlurb1 =+      [ "Walk throughout a level with mouse or numeric keypad (right diagram below)"+      , "or the Vi editor keys (middle) or the left-hand movement keys (left). Run until"+      , "disturbed with Shift or Control. Go-to a position with LMB (left mouse button)."       ]-    categoryEnding =-      [ ""-      , "Press SPACE to see the next page of command descriptions."+    movSchema =+      [ "     q w e     y k u     7 8 9"+      , "      \\|/       \\|/       \\|/"+      , "     a-s-d     h-.-l     4-5-6"+      , "      /|\\       /|\\       /|\\"+      , "     z x c     b j n     1 2 3"       ]-    itemMenuEnding =-      [ ""-      , "Note how lower case item commands (pack an item, equip, stash)"-      , "let you move items into a particular item store."+    movBlurb2 =+      [ "In aiming mode, the same keys (and mouse) move the aiming crosshair."+      , "Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any"+      , "damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5`"+      , "(the same key with Shift or Control) to lurk 0.1 of a turn, without bracing."       , ""-      , "Press SPACE to see the detailed descriptions of other item-related commands."+      , "Displace enemies by running into them with Shift/Control or S-LMB. Search,"+      , "open, descend and attack by bumping into walls, doors, stairs and enemies."+      , "The best, not on cooldown, melee weapon is automatically chosen from your"+      , "equipment and from among your body parts."       ]-    itemRemainingEnding =-      [ ""-      , "Note how upper case item commands (manage Pack, Equipment,"-      , "Stash, etc.) let you view and organize items within"-      , "a particular item store. Once a menu is opened, you can"-      , "switch stores at will, so each of the commands only"-      , "determines the starting item store. Each store"-      , "is accessible from the dashboard, as well."-      , ""-      , "Press SPACE to see the next page of command descriptions."+    minimalBlurb =+      [ "The following few commands, joined with the movement and running keys,"+      , "let you accomplish almost anything in the game, though not necessarily"+      , "with the fewest keystrokes. You can also play the game exclusively"+      , "with a mouse, or both mouse and keyboard (e.g., mouse for go-to"+      , "and terrain inspection and keyboard for everything else). Lastly,"+      , "you can select a command with arrows or mouse directly from the help"+      , "screen or the dashboard and execute it on the spot."       ]     itemAllEnding =-      [ ""-      , "Note how lower case item commands (pack an item, equip, stash)"-      , "let you move items into a particular item store, while"-      , "upper case item commands (manage Pack, Equipment, Stash, etc.)"-      , "let you view and organize items within an item store."-      , "Once a store management menu is opened, you can switch"-      , "stores at will, so the multiple commands only determine"-      , "the starting item store. Each store is accessible"-      , "from the dashboard as well."-      , ""-      , "Press SPACE to see the next page of command descriptions."+      [ "Note how lower case item commands (stash item, equip item) place items"+      , "into a particular item store, while upper case item commands (manage Inventory,"+      , "manage Outfit) open management menu for a store. Once a store menu is opened,"+      , "you can switch stores with `<` and `>`, so the multiple commands only determine"+      , "the starting item store. Each store is accessible from the dashboard as well."       ]     mouseBasicsBlurb =-      [ "Screen area and UI mode (exploration/aiming) determine"-      , "mouse click effects. First, we give an overview"-      , "of effects of each button over the game map area."-      , "The list includes not only left and right buttons, but also"-      , "the optional middle mouse button (MMB) and the mouse wheel,"-      , "which is also used over menus, to page-scroll them."-      , "(For mice without RMB, one can use Control key with LMB and for mice"-      , "without MMB, one can use C-RMB or C-S-LMB.)"-      , "Next we show mouse button effects per screen area,"-      , "in exploration mode and (if different) in aiming mode."-      , ""+      [ "Screen area and UI mode (exploration/aiming) determine mouse click"+      , "effects. Here we give an overview of effects of each button over"+      , "the game map area. The list includes not only left and right buttons,"+      , "but also the optional middle mouse button (MMB) and the mouse wheel,"+      , "which is also used over menus, to page-scroll them. For mice without RMB,"+      , "one can use Control key with LMB and for mice without MMB, one can use"+      , "C-RMB or C-S-LMB."       ]-    mouseBasicsEnding =-      [ ""-      , "Press SPACE to see mouse commands in exploration and aiming modes."+    mouseAreasBlurb =+      [ "Next we show mouse button effects per screen area, in exploration mode"+      , "and (if different) in aiming mode. Note that this is all optional. Keyboard"+      , "suffices, at worst requiring the more obscure commands listed later on."       ]-    lastHelpEnding =-      [ ""-      , "For more playing instructions see file PLAYING.md. Press PGUP or scroll"-      , "mouse wheel for previous pages and press SPACE or ESC to see the map again."+    mouseAreasMini =+      [ "Mouse button effects per screen area, in exploration and in aiming modes"       ]-    keyL = 12+    movTextEnd = "Press SPACE or PGDN to advance or ESC to see the map again."+    lastHelpEnd = "Use mouse wheel or PGUP to go back and ESC to see the map again."+    seeAlso = "For more playing instructions see file PLAYING.md."+    offsetCol2 = 12     pickLeaderDescription =-      [ fmt keyL "0, 1 ... 6" "pick a particular actor as the new leader"+      [ fmt offsetCol2 "0, 1 ... 9"+                       "pick a particular actor as the new pointman"       ]     casualDescription = "Minimal cheat sheet for casual play"-    fmt n k h = " " <> T.justifyLeft n ' ' k <+> h-    fmts s = " " <> s-    introText = map fmts introBlurb-    movText = map fmts movBlurb-    movTextEnd = map fmts movBlurbEnd-    minimalText = map fmts minimalBlurb-    casualEnd = map fmts casualEnding-    categoryEnd = map fmts categoryEnding-    itemMenuEnd = map fmts itemMenuEnding-    itemRemainingEnd = map fmts itemRemainingEnding-    itemAllEnd = map fmts itemAllEnding-    mouseBasicsText = map fmts mouseBasicsBlurb-    mouseBasicsEnd = map fmts mouseBasicsEnding-    lastHelpEnd = map fmts lastHelpEnding-    keyCaptionN n = fmt n "keys" "command"-    keyCaption = keyCaptionN keyL-    okxs = okxsN coinput offset keyL (const False) True-    renumber y (km, (y0, x1, x2)) = (km, (y0 + y, x1, x2))+    fmt0 n k h = T.justifyLeft n ' ' k <> " " <> h+    fmt n k h = " " <> fmt0 n k h+    keyCaption = fmt offsetCol2 "keys" "command"+    mouseOverviewCaption = fmt offsetCol2 "keys" "command (exploration/aiming)"+    spLen = textSize monoFont " "+    pamoveRight :: Int -> (PointUI, a) -> (PointUI, a)+    pamoveRight xoff (PointUI x y, a) = (PointUI (x + xoff) y, a)+    okxs cat headers footers =+      let (ovs, kyx) = okxsN coinput monoFont propFont 0 offsetCol2+                             (const False) True cat headers footers+      in ( EM.map (map (pamoveRight spLen)) ovs+         , map (second $ pamoveRight spLen) kyx )+    renumber dy (km, (PointUI x y, len)) = (km, (PointUI x (y + dy), len))+    renumberOv dy = map (\(PointUI x y, al) -> (PointUI x (y + dy), al))     mergeOKX :: OKX -> OKX -> OKX-    mergeOKX (ov1, ks1) (ov2, ks2) =-      (ov1 ++ ov2, ks1 ++ map (renumber $ length ov1) ks2)+    mergeOKX (ovs1, ks1) (ovs2, ks2) =+      let off = 1 + EM.foldr (\ov acc -> max acc (maxYofOverlay ov)) 0 ovs1+      in ( EM.unionWith (++) ovs1 $ EM.map (renumberOv off) ovs2+         , ks1 ++ map (renumber off) ks2 )     catLength cat = length $ filter (\(_, (cats, desc, _)) ->       cat `elem` cats && (desc /= "" || CmdInternal `elem` cats)) bcmdList     keyM = 13@@ -149,7 +123,7 @@     truncatem b = if T.length b > keyB                   then T.take (keyB - 1) b <> "$"                   else b-    fmm a b c = fmt keyM a $ fmt keyB (truncatem b) (" " <> truncatem c)+    fmm a b c = fmt (keyM + 1) a $ fmt0 keyB (truncatem b) (truncatem c)     areaCaption t = fmm t "LMB (left mouse button)" "RMB (right mouse button)"     keySel :: (forall a. (a, a) -> a) -> K.KM            -> [(CmdArea, Either K.KM SlotChar, Text)]@@ -174,104 +148,177 @@                   Nothing -> (key, "(not described:" <+> tshow cmd2 <> ")")             in (ca, Left km, desc)       in map caMakeChoice caCmds-    okm :: (forall a. (a, a) -> a)-        -> K.KM -> K.KM -> [Text] -> [Text]-        -> OKX-    okm sel key1 key2 header footer =+    doubleIfSquare n | isSquareFont monoFont = 2 * n+                     | otherwise = n+    okm :: (forall a. (a, a) -> a) -> K.KM -> K.KM -> [Text] -> OKX+    okm sel key1 key2 header =       let kst1 = keySel sel key1           kst2 = keySel sel key2           f (ca1, Left km1, _) (ca2, Left km2, _) y =-            assert (ca1 == ca2 `blame` (kst1, kst2))-              [ (Left [km1], (y, keyM + 3, keyB + keyM + 3))-              , (Left [km2], (y, keyB + keyM + 5, 2 * keyB + keyM + 5)) ]+            assert (ca1 == ca2 `blame` (ca1, ca2, km1, km2, kst1, kst2))+              [ (Left [km1], ( PointUI (doubleIfSquare $ keyM + 4) y+                             , ButtonWidth monoFont keyB ))+              , (Left [km2], ( PointUI (doubleIfSquare $ keyB + keyM + 5) y+                             , ButtonWidth monoFont keyB )) ]           f c d e = error $ "" `showFailure` (c, d, e)-          kxs = concat $ zipWith3 f kst1 kst2 [offset + length header..]-          render (ca1, _, desc1) (_, _, desc2) =-            fmm (areaDescription ca1) desc1 desc2-          menu = zipWith render kst1 kst2-      in (map textToAL $ "" : header ++ menu ++ footer, kxs)-  in concat-    [ [ ( rtitle corule <+> "- backstory"-        , (map textToAL introText, []) ) ]-    , if catLength CmdMinimal-         + length movText + length minimalText + length casualEnd-         + 5 > rheight then-        [ ( casualDescription <+> "(1/2)."-          , (map textToAL ([""] ++ movText ++ [""] ++ movTextEnd), []) )-        , ( casualDescription <+> "(2/2)."-          , okxs CmdMinimal (minimalText ++ [keyCaption]) casualEnd ) ]-      else-        [ ( casualDescription <> "."-          , okxs CmdMinimal-                 (movText ++ [""] ++ minimalText ++ [keyCaption])-                 casualEnd ) ]-    , if catLength CmdItemMenu + catLength CmdItem-         + 9 > rheight then-        [ ( categoryDescription CmdItemMenu <> "."-          , okxs CmdItemMenu [keyCaption] itemMenuEnd )-        , ( categoryDescription CmdItem <> "."-          , okxs CmdItem [keyCaption] itemRemainingEnd ) ]-      else-        [ ( categoryDescription CmdItemMenu <> "."+          kxs = concat $ zipWith3 f kst1 kst2 [1 + length header..]+          menuLeft = map (\(ca1, _, _) -> areaDescription ca1) kst1+          menuMiddle = map (\(_, _, desc) -> desc) kst1+          menuRight = map (\(_, _, desc) -> desc) kst2+          y0 = 1 + length header+      in ( EM.unionsWith (++)+             [ typesetInMono $ "" : header+             , EM.singleton monoFont+               $ typesetXY (doubleIfSquare 2, y0) menuLeft+             , EM.singleton propFont+               $ typesetXY (doubleIfSquare $ keyM + 4, y0) menuMiddle+             , EM.singleton propFont+               $ typesetXY (doubleIfSquare $ keyB + keyM + 5, y0) menuRight ]+         , kxs )+    typesetInSquare :: [Text] -> FontOverlayMap+    typesetInSquare = EM.singleton squareFont . offsetOverlayX+                      . map (\t -> (spLen, textToAL t))+    typesetInMono :: [Text] -> FontOverlayMap+    typesetInMono = EM.singleton monoFont . offsetOverlayX+                    . map (\t -> (spLen, textToAL t))+    typesetInProp :: [Text] -> FontOverlayMap+    typesetInProp = EM.singleton propFont . offsetOverlayX+                    . map (\t -> (spLen, textToAL t))+    typesetXY :: (Int, Int) -> [Text] -> Overlay+    typesetXY (xoffset, yoffset) =+      map (\(y, t) -> (PointUI xoffset (y + yoffset), textToAL t)) . zip [0..]+    sideBySide :: [(Text, OKX)] -> [(Text, OKX)]+    sideBySide ((_t1, (ovs1, kyx1)) : (t2, (ovs2, kyx2)) : rest)+      | not $ isSquareFont propFont =+        (t2, ( EM.unionWith (++) ovs1 (EM.map (map (pamoveRight rwidth)) ovs2)+             , sortOn (\(_, (PointUI x y, _)) -> (y, x))+               $ kyx1 ++ map (second $ pamoveRight rwidth) kyx2 ))+        : sideBySide rest+    sideBySide l = l+  in sideBySide $ concat+    [ if catLength CmdMinimal+         + length movBlurb1 + length movSchema + length movBlurb2+         + length minimalBlurb+         + 6 > rheight then+        [ ( movTextEnd           , mergeOKX-              (okxs CmdItemMenu [keyCaption] [""])-              (okxs CmdItem-                    [categoryDescription CmdItem <> ".", "", keyCaption]-                    itemAllEnd) ) ]-    , if catLength CmdMove + catLength CmdAim-         + 9 > rheight then-        [ ( "All terrain exploration and alteration commands."-          , okxs CmdMove [keyCaption] (pickLeaderDescription ++ categoryEnd) )-        , ( categoryDescription CmdAim <> "."-          , okxs CmdAim [keyCaption] categoryEnd ) ]+              (mergeOKX ( typesetInMono ["", casualDescription <+> "(1/2)", ""]+                        , [] )+                        (mergeOKX (typesetInProp movBlurb1, [])+                                  (typesetInSquare $ "" : movSchema, [])))+              (typesetInProp $ "" : movBlurb2, []) )+        , ( movTextEnd+          , okxs CmdMinimal+                 ( ["", casualDescription <+> "(2/2)", ""]+                 , minimalBlurb ++ [""]+                 , [keyCaption] )+                 ([], []) ) ]       else-        [ ( "All terrain exploration and alteration commands."+        [ ( movTextEnd           , mergeOKX-              (okxs CmdMove [keyCaption] (pickLeaderDescription ++ [""]))-              (okxs CmdAim-                    [categoryDescription CmdAim <> ".", "", keyCaption]-                    categoryEnd) ) ]+              (mergeOKX ( typesetInMono ["", casualDescription, ""]+                        , [] )+                        (mergeOKX (typesetInProp movBlurb1, [])+                                  (typesetInSquare $ "" : movSchema, [])))+              (okxs CmdMinimal+                    ( []+                    , [""] ++ movBlurb2 ++ [""]+                       ++ minimalBlurb ++ [""]+                    , [keyCaption] )+                    ([], [""])) ) ]     , if 45 > rheight then-        [ ( "Mouse overview."+        [ ( movTextEnd           , let (ls, _) = okxs CmdMouse-                               (mouseBasicsText ++ [keyCaption])-                               mouseBasicsEnd+                               ( ["", "Optional mouse commands", ""]+                               , mouseBasicsBlurb ++ [""]+                               , [mouseOverviewCaption] )+                               ([], [])             in (ls, []) )  -- don't capture mouse wheel, etc.-        , ( "Mouse in exploration and aiming modes."+        , ( movTextEnd           , mergeOKX-               (okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM-                    [areaCaption "exploration"] [])-               (okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM-                    [areaCaption "aiming mode"] categoryEnd) ) ]+              (typesetInMono $ "" : mouseAreasMini, [])+              (mergeOKX+                 (okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM+                      [areaCaption "Exploration"])+                 (okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM+                      [areaCaption "Aiming Mode"])) ) ]       else-        [ ( "Mouse commands."+        [ ( movTextEnd           , let (ls, _) = okxs CmdMouse-                               (mouseBasicsText ++ [keyCaption])-                               []+                               ( ["", "Optional mouse commands", ""]+                               , mouseBasicsBlurb ++ [""]+                               , [mouseOverviewCaption] )+                               ([], [])                 okx0 = (ls, [])  -- don't capture mouse wheel, etc.             in mergeOKX                  (mergeOKX                     okx0+                    (typesetInProp $ "" : mouseAreasBlurb, []))+                 (mergeOKX                     (okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM-                         [areaCaption "exploration"] []))-                 (okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM-                      [areaCaption "aiming mode"] categoryEnd) ) ]-    , [ ( categoryDescription CmdMeta <> "."-        , okxs CmdMeta [keyCaption] lastHelpEnd ) ]+                         [areaCaption "Exploration"])+                    (okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM+                         [areaCaption "Aiming Mode"] )) ) ]+    , if catLength CmdItem + catLength CmdMove + 9 + 9 > rheight then+        [ ( movTextEnd+          , okxs CmdItem+                 (["", categoryDescription CmdItem], [], ["", keyCaption])+                 ([], "" : itemAllEnding) )+        , ( movTextEnd+          , okxs CmdMove+                 (["", categoryDescription CmdMove], [], ["", keyCaption])+                 (pickLeaderDescription, []) ) ]+      else+        [ ( movTextEnd+          , mergeOKX+              (okxs CmdItem+                    (["", categoryDescription CmdItem], [], ["", keyCaption])+                    ([], "" : itemAllEnding))+              (okxs CmdMove+                    ( ["", "", categoryDescription CmdMove]+                    , []+                    , ["", keyCaption] )+                    (pickLeaderDescription, [""])) ) ]+    , if catLength CmdAim + catLength CmdMeta + 9 > rheight then+        [ ( movTextEnd+          , okxs CmdAim+                 (["", categoryDescription CmdAim], [], ["", keyCaption])+                 ([], []) )+        , ( lastHelpEnd+          , okxs CmdMeta+                 (["", categoryDescription CmdMeta], [], ["", keyCaption])+                 ([], ["", seeAlso]) ) ]+      else+        [ ( lastHelpEnd+          , mergeOKX+              (okxs CmdAim+                    (["", categoryDescription CmdAim], [], ["", keyCaption])+                    ([], []))+              (okxs CmdMeta+                    ( ["", "", categoryDescription CmdMeta]+                    , []+                    , ["", keyCaption] )+                    ([], ["", seeAlso, ""])) ) ]     ]  -- | Turn the specified portion of bindings into a menu.-okxsN :: InputContent -> Int -> Int -> (HumanCmd -> Bool) -> Bool -> CmdCategory-      -> [Text] -> [Text] -> OKX-okxsN InputContent{..} offset n greyedOut showManyKeys cat header footer =-  let fmt k h = " " <> T.justifyLeft n ' ' k <+> h+--+-- The length of the button may be wrong if the two supplied fonts+-- have very different widths.+okxsN :: InputContent -> DisplayFont -> DisplayFont -> Int -> Int+      -> (HumanCmd -> Bool) -> Bool -> CmdCategory+      -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX+okxsN InputContent{..} keyFont descFont offset offsetCol2 greyedOut+      showManyKeys cat (headerMono1, headerProp, headerMono2)+                       (footerMono, footerProp) =+  let fmt k h = (T.singleton '\x00a0' <> k, h)       coImage :: HumanCmd -> [K.KM]       coImage cmd = M.findWithDefault (error $ "" `showFailure` cmd) cmd brevMap       disp = T.intercalate " or " . map (T.pack . K.showKM)       keyKnown km = case K.key km of         K.Unknown{} -> False         _ -> True-      keys :: [(Either [K.KM] SlotChar, (Bool, Text))]+      keys :: [(Either [K.KM] SlotChar, (Bool, (Text, Text)))]       keys = [ (Left kmsRes, (greyedOut cmd, fmt keyNames desc))              | (_, (cats, desc, cmd)) <- bcmdList              , let kms = coImage cmd@@ -281,8 +328,29 @@                    kmsRes = if desc == "" then knownKeys else kms              , cat `elem` cats              , desc /= "" || CmdInternal `elem` cats]-      f (ks, (_, tkey)) y = (ks, (y, 1, T.length tkey))-      kxs = zipWith f keys [offset + length header..]-      ts = map (False,) ("" : header) ++ map snd keys ++ map (False,) footer-      greyToAL (b, t) = if b then textFgToAL Color.BrBlack t else textToAL t-  in (map greyToAL ts, kxs)+      spLen = textSize keyFont " "+      f (ks, (_, (_, t2))) y =+        (ks, ( PointUI spLen y+             , ButtonWidth keyFont (offsetCol2 + 2 + T.length t2 - 1)))+      kxs = zipWith f keys [offset + length headerMono1+                                   + length headerProp+                                   + length headerMono2 ..]+      renumberOv = map (\(PointUI x y, al) -> (PointUI x (y + offset), al))+      ts = map (\t -> (False, (t, ""))) headerMono1+           ++ map (\t -> (False, ("", t))) headerProp+           ++ map (\t -> (False, (t, ""))) headerMono2+           ++ map snd keys+           ++ map (\t -> (False, (t, ""))) footerMono+           ++ map (\t -> (False, ("", t))) footerProp+      greyToAL (b, (t1, t2)) =+        if b+        then let al1 = textFgToAL Color.BrBlack t1+             in (al1, ( if T.null t1 then 0 else spLen * (offsetCol2 + 2)+                      , textFgToAL Color.BrBlack t2 ))+        else let al1 = textToAL t1+             in (al1, ( if T.null t1 then 0 else spLen * (offsetCol2 + 2)+                      , textToAL t2 ))+      (greyLab, greyDesc) = unzip $ map greyToAL ts+  in ( EM.insertWith (++) descFont (renumberOv (offsetOverlayX greyDesc))+       $ EM.singleton keyFont $ renumberOv $ offsetOverlay greyLab+     , kxs )

engine-src/Game/LambdaHack/Client/UI/MonadClientUI.hs view

@@ -8,16 +8,17 @@                  , getCachePath                  )     -- * Assorted primitives-  , clientPrintUI, mapStartY, getSession, putSession, displayFrames+  , clientPrintUI, debugPossiblyPrintUI, getSession, putSession, displayFrames   , connFrontendFrontKey, setFrontAutoYes, frontendShutdown, printScreen   , chanFrontend, anyKeyPressed, discardPressedKey, resetPressedKeys-  , addPressedControlEsc, revCmdMap-  , getReportUI, getLeaderUI, getArenaUI, viewedLevelUI-  , leaderTgtToPos, xhairToPos, clearAimMode, scoreToSlideshow, defaultHistory+  , addPressedControlEsc, revCmdMap, getReportUI, computeChosenLore+  , miniHintAimingBare, miniHintAimingLore+  , getLeaderUI, getArenaUI, viewedLevelUI+  , xhairToPos, setXHairFromGUI, clearAimMode+  , getFontSetup, scoreToSlideshow, defaultHistory   , tellAllClipPS, tellGameClipPS, elapsedSessionTimeGT-  , resetSessionStart, resetGameStart-  , partActorLeader, partActorLeaderFun, partPronounLeader-  , tryRestore, leaderSkillsClientUI+  , resetSessionStart, resetGameStart, partActorLeader, partPronounLeader+  , tryRestore, leaderSkillsClientUI, rndToActionUI, tryOpenBrowser #ifdef EXPOSE_INTERNAL     -- * Internal operations   , connFrontend, displayFrame, addPressedKey@@ -28,8 +29,10 @@  import Game.LambdaHack.Core.Prelude +import qualified Control.Monad.Trans.State.Strict as St import qualified Data.EnumMap.Strict as EM import qualified Data.Map.Strict as M+import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.IO as T import           Data.Time.Clock@@ -39,9 +42,9 @@ import qualified NLP.Miniutter.English as MU import           System.FilePath import           System.IO (hFlush, stdout)+import           Web.Browser (openBrowser)  import           Game.LambdaHack.Client.Bfs-import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.CommonM import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.State@@ -49,20 +52,23 @@ import           Game.LambdaHack.Client.UI.Content.Input import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.EffectDescription import           Game.LambdaHack.Client.UI.Frame-import           Game.LambdaHack.Client.UI.Frontend import qualified Game.LambdaHack.Client.UI.Frontend as Frontend import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.Msg+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.SessionUI import           Game.LambdaHack.Client.UI.Slideshow import           Game.LambdaHack.Client.UI.UIOptions import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.File import qualified Game.LambdaHack.Common.HighScore as HighScore+import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Misc import           Game.LambdaHack.Common.MonadStateRead@@ -74,19 +80,22 @@ import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.RuleKind+import           Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability-import           Game.LambdaHack.Definition.Defs  -- Assumes no interleaving with other clients, because each UI client -- in a different terminal/window/machine. clientPrintUI :: MonadClientUI m => Text -> m () clientPrintUI t = liftIO $ do-  T.hPutStrLn stdout t+  T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough   hFlush stdout --- | The row where the dungeon map starts.-mapStartY :: Y-mapStartY = 1+debugPossiblyPrintUI :: MonadClientUI m => Text -> m ()+debugPossiblyPrintUI t = do+  sdbgMsgCli <- getsClient $ sdbgMsgCli . soptions+  when sdbgMsgCli $ liftIO $ do+    T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough+    hFlush stdout  -- | The monad that gives the client access to UI operations, -- but not to modifying client state.@@ -104,98 +113,143 @@ putSession s = modifySession (const s)  -- | Write a UI request to the frontend and read a corresponding reply.-connFrontend :: MonadClientUI m => FrontReq a -> m a+connFrontend :: MonadClientUI m => Frontend.FrontReq a -> m a connFrontend req = do-  ChanFrontend f <- getsSession schanF+  Frontend.ChanFrontend f <- getsSession schanF   liftIO $ f req  displayFrame :: MonadClientUI m => Maybe Frame -> m () displayFrame mf = do   frame <- case mf of-    Nothing -> return $! FrontDelay 1+    Nothing -> return $! Frontend.FrontDelay 1     Just fr -> do       modifySession $ \cli -> cli {snframes = snframes cli + 1}-      return $! FrontFrame fr+      return $! Frontend.FrontFrame fr   connFrontend frame  -- | Push frames or delays to the frame queue. The frames depict -- the @lid@ level.-displayFrames :: MonadClientUI m => LevelId -> PreFrames -> m ()+displayFrames :: MonadClientUI m => LevelId -> PreFrames3 -> m () displayFrames lid frs = do-  let frames = case frs of+  let framesRaw = case frs of         [] -> []-        [Just (bfr, ffr)] -> [Just (FrameBase $ U.unsafeThaw bfr, ffr)]+        [Just ((bfr, ffr), (ovProp, ovMono))] ->+          [Just ((FrameBase $ U.unsafeThaw bfr, ffr), (ovProp, ovMono))]         _ ->           -- Due to the frames coming from the same base frame,           -- we have to copy it to avoid picture corruption.-          map (fmap $ \(bfr, ffr) -> (FrameBase $ U.thaw bfr, ffr)) frs-  mapM_ displayFrame frames-  -- Can be different than @blid b@, e.g., when our actor is attacked-  -- on a remote level.+          map (fmap $ \((bfr, ffr), (ovProp, ovMono)) ->+                ((FrameBase $ U.thaw bfr, ffr), (ovProp, ovMono))) frs+  -- If display level different than the man viewed level,+  -- e.g., when our actor is attacked on a remote level,+  -- then pad with tripple delay to give more time to see the remote frames(s).   lidV <- viewedLevelUI-  when (lidV == lid) $-    modifySession $ \sess -> sess {sdisplayNeeded = False}+  frames <- if lidV == lid+            then do+              modifySession $ \sess -> sess { sdisplayNeeded = False+                                            , sturnDisplayed = True }+              return framesRaw+            else return $ framesRaw ++ [Nothing, Nothing, Nothing]+  mapM_ displayFrame frames --- | Write 'FrontKey' UI request to the frontend, read the reply,+-- | Write 'Frontend.FrontKey' UI request to the frontend, read the reply, -- set pointer, return key.-connFrontendFrontKey :: MonadClientUI m => [K.KM] -> PreFrame -> m K.KM-connFrontendFrontKey frontKeyKeys (bfr, ffr) = do-  let frontKeyFrame = (FrameBase $ U.unsafeThaw bfr, ffr)-  kmp <- connFrontend $ FrontKey frontKeyKeys frontKeyFrame+connFrontendFrontKey :: MonadClientUI m => [K.KM] -> PreFrame3 -> m K.KM+connFrontendFrontKey frontKeyKeys ((bfr, ffr), (ovProp, ovMono)) = do+  let frontKeyFrame = ((FrameBase $ U.unsafeThaw bfr, ffr), (ovProp, ovMono))+  kmp <- connFrontend $ Frontend.FrontKey frontKeyKeys frontKeyFrame   modifySession $ \sess -> sess {spointer = K.kmpPointer kmp}   return $! K.kmpKeyMod kmp  setFrontAutoYes :: MonadClientUI m => Bool -> m ()-setFrontAutoYes b = connFrontend $ FrontAutoYes b+setFrontAutoYes b = connFrontend $ Frontend.FrontAutoYes b  frontendShutdown :: MonadClientUI m => m ()-frontendShutdown = connFrontend FrontShutdown+frontendShutdown = connFrontend Frontend.FrontShutdown  printScreen :: MonadClientUI m => m ()-printScreen = connFrontend FrontPrintScreen+printScreen = connFrontend Frontend.FrontPrintScreen  -- | Initialize the frontend chosen by the player via client options. chanFrontend :: MonadClientUI m-             => ScreenContent -> ClientOptions -> m ChanFrontend+             => ScreenContent -> ClientOptions -> m Frontend.ChanFrontend chanFrontend coscreen soptions =   liftIO $ Frontend.chanFrontendIO coscreen soptions  anyKeyPressed :: MonadClientUI m => m Bool-anyKeyPressed = connFrontend FrontPressed+anyKeyPressed = connFrontend Frontend.FrontPressed  discardPressedKey :: MonadClientUI m => m ()-discardPressedKey = connFrontend FrontDiscardKey+discardPressedKey = connFrontend Frontend.FrontDiscardKey  resetPressedKeys :: MonadClientUI m => m ()-resetPressedKeys = connFrontend FrontResetKeys+resetPressedKeys = connFrontend Frontend.FrontResetKeys  addPressedKey :: MonadClientUI m => K.KMP -> m ()-addPressedKey = connFrontend . FrontAdd+addPressedKey = connFrontend . Frontend.FrontAdd  addPressedControlEsc :: MonadClientUI m => m () addPressedControlEsc = addPressedKey K.KMP { K.kmpKeyMod = K.controlEscKM-                                           , K.kmpPointer = originPoint }+                                           , K.kmpPointer = PointUI 0 0 } -revCmdMap :: MonadClientUI m => m (K.KM -> HumanCmd.HumanCmd -> K.KM)+revCmdMap :: MonadClientUI m => m (HumanCmd.HumanCmd -> K.KM) revCmdMap = do   CCUI{coinput=InputContent{brevMap}} <- getsSession sccui-  let revCmd dflt cmd = case M.lookup cmd brevMap of-        Nothing -> dflt+  let revCmd cmd = case M.lookup cmd brevMap of+        Nothing -> K.undefinedKM         Just (k : _) -> k         Just [] -> error $ "" `showFailure` brevMap   return revCmd -getReportUI :: MonadClientUI m => m Report-getReportUI = do+getReportUI :: MonadClientUI m => Bool -> m Report+getReportUI insideMenu = do+  side <- getsClient sside+  saimMode <- getsSession saimMode+  (inhabitants, embeds) <-+    if isJust saimMode then computeChosenLore else return ([], [])   sUIOptions <- getsSession sUIOptions   report <- getsSession $ newReport . shistory-  side <- getsClient sside   fact <- getsState $ (EM.! side) . sfactionD-  let underAI = isAIFact fact-      mem = EM.fromList <$> uMessageColors sUIOptions-      promptAI = toMsg mem MsgPrompt "[press any key for main menu]"-  return $! if underAI then consReport promptAI report else report+  let newcomerHelp = True  -- TODO+      detailAtDefault = (detailLevel <$> saimMode) == Just defaultDetailLevel+      detailMinimal = (detailLevel <$> saimMode) == Just minBound+      underAI = isAIFact fact+      prefixColors = uMessageColors sUIOptions+      -- Here we assume newbies don't override default keys.+      miniHintAiming = if null inhabitants && null embeds+                       then miniHintAimingBare+                       else miniHintAimingLore+      promptAim = toMsgShared prefixColors MsgPromptGeneric+                  $ miniHintAiming <> "\n"+      promptAI = toMsgShared prefixColors MsgPromptAction+                             "<press any key for main menu>"+  return $! if | newcomerHelp && not insideMenu+                 && detailAtDefault && not detailMinimal ->+                   consReport promptAim report+               | underAI -> consReport promptAI report+               | otherwise -> report +computeChosenLore :: MonadClientUI m+                  => m ([(ActorId, Actor)], [(ItemId, ItemQuant)])+computeChosenLore = do+  side <- getsClient sside+  mxhairPos <- xhairToPos+  leader0 <- getLeaderUI+  b0 <- getsState $ getActorBody leader0+  let xhairPos = fromMaybe (bpos b0) mxhairPos+  lidV <- viewedLevelUI+  let isOurs (_, b) = bfid b == side+  inhabitants0 <- getsState $ filter (not . isOurs)+                  . posToAidAssocs xhairPos lidV+  embeds0 <- getsState $ EM.assocs . getEmbedBag lidV xhairPos+  return (inhabitants0, embeds0)++miniHintAimingBare :: Text+miniHintAimingBare = "Aiming mode: press 'f' to fling, SPACE or RMB to cycle detail, ESC to cancel."++miniHintAimingLore :: Text+miniHintAimingLore = "Aiming mode: '~' for lore, 'f' to fling, SPACE or RMB to hush, ESC to cancel."+ getLeaderUI :: MonadClientUI m => m ActorId getLeaderUI = do   cli <- getClient@@ -228,16 +282,6 @@   saimMode <- getsSession saimMode   return $! maybe arena aimLevelId saimMode -leaderTgtToPos :: MonadClientUI m => m (Maybe Point)-leaderTgtToPos = do-  lidV <- viewedLevelUI-  mleader <- getsClient sleader-  case mleader of-    Nothing -> return Nothing-    Just aid -> do-      mtgt <- getsClient $ getTarget aid-      getsState $ aidTgtToPos aid lidV mtgt- xhairToPos :: MonadClientUI m => m (Maybe Point) xhairToPos = do   lidV <- viewedLevelUI@@ -248,6 +292,12 @@     Just aid -> getsState $ aidTgtToPos aid lidV sxhair                   -- e.g., xhair on another level +setXHairFromGUI :: MonadClientUI m => Maybe Target -> m ()+setXHairFromGUI xhair2 = do+  xhair0 <- getsSession sxhair+  modifySession $ \sess -> sess {sxhairGoTo = Nothing}+  when (xhair0 /= xhair2) $ modifySession $ \sess -> sess {sxhair = xhair2}+ -- If aim mode is exited, usually the player had the opportunity to deal -- with xhair on a foe spotted on another level, so now move xhair -- back to the leader level.@@ -266,8 +316,24 @@           Just TPoint{} -> Just $ TPoint TUnknown lidV xhairPos             -- the point is possibly unknown on this level; unimportant anyway           _ -> sxhairOld-    modifySession $ \sess -> sess {sxhair}+    setXHairFromGUI sxhair +getFontSetup :: MonadClientUI m => m FontSetup+getFontSetup = do+  soptions@ClientOptions{schosenFontset, sfontsets} <- getsClient soptions+  let chosenFontsetID = fromJust schosenFontset+      chosenFontset = case lookup chosenFontsetID sfontsets of+        Nothing -> error $ "Fontset not defined in config file"+                           `showFailure` chosenFontsetID+        Just fs -> fs+      multiFont = Frontend.frontendName soptions == "sdl"+                  && not (T.null (fontPropRegular chosenFontset))+  return $! if | not multiFont -> singleFontSetup+               | fontPropRegular chosenFontset == fontMono chosenFontset+                 && fontPropBold chosenFontset == fontMono chosenFontset ->+                 monoFontSetup+               | otherwise -> multiFontSetup+ scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow scoreToSlideshow total status = do   CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui@@ -299,23 +365,30 @@                            (T.unwords $ tail $ T.words $ gname fact)                            ourVictims theirVictims                            (fhiCondPoly $ gplayer fact)-      sli = highSlideshow rwidth (rheight - 1) ntable pos gameModeName tz+  fontSetup <- getFontSetup+  let sli = highSlideshow fontSetup rwidth (rheight - 1) ntable pos+                          gameModeName tz   return $! if worthMentioning             then sli             else emptySlideshow -defaultHistory :: MonadClientUI m => m History+defaultHistory :: (MonadClient m, MonadClientUI m) => m History defaultHistory = do   sUIOptions <- getsSession sUIOptions+  curTutorial <- getsSession scurTutorial+  overrideTut <- getsSession soverrideTut+  let displayHints = fromMaybe curTutorial overrideTut   liftIO $ do     utcTime <- getCurrentTime     timezone <- getTimeZone utcTime     let curDate = T.pack $ take 19 $ show $ utcToLocalTime timezone utcTime         emptyHist = emptyHistory $ uHistoryMax sUIOptions-        mem = EM.fromList <$> uMessageColors sUIOptions-        msg = toMsg mem MsgAdmin+        msg = toMsgShared (uMessageColors sUIOptions) MsgBookKeeping               $ "History log started on " <> curDate <> "."-    return $! fst $ addToReport emptyHist msg 0 timeZero+        -- Tuturial hints from initial message can be repeated.+        (_, nhistory, _) =+          addToReport S.empty displayHints False emptyHist msg timeZero+    return nhistory  tellAllClipPS :: MonadClientUI m => m () tellAllClipPS = do@@ -330,8 +403,8 @@     let time = absoluteTimeAdd allTime gtime         nframes = allNframes + gnframes         diff = fromRational $ toRational $ curPOSIX - sstartPOSIX-        cps = fromIntegral (timeFit time timeClip) / diff :: Double-        fps = fromIntegral nframes / diff :: Double+        cps = intToDouble (timeFit time timeClip) / diff+        fps = intToDouble nframes / diff     clientPrintUI $       "Session time:" <+> tshow diff <> "s; frames:" <+> tshow nframes <> "."       <+> "Average clips per second:" <+> tshow cps <> "."@@ -348,8 +421,8 @@       time <- getsState stime       nframes <- getsSession snframes       let diff = fromRational $ toRational $ curPOSIX - sgstartPOSIX-          cps = fromIntegral (timeFit time timeClip) / diff :: Double-          fps = fromIntegral nframes / diff :: Double+          cps = intToDouble (timeFit time timeClip) / diff+          fps = intToDouble nframes / diff       -- This means: "Game portion after last reload time:...".       clientPrintUI $         "Game time:" <+> tshow diff <> "s; frames:" <+> tshow nframes <> "."@@ -360,7 +433,9 @@ elapsedSessionTimeGT stopAfter = do   current <- liftIO getPOSIXTime   sstartPOSIX <- getsSession sstart-  return $! fromIntegral stopAfter + sstartPOSIX <= current+  return $! (fromIntegralWrap :: Int -> NominalDiffTime) stopAfter+            + sstartPOSIX+            <= current  resetSessionStart :: MonadClientUI m => m () resetSessionStart = do@@ -373,17 +448,11 @@   sgstart <- liftIO getPOSIXTime   time <- getsState stime   nframes <- getsSession snframes-  modifySession $ \cli ->-    cli { sgstart-        , sallTime = absoluteTimeAdd (sallTime cli) time+  modifySession $ \sess ->+    sess { sgstart+        , sallTime = absoluteTimeAdd (sallTime sess) time         , snframes = 0-        , sallNframes = sallNframes cli + nframes }--partActorLeaderCommon :: Maybe ActorId -> ActorUI -> Actor -> ActorId -> MU.Part-partActorLeaderCommon mleader bUI b aid = case mleader of-  Just leader | aid == leader -> "you"-  _ | bhp b <= 0 -> MU.Phrase ["the fallen", partActor bUI]-  _ -> partActor bUI+        , sallNframes = sallNframes sess + nframes }  -- | The part of speech describing the actor or the "you" pronoun if he is -- the leader of the observer's faction.@@ -392,15 +461,12 @@   mleader <- getsClient sleader   bUI <- getsSession $ getActorUI aid   b <- getsState $ getActorBody aid-  return $! partActorLeaderCommon mleader bUI b aid--partActorLeaderFun :: MonadClientUI m => m (ActorId -> MU.Part)-partActorLeaderFun = do-  mleader <- getsClient sleader-  sess <- getSession-  s <- getState-  return $! \aid ->-    partActorLeaderCommon mleader (getActorUI aid sess) (getActorBody aid s) aid+  return $! case mleader of+    Just leader | aid == leader -> "you"+    _ | bhp b <= 0+        && not (bproj b) ->  -- avoid "the fallen falling" projectiles+      MU.Phrase ["the fallen", partActor bUI]+    _ -> partActor bUI  -- | The part of speech with the actor's pronoun or "you" if a leader -- of the client's faction.@@ -415,21 +481,34 @@ -- | Try to read saved client game state from the file system. tryRestore :: MonadClientUI m => m (Maybe (StateClient, Maybe SessionUI)) tryRestore = do-  cops@COps{corule} <- getsState scops-  bench <- getsClient $ sbenchmark . soptions-  if bench then return Nothing+  COps{corule} <- getsState scops+  clientOptions <- getsClient soptions+  if sbenchmark clientOptions then return Nothing   else do     side <- getsClient sside     prefix <- getsClient $ ssavePrefixCli . soptions-    let fileName = prefix <> Save.saveNameCli cops side-    res <- liftIO $ Save.restoreGame cops fileName+    let fileName = prefix <> Save.saveNameCli corule side+    res <- liftIO $ Save.restoreGame corule clientOptions fileName     let cfgUIName = rcfgUIName corule-        content = rcfgUIDefault corule+        (configString, _) = rcfgUIDefault corule     dataDir <- liftIO appDataDir-    liftIO $ tryWriteFile (dataDir </> cfgUIName) content+    liftIO $ tryWriteFile (dataDir </> cfgUIName) configString     return res +-- For a leader, the skills are both current and max skills. leaderSkillsClientUI :: MonadClientUI m => m Ability.Skills+{-# INLINE leaderSkillsClientUI #-} leaderSkillsClientUI = do   leader <- getLeaderUI   getsState $ getActorMaxSkills leader++-- | Invoke pseudo-random computation with the generator kept in the session.+rndToActionUI :: MonadClientUI m => Rnd a -> m a+rndToActionUI r = do+  gen1 <- getsSession srandomUI+  let (a, gen2) = St.runState r gen1+  modifySession $ \sess -> sess {srandomUI = gen2}+  return a++tryOpenBrowser :: MonadClientUI m => String -> m Bool+tryOpenBrowser address = liftIO $ openBrowser address

engine-src/Game/LambdaHack/Client/UI/Msg.hs view

@@ -3,19 +3,23 @@ -- and then saved to player history. module Game.LambdaHack.Client.UI.Msg   ( -- * Msg-    Msg, toMsg-  , MsgClass(..), interruptsRunning, disturbsResting+    Msg, MsgShared, toMsgShared, toMsgDistinct+  , MsgClassShowAndSave(..), MsgClassShow(..), MsgClassSave(..)+  , MsgClassIgnore(..), MsgClassDistinct(..)+  , MsgClass, interruptsRunning, disturbsResting     -- * Report-  , Report, nullReport, consReport, renderReport, anyInReport+  , Report, nullVisibleReport, consReport, renderReport, anyInReport     -- * History-  , History, newReport, emptyHistory, addToReport, archiveReport, lengthHistory-  , renderHistory+  , History, newReport, emptyHistory, addToReport, addEolToNewReport+  , archiveReport, lengthHistory, renderHistory #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , isSavedToHistory, isDisplayed, bindsPronouns, msgColor-  , UAttrLine, RepMsgN, uToAttrLine, attrLineToU-  , emptyReport, snocReport, renderWholeReport, renderRepetition-  , scrapRepetition, renderTimeReport+  , UAttrString, uToAttrString, attrStringToU+  , toMsg, MsgPrototype, tripleFromProto+  , scrapsRepeats, tutorialHint, msgColor+  , RepMsgNK, nullRepMsgNK+  , emptyReport, renderWholeReport, renderRepetition+  , scrapRepetitionSingle, scrapRepetition, renderTimeReport #endif   ) where @@ -23,12 +27,11 @@  import Game.LambdaHack.Core.Prelude -import           Control.DeepSeq import           Data.Binary-import qualified Data.EnumMap.Strict as EM+import qualified Data.Char as Char+import qualified Data.Set as S import           Data.Vector.Binary () import qualified Data.Vector.Unboxed as U-import           Data.Word (Word32) import           GHC.Generics (Generic)  import           Game.LambdaHack.Client.UI.Overlay@@ -36,274 +39,424 @@ import           Game.LambdaHack.Common.Time import qualified Game.LambdaHack.Definition.Color as Color --- * UAttrLine+-- * UAttrString -type UAttrLine = U.Vector Word32+type UAttrString = U.Vector Word32 -uToAttrLine :: UAttrLine -> AttrLine-uToAttrLine v = map Color.AttrCharW32 $ U.toList v+uToAttrString :: UAttrString -> AttrString+uToAttrString v = map Color.AttrCharW32 $ U.toList v -attrLineToU :: AttrLine -> UAttrLine-attrLineToU l = U.fromList $ map Color.attrCharW32 l+attrStringToU :: AttrString -> UAttrString+attrStringToU l = U.fromList $ map Color.attrCharW32 l  -- * Msg  -- | The type of a single game message. data Msg = Msg-  { msgLine  :: AttrLine  -- ^ the colours and characters of the message;-                          --   not just text, in case there was some colour-                          --   unrelated to msg class-  , msgClass :: MsgClass  -- ^ whether message should be displayed,-                          --   recorded in history, with what color, etc.+  { msgShow  :: AttrString  -- ^ the colours and characters of the message+                            --   to be shown on the screen; not just text,+                            --   in case there was some colour not coming+                            --   from the message class+  , msgSave  :: AttrString  -- ^ the same to be saved in the message log only+  , msgClass :: MsgClass   }-  deriving (Show, Eq, Generic)+  deriving (Show, Eq, Ord, Generic)  instance Binary Msg -toMsg :: Maybe (EM.EnumMap MsgClass Color.Color) -> MsgClass -> Text -> Msg-toMsg mem msgClass l =-  let findColorInConfig = EM.findWithDefault Color.White msgClass-      color = maybe (msgColor msgClass) findColorInConfig mem-      msgLine = textFgToAL color l+toMsg :: [(String, Color.Color)] -> MsgPrototype -> Msg+toMsg prefixColors msgProto =+  let (tShow, tSave, msgClass) = tripleFromProto msgProto+      msgClassName = showSimpleMsgClass msgClass+      mprefixColor = find ((`isPrefixOf` msgClassName) . fst) prefixColors+      color = maybe (msgColor msgClass) snd mprefixColor+      msgShow = textFgToAS color tShow+      msgSave = textFgToAS color tSave   in Msg {..} +data MsgPrototype =+    MsgProtoShowAndSave MsgClassShowAndSave Text+  | MsgProtoShow MsgClassShow Text+  | MsgProtoSave MsgClassSave Text+  | MsgProtoIgnore MsgClassIgnore+  | MsgProtoDistinct MsgClassDistinct Text Text++tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass)+tripleFromProto = \case+  MsgProtoShowAndSave x t -> (t, t, MsgClassShowAndSave x)+  MsgProtoShow x t -> (t, "", MsgClassShow x)+  MsgProtoSave x t -> ("", t, MsgClassSave x)+  MsgProtoIgnore x -> ("", "", MsgClassIgnore x)+  MsgProtoDistinct x t1 t2 -> (t1, t2, MsgClassDistinct x)++class MsgShared a where+  toMsgShared :: [(String, Color.Color)] -> a -> Text -> Msg++instance MsgShared MsgClassShowAndSave where+  toMsgShared prefixColors msgClass t =+    toMsg prefixColors $ MsgProtoShowAndSave msgClass t++instance MsgShared MsgClassShow where+  toMsgShared prefixColors msgClass t =+    toMsg prefixColors $ MsgProtoShow msgClass t++instance MsgShared MsgClassSave where+  toMsgShared prefixColors msgClass t =+    toMsg prefixColors $ MsgProtoSave msgClass t++instance MsgShared MsgClassIgnore where+  toMsgShared prefixColors msgClass _ =+    toMsg prefixColors $ MsgProtoIgnore msgClass++toMsgDistinct :: [(String, Color.Color)] -> MsgClassDistinct -> Text -> Text+              -> Msg+toMsgDistinct prefixColors msgClass t1 t2 =+  toMsg prefixColors $ MsgProtoDistinct msgClass t1 t2++-- Each constructor name should have length as asserted in @emptyReport@,+-- so that the message log with message classes (if set in config) looks tidy. data MsgClass =-    MsgAdmin-  | MsgBecome-  | MsgNoLonger-  | MsgLongerUs-  | MsgLonger+    MsgClassShowAndSave MsgClassShowAndSave+  | MsgClassShow MsgClassShow+  | MsgClassSave MsgClassSave+  | MsgClassIgnore MsgClassIgnore+  | MsgClassDistinct MsgClassDistinct+  deriving (Show, Eq, Ord, Generic)++instance Binary MsgClass++showSimpleMsgClass :: MsgClass -> String+showSimpleMsgClass = \case+  MsgClassShowAndSave x -> show x+  MsgClassShow x -> show x+  MsgClassSave x -> show x+  MsgClassIgnore x -> show x+  MsgClassDistinct x -> show x++data MsgClassShowAndSave =+    MsgBookKeeping+  | MsgStatusWakeup+  | MsgStatusStopUs+  | MsgStatusStopThem   | MsgItemCreation-  | MsgItemDestruction-  | MsgDeathGood-  | MsgDeathBad-  | MsgDeath-  | MsgDeathThreat-  | MsgLeader-  | MsgDiplomacy-  | MsgOutcome-  | MsgPlot-  | MsgLandscape-  | MsgTileDisco-  | MsgItemDisco-  | MsgActorSpot-  | MsgFirstEnemySpot-  | MsgItemSpot-  | MsgItemMove-  | MsgAction+  | MsgItemRuination+  | MsgDeathVictory+  | MsgDeathDeafeat+  | MsgDeathBoring+  | MsgRiskOfDeath+  | MsgPointmanSwap+  | MsgFactionIntel+  | MsgFinalOutcome+  | MsgPlotExposition+  | MsgBackdropInfo+  | MsgTerrainReveal+  | MsgItemDiscovery+  | MsgSpottedActor+  | MsgItemMovement+  | MsgActionMajor   | MsgActionMinor   | MsgEffectMajor-  | MsgEffect+  | MsgEffectMedium   | MsgEffectMinor-  | MsgMisc-  | MsgHeardClose-  | MsgHeard-  | MsgFocus-  | MsgWarning-  | MsgRangedPowerfulWe-  | MsgRangedPowerfulUs-  | MsgRanged  -- our non-projectile actors are not hit-  | MsgRangedUs-  | MsgRare-  | MsgVeryRare-  | MsgMeleePowerfulWe-  | MsgMeleePowerfulUs-  | MsgMeleeInterestingWe-  | MsgMeleeInterestingUs-  | MsgMelee  -- our non-projectile actors are not hit-  | MsgMeleeUs-  | MsgDone+  | MsgMiscellanous+  | MsgHeardOutside+  | MsgHeardNearby+  | MsgHeardFaraway+  | MsgBackdropFocus+  | MsgActionWarning+  | MsgRangedMightyWe+  | MsgRangedMightyUs+  | MsgRangedOthers  -- not ours or projectiles are hit+  | MsgRangedNormalUs+  | MsgGoodMiscEvent+  | MsgBadMiscEvent+  | MsgNeutralEvent+  | MsgSpecialEvent+  | MsgMeleeMightyWe+  | MsgMeleeMightyUs+  | MsgMeleeComplexWe+  | MsgMeleeComplexUs+  | MsgMeleeOthers  -- not ours or projectiles are hit+  | MsgMeleeNormalUs+  | MsgActionComplete   | MsgAtFeetMajor-  | MsgAtFeet-  | MsgNumeric-  | MsgSpam-  | MsgMacro-  | MsgRunStop-  | MsgPrompt+  | MsgAtFeetMinor+  | MsgTutorialHint+  deriving (Show, Eq, Ord, Enum, Bounded, Generic)++instance Binary MsgClassShowAndSave++data MsgClassShow =+    MsgPromptGeneric   | MsgPromptFocus-  | MsgAlert-  | MsgStopPlayback- deriving (Show, Read, Eq, Enum, Generic)+  | MsgPromptMention+  | MsgPromptModify+  | MsgPromptActors+  | MsgPromptItems+  | MsgPromptAction+  | MsgActionAlert+  | MsgSpottedThreat+  deriving (Show, Eq, Ord, Enum, Bounded, Generic) -instance NFData MsgClass+instance Binary MsgClassShow -instance Binary MsgClass+data MsgClassSave =+    MsgInnerWorkSpam+  | MsgNumericReport+  deriving (Show, Eq, Ord, Enum, Bounded, Generic) -isSavedToHistory :: MsgClass -> Bool-isSavedToHistory MsgNumeric = False-isSavedToHistory MsgSpam = False-isSavedToHistory MsgMacro = False-isSavedToHistory MsgRunStop = False-isSavedToHistory MsgPrompt = False-isSavedToHistory MsgPromptFocus = False-isSavedToHistory MsgAlert = False-isSavedToHistory MsgStopPlayback = False-isSavedToHistory _ = True+instance Binary MsgClassSave -isDisplayed :: MsgClass -> Bool-isDisplayed MsgRunStop = False-isDisplayed MsgNumeric = False-isDisplayed MsgSpam = False-isDisplayed MsgMacro = False-isDisplayed MsgStopPlayback = False-isDisplayed _ = True+data MsgClassIgnore =+    MsgMacroOperation+  | MsgRunStopReason+  | MsgStopPlayback+  deriving (Show, Eq, Ord, Enum, Bounded, Generic) +instance Binary MsgClassIgnore++data MsgClassDistinct =+    MsgSpottedItem+  | MsgStatusSleep+  | MsgStatusGoodUs+  | MsgStatusBadUs+  | MsgStatusOthers+  | MsgStatusBenign+  | MsgStatusWarning+  | MsgStatusLongerUs+  | MsgStatusLongThem+  deriving (Show, Eq, Ord, Enum, Bounded, Generic)++instance Binary MsgClassDistinct+ interruptsRunning :: MsgClass -> Bool-interruptsRunning MsgHeard = False-  -- MsgHeardClose interrupts, even if running started while hearing close-interruptsRunning MsgEffectMinor = False-interruptsRunning MsgItemDisco = False-interruptsRunning MsgItemMove = False-interruptsRunning MsgActionMinor = False-interruptsRunning MsgAtFeet = False-interruptsRunning MsgNumeric = False-interruptsRunning MsgSpam = False-interruptsRunning MsgMacro = False-interruptsRunning MsgRunStop = False-interruptsRunning MsgPrompt = False-interruptsRunning MsgPromptFocus = False-  -- MsgAlert means something went wrong, so alarm-interruptsRunning _ = True+interruptsRunning = \case+  MsgClassShowAndSave x -> case x of+    MsgBookKeeping -> False+    MsgStatusStopThem -> False+    MsgItemMovement -> False+    MsgActionMinor -> False+    MsgEffectMinor -> False+    MsgMiscellanous -> False  -- taunts are colourful, but spammy+    MsgHeardOutside -> False  -- cause must be 'profound', but even taunts are+    MsgHeardFaraway -> False+    -- MsgHeardNearby interrupts, even if running started while hearing close+    MsgRangedOthers -> False+    MsgAtFeetMinor -> False+    _ -> True+  MsgClassShow x -> case x of+    MsgPromptGeneric -> False+    MsgPromptFocus -> False+    MsgPromptMention -> False+    MsgPromptModify -> False+    MsgPromptActors -> False+    MsgPromptItems -> False+    MsgPromptAction -> False+    MsgActionAlert -> True  -- action alerts or questions cause alarm+    MsgSpottedThreat -> True+  MsgClassSave x -> case x of+    MsgInnerWorkSpam -> False+    MsgNumericReport -> False+  MsgClassIgnore x -> case x of+    MsgMacroOperation -> False+    MsgRunStopReason -> True+    MsgStopPlayback -> True+  MsgClassDistinct x -> case x of+    MsgSpottedItem -> False+    MsgStatusLongThem -> False+    MsgStatusOthers -> False+    MsgStatusBenign -> False+    MsgStatusWarning -> False+    _ -> True  disturbsResting :: MsgClass -> Bool-disturbsResting MsgHeard = False-disturbsResting MsgHeardClose = False -- handled separately-disturbsResting MsgLeader = False -- handled separately-disturbsResting MsgEffectMinor = False-disturbsResting MsgItemDisco = False-disturbsResting MsgItemMove = False-disturbsResting MsgActionMinor = False-disturbsResting MsgAtFeet = False-disturbsResting MsgNumeric = False-disturbsResting MsgSpam = False-disturbsResting MsgMacro = False-disturbsResting MsgRunStop = False-disturbsResting MsgPrompt = False-disturbsResting MsgPromptFocus = False-  -- MsgAlert means something went wrong, so alarm-disturbsResting _ = True+disturbsResting = \case+  MsgClassShowAndSave x -> case x of+    MsgPointmanSwap -> False  -- handled separately+    MsgItemDiscovery -> False  -- medium importance+    MsgHeardNearby -> False  -- handled separately; no disturbance if old+    _ -> interruptsRunning $ MsgClassShowAndSave x+  msgClass -> interruptsRunning msgClass --- Only player's non-projectile actors getting hit introduce subjects,--- because only such hits are guaranteed to be perceived.--- Here we also mark friends being hit, but that's a safe approximation.--- We also mark the messages that use the introduced subjects--- by referring to them via pronouns. They can't be moved freely either.-bindsPronouns :: MsgClass -> Bool-bindsPronouns MsgRangedPowerfulUs = True-bindsPronouns MsgRangedUs = True-bindsPronouns MsgMeleePowerfulUs = True-bindsPronouns MsgMeleeInterestingUs = True-bindsPronouns MsgMeleeUs = True-bindsPronouns MsgLongerUs = True-bindsPronouns _ = False+scrapsRepeats :: MsgClass -> Bool+scrapsRepeats = \case+  MsgClassShowAndSave x -> case x of+    MsgBookKeeping -> False  -- too important to scrap+    MsgDeathDeafeat -> False+    MsgRiskOfDeath -> False+    MsgFinalOutcome -> False+    _ -> True+  MsgClassShow x -> case x of+    MsgPromptGeneric -> False+    MsgPromptFocus -> False+    MsgPromptMention -> False+    MsgPromptModify -> False+    MsgPromptActors -> False+    MsgPromptItems -> False+    MsgPromptAction -> False+    MsgActionAlert -> False+    MsgSpottedThreat -> True+  MsgClassSave x -> case x of+    MsgInnerWorkSpam -> True+    MsgNumericReport -> True+  MsgClassIgnore _ -> False  -- ignored, so no need to scrap+  MsgClassDistinct x -> case x of+    _ -> True --- Only @White@ color gets replaced by this one.+tutorialHint :: MsgClass -> Bool+tutorialHint = \case+  MsgClassShowAndSave x -> case x of  -- show and save: least surprise+    MsgTutorialHint -> True+    _ -> False+  MsgClassShow _ -> False+  MsgClassSave _ -> False+  MsgClassIgnore _ -> False+  MsgClassDistinct _ -> False++-- Only initially @White@ colour in text (e.g., not highlighted @BrWhite@)+-- gets replaced by the one indicated. msgColor :: MsgClass -> Color.Color-msgColor MsgAdmin = Color.White-msgColor MsgBecome = Color.BrBlue  -- similar color to cyan and role to Effect-msgColor MsgNoLonger = Color.Blue-msgColor MsgLongerUs = Color.White  -- not important enough-msgColor MsgLonger = Color.White  -- not important enough-msgColor MsgItemCreation = Color.BrBlue-msgColor MsgItemDestruction = Color.Blue-msgColor MsgDeathGood = Color.BrGreen-msgColor MsgDeathBad = Color.BrRed-msgColor MsgDeath = Color.White-msgColor MsgDeathThreat = Color.BrRed-msgColor MsgLeader = Color.White-msgColor MsgDiplomacy = Color.BrYellow-msgColor MsgOutcome = Color.BrWhite-msgColor MsgPlot = Color.White-msgColor MsgLandscape = Color.White-msgColor MsgTileDisco = Color.Magenta-msgColor MsgItemDisco = Color.BrMagenta-msgColor MsgActorSpot = Color.White  -- too common-msgColor MsgFirstEnemySpot = Color.Red-msgColor MsgItemSpot = Color.White-msgColor MsgItemMove = Color.White-msgColor MsgAction = Color.White-msgColor MsgActionMinor = Color.White-msgColor MsgEffectMajor = Color.BrCyan-msgColor MsgEffect = Color.Cyan-msgColor MsgEffectMinor = Color.White-msgColor MsgMisc = Color.White-msgColor MsgHeardClose = Color.BrYellow-msgColor MsgHeard = Color.Brown-msgColor MsgFocus = Color.Green-msgColor MsgWarning = Color.BrYellow-msgColor MsgRangedPowerfulWe = Color.Green-msgColor MsgRangedPowerfulUs = Color.Red-msgColor MsgRanged = Color.White-msgColor MsgRangedUs = Color.White-msgColor MsgRare = Color.Cyan-msgColor MsgVeryRare = Color.BrCyan-msgColor MsgMeleePowerfulWe = Color.Green-msgColor MsgMeleePowerfulUs = Color.Red-msgColor MsgMeleeInterestingWe = Color.Green-msgColor MsgMeleeInterestingUs = Color.Red-msgColor MsgMelee = Color.White-msgColor MsgMeleeUs = Color.White-msgColor MsgDone = Color.White-msgColor MsgAtFeetMajor = Color.White-msgColor MsgAtFeet = Color.White-msgColor MsgNumeric = Color.White-msgColor MsgSpam = Color.White-msgColor MsgMacro = Color.White-msgColor MsgRunStop = Color.White-msgColor MsgPrompt = Color.White-msgColor MsgPromptFocus = Color.Green-msgColor MsgAlert = Color.BrYellow-msgColor MsgStopPlayback = Color.BrYellow+msgColor = \case+  MsgClassShowAndSave x -> case x of+    MsgBookKeeping -> Color.cBoring+    MsgStatusWakeup -> Color.cWakeUp+    MsgStatusStopUs -> Color.cBoring+    MsgStatusStopThem -> Color.cBoring+    MsgItemCreation -> Color.cGreed+    MsgItemRuination -> Color.cBoring  -- common, colourful components created+    MsgDeathVictory -> Color.cVeryGoodEvent+    MsgDeathDeafeat -> Color.cVeryBadEvent+    MsgDeathBoring -> Color.cBoring+    MsgRiskOfDeath -> Color.cGraveRisk+    MsgPointmanSwap -> Color.cBoring+    MsgFactionIntel -> Color.cMeta  -- good or bad+    MsgFinalOutcome -> Color.cGameOver+    MsgPlotExposition -> Color.cBoring+    MsgBackdropInfo -> Color.cBoring+    MsgTerrainReveal -> Color.cIdentification+    MsgItemDiscovery -> Color.cIdentification+    MsgSpottedActor -> Color.cBoring  -- common; warning in @MsgSpottedThreat@+    MsgItemMovement -> Color.cBoring+    MsgActionMajor -> Color.cBoring+    MsgActionMinor -> Color.cBoring+    MsgEffectMajor -> Color.cRareNeutralEvent+    MsgEffectMedium -> Color.cNeutralEvent+    MsgEffectMinor -> Color.cBoring+    MsgMiscellanous -> Color.cBoring+    MsgHeardOutside -> Color.cBoring+    MsgHeardNearby -> Color.cGraveRisk+    MsgHeardFaraway -> Color.cRisk+    MsgBackdropFocus -> Color.cVista+    MsgActionWarning -> Color.cMeta+    MsgRangedMightyWe -> Color.cGoodEvent+    MsgRangedMightyUs -> Color.cVeryBadEvent+    MsgRangedOthers -> Color.cBoring+    MsgRangedNormalUs -> Color.cBadEvent+    MsgGoodMiscEvent -> Color.cGoodEvent+    MsgBadMiscEvent -> Color.cBadEvent+    MsgNeutralEvent -> Color.cNeutralEvent+    MsgSpecialEvent -> Color.cRareNeutralEvent+    MsgMeleeMightyWe -> Color.cGoodEvent+    MsgMeleeMightyUs -> Color.cVeryBadEvent+    MsgMeleeComplexWe -> Color.cGoodEvent+    MsgMeleeComplexUs -> Color.cBadEvent+    MsgMeleeOthers -> Color.cBoring+    MsgMeleeNormalUs -> Color.cBadEvent+    MsgActionComplete -> Color.cBoring+    MsgAtFeetMajor -> Color.cBoring+    MsgAtFeetMinor -> Color.cBoring+    MsgTutorialHint -> Color.cTutorialHint+  MsgClassShow x -> case x of+    MsgPromptGeneric -> Color.cBoring+    MsgPromptFocus -> Color.cVista+    MsgPromptMention -> Color.cNeutralEvent+    MsgPromptModify -> Color.cRareNeutralEvent+    MsgPromptActors -> Color.cRisk+    MsgPromptItems -> Color.cGreed+    MsgPromptAction -> Color.cMeta+    MsgActionAlert -> Color.cMeta+    MsgSpottedThreat -> Color.cGraveRisk+  MsgClassSave x -> case x of+    MsgInnerWorkSpam -> Color.cBoring+    MsgNumericReport -> Color.cBoring+  MsgClassIgnore x -> case x of+    MsgMacroOperation -> Color.cBoring+    MsgRunStopReason -> Color.cBoring+    MsgStopPlayback -> Color.cMeta+  MsgClassDistinct x -> case x of+    MsgSpottedItem -> Color.cBoring+    MsgStatusSleep -> Color.cSleep+    MsgStatusGoodUs -> Color.cGoodEvent+    MsgStatusBadUs -> Color.cBadEvent+    MsgStatusOthers -> Color.cBoring+    MsgStatusBenign -> Color.cBoring+    MsgStatusWarning -> Color.cMeta+    MsgStatusLongerUs -> Color.cBoring  -- not important enough+    MsgStatusLongThem -> Color.cBoring  -- not important enough, no disturb even  -- * Report -data RepMsgN = RepMsgN {repMsg :: Msg, _repN :: Int}+data RepMsgNK = RepMsgNK {repMsg :: Msg, _repShow :: Int, _repSave :: Int}   deriving (Show, Generic) -instance Binary RepMsgN+instance Binary RepMsgNK +-- | If only one of the message components is non-empty and non-whitespace,+-- but its count is zero, the message is considered empty.+nullRepMsgNK :: RepMsgNK -> Bool+nullRepMsgNK (RepMsgNK Msg{..} _ _) =+  all (Char.isSpace . Color.charFromW32) msgShow+  && all (Char.isSpace . Color.charFromW32) msgSave+ -- | The set of messages, with repetitions, to show at the screen at once.-newtype Report = Report [RepMsgN]+newtype Report = Report [RepMsgNK]   deriving (Show, Binary)  -- | Empty set of messages. emptyReport :: Report-emptyReport = Report []---- | Test if the set of messages is empty.-nullReport :: Report -> Bool-nullReport (Report l) = null l+emptyReport = assert (let checkLen msgClass =+                            let len = length (showSimpleMsgClass msgClass)+                            in len >= 14 && len <= 17+                          l = map MsgClassShowAndSave [minBound .. maxBound]+                              ++ map MsgClassShow [minBound .. maxBound]+                              ++ map MsgClassSave [minBound .. maxBound]+                              ++ map MsgClassIgnore [minBound .. maxBound]+                              ++ map MsgClassDistinct [minBound .. maxBound]+                      in allB checkLen l)+              $ Report []  -- as good place as any to verify display lengths --- | Add a message to the end of the report.-snocReport :: Report -> Msg -> Int -> Report-snocReport (Report !r) y n =-  if null $ msgLine y then Report r else Report $ RepMsgN y n : r+-- | Test if the list of non-whitespace messages is empty.+nullVisibleReport :: Report -> Bool+nullVisibleReport (Report l) =+  all (all (Char.isSpace . Color.charFromW32) . msgShow . repMsg) l  -- | Add a message to the start of report. consReport :: Msg -> Report -> Report-consReport Msg{msgLine=[]} rep = rep-consReport y (Report r) = Report $ r ++ [RepMsgN y 1]+consReport msg (Report r) = Report $ r ++ [RepMsgNK msg 1 1] --- | Render a report as a (possibly very long) 'AttrLine'. Filter out--- messages not meant for display.-renderReport :: Report -> AttrLine-renderReport (Report r) =-  let rep = Report $ filter (isDisplayed . msgClass . repMsg) r-  in renderWholeReport rep+-- | Render a report as a (possibly very long) 'AttrString'. Filter out+-- messages not meant for display, unless not showing, but saving to history.+renderReport :: Bool -> Report -> [AttrString]+renderReport displaying (Report r) =+  let rep = map (\(RepMsgNK msg n k) -> if displaying+                                        then (msgShow msg, n)+                                        else (msgSave msg, k)) r+  in renderWholeReport rep [] --- | Render a report as a (possibly very long) 'AttrLine'.-renderWholeReport :: Report -> AttrLine-renderWholeReport (Report []) = []-renderWholeReport (Report (x : xs)) =-  renderWholeReport (Report xs) <+:> renderRepetition x+-- | Render a report as a (possibly very long) 'AttrString'.+renderWholeReport :: [(AttrString, Int)] -> [AttrString] -> [AttrString]+renderWholeReport [] acc = acc+renderWholeReport (x : xs) acc = renderWholeReport xs (renderRepetition x : acc) -renderRepetition :: RepMsgN -> AttrLine-renderRepetition (RepMsgN s 0) = msgLine s-renderRepetition (RepMsgN s 1) = msgLine s-renderRepetition (RepMsgN s n) = msgLine s ++ stringToAL ("<x" ++ show n ++ ">")+renderRepetition :: (AttrString, Int) -> AttrString+renderRepetition (asRaw, n) =+  let as = dropWhileEnd (Char.isSpace . Color.charFromW32) asRaw+  in if n <= 1 || null as+     then as+     else as ++ stringToAS ("<x" ++ show n ++ ">")  anyInReport :: (MsgClass -> Bool) -> Report -> Bool-anyInReport f (Report xns) = any (f . msgClass . repMsg) xns+anyInReport f (Report xns) = any (f . msgClass. repMsg) xns  -- * History @@ -315,7 +468,7 @@   , newTime         :: Time   , oldReport       :: Report   , oldTime         :: Time-  , archivedHistory :: RB.RingBuffer UAttrLine }+  , archivedHistory :: RB.RingBuffer UAttrString }   deriving (Show, Generic)  instance Binary History@@ -327,6 +480,28 @@   in History emptyReport timeZero emptyReport timeZero              (RB.empty ringBufferSize U.empty) +scrapRepetitionSingle :: (AttrString, Int)+                      -> [(AttrString, Int)]+                      -> [(AttrString, Int)]+                      -> (Bool, [(AttrString, Int)], [(AttrString, Int)])+scrapRepetitionSingle (s1, n1) rest1 oldMsgs =+  let butLastEOLs = dropWhileEnd ((== '\n') . Color.charFromW32)+      eqs1 (s2, _) = butLastEOLs s1 == butLastEOLs s2+  in case break eqs1 rest1 of+    (_, []) -> case break eqs1 oldMsgs of+      (noDup, (_, n2) : rest2) ->+        -- We keep the occurence of the message in the new report only.+        let newReport = (s1, n1 + n2) : rest1+            oldReport = noDup ++ ([], 0) : rest2+        in (True, newReport, oldReport)+      _ -> (False, (s1, n1) : rest1, oldMsgs)+    (noDup, (s2, n2) : rest3) ->+      -- We keep the older (and so, oldest) occurence of the message,+      -- to avoid visual disruption by moving the message around.+      let newReport = ([], 0) : noDup ++ (s2, n1 + n2) : rest3+          oldReport = oldMsgs+      in (True, newReport, oldReport)+ scrapRepetition :: History -> Maybe History scrapRepetition History{ newReport = Report newMsgs                        , oldReport = Report oldMsgs@@ -337,65 +512,122 @@     -- We keep the message in the new report, because it should not     -- vanish from the screen. In this way the message may be passed     -- along many reports.-    RepMsgN s1 n1 : rest1 ->-      let commutative s = not $ bindsPronouns $ msgClass s-          f (RepMsgN s2 _) = msgLine s1 == msgLine s2-      in case break f rest1 of-        (_, []) | commutative s1 -> case break f oldMsgs of-          (noDup, RepMsgN s2 n2 : rest2) ->-            -- We keep the occurence of the message in the new report only.-            let newReport = Report $ RepMsgN s2 (n1 + n2) : rest1-                oldReport = Report $ noDup ++ rest2-            in Just History{..}-          _ -> Nothing-        (noDup, RepMsgN s2 n2 : rest2) | commutative s1-                                         || all (commutative . repMsg) noDup ->-          -- We keep the older (and so, oldest) occurence of the message,-          -- to avoid visual disruption by moving the message around.-          let newReport = Report $ noDup ++ RepMsgN s2 (n1 + n2) : rest2-              oldReport = Report oldMsgs-          in Just History{..}-        _ -> Nothing-    _ -> Nothing  -- empty new report+    RepMsgNK msg1 n1 k1 : rest1 ->+      let -- We ignore message classes and scrap even if same strings+          -- come from different classes. Otherwise user would be confused.+          makeShow = map (\(RepMsgNK msg n _) -> (msgShow msg, n))+          makeSave = map (\(RepMsgNK msg _ k) -> (msgSave msg, k))+          (scrapShowNeeded, scrapShowNew, scrapShowOld) =+            scrapRepetitionSingle (msgShow msg1, n1)+                                  (makeShow rest1)+                                  (makeShow oldMsgs)+          (scrapSaveNeeded, scrapSaveNew, scrapSaveOld) =+            scrapRepetitionSingle (msgSave msg1, k1)+                                  (makeSave rest1)+                                  (makeSave oldMsgs)+      in if scrapShowNeeded || scrapSaveNeeded+         then let combineMsg _ ([], _) ([], _) = Nothing+                  combineMsg msg (s, n) (t, k) = Just $+                    RepMsgNK msg{msgShow = s, msgSave = t} n k+                  zipMsg l1 l2 l3 = Report $ catMaybes $+                    zipWith3 combineMsg (map repMsg l1) l2 l3+                  newReport = zipMsg newMsgs scrapShowNew scrapSaveNew+                  oldReport = zipMsg oldMsgs scrapShowOld scrapSaveOld+              in Just History{..}+         else Nothing+    _ -> error "scrapRepetition: empty new report for scrapping"  -- | Add a message to the new report of history, eliminating a possible -- duplicate and noting its existence in the result.-addToReport :: History -> Msg -> Int -> Time -> (History, Bool)-addToReport History{..} msg n time =-  let newH = History{newReport = snocReport newReport msg n, newTime = time, ..}-  in case scrapRepetition newH of-    Just scrappedH -> (scrappedH, True)-    Nothing -> (newH, False)+addToReport :: S.Set Msg -> Bool -> Bool -> History -> Msg -> Time+            -> (S.Set Msg, History, Bool)+addToReport usedHints displayHints inMelee+            oldHistory@History{newReport = Report r, ..} msgRaw time =+  -- When each turn we lose HP, stuff that wouldn't interrupt+  -- running should go at most to message log, not onto the screen,+  -- unless it goes only onto screen, so the message would be lost.+  let isMsgClassShow = \case+        MsgClassShow{} -> True+        _ -> False+      msg = if inMelee+               && not (interruptsRunning (msgClass msgRaw))+               && not (isMsgClassShow $ msgClass msgRaw)+            then msgRaw {msgShow = []}+            else msgRaw+      repMsgNK = RepMsgNK msg 1 1+      newH = History { newReport = Report $ repMsgNK : r+                     , newTime = time+                     , .. }+      msgIsHint = tutorialHint (msgClass msg)+      msgUsedAsHit = S.member msg usedHints+      newUsedHints = if msgIsHint && displayHints && not msgUsedAsHit+                     then S.insert msg usedHints+                     else usedHints+  in -- Tutorial hint shown only when tutorial enabled and hint not yet shown.+     if | msgIsHint && (not displayHints || msgUsedAsHit) ->+          (usedHints, oldHistory, False)+        | not (scrapsRepeats $ msgClass msg)+          || nullRepMsgNK repMsgNK ->+          -- Don't waste time on never shown messages.+          (newUsedHints, newH, False)+        | otherwise -> case scrapRepetition newH of+            Just scrappedH -> (newUsedHints, scrappedH, True)+            Nothing -> (newUsedHints, newH, False) +-- | Add a newline to end of the new report of history, unless empty.+addEolToNewReport :: History -> History+addEolToNewReport hist =+  let addEolToReport (Report []) = Report []+      addEolToReport (Report (hd : tl)) = Report $ addEolToRepMsgNK hd : tl+      addEolToRepMsgNK rm = rm {repMsg = addEolToMsg $ repMsg rm}+      addEolToMsg msg = msg { msgShow = addEolToAS $ msgShow msg+                            , msgSave = addEolToAS $ msgSave msg }+      addEolToAS as = as ++ stringToAS "\n"+  in hist {newReport = addEolToReport $ newReport hist}+ -- | Archive old report to history, filtering out messages with 0 duplicates -- and prompts. Set up new report with a new timestamp.-archiveReport :: History -> History-archiveReport History{newReport=Report newMsgs, ..} =-  let f (RepMsgN _ n) = n > 0-      newReportNon0 = Report $ filter f newMsgs-  in if nullReport newReportNon0+archiveReport :: Bool -> History -> History+archiveReport uHistory1PerLine History{newReport=Report newMsgs, ..} =+  let newFiltered@(Report r) = Report $ filter (not . nullRepMsgNK) newMsgs+  in if null r      then -- Drop empty new report.           History emptyReport timeZero oldReport oldTime archivedHistory-     else let lU = map attrLineToU $ renderTimeReport oldTime oldReport-          in History emptyReport timeZero newReportNon0 newTime-             $ foldl' (\ !h !v -> RB.cons v h) archivedHistory (reverse lU)+     else let lU = map attrStringToU+                   $ renderTimeReport uHistory1PerLine oldTime oldReport+          in History emptyReport timeZero newFiltered newTime+             $ foldl' (\ !h !v -> RB.cons v h) archivedHistory lU -renderTimeReport :: Time -> Report -> [AttrLine]-renderTimeReport !t (Report r) =+renderTimeReport :: Bool -> Time -> Report -> [AttrString]+renderTimeReport uHistory1PerLine t rep@(Report r) =   let turns = t `timeFitUp` timeTurn-      rep = Report $ filter (isSavedToHistory . msgClass . repMsg) r-  in if nullReport rep-     then []-     else [stringToAL (show turns ++ ": ") ++ renderReport rep]+      repMsgs = renderReport False rep+      mgsClasses = reverse $ map (showSimpleMsgClass . msgClass . repMsg) r+      turnsString = show turns+      isSpace32 = Char.isSpace . Color.charFromW32+      worthSaving = not . all isSpace32+      renderAS as = stringToAS (turnsString ++ ": ") ++ dropWhile isSpace32 as+      renderClass (as, msgClassString) =+        let lenUnderscore = 17 - length msgClassString+                            + max 0 (3 - length turnsString)+        in stringToAS (turnsString ++ ":")+           ++ map (Color.attrChar2ToW32 Color.BrBlack)+                  ("[" ++ replicate lenUnderscore '_' ++ msgClassString ++ "]")+           ++ [Color.spaceAttrW32]+           ++ dropWhile isSpace32 as+  in if uHistory1PerLine+     then map renderClass $ filter (worthSaving . fst) $ zip repMsgs mgsClasses+     else map renderAS $ filter worthSaving [foldr (<+:>) [] repMsgs] -lengthHistory :: History -> Int-lengthHistory History{oldReport, archivedHistory} =+lengthHistory :: Bool -> History -> Int+lengthHistory uHistory1PerLine History{oldReport, archivedHistory} =   RB.length archivedHistory-  + length (renderTimeReport timeZero oldReport)-      -- matches @renderHistory@+  + length (renderTimeReport uHistory1PerLine timeZero oldReport)+    -- matches @renderHistory@  -- | Render history as many lines of text. New report is not rendered. -- It's expected to be empty when history is shown.-renderHistory :: History -> [AttrLine]-renderHistory History{..} = map uToAttrLine (RB.toList archivedHistory)-                            ++ renderTimeReport oldTime oldReport+renderHistory :: Bool -> History -> [AttrString]+renderHistory uHistory1PerLine History{..} =+  map uToAttrString (RB.toList archivedHistory)+  ++ renderTimeReport uHistory1PerLine oldTime oldReport

engine-src/Game/LambdaHack/Client/UI/MsgM.hs view

@@ -1,6 +1,6 @@ -- | Monadic operations on game messages. module Game.LambdaHack.Client.UI.MsgM-  ( msgAddDuplicate, msgAdd, msgAdd0, promptAdd, promptAdd0+  ( msgAddDuplicate, msgAddDistinct, msgAdd, msgLnAdd   , promptMainKeys, recordHistory   ) where @@ -8,10 +8,9 @@  import Game.LambdaHack.Core.Prelude -import qualified Data.EnumMap.Strict as EM- import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.State+import           Game.LambdaHack.Client.UI.EffectDescription import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.MonadClientUI@@ -23,82 +22,106 @@ import           Game.LambdaHack.Common.State import           Game.LambdaHack.Definition.Defs --- | Add a message to the current report.-msgAddDuplicate :: MonadClientUI m => Text -> MsgClass -> Int -> m Bool-msgAddDuplicate msg msgClass n = do+-- | Add a shared message to the current report. Say if it was a duplicate.+msgAddDuplicate :: (MonadClient m, MonadClientUI m, MsgShared a)+                => a -> Text -> m Bool+msgAddDuplicate msgClass t = do   sUIOptions <- getsSession sUIOptions   time <- getsState stime   history <- getsSession shistory-  let mem = EM.fromList <$> uMessageColors sUIOptions-      (nhistory, duplicate) =-        addToReport history (toMsg mem msgClass msg) n time-  modifySession $ \sess -> sess {shistory = nhistory}+  curTutorial <- getsSession scurTutorial+  overrideTut <- getsSession soverrideTut+  usedHints <- getsSession susedHints+  lid <- getArenaUI+  condInMelee <- condInMeleeM lid+  let displayHints = fromMaybe curTutorial overrideTut+      msg = toMsgShared (uMessageColors sUIOptions) msgClass t+      (nusedHints, nhistory, duplicate) =+        addToReport usedHints displayHints condInMelee history msg time+  modifySession $ \sess -> sess {shistory = nhistory, susedHints = nusedHints}   return duplicate --- | Add a message to the current report. Do not report if it was a duplicate.-msgAdd :: MonadClientUI m => MsgClass -> Text -> m ()-msgAdd msgClass msg = void $ msgAddDuplicate msg msgClass 1---- | Add a message to the current report with 0 copies for the purpose--- of collating duplicates. Do not report if it was a duplicate.-msgAdd0 :: MonadClientUI m => MsgClass -> Text -> m ()-msgAdd0 msgClass msg = void $ msgAddDuplicate msg msgClass 0+-- | Add a message comprising of two different texts, one to show, the other+-- to save to messages log, to the current report.+msgAddDistinct :: (MonadClient m, MonadClientUI m)+               => MsgClassDistinct -> (Text, Text) -> m ()+msgAddDistinct msgClass (t1, t2) = do+  sUIOptions <- getsSession sUIOptions+  time <- getsState stime+  history <- getsSession shistory+  curTutorial <- getsSession scurTutorial+  overrideTut <- getsSession soverrideTut+  usedHints <- getsSession susedHints+  lid <- getArenaUI+  condInMelee <- condInMeleeM lid+  let displayHints = fromMaybe curTutorial overrideTut+      msg = toMsgDistinct (uMessageColors sUIOptions) msgClass t1 t2+      (nusedHints, nhistory, _) =+        addToReport usedHints displayHints condInMelee history msg time+  modifySession $ \sess -> sess {shistory = nhistory, susedHints = nusedHints} --- | Add a prompt to the current report. Do not report if it was a duplicate.-promptAdd :: MonadClientUI m => Text -> m ()-promptAdd = msgAdd MsgAlert+-- | Add a message to the current report.+msgAdd :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> Text -> m ()+msgAdd msgClass t = void $ msgAddDuplicate msgClass t --- | Add a prompt to the current report with 0 copies for the purpose--- of collating duplicates. Do not report if it was a duplicate.-promptAdd0 :: MonadClientUI m => Text -> m ()-promptAdd0 = msgAdd0 MsgPrompt+-- | Add a message to the current report. End previously collected report,+-- if any, with newline.+msgLnAdd :: (MonadClient m, MonadClientUI m, MsgShared a) => a -> Text -> m ()+msgLnAdd msgClass t = do+  modifySession $ \sess -> sess {shistory = addEolToNewReport $ shistory sess}+  msgAdd msgClass t  -- | Add a prompt with basic keys description.-promptMainKeys :: MonadClientUI m => m ()+promptMainKeys :: (MonadClient m, MonadClientUI m) => m () promptMainKeys = do   side <- getsClient sside   ours <- getsState $ fidActorNotProjGlobalAssocs side   revCmd <- revCmdMap-  let kmHelp = revCmd K.undefinedKM HumanCmd.Hint-      kmViewEqp = revCmd K.undefinedKM (HumanCmd.ChooseItemMenu (MStore CEqp))-      kmItemEqp = revCmd K.undefinedKM-                         (HumanCmd.MoveItem [CGround, CInv, CSha] CEqp-                                            Nothing False)-      kmXhairPointerFloor = revCmd K.undefinedKM HumanCmd.XhairPointerFloor+  let kmHelp = revCmd HumanCmd.Hint+      kmViewStash = revCmd (HumanCmd.ChooseItemMenu (MStore CStash))+      kmItemStash = revCmd (HumanCmd.MoveItem [CGround, CEqp] CStash+                                              Nothing False)+      kmXhairPointerFloor = revCmd HumanCmd.XhairPointerFloor   saimMode <- getsSession saimMode-  UIOptions{uVi, uLaptop} <- getsSession sUIOptions+  UIOptions{uVi, uLeftHand} <- getsSession sUIOptions   xhair <- getsSession sxhair-  -- The silly "uk8o79jl" ordering of keys is chosen to match "hjklyubn",+  -- The silly "axwdqezc" name of keys is chosen to match "hjklyubn",   -- which the usual way of writing them.-  let moveKeys | uVi = "keypad or hjklyubn"-               | uLaptop = "keypad or uk8o79jl"+  let moveKeys | uVi && uLeftHand = "keypad or axwdqezc or hjklyubn"+               | uLeftHand = "keypad or axwdqezc"+               | uVi = "keypad or hjklyubn"                | otherwise = "keypad"       manyTeammates = length ours > 1+      detailAtDefault = (detailLevel <$> saimMode) == Just defaultDetailLevel+      -- @Tab@ here is not a button, which we would write consistently+      -- as @TAB@, just as in our internal in-game key naming, but a key name+      -- as written on the keyboard, hence most useful to a newbie.       keepTab = if manyTeammates-                then "Keep TAB of teammates (S-TAB for other levels)."+                then "Switch to another teammate with Tab, while all others auto-melee foes, if adjacent, but normally don't chase them."                 else ""-      describePos = if mmbIsNormal-                    then "Describe map position with MMB."+      describePos = if describeIsNormal+                    then "Describe map position with MMB or RMB."                     else ""-      viewEquip = if eqpKeysAreNormal-                  then "View (E)quipment and (e)quip items."+      viewEquip = if stashKeysAreNormal+                  then "View shared 'I'nventory stash and stash items into the 'i'nventory."                   else ""-      moreHelp = "Press" <+> tshow kmHelp <+> "for help."-      mmbIsNormal = kmXhairPointerFloor == K.middleButtonReleaseKM-      eqpKeysAreNormal = kmViewEqp == K.mkChar 'E'-                         && kmItemEqp == K.mkChar 'e'+      moreHelp = "Press '" <> tshow kmHelp <> "' for more help."+      describeIsNormal = kmXhairPointerFloor == K.middleButtonReleaseKM+      stashKeysAreNormal = kmViewStash == K.mkChar 'I'+                           && kmItemStash == K.mkChar 'i'       keys | isNothing saimMode =-        "Explore with" <+> moveKeys <+> "keys or mouse."+        "Explore with" <+> moveKeys <+> "or mouse."         <+> describePos         <+> viewEquip         <+> keepTab         <+> moreHelp            | otherwise =-        tgtKindVerb xhair+        (if detailAtDefault then "" else miniHintAimingBare)+        <+> tgtKindVerb xhair         <+> "with" <+> moveKeys <+> "keys or mouse."         <+> keepTab         <+> moreHelp-  void $ promptAdd0 keys+  void $ msgAdd MsgPromptGeneric keys  tgtKindVerb :: Maybe Target -> Text tgtKindVerb mtgt = case mtgt of@@ -110,5 +133,7 @@  -- | Store new report in the history and archive old report. recordHistory :: MonadClientUI m => m ()-recordHistory =-  modifySession $ \sess -> sess {shistory = archiveReport $ shistory sess}+recordHistory = do+  UIOptions{uHistory1PerLine} <- getsSession sUIOptions+  modifySession $ \sess ->+    sess {shistory = archiveReport uHistory1PerLine $ shistory sess}

engine-src/Game/LambdaHack/Client/UI/Overlay.hs view

@@ -1,16 +1,18 @@ {-# LANGUAGE RankNTypes #-} -- | Screen overlays. module Game.LambdaHack.Client.UI.Overlay-  ( -- * AttrLine-    AttrLine, emptyAttrLine, textToAL, textFgToAL, stringToAL, (<+:>)+  ( -- * AttrString+    AttrString, blankAttrString, textToAS, textFgToAS, stringToAS+  , (<+:>), (<\:>)+    -- * AttrLine+  , AttrLine, attrLine, emptyAttrLine, attrStringToAL, firstParagraph, linesAttr+  , textToAL, textFgToAL, stringToAL, splitAttrString+  , indentSplitAttrString, indentSplitAttrString2     -- * Overlay-  , Overlay, IntOverlay-  , splitAttrLine, indentSplitAttrLine, glueLines, updateLines-    -- * Misc-  , ColorMode(..)+  , Overlay, offsetOverlay, offsetOverlayX, updateLine #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , linesAttr, splitAttrPhrase+  , splitAttrPhrase #endif   ) where @@ -18,128 +20,220 @@  import Game.LambdaHack.Core.Prelude +import           Data.Char (isSpace) import qualified Data.Text as T +import           Game.LambdaHack.Client.UI.PointUI import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Definition.Defs --- * AttrLine+-- * AttrString --- | Line of colourful text.-type AttrLine = [Color.AttrCharW32]+-- | String of colourful text. End of line characters permitted.+type AttrString = [Color.AttrCharW32] -emptyAttrLine :: Int -> AttrLine-emptyAttrLine w = replicate w Color.spaceAttrW32+blankAttrString :: Int -> AttrString+blankAttrString w = replicate w Color.spaceAttrW32 -textToAL :: Text -> AttrLine-textToAL !t =+textToAS :: Text -> AttrString+textToAS !t =   let f c l = let !ac = Color.attrChar1ToW32 c               in ac : l   in T.foldr f [] t -textFgToAL :: Color.Color -> Text -> AttrLine-textFgToAL !fg !t =+textFgToAS :: Color.Color -> Text -> AttrString+textFgToAS !fg !t =   let f ' ' l = Color.spaceAttrW32 : l-                  -- for speed and simplicity we always keep the space @White@+                  -- for speed and simplicity (testing if char is a space)+                  -- we always keep the space @White@       f c l = let !ac = Color.attrChar2ToW32 fg c               in ac : l   in T.foldr f [] t -stringToAL :: String -> AttrLine-stringToAL = map Color.attrChar1ToW32+stringToAS :: String -> AttrString+stringToAS = map Color.attrChar1ToW32 +-- Follows minimorph.<+>. infixr 6 <+:>  -- matches Monoid.<>-(<+:>) :: AttrLine -> AttrLine -> AttrLine+(<+:>) :: AttrString -> AttrString -> AttrString (<+:>) [] l2 = l2 (<+:>) l1 [] = l1-(<+:>) l1 l2 = l1 ++ [Color.spaceAttrW32] ++ l2---- * Overlay---- | A series of screen lines that either fit the width of the screen--- or are intended for truncation when displayed. The length of overlay--- may exceed the length of the screen, unlike in @SingleFrame@.--- An exception is lines generated from animation, which have to fit--- in either dimension.-type Overlay = [AttrLine]---- | Sparse screen overlay representation where only the indicated rows--- are overlayed and the remaining rows are kept unchanged.-type IntOverlay = [(Int, AttrLine)]---- | Split a string into lines. Avoids ending the line with--- a character other than space. Space characters are removed--- from the start, but never from the end of lines. Newlines are respected.------ Note that we only split wrt @White@ space, nothing else.-splitAttrLine :: X -> AttrLine -> Overlay-splitAttrLine w l =-  concatMap (splitAttrPhrase w . dropWhile (== Color.spaceAttrW32))-  $ linesAttr l--indentSplitAttrLine :: X -> AttrLine -> [AttrLine]-indentSplitAttrLine w l =-  -- First line could be split at @w@, not @w - 1@, but it's good enough.-  let ts = splitAttrLine (w - 1) l-  in case ts of-    [] -> []-    hd : tl -> hd : map ([Color.spaceAttrW32] ++) tl+(<+:>) l1 l2@(c2 : _) =+  if isSpace (Color.charFromW32 c2) || isSpace (Color.charFromW32 (last l1))+  then l1 ++ l2+  else l1 ++ [Color.spaceAttrW32] ++ l2 -linesAttr :: AttrLine -> Overlay-linesAttr l | null l = []-            | otherwise = h : if null t then [] else linesAttr (tail t)- where (h, t) = span (/= Color.retAttrW32) l+infixr 6 <\:>  -- matches Monoid.<>+(<\:>) :: AttrString -> AttrString -> AttrString+(<\:>) [] l2 = l2+(<\:>) l1 [] = l1+(<\:>) l1 l2@(c2 : _) =+  if Color.charFromW32 c2 == '\n' || Color.charFromW32 (last l1) == '\n'+  then l1 ++ l2+  else l1 ++ stringToAS "\n" ++ l2  -- We consider only these, because they are short and form a closed category.-nonbreakableRev :: [AttrLine]-nonbreakableRev = map stringToAL ["eht", "a", "na", "ehT", "A", "nA"]+nonbreakableRev :: [String]+nonbreakableRev = ["eht", "a", "na", "ehT", "A", "nA", "I"] -breakAtSpace :: AttrLine -> (AttrLine, AttrLine)+isPrefixOfNonbreakable :: AttrString -> Bool+isPrefixOfNonbreakable s =+  let isPrefixOfNb sRev nbRev = case stripPrefix nbRev sRev of+        Nothing -> False+        Just [] -> True+        Just (c : _) -> isSpace c+  in any (isPrefixOfNb $ map Color.charFromW32 s) nonbreakableRev++breakAtSpace :: AttrString -> (AttrString, AttrString) breakAtSpace lRev =   let (pre, post) = break (== Color.spaceAttrW32) lRev   in case post of     c : rest | c == Color.spaceAttrW32 ->-      if any (`isPrefixOf` rest) nonbreakableRev+      if isPrefixOfNonbreakable rest       then let (pre2, post2) = breakAtSpace rest            in (pre ++ c : pre2, post2)       else (pre, post)     _ -> (pre, post)  -- no space found, give up -splitAttrPhrase :: X -> AttrLine -> Overlay-splitAttrPhrase w xs-  | w >= length xs = [xs]  -- no problem, everything fits+-- * AttrLine++-- | Line of colourful text. End of line characters forbidden.+newtype AttrLine = AttrLine {attrLine :: AttrString}+  deriving (Show, Eq)++emptyAttrLine :: AttrLine+emptyAttrLine = AttrLine []++attrStringToAL :: AttrString -> AttrLine+attrStringToAL s =+#ifdef WITH_EXPENSIVE_ASSERTIONS+  assert (allB (\ac -> Color.charFromW32 ac /= '\n') s) $  -- expensive in menus+  assert (length s == 0 || last s /= Color.spaceAttrW32+          `blame` map Color.charFromW32 s) $+    -- only expensive for menus, but often violated by code changes, so disabled+    -- outside test runs+#endif+    AttrLine s++firstParagraph :: AttrString -> AttrLine+firstParagraph s = case linesAttr s of+  [] -> emptyAttrLine+  l : _ -> l++textToAL :: Text -> AttrLine+textToAL !t =+  let f '\n' _ = error $ "illegal end of line in: " ++ T.unpack t+      f c l = let !ac = Color.attrChar1ToW32 c+              in ac : l+      s = T.foldr f [] t+  in AttrLine $+#ifdef WITH_EXPENSIVE_ASSERTIONS+  assert (length s == 0 || last s /= Color.spaceAttrW32 `blame` t)+#endif+    s++textFgToAL :: Color.Color -> Text -> AttrLine+textFgToAL !fg !t =+  let f '\n' _ = error $ "illegal end of line in: " ++ T.unpack t+      f ' ' l = Color.spaceAttrW32 : l+                  -- for speed and simplicity (testing if char is a space)+                  -- we always keep the space @White@+      f c l = let !ac = Color.attrChar2ToW32 fg c+              in ac : l+      s = T.foldr f [] t+  in AttrLine $+#ifdef WITH_EXPENSIVE_ASSERTIONS+  assert (length s == 0 || last s /= Color.spaceAttrW32 `blame` t)+#endif+    s++stringToAL :: String -> AttrLine+stringToAL s = attrStringToAL $ map Color.attrChar1ToW32 s++-- Mimics @lines@.+linesAttr :: AttrString -> [AttrLine]+linesAttr [] = []+linesAttr l = cons (case break (\ac -> Color.charFromW32 ac == '\n') l of+  (h, t) -> (attrStringToAL h, case t of+                                 [] -> []+                                 _ : tt -> linesAttr tt))+ where+  cons ~(h, t) = h : t++-- | Split a string into lines. Avoids breaking the line at a character+-- other than space. Remove space characters from the starts and ends+-- of created lines. Newlines are respected.+--+-- Note that we only split wrt @White@ space, nothing else,+-- and the width, in the first argument, is calculated in characters,+-- not in UI (mono font) coordinates, so that taking and dropping characters+-- is performed correctly.+splitAttrString :: Int -> Int -> AttrString -> [AttrLine]+splitAttrString w0 w1 l = case linesAttr l of+  [] -> []+  x : xs ->+    (splitAttrPhrase w0 w1+     . AttrLine . dropWhile (== Color.spaceAttrW32) . attrLine) x+    ++ concatMap (splitAttrPhrase w1 w1+                  . AttrLine . dropWhile (== Color.spaceAttrW32) . attrLine) xs++indentSplitAttrString :: Int -> AttrString -> [AttrLine]+indentSplitAttrString w l =+  let ts = splitAttrString w (w - 1) l+  in case ts of+    [] -> []+    hd : tl -> hd : map (AttrLine . ([Color.spaceAttrW32] ++) . attrLine) tl++indentSplitAttrString2 :: Bool -> Int -> AttrString -> [AttrLine]+indentSplitAttrString2 isProp w l =+  let nspaces = if isProp then 4 else 2+      ts = splitAttrString w (w - nspaces) l+      -- Proportional spaces are very narrow.+      spaces = replicate nspaces Color.spaceAttrW32+  in case ts of+    [] -> []+    hd : tl -> hd : map (AttrLine . (spaces ++) . attrLine) tl++-- We pass empty line along for the case of appended buttons, which need+-- either space or new lines before them.+splitAttrPhrase :: Int -> Int -> AttrLine -> [AttrLine]+splitAttrPhrase w0 w1 (AttrLine xs)+  | w0 >= length xs = [AttrLine xs]  -- no problem, everything fits   | otherwise =-      let (pre, postRaw) = splitAt w xs+      let (pre, postRaw) = splitAt w0 xs           preRev = reverse pre           ((ppre, ppost), post) = case postRaw of             c : rest | c == Color.spaceAttrW32-                       && not (any (`isPrefixOf` preRev) nonbreakableRev) ->+                       && not (isPrefixOfNonbreakable preRev) ->               (([], preRev), rest)             _ -> (breakAtSpace preRev, postRaw)-          testPost = dropWhileEnd (== Color.spaceAttrW32) ppost-      in if null testPost-         then pre : splitAttrPhrase w post-         else reverse ppost : splitAttrPhrase w (reverse ppre ++ post)+      in if all (== Color.spaceAttrW32) ppost+         then AttrLine (reverse $ dropWhile (== Color.spaceAttrW32) preRev) :+              splitAttrPhrase w1 w1 (AttrLine post)+         else AttrLine (reverse $ dropWhile (== Color.spaceAttrW32) ppost)+              : splitAttrPhrase w1 w1 (AttrLine $ reverse ppre ++ post) -glueLines :: Overlay -> Overlay -> Overlay-glueLines ov1 ov2 = reverse $ glue (reverse ov1) ov2- where glue [] l = l-       glue m [] = m-       glue (mh : mt) (lh : lt) = reverse lt ++ (mh <+:> lh) : mt+-- * Overlay --- @f@ should not enlarge the line beyond screen width.-updateLines :: Int -> (AttrLine -> AttrLine) -> Overlay -> Overlay-updateLines n f ov =-  let upd k (l : ls) = if k == 0-                       then f l : ls-                       else l : upd (k - 1) ls-      upd _ [] = []-  in upd n ov+-- | A series of screen lines with start positions at which they should+-- be overlayed over the base frame or a blank screen, depending on context.+-- The position point is represented as in integer that is an index into the+-- frame character array.+-- The lines either fit the width of the screen or are intended+-- for truncation when displayed. The start positions of lines may fall outside+-- the length of the screen, too, unlike in @SingleFrame@. Then they are+-- simply not shown.+type Overlay = [(PointUI, AttrLine)] --- * Misc+offsetOverlay :: [AttrLine] -> Overlay+offsetOverlay l = map (first $ PointUI 0) $ zip [0..] l --- | Color mode for the display.-data ColorMode =-    ColorFull  -- ^ normal, with full colours-  | ColorBW    -- ^ black and white only-  deriving Eq+offsetOverlayX :: [(Int, AttrLine)] -> Overlay+offsetOverlayX l =+  map (\(y, (x, al)) -> (PointUI x y, al)) $ zip [0..] l++-- @f@ should not enlarge the line beyond screen width nor introduce linebreaks.+updateLine :: Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay+updateLine y f ov =+  let upd (p@(PointUI px py), AttrLine l) =+        if py == y then (p, AttrLine $ f px l) else (p, AttrLine l)+  in map upd ov

+ engine-src/Game/LambdaHack/Client/UI/PointUI.hs view

@@ -0,0 +1,48 @@+-- | UI screen coordinates.+module Game.LambdaHack.Client.UI.PointUI+  ( PointUI(..), PointSquare(..), squareToUI, uiToSquare+  , squareToMap, mapToSquare+#ifdef EXPOSE_INTERNAL+    -- * Internal operations+  , mapStartY+#endif+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import Game.LambdaHack.Common.Point++-- | UI screen coordinates, independent of whether square or monospace fonts+-- are being placed on the screen (though square fonts are never placed+-- on odd coordinates). These are not game map coordinates,+-- becuse UI is larger and more fine-grained than just the game map.+data PointUI = PointUI Int Int+  deriving (Eq, Show)++-- | Coordinates of the big square fonts. These are not game map coordinates,+-- because the latter are offset by @mapStartY@ and represented by @Point@.+data PointSquare = PointSquare Int Int+  deriving (Eq, Show)++squareToUI :: PointSquare -> PointUI+{-# INLINE squareToUI #-}+squareToUI (PointSquare x y) = PointUI (x * 2) y++uiToSquare :: PointUI -> PointSquare+{-# INLINE uiToSquare #-}+uiToSquare (PointUI x y) = PointSquare (x `div` 2) y++-- | The row where the dungeon map starts, both in @PointUI@+-- and @PointSquare@ coordinates.+mapStartY :: Int+mapStartY = 1++squareToMap :: PointSquare -> Point+{-# INLINE squareToMap #-}+squareToMap (PointSquare x y) = Point x (y - mapStartY)++mapToSquare :: Point -> PointSquare+{-# INLINE mapToSquare #-}+mapToSquare (Point x y) = PointSquare x (y + mapStartY)

engine-src/Game/LambdaHack/Client/UI/RunM.hs view

@@ -25,7 +25,6 @@ import qualified Data.EnumMap.Strict as EM import           GHC.Exts (inline) -import           Game.LambdaHack.Client.CommonM import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.Request import           Game.LambdaHack.Client.State@@ -38,13 +37,12 @@ import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level import           Game.LambdaHack.Common.MonadStateRead+import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Content.TileKind (TileKind)-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs  -- | Continue running in the given direction.@@ -118,7 +116,7 @@     let msgInterrupts = anyInReport interruptsRunning report     if msgInterrupts then return $ Left "message shown"     else do-      cops@COps{cotile} <- getsState scops+      cops@COps{coTileSpeedup} <- getsState scops       rbody <- getsState $ getActorBody runLeader       let rposHere = bpos rbody           rposLast = fromMaybe (error $ "" `showFailure` (runLeader, rbody))@@ -132,7 +130,8 @@           posThere = posHere `shift` dir           bigActorThere = occupiedBigLvl posThere lvl           projsThere = occupiedProjLvl posThere lvl-      let openableLast = Tile.isOpenable cotile (lvl `at` (posHere `shift` dir))+      let openableLast =+            Tile.isOpenable coTileSpeedup (lvl `at` (posHere `shift` dir))           check             | bigActorThere = return $ Left "actor in the way"             | projsThere = return $ Left "projectile in the way"@@ -158,14 +157,15 @@ tryTurning :: MonadClientRead m            => ActorId -> m (Either Text Vector) tryTurning aid = do-  cops@COps{cotile} <- getsState scops+  cops@COps{coTileSpeedup} <- getsState scops   body <- getsState $ getActorBody aid   let lid = blid body   lvl <- getLevel lid   let posHere = bpos body       posLast = fromMaybe (error $ "" `showFailure` (aid, body)) (boldpos body)       dirLast = posHere `vectorToFrom` posLast-  let openableDir dir = Tile.isOpenable cotile (lvl `at` (posHere `shift` dir))+  let openableDir dir =+        Tile.isOpenable coTileSpeedup (lvl `at` (posHere `shift` dir))       dirWalkable dir = walkableDir cops lvl posHere dir || openableDir dir       dirNearby dir1 dir2 = euclidDistSqVector dir1 dir2 == 1       -- Distance 2 could be useful, but surprising even to apt players.@@ -187,7 +187,6 @@             => ActorId -> Vector -> m (Either Text Vector) checkAndRun aid dir = do   COps{coTileSpeedup} <- getsState scops-  actorSk <- currentSkillsClient aid   actorMaxSkills <- getsState sactorMaxSkills   body <- getsState $ getActorBody aid   fact <- getsState $ (EM.! bfid body) . sfactionD@@ -204,7 +203,7 @@                 Nothing -> False                 Just aid2 -> g aid2 $ actorD EM.! aid2             g aid2 !b2 = inline isFoe (bfid body) fact (bfid b2)-                         && actorCanMelee actorMaxSkills aid2 b2+                         && actorCanMeleeToHarm actorMaxSkills aid2 b2                          && bhp b2 > 0  -- uncommon         in any f $ vicinityUnsafe posThere       projsThere = occupiedProjLvl posThere lvl@@ -236,15 +235,17 @@       rightTilesLast = map (lvl `at`) rightPsLast       leftForwardTileHere = lvl `at` leftForwardPosHere       rightForwardTileHere = lvl `at` rightForwardPosHere-      tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool)+      tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)       tilePropAt tile =         let suspect =               smarkSuspect > 0 && Tile.isSuspect coTileSpeedup tile               || smarkSuspect > 1 && Tile.isHideAs coTileSpeedup tile-            alterSkill = Ability.getSk Ability.SkAlter actorSk-            alterable = alterSkill >= Tile.alterMinSkill coTileSpeedup tile+            embed = Tile.isEmbed coTileSpeedup tile  -- no matter if embeds left             walkable = Tile.isWalkable coTileSpeedup tile-        in (suspect, alterable, walkable)+            openable = Tile.isOpenable coTileSpeedup tile+            closable = Tile.isClosable coTileSpeedup tile+            modifiable = Tile.isModifiable coTileSpeedup tile+        in (suspect, embed, walkable, openable, closable, modifiable)       terrainChangeMiddle = tilePropAt tileThere                             `notElem` map tilePropAt [tileLast, tileHere]       terrainChangeLeft = tilePropAt leftForwardTileHere

engine-src/Game/LambdaHack/Client/UI/SessionUI.hs view

@@ -1,9 +1,10 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | The client UI session state. module Game.LambdaHack.Client.UI.SessionUI-  ( SessionUI(..), ItemDictUI, AimMode(..), RunParams(..), LastRecord(..)-  , HintMode(..)-  , emptySessionUI, toggleMarkVision, toggleMarkSmell, getActorUI+  ( SessionUI(..), ItemDictUI, AimMode(..), KeyMacro(..), KeyMacroFrame(..)+  , RunParams(..), ChosenLore(..)+  , emptySessionUI, emptyMacroFrame+  , toggleMarkVision, toggleMarkSmell, cycleOverrideTut, getActorUI   ) where  import Prelude ()@@ -14,20 +15,26 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M+import qualified Data.Set as S import           Data.Time.Clock.POSIX+import           GHC.Generics (Generic)  import           Game.LambdaHack.Client.State import           Game.LambdaHack.Client.UI.ActorUI import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.EffectDescription (DetailLevel (..)) import           Game.LambdaHack.Client.UI.Frontend import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.Msg+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.UIOptions-import           Game.LambdaHack.Common.Point+import           Game.LambdaHack.Common.Actor+import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Definition.Defs+import qualified System.Random.SplitMix32 as SM  -- | The information that is used across a client playing session, -- including many consecutive games in a single session.@@ -35,6 +42,7 @@ -- An important component is the frontend session. data SessionUI = SessionUI   { sxhair         :: Maybe Target       -- ^ the common xhair+  , sxhairGoTo     :: Maybe Target       -- ^ xhair set for last GoTo   , sactorUI       :: ActorDictUI        -- ^ assigned actor UI presentations   , sitemUI        :: ItemDictUI         -- ^ assigned item first seen level   , sslots         :: ItemSlots          -- ^ map from slots to items@@ -53,21 +61,29 @@   , srunning       :: Maybe RunParams                                     -- ^ parameters of the current run, if any   , shistory       :: History       -- ^ history of messages-  , spointer       :: Point         -- ^ mouse pointer position-  , slastRecord    :: LastRecord    -- ^ state of key sequence recording-  , slastPlay      :: [K.KM]        -- ^ state of key sequence playback+  , spointer       :: PointUI       -- ^ mouse pointer position+  , smacroFrame    :: KeyMacroFrame -- ^ the head of the key macro stack+  , smacroStack    :: [KeyMacroFrame]+                                    -- ^ the tail of the key macro stack   , slastLost      :: ES.EnumSet ActorId                                     -- ^ actors that just got out of sight   , swaitTimes     :: Int           -- ^ player just waited this many times   , swasAutomated  :: Bool          -- ^ the player just exited AI automation   , smarkVision    :: Bool          -- ^ mark leader and party FOV   , smarkSmell     :: Bool          -- ^ mark smell, if the leader can smell+  , snxtScenario   :: Int           -- ^ next game scenario number+  , scurTutorial   :: Bool          -- ^ whether current game is a tutorial+  , snxtTutorial   :: Bool          -- ^ whether next game is to be tutorial+  , soverrideTut   :: Maybe Bool    -- ^ override display of tutorial hints+  , susedHints     :: S.Set Msg     -- ^ tutorial hints already shown this game   , smenuIxMap     :: M.Map String Int                                     -- ^ indices of last used menu items+  , schosenLore    :: ChosenLore    -- ^ last lore chosen to display   , sdisplayNeeded :: Bool          -- ^ current level needs displaying-  , shintMode      :: HintMode      -- ^ how to show keys hints when no messages-  , sreportNull    :: Bool          -- ^ whether no report created last UI turn-                                    --   or the report wiped out from screen+  , sturnDisplayed :: Bool          -- ^ a frame was already displayed this turn+  , sreportNull    :: Bool          -- ^ whether no visible report created+                                    --   last UI faction turn or the report+                                    --   wiped out from screen since   , sstart         :: POSIXTime     -- ^ this session start time   , sgstart        :: POSIXTime     -- ^ this game start time   , sallTime       :: Time          -- ^ clips from start of session@@ -75,14 +91,42 @@   , snframes       :: Int           -- ^ this game current frame count   , sallNframes    :: Int           -- ^ frame count from start of session                                     --   to current game start+  , srandomUI      :: SM.SMGen      -- ^ current random generator for UI   } +-- | Local macro buffer frame. Predefined macros have their own in-game macro+-- buffer, allowing them to record in-game macro, queue actions and repeat+-- the last macro's action.+-- Running predefined macro pushes new @KeyMacroFrame@ onto the stack. We pop+-- buffers from the stack if locally there are no actions pending to be handled.+data KeyMacroFrame = KeyMacroFrame+  { keyMacroBuffer :: Either [K.KM] KeyMacro -- ^ record keystrokes in Left;+                                             --   repeat from Right+  , keyPending     :: KeyMacro               -- ^ actions pending to be handled+  , keyLast        :: Maybe K.KM             -- ^ last pressed key+  } deriving (Show)++-- This can stay a map forever, not a vector, because it's added to often,+-- but never read from, except when the user requests item details. type ItemDictUI = EM.EnumMap ItemId LevelId  -- | Current aiming mode of a client.-newtype AimMode = AimMode { aimLevelId :: LevelId }-  deriving (Show, Eq, Binary)+data AimMode = AimMode+  { aimLevelId  :: LevelId+  , detailLevel :: DetailLevel+  }+  deriving (Show, Eq, Generic) +instance Binary AimMode++-- | In-game macros. We record menu navigation keystrokes and keystrokes+-- bound to commands with one exception --- we exclude keys that invoke+-- the @Record@ command, to avoid surprises.+-- Keys are kept in the same order in which they're meant to be replayed,+-- i.e. the first element of the list is replayed also as the first one.+newtype KeyMacro = KeyMacro {unKeyMacro :: [K.KM]}+  deriving (Show, Eq, Binary, Semigroup, Monoid)+ -- | Parameters of the current run. data RunParams = RunParams   { runLeader  :: ActorId         -- ^ the original leader from run start@@ -92,28 +136,21 @@   , runStopMsg :: Maybe Text      -- ^ message with the next stop reason   , runWaiting :: Int             -- ^ waiting for others to move out of the way   }-  deriving (Show)---- | State of last recorded and currently being recorded key sequences.-data LastRecord = LastRecord-  { currentKeys  :: [K.KM]  -- ^ accumulated keys of the current command-  , previousKeys :: [K.KM]  -- ^ keys of the rest of the recorded command batch-  , freeSpace    :: Int     -- ^ space left for commands to record in this batch-  }+  deriving Show -data HintMode =-    HintAbsent-  | HintShown-  | HintWiped-  deriving (Eq, Enum, Bounded)+-- | Last lore being aimed at.+data ChosenLore =+    ChosenLore [(ActorId, Actor)] [(ItemId, ItemQuant)]+  | ChosenNothing  emptySessionUI :: UIOptions -> SessionUI emptySessionUI sUIOptions =   SessionUI     { sxhair = Nothing+    , sxhairGoTo = Nothing     , sactorUI = EM.empty     , sitemUI = EM.empty-    , sslots = ItemSlots $ EM.fromAscList+    , sslots = ItemSlots $ EM.fromDistinctAscList                $ zip [minBound..maxBound] (repeat EM.empty)     , slastItemMove = Nothing     , schanF = ChanFrontend $ const $@@ -126,31 +163,47 @@     , sselected = ES.empty     , srunning = Nothing     , shistory = emptyHistory 0-    , spointer = originPoint-    , slastRecord = LastRecord [] [] 0-    , slastPlay = []+    , spointer = PointUI 0 0+    , smacroFrame = emptyMacroFrame+    , smacroStack = []     , slastLost = ES.empty     , swaitTimes = 0     , swasAutomated = False     , smarkVision = False     , smarkSmell = True-    , smenuIxMap = M.singleton "main" (2 - 9)  -- subtracting @initIx@+    , snxtScenario = 0+    , scurTutorial = False+    , snxtTutorial = True  -- matches @snxtScenario = 0@+    , soverrideTut = Nothing+    , susedHints = S.empty+    , smenuIxMap = M.empty+    , schosenLore = ChosenNothing     , sdisplayNeeded = False+    , sturnDisplayed = False     , sreportNull = True-    , shintMode = HintAbsent     , sstart = 0     , sgstart = 0     , sallTime = timeZero     , snframes = 0     , sallNframes = 0+    , srandomUI = SM.mkSMGen 0     } +emptyMacroFrame :: KeyMacroFrame+emptyMacroFrame = KeyMacroFrame (Right mempty) mempty Nothing+ toggleMarkVision :: SessionUI -> SessionUI-toggleMarkVision s@SessionUI{smarkVision} = s {smarkVision = not smarkVision}+toggleMarkVision sess = sess {smarkVision = not (smarkVision sess)}  toggleMarkSmell :: SessionUI -> SessionUI-toggleMarkSmell s@SessionUI{smarkSmell} = s {smarkSmell = not smarkSmell}+toggleMarkSmell sess = sess {smarkSmell = not (smarkSmell sess)} +cycleOverrideTut :: SessionUI -> SessionUI+cycleOverrideTut sess = sess {soverrideTut = case soverrideTut sess of+                                Nothing -> Just False+                                Just False -> Just True+                                Just True -> Nothing}+ getActorUI :: ActorId -> SessionUI -> ActorUI getActorUI aid sess =   EM.findWithDefault (error $ "" `showFailure` (aid, sactorUI sess)) aid@@ -167,10 +220,16 @@     put sitemSel     put sselected     put srunning-    put shistory+    put $ archiveReport True shistory+      -- avoid displaying ending messages again at game start     put smarkVision     put smarkSmell-    put sdisplayNeeded+    put snxtScenario+    put scurTutorial+    put snxtTutorial+    put soverrideTut+    put susedHints+    put (show srandomUI)   get = do     sxhair <- get     sactorUI <- get@@ -184,26 +243,35 @@     shistory <- get     smarkVision <- get     smarkSmell <- get-    sdisplayNeeded <- get-    let slastItemMove = Nothing+    snxtScenario <- get+    scurTutorial <- get+    snxtTutorial <- get+    soverrideTut <- get+    susedHints <- get+    g <- get+    let sxhairGoTo = Nothing+        slastItemMove = Nothing         schanF = ChanFrontend $ const $           error $ "Binary: ChanFrontend" `showFailure` ()         sccui = emptyCCUI         sxhairMoused = True-        spointer = originPoint-        slastRecord = LastRecord [] [] 0-        slastPlay = []+        spointer = PointUI 0 0+        smacroFrame = emptyMacroFrame+        smacroStack = []         slastLost = ES.empty         swaitTimes = 0         swasAutomated = False-        smenuIxMap = M.singleton "main" (2 - 9)  -- subtracting @initIx@+        smenuIxMap = M.empty+        schosenLore = ChosenNothing+        sdisplayNeeded = False  -- displayed regardless+        sturnDisplayed = False         sreportNull = True-        shintMode = HintAbsent         sstart = 0         sgstart = 0         sallTime = timeZero         snframes = 0         sallNframes = 0+        srandomUI = read g     return $! SessionUI{..}  instance Binary RunParams where

engine-src/Game/LambdaHack/Client/UI/Slideshow.hs view

@@ -1,8 +1,11 @@ -- | Slideshows. module Game.LambdaHack.Client.UI.Slideshow-  ( KYX, OKX, Slideshow(slideshow)-  , emptySlideshow, unsnoc, toSlideshow, menuToSlideshow-  , wrapOKX, splitOverlay, splitOKX, highSlideshow+  ( DisplayFont, isSquareFont, isMonoFont, FontOverlayMap, FontSetup(..)+  , multiFontSetup, monoFontSetup, singleFontSetup, textSize+  , ButtonWidth(..), KYX, OKX, Slideshow(slideshow)+  , emptySlideshow, unsnoc, toSlideshow, attrLinesToFontMap+  , maxYofOverlay, menuToSlideshow, wrapOKX, splitOverlay, splitOKX+  , highSlideshow #ifdef EXPOSE_INTERNAL     -- * Internal operations   , moreMsg, endMsg, keysOKX, showTable, showNearbyScores@@ -13,23 +16,68 @@  import Game.LambdaHack.Core.Prelude -import Data.Time.LocalTime+import qualified Data.EnumMap.Strict as EM+import           Data.Time.LocalTime  import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import qualified Game.LambdaHack.Common.HighScore as HighScore import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Definition.Defs +data DisplayFont = SquareFont | MonoFont | PropFont+  deriving (Show, Eq, Enum)++isSquareFont :: DisplayFont -> Bool+isSquareFont SquareFont = True+isSquareFont _ = False++isMonoFont :: DisplayFont -> Bool+isMonoFont MonoFont = True+isMonoFont _ = False++type FontOverlayMap = EM.EnumMap DisplayFont Overlay++data FontSetup = FontSetup+  { squareFont :: DisplayFont+  , monoFont   :: DisplayFont+  , propFont   :: DisplayFont+  }++multiFontSetup :: FontSetup+multiFontSetup = FontSetup SquareFont MonoFont PropFont++monoFontSetup :: FontSetup+monoFontSetup = FontSetup SquareFont MonoFont MonoFont++singleFontSetup :: FontSetup+singleFontSetup = FontSetup SquareFont SquareFont SquareFont++textSize :: DisplayFont -> [a] -> Int+textSize SquareFont l = 2 * length l+textSize MonoFont l = length l+textSize PropFont _ = error "size of proportional font texts is not defined"++-- TODO: probably best merge the PointUI into that and represent+-- the position as characters, too, translating to UI positions as needed.+-- The problem is that then I need to do a lot of reverse translation+-- when creating buttons.+-- | Width of on-screen button text, expressed in characters,+-- and so UI (mono font) width is deduced from the used font.+data ButtonWidth = ButtonWidth+  { buttonFont  :: DisplayFont+  , buttonWidth :: Int }+  deriving (Show, Eq)+ -- | A key or an item slot label at a given position on the screen.-type KYX = (Either [K.KM] SlotChar, (Y, X, X))+type KYX = (Either [K.KM] SlotChar, (PointUI, ButtonWidth))  -- | An Overlay of text with an associated list of keys or slots -- that activated when the specified screen position is pointed at. -- The list should be sorted wrt rows and then columns.-type OKX = (Overlay, [KYX])+type OKX = (FontOverlayMap, [KYX])  -- | A list of active screenfulls to be shown one after another. -- Each screenful has an independent numbering of rows and columns.@@ -45,122 +93,291 @@     [] -> Nothing     okx : rest -> Just (Slideshow $ reverse rest, okx) -toSlideshow :: [OKX] -> Slideshow-toSlideshow okxs = Slideshow $ addFooters False okxsNotNull+toSlideshow :: FontSetup -> [OKX] -> Slideshow+toSlideshow FontSetup{..} okxs = Slideshow $ addFooters False okxsNotNull  where   okxFilter (ov, kyxs) =     (ov, filter (either (not . null) (const True) . fst) kyxs)   okxsNotNull = map okxFilter okxs+  pofOv :: Overlay -> PointUI+  pofOv [] = PointUI 0 0+  pofOv l = let pyAfterLast = 1 + maxYofOverlay l  -- append after last line+            in PointUI 0 pyAfterLast+  atEnd = flip (++)+  appendToFontOverlayMap :: FontOverlayMap -> AttrLine+                         -> (FontOverlayMap, PointUI, DisplayFont)+  appendToFontOverlayMap ovs al =+    let maxYminXofOverlay ov = let ymxOfOverlay (PointUI x y, _) = (- y, x)+                               in minimum $ (0, 0) : map ymxOfOverlay ov+        -- @SortOn@ less efficient here, because function cheap.+        assocsYX = sortBy (comparing snd)+                   $ EM.assocs $ EM.map maxYminXofOverlay ovs+        (fontMax, unique) = case assocsYX of+          [] -> (monoFont, False)+          (font, (y, _x)) : rest -> (font, all (\(_, (y2, _)) -> y /= y2) rest)+        insertAl ovF =+          let p = pofOv ovF+              displayFont = case fontMax of+                SquareFont | unique -> SquareFont+                _ -> monoFont+          in (EM.insertWith atEnd displayFont [(p, al)] ovs, p, displayFont)+    in case EM.lookup fontMax ovs of+      Just ovF -> insertAl ovF+      Nothing -> insertAl []+  addFooters :: Bool -> [OKX] -> [OKX]   addFooters _ [] = error $ "" `showFailure` okxsNotNull   addFooters _ [(als, [])] =-    [( als ++ [stringToAL endMsg]-     , [(Left [K.safeSpaceKM], (length als, 0, 15))] )]+    let (ovs, p, font) = appendToFontOverlayMap als (stringToAL endMsg)+    in [(ovs, [(Left [K.safeSpaceKM], (p, ButtonWidth font 15))])]   addFooters False [(als, kxs)] = [(als, kxs)]   addFooters True [(als, kxs)] =-    [( als ++ [stringToAL endMsg]-     , kxs ++ [(Left [K.safeSpaceKM], (length als, 0, 15))] )]+    let (ovs, p, font) = appendToFontOverlayMap als (stringToAL endMsg)+    in [(ovs, kxs ++ [(Left [K.safeSpaceKM], (p, ButtonWidth font 15))])]   addFooters _ ((als, kxs) : rest) =-    ( als ++ [stringToAL moreMsg]-    , kxs ++ [(Left [K.safeSpaceKM], (length als, 0, 8))] )-    : addFooters True rest+    let (ovs, p, font) = appendToFontOverlayMap als (stringToAL moreMsg)+    in (ovs, kxs ++ [(Left [K.safeSpaceKM], (p, ButtonWidth font 8))])+       : addFooters True rest +attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap+attrLinesToFontMap start0 blurb =+  let zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)+      zipAttrLines start als =+        ( map (first $ PointUI 0) $ zip [start ..] als+        , start + length als )+      addOverlay :: (FontOverlayMap, Int) -> (DisplayFont, [AttrLine])+                 -> (FontOverlayMap, Int)+      addOverlay (!em, !start) (font, als) =+        let (als2, start2) = zipAttrLines start als+        in ( EM.insertWith (++) font als2 em+           , start2 )+      (ov, _) = foldl' addOverlay (EM.empty, start0) blurb+  in ov+ moreMsg :: String-moreMsg = "--more--  "+moreMsg = "--more--"  endMsg :: String-endMsg = "--back to top--  "+endMsg = "--back to top--" +maxYofOverlay :: Overlay -> Int+maxYofOverlay ov = let yOfOverlay (PointUI _ y, _) = y+                   in maximum $ 0 : map yOfOverlay ov+ menuToSlideshow :: OKX -> Slideshow menuToSlideshow (als, kxs) =-  assert (not (null als || null kxs)) $ Slideshow [(als, kxs)]+  assert (not (EM.null als || null kxs)) $ Slideshow [(als, kxs)] -wrapOKX :: Y -> X -> X -> [(K.KM, String)] -> OKX-wrapOKX ystart xstart xBound ks =-  let f ((y, x), (kL, kV, kX)) (key, s) =-        let len = length s-        in if x + len > xBound-           then f ((y + 1, 0), ([], kL : kV, kX)) (key, s)-           else ( (y, x + len + 1)-                , (s : kL, kV, (Left [key], (y, x, x + len)) : kX) )-      (kL1, kV1, kX1) = snd $ foldl' f ((ystart, xstart), ([], [], [])) ks-      catL = stringToAL . intercalate " " . reverse-  in (reverse $ map catL $ kL1 : kV1, reverse kX1)+wrapOKX :: DisplayFont -> Int -> Int -> Int -> [(K.KM, String)]+        -> (Overlay, [KYX])+wrapOKX _ _ _ _ [] = ([], [])+wrapOKX displayFont ystart xstart width ks =+  let overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)+      overlayLineFromStrings xlineStart y strings =+        let p = PointUI xlineStart y+        in (p, stringToAL $ intercalate " " (reverse strings))+      f :: ((Int, Int), (Int, [String], Overlay, [KYX])) -> (K.KM, String)+        -> ((Int, Int), (Int, [String], Overlay, [KYX]))+      f ((y, x), (xlineStart, kL, kV, kX)) (key, s) =+        let len = textSize displayFont s+            len1 = len + textSize displayFont " "+        in if x + len >= width+           then let iov = overlayLineFromStrings xlineStart y kL+                in f ((y + 1, 0), (0, [], iov : kV, kX)) (key, s)+           else ( (y, x + len1)+                , ( xlineStart+                  , s : kL+                  , kV+                  , (Left [key], ( PointUI x y+                                 , ButtonWidth displayFont (length s) ))+                    : kX ) )+      ((ystop, _), (xlineStop, kL1, kV1, kX1)) =+        foldl' f ((ystart, xstart), (xstart, [], [], [])) ks+      iov1 = overlayLineFromStrings xlineStop ystop kL1+  in (reverse $ iov1 : kV1, reverse kX1) -keysOKX :: Y -> X -> X -> [K.KM] -> OKX-keysOKX ystart xstart xBound keys =+keysOKX :: DisplayFont -> Int -> Int -> Int -> [K.KM] -> (Overlay, [KYX])+keysOKX displayFont ystart xstart width keys =   let wrapB :: String -> String       wrapB s = "[" ++ s ++ "]"       ks = map (\key -> (key, wrapB $ K.showKM key)) keys-  in wrapOKX ystart xstart xBound ks+  in wrapOKX displayFont ystart xstart width ks -splitOverlay :: X -> Y -> Report -> [K.KM] -> OKX -> Slideshow-splitOverlay width height report keys (ls0, kxs0) =-  toSlideshow $ splitOKX width height (renderReport report) keys (ls0, kxs0)+-- The font argument is for the report and keys overlay. Others already have+-- assigned fonts.+splitOverlay :: FontSetup -> Bool -> Int -> Int -> Int+             -> Report -> [K.KM] -> OKX+             -> Slideshow+splitOverlay fontSetup uScreen1PerLine width height wrap+             report keys (ls0, kxs0) =+  let renderedReport = renderReport True report+      reportAS = if uScreen1PerLine+                 then foldr (<\:>) [] renderedReport+                 else foldr (<+:>) [] renderedReport+      msgLong = not uScreen1PerLine+                && null keys && EM.null ls0 && null kxs0+                && length reportAS <= 2 * width+                && all ((/= '\n') . Color.charFromW32) reportAS+                     -- if fits in one long line, don't wrap into short lines+  in toSlideshow fontSetup $ splitOKX fontSetup msgLong width height wrap+                                      reportAS keys (ls0, kxs0)  -- Note that we only split wrt @White@ space, nothing else.-splitOKX :: X -> Y -> AttrLine -> [K.KM] -> OKX -> [OKX]-splitOKX width height rrep keys (ls0, kxs0) =-  assert (height > 2) $  -- and kxs0 is sorted-  let msgRaw = splitAttrLine width rrep-      (lX0, keysX0) = keysOKX 0 0 maxBound keys-      (lX, keysX) | null msgRaw = (lX0, keysX0)-                  | otherwise = keysOKX (length msgRaw - 1)-                                        (length (last msgRaw) + 1)-                                        width keys-      msgOkx = (glueLines msgRaw lX, keysX)-      ((lsInit, kxsInit), (header, rkxs)) =-        -- Check whether most space taken by report and keys.-        if length (glueLines msgRaw lX0) * 2 > height-        then (msgOkx, ( [intercalate [Color.spaceAttrW32] lX0 <+:> rrep]-                      , keysX0 ))-               -- will display "$" (unless has EOLs)-        else (([], []), msgOkx)-      renumber y (km, (y0, x1, x2)) = (km, (y0 + y, x1, x2))-      splitO yoffset (hdr, rk) (ls, kxs) =-        let zipRenumber = map $ renumber $ length hdr - yoffset-            (pre, post) = splitAt (height - 1) $ hdr ++ ls-            yoffsetNew = yoffset + height - length hdr - 1-        in if null post-           then [(pre, rk ++ zipRenumber kxs)]  -- all fits on one screen-           else let (preX, postX) =-                      break (\(_, (y1, _, _)) -> y1 >= yoffsetNew) kxs-                in (pre, rk ++ zipRenumber preX)-                   : splitO yoffsetNew (hdr, rk) (post, postX)-      initSlides = if null lsInit+splitOKX :: FontSetup -> Bool -> Int -> Int -> Int -> AttrString -> [K.KM]+         -> OKX+         -> [OKX]+splitOKX FontSetup{..} msgLong width height wrap reportAS keys (ls0, kxs0) =+  assert (height > 2) $+  let indentSplitSpaces = indentSplitAttrString2+                            (not (isMonoFont propFont || isSquareFont propFont))+      reportParagraphs = linesAttr reportAS+      -- TODO: until SDL support for measuring prop font text is released,+      -- we have to use MonoFont for the paragraph that ends with buttons.+      (repProp, repMono) =+        if null keys+        then (reportParagraphs, emptyAttrLine)+        else case reverse reportParagraphs of+          [] -> ([], emptyAttrLine)+          l : rest ->+            (reverse rest, attrStringToAL $ attrLine l ++ [Color.nbspAttrW32])+      msgWrap = if msgLong && not (isSquareFont propFont)+                then 2 * width+                else wrap  -- TODO if with width fits on one screen, use it+      msgWidth = if msgLong && not (isSquareFont propFont)+                 then 2 * width+                 else width+      repProp0 = offsetOverlay $ case repProp of+        [] -> []+        r : rs ->+          -- Make lines of first paragraph long if it has 2 lines at most.+          -- The first line does not obscure anything and the second line+          -- is often short anyway.+          let firstWidth = if length (attrLine r) <= 2 * msgWidth+                           then msgWidth+                           else msgWrap+          in (indentSplitSpaces firstWidth . attrLine) r  -- first possibly long+             ++ concatMap (indentSplitSpaces msgWrap . attrLine) rs+      -- TODO: refactor this ugly pile of copy-paste+      repPropW = offsetOverlay+                 $ concatMap (indentSplitSpaces width . attrLine) repProp+      -- If the mono portion first on the line, let it take half width,+      -- but if previous lines shorter, match them and only buttons+      -- are permitted to stick out.+      monoWidth = if null repProp then msgWidth else msgWrap+      repMono0 = map (\(PointUI x y, al) ->+                        (PointUI x (y + length repProp0), al))+                 $ offsetOverlay+                 $ indentSplitAttrString monoWidth $ attrLine repMono+      repMonoW = map (\(PointUI x y, al) ->+                        (PointUI x (y + length repPropW), al))+                 $ offsetOverlay+                 $ indentSplitAttrString width $ attrLine repMono+      repWhole0 = offsetOverlay+                  $ concatMap (indentSplitSpaces msgWidth . attrLine)+                              reportParagraphs+      repWhole1 = map (\(PointUI x y, al) -> (PointUI x (y + 1), al)) repWhole0+      lenOfRep0 = length repProp0 + length repMono0+      lenOfRepW = length repPropW + length repMonoW+      startOfKeys = if null repMono0+                    then 0+                    else textSize monoFont (attrLine $ snd $ last repMono0)+      startOfKeysW = if null repMonoW+                     then 0+                     else textSize monoFont (attrLine $ snd $ last repMonoW)+      pressAKey = stringToAS "A long report is shown. Press a key:"+                  ++ [Color.nbspAttrW32]+      (lX0, keysX0) = keysOKX monoFont 0 (length pressAKey) width keys+      (lX1, keysX1) = keysOKX monoFont 1 0 width keys+      (lX, keysX) = keysOKX monoFont (lenOfRep0 - 1) startOfKeys+                            (2 * width) keys+      (lXW, keysXW) = keysOKX monoFont (lenOfRepW - 1) startOfKeysW+                              (2 * width) keys+      renumber dy (km, (PointUI x y, len)) = (km, (PointUI x (y + dy), len))+      renumberOv dy = map (\(PointUI x y, al) -> (PointUI x (y + dy), al))+      splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]+      splitO yoffset (hdrProp, hdrMono, rk) (ls, kxs) =+        let hdrOff | null hdrProp && null hdrMono = 0+                   | otherwise = 1 + maxYofOverlay hdrMono+            keyRenumber = map $ renumber (hdrOff - yoffset)+            lineRenumber = EM.map $ renumberOv (hdrOff - yoffset)+            yoffsetNew = yoffset + height - hdrOff - 1+            ltOffset :: (PointUI, a) -> Bool+            ltOffset (PointUI _ y, _) = y < yoffsetNew+            (pre, post) = ( filter ltOffset <$> ls+                          , filter (not . ltOffset) <$> ls )+            prependHdr = EM.insertWith (++) propFont hdrProp+                         . EM.insertWith (++) monoFont hdrMono+        in if all null $ EM.elems post  -- all fits on one screen+           then [(prependHdr $ lineRenumber pre, rk ++ keyRenumber kxs)]+           else let (preX, postX) = span (\(_, pa) -> ltOffset pa) kxs+                in (prependHdr $ lineRenumber pre, rk ++ keyRenumber preX)+                   : splitO yoffsetNew (hdrProp, hdrMono, rk) (post, postX)+      firstParaReport = firstParagraph reportAS+      hdrShortened = ( [(PointUI 0 0, firstParaReport)]+                         -- shortened for the main slides; in full beforehand+                     , take 3 lX1  -- 3 lines ought to be enough for everyone+                     , keysX1 )+      ((lsInit, kxsInit), (headerProp, headerMono, rkxs)) =+        -- Check whether all space taken by report and keys.+        if | (lenOfRep0 + length lX) < height ->  -- display normally+             ((EM.empty, []), (repProp0, lX ++ repMono0, keysX))+           | (lenOfRepW + length lXW) < height ->  -- display widely+             ((EM.empty, []), (repPropW, lXW ++ repMonoW, keysXW))+           | length reportParagraphs == 1+             && length (attrLine firstParaReport) <= 2 * width ->+             ( (EM.empty, [])  -- already shown in full in @hdrShortened@+             , hdrShortened )+           | otherwise -> case lX0 of+               [] ->+                 ( (EM.singleton propFont repWhole0, [])+                     -- showing in full in the init slide+                 , hdrShortened )+               lX0first : _ ->+                 ( ( EM.insertWith (++) propFont repWhole1+                     $ EM.singleton monoFont+                         [(PointUI 0 0, firstParagraph pressAKey), lX0first]+                   , filter (\(_, (PointUI _ y, _)) -> y == 0) keysX0 )+                 , hdrShortened )+      initSlides = if EM.null lsInit                    then assert (null kxsInit) []-                   else splitO 0 ([], []) (lsInit, kxsInit)-      mainSlides = if null ls0 && not (null lsInit)+                   else splitO 0 ([], [], []) (lsInit, kxsInit)+      -- If @ls0@ is not empty, we still want to display the report,+      -- one way or another.+      mainSlides = if EM.null ls0 && not (EM.null lsInit)                    then assert (null kxs0) []-                   else splitO 0 (header, rkxs) (ls0, kxs0)+                   else splitO 0 (headerProp, headerMono, rkxs) (ls0, kxs0)   in initSlides ++ mainSlides  -- | Generate a slideshow with the current and previous scores.-highSlideshow :: X          -- ^ width of the display area-              -> Y          -- ^ height of the display area+highSlideshow :: FontSetup+              -> Int        -- ^ width of the display area+              -> Int        -- ^ height of the display area               -> HighScore.ScoreTable -- ^ current score table               -> Int        -- ^ position of the current score in the table               -> Text       -- ^ the name of the game mode               -> TimeZone   -- ^ the timezone where the game is run               -> Slideshow-highSlideshow width height table pos gameModeName tz =+highSlideshow fontSetup@FontSetup{monoFont} width height table pos+              gameModeName tz =   let entries = (height - 3) `div` 3       msg = HighScore.showAward entries table pos gameModeName-      tts = showNearbyScores tz pos table entries-      al = textToAL msg+      tts = map offsetOverlay $ showNearbyScores tz pos table entries+      al = textToAS msg       splitScreen ts =-        splitOKX width height al [K.spaceKM, K.escKM] (ts, [])-  in toSlideshow $ concat $ map splitScreen tts+        splitOKX fontSetup False width height width al [K.spaceKM, K.escKM]+                 (EM.singleton monoFont ts, [])+  in toSlideshow fontSetup $ concat $ map splitScreen tts  -- | Show a screenful of the high scores table. -- Parameter @entries@ is the number of (3-line) scores to be shown.-showTable :: TimeZone -> Int -> HighScore.ScoreTable -> Int -> Int -> [AttrLine]+showTable :: TimeZone -> Int -> HighScore.ScoreTable -> Int -> Int+          -> [AttrLine] showTable tz pos table start entries =   let zipped    = zip [1..] $ HighScore.unTable table       screenful = take entries . drop (start - 1) $ zipped       renderScore (pos1, score1) =         map (if pos1 == pos then textFgToAL Color.BrWhite else textToAL)         $ HighScore.showScore tz pos1 score1-  in [] : intercalate [[]] (map renderScore screenful)+  in emptyAttrLine : intercalate [emptyAttrLine] (map renderScore screenful)  -- | Produce a couple of renderings of the high scores table. showNearbyScores :: TimeZone -> Int -> HighScore.ScoreTable -> Int@@ -168,5 +385,6 @@ showNearbyScores tz pos h entries =   if pos <= entries   then [showTable tz pos h 1 entries]-  else [showTable tz pos h 1 entries,-        showTable tz pos h (max (entries + 1) (pos - entries `div` 2)) entries]+  else [ showTable tz pos h 1 entries+       , showTable tz pos h (max (entries + 1) (pos - entries `div` 2))+                   entries ]

engine-src/Game/LambdaHack/Client/UI/SlideshowM.hs view

@@ -1,6 +1,6 @@ -- | Monadic operations on slideshows and related data. module Game.LambdaHack.Client.UI.SlideshowM-  ( overlayToSlideshow, reportToSlideshow, reportToSlideshowKeep+  ( overlayToSlideshow, reportToSlideshow, reportToSlideshowKeepHalt   , displaySpaceEsc, displayMore, displayMoreKeep, displayYesNo, getConfirms   , displayChoiceScreen   ) where@@ -10,51 +10,69 @@ import Game.LambdaHack.Core.Prelude  import           Data.Either+import qualified Data.EnumMap.Strict as EM import qualified Data.Map.Strict as M+import qualified Data.Text as T +import           Game.LambdaHack.Client.MonadClient import           Game.LambdaHack.Client.UI.Content.Screen import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.Frame import           Game.LambdaHack.Client.UI.FrameM import           Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.MonadClientUI+import           Game.LambdaHack.Client.UI.Msg import           Game.LambdaHack.Client.UI.MsgM import           Game.LambdaHack.Client.UI.Overlay+import           Game.LambdaHack.Client.UI.PointUI import           Game.LambdaHack.Client.UI.SessionUI import           Game.LambdaHack.Client.UI.Slideshow-import           Game.LambdaHack.Common.Point+import           Game.LambdaHack.Client.UI.UIOptions import qualified Game.LambdaHack.Definition.Color as Color-import           Game.LambdaHack.Definition.Defs  -- | Add current report to the overlay, split the result and produce, -- possibly, many slides.-overlayToSlideshow :: MonadClientUI m => Y -> [K.KM] -> OKX -> m Slideshow+overlayToSlideshow :: MonadClientUI m+                   => Int -> [K.KM] -> OKX -> m Slideshow overlayToSlideshow y keys okx = do-  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui-  report <- getReportUI+  CCUI{coscreen=ScreenContent{rwidth, rwrap}} <- getsSession sccui+  UIOptions{uScreen1PerLine} <- getsSession sUIOptions+  report <- getReportUI True   recordHistory  -- report will be shown soon, remove it to history-  return $! splitOverlay rwidth y report keys okx+  fontSetup <- getFontSetup+  return $! splitOverlay fontSetup uScreen1PerLine rwidth y rwrap+                         report keys okx  -- | Split current report into a slideshow. reportToSlideshow :: MonadClientUI m => [K.KM] -> m Slideshow reportToSlideshow keys = do   CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui-  overlayToSlideshow (rheight - 2) keys ([], [])+  overlayToSlideshow (rheight - 2) keys (EM.empty, [])  -- | Split current report into a slideshow. Keep report unchanged.-reportToSlideshowKeep :: MonadClientUI m => [K.KM] -> m Slideshow-reportToSlideshowKeep keys = do-  CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui-  report <- getReportUI+-- Assume the game either halts waiting for a key after this is shown,+-- or many slides are produced, all but the last are displayed+-- with player promts between and the last is either shown+-- in full or ignored if inside macro (can be recovered from history,+-- if important). Unless the prompts interrupt the macro, which is as well.+reportToSlideshowKeepHalt :: MonadClientUI m => Bool -> [K.KM] -> m Slideshow+reportToSlideshowKeepHalt insideMenu keys = do+  CCUI{coscreen=ScreenContent{rwidth, rheight, rwrap}} <- getsSession sccui+  UIOptions{uScreen1PerLine} <- getsSession sUIOptions+  report <- getReportUI insideMenu   -- Don't do @recordHistory@; the message is important, but related   -- to the messages that come after, so should be shown together.-  return $! splitOverlay rwidth (rheight - 2) report keys ([], [])+  fontSetup <- getFontSetup+  return $! splitOverlay fontSetup uScreen1PerLine rwidth (rheight - 2) rwrap+                         report keys (EM.empty, [])  -- | Display a message. Return value indicates if the player wants to continue. -- Feature: if many pages, only the last SPACE exits (but first ESC).-displaySpaceEsc :: MonadClientUI m => ColorMode -> Text -> m Bool+displaySpaceEsc :: (MonadClient m, MonadClientUI m)+                => ColorMode -> Text -> m Bool displaySpaceEsc dm prompt = do-  promptAdd0 prompt+  unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt   -- Two frames drawn total (unless @prompt@ very long).   slides <- reportToSlideshow [K.spaceKM, K.escKM]   km <- getConfirms dm [K.spaceKM, K.escKM] slides@@ -62,29 +80,29 @@  -- | Display a message. Ignore keypresses. -- Feature: if many pages, only the last SPACE exits (but first ESC).-displayMore :: MonadClientUI m => ColorMode -> Text -> m ()+displayMore :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m () displayMore dm prompt = do-  promptAdd0 prompt+  unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt   slides <- reportToSlideshow [K.spaceKM]   void $ getConfirms dm [K.spaceKM, K.escKM] slides -displayMoreKeep :: MonadClientUI m => ColorMode -> Text -> m ()+displayMoreKeep :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m () displayMoreKeep dm prompt = do-  promptAdd0 prompt-  slides <- reportToSlideshowKeep [K.spaceKM]+  unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt+  slides <- reportToSlideshowKeepHalt True [K.spaceKM]   void $ getConfirms dm [K.spaceKM, K.escKM] slides  -- | Print a yes/no question and return the player's answer. Use black -- and white colours to turn player's attention to the choice.-displayYesNo :: MonadClientUI m => ColorMode -> Text -> m Bool+displayYesNo :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m Bool displayYesNo dm prompt = do-  promptAdd0 prompt+  unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt   let yn = map K.mkChar ['y', 'n']   slides <- reportToSlideshow yn   km <- getConfirms dm (K.escKM : yn) slides   return $! km == K.mkChar 'y' -getConfirms :: MonadClientUI m+getConfirms :: (MonadClient m, MonadClientUI m)             => ColorMode -> [K.KM] -> Slideshow -> m K.KM getConfirms dm extraKeys slides = do   ekm <- displayChoiceScreen "" dm False slides extraKeys@@ -95,12 +113,12 @@ -- can again be placed at that spot next time menu is displayed). -- -- This function is the only source of menus and so, effectively, UI modes.-displayChoiceScreen :: forall m . MonadClientUI m+displayChoiceScreen :: forall m . (MonadClient m, MonadClientUI m)                     => String -> ColorMode -> Bool -> Slideshow -> [K.KM]                     -> m (Either K.KM SlotChar) displayChoiceScreen menuName dm sfBlank frsX extraKeys = do   let frs = slideshow frsX-      keys = concatMap (concatMap (either id (const []) . fst) . snd) frs+      keys = concatMap (concatMap (fromLeft [] . fst) . snd) frs              ++ extraKeys       !_A = assert (K.escKM `elem` extraKeys) ()       navigationKeys = [ K.leftButtonReleaseKM, K.rightButtonReleaseKM@@ -108,6 +126,7 @@                        , K.upKM, K.leftKM, K.downKM, K.rightKM                        , K.pgupKM, K.pgdnKM, K.wheelNorthKM, K.wheelSouthKM                        , K.homeKM, K.endKM, K.controlP ]+                       ++ [K.mkChar '?' | menuName == "help"]  -- a hack       legalKeys = keys ++ navigationKeys       -- The arguments go from first menu line and menu page to the last,       -- in order. Their indexing is from 0. We select the nearest item@@ -134,18 +153,27 @@       page :: Int -> m (Either K.KM SlotChar, Int)       page pointer = assert (pointer >= 0) $ case findKYX pointer frs of         Nothing -> error $ "no menu keys" `showFailure` frs-        Just ((ov, kyxs), (ekm, (y, x1, x2)), ixOnPage) -> do+        Just ( (ovs, kyxs)+             , (ekm, (PointUI x1 y, ButtonWidth fontX1 len))+             , ixOnPage ) -> do           let highableAttrs =                 [Color.defAttr, Color.defAttr {Color.fg = Color.BrBlack}]-              highAttr x | Color.acAttr x `notElem` highableAttrs = x+              highAttr x | Color.acAttr x `notElem` highableAttrs+                           || Color.acChar x == ' ' = x               highAttr x = x {Color.acAttr =                                 (Color.acAttr x) {Color.fg = Color.BrWhite}}               cursorAttr x = x {Color.acAttr =                                   (Color.acAttr x)                                     {Color.bg = Color.HighlightNoneCursor}}-              drawHighlight xs =-                let (xs1, xsRest) = splitAt x1 xs-                    (xs2, xs3) = splitAt (x2 - x1) xsRest+              -- This also highlights dull white item symbols, but who cares.+              lenUI = if isSquareFont fontX1 then len * 2 else len+              drawHighlight xstart xs | x1 + lenUI < xstart = xs+                                      | otherwise =+                let x1MinusXStartChars = if isSquareFont fontX1+                                         then (x1 - xstart) `div` 2+                                         else x1 - xstart+                    (xs1, xsRest) = splitAt x1MinusXStartChars xs+                    (xs2, xs3) = splitAt len xsRest                     highW32 = Color.attrCharToW32                               . highAttr                               . Color.attrCharFromW32@@ -156,10 +184,11 @@                       [] -> []                       xh : xhrest -> cursorW32 xh : xhrest                 in xs1 ++ xs2High ++ xs3-              ov1 = updateLines y drawHighlight ov+              ovs1 = EM.map (updateLine y drawHighlight) ovs               ignoreKey = page pointer               pageLen = length kyxs-              xix (_, (_, x1', _)) = x1' == x1+              xix :: KYX -> Bool+              xix (_, (PointUI x1' _, _)) = x1' <= x1 + 2 && x1' >= x1 - 2               firstRowOfNextPage = pointer + pageLen - ixOnPage               restOKX = drop firstRowOfNextPage allOKX               firstItemOfNextPage = case findIndex (isRight . fst) restOKX of@@ -180,9 +209,11 @@                     Left [] -> error $ "" `showFailure` ikm                     Right c -> return (Right c, pointer)                   K.LeftButtonRelease -> do-                    Point{..} <- getsSession spointer-                    let onChoice (_, (cy, cx1, cx2)) =-                          cy == py && cx1 <= px && cx2 > px+                    PointUI mx my <- getsSession spointer+                    let onChoice (_, (PointUI cx cy, ButtonWidth font clen)) =+                          let blen | isSquareFont font = 2 * clen+                                   | otherwise = clen+                          in my == cy && mx >= cx && mx < cx + blen                     case find onChoice kyxs of                       Nothing | ikm `elem` keys -> return (Left ikm, pointer)                       Nothing -> if K.spaceKM `elem` keys@@ -201,6 +232,9 @@                        | otherwise -> ignoreKey                   K.Space | firstItemOfNextPage <= maxIx ->                     page firstItemOfNextPage+                  K.Char '?' | firstItemOfNextPage <= maxIx+                               && menuName == "help" ->  -- a hack+                    page firstItemOfNextPage                   K.Unknown "SAFE_SPACE" ->                     if firstItemOfNextPage <= maxIx                     then page firstItemOfNextPage@@ -222,11 +256,15 @@                   _ | K.key ikm `elem` [K.PgUp, K.WheelNorth] ->                     page (max 0 (pointer - ixOnPage - 1))                   _ | K.key ikm `elem` [K.PgDn, K.WheelSouth] ->+                    -- This doesn't scroll by screenful when header very long+                    -- and menu non-empty, but that scenario is rare, so OK,+                    -- arrow keys may be used instead.                     page (min maxIx firstItemOfNextPage)-                  K.Space -> if pointer == maxIx then page clearIx+                  K.Space -> if pointer == maxIx+                             then page clearIx                              else page maxIx                   _ -> error $ "unknown key" `showFailure` ikm-          pkm <- promptGetKey dm ov1 sfBlank legalKeys+          pkm <- promptGetKey dm ovs1 sfBlank legalKeys           interpretKey pkm   menuIxMap <- getsSession smenuIxMap   -- Beware, values in @menuIxMap@ may be negative (meaning: a key, not slot).

engine-src/Game/LambdaHack/Client/UI/UIOptions.hs view

@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}--- | UI client options.+-- | UI client options specified in the config file. module Game.LambdaHack.Client.UI.UIOptions   ( UIOptions(..)   ) where@@ -14,31 +14,36 @@  import           Game.LambdaHack.Client.UI.HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K-import           Game.LambdaHack.Client.UI.Msg+import           Game.LambdaHack.Common.ClientOptions (FullscreenMode)+import           Game.LambdaHack.Common.Misc import qualified Game.LambdaHack.Definition.Color as Color --- | Options that affect the UI of the client.+-- | Options that affect the UI of the client, specified in the config file. More documentation is in the default config file. data UIOptions = UIOptions   { -- commands-    uCommands           :: [(K.KM, CmdTriple)]+    uCommands         :: [(K.KM, CmdTriple)]     -- hero names-  , uHeroNames          :: [(Int, (Text, Text))]+  , uHeroNames        :: [(Int, (Text, Text))]     -- ui-  , uVi                 :: Bool  -- ^ the option for Vi keys takes precendence-  , uLaptop             :: Bool  -- ^ because the laptop keys are the default-  , uGtkFontFamily      :: Text-  , uSdlFontFile        :: Text-  , uSdlScalableSizeAdd :: Int-  , uSdlBitmapSizeAdd   :: Int-  , uScalableFontSize   :: Int-  , uHistoryMax         :: Int-  , uMaxFps             :: Int-  , uNoAnim             :: Bool-  , uhpWarningPercent   :: Int+  , uVi               :: Bool+  , uLeftHand         :: Bool+  , uChosenFontset    :: Text+  , uAllFontsScale    :: Double+  , uScreen1PerLine   :: Bool+  , uHistory1PerLine  :: Bool+  , uHistoryMax       :: Int+  , uMaxFps           :: Double+  , uNoAnim           :: Bool+  , uhpWarningPercent :: Int       -- ^ HP percent at which warning is emitted.-  , uMessageColors      :: Maybe [(MsgClass, Color.Color)]-  , uCmdline            :: [String]+  , uMessageColors    :: [(String, Color.Color)]+      -- ^ Prefixes of message class constructor names paired with colors.+      --   The first prefix that matches, wins.+  , uCmdline          :: [String]       -- ^ Hardwired commandline arguments to process.+  , uFonts            :: [(Text, FontDefinition)]+  , uFontsets         :: [(Text, FontSet)]+  , uFullscreenMode   :: FullscreenMode   }   deriving (Show, Generic)

engine-src/Game/LambdaHack/Client/UI/UIOptionsParse.hs view

@@ -16,24 +16,29 @@ import qualified Data.Ini.Reader as Ini import qualified Data.Ini.Types as Ini import qualified Data.Map.Strict as M+import qualified Data.Text as T+import           Data.Version import           System.FilePath+import           Text.ParserCombinators.ReadP (readP_to_S) import           Text.Read -import           Game.LambdaHack.Client.ClientOptions import           Game.LambdaHack.Client.UI.HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import           Game.LambdaHack.Client.UI.UIOptions+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.File import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Misc+import           Game.LambdaHack.Common.Save (compatibleVersion, delayPrint)+import qualified Game.LambdaHack.Common.Save as Save import           Game.LambdaHack.Content.RuleKind  configError :: String -> a configError err = error $ "Error when parsing configuration file. Please fix config.ui.ini or remove it altogether. The details:\n" ++ err  readError :: Read a => String -> a-readError = either (configError . ("when reading a value" `showFailure`)) id-            . readEither+readError s = either (configError . ("when reading:\n" ++ s `showFailure`)) id+              $ readEither s  parseConfig :: Ini.Config -> UIOptions parseConfig cfg =@@ -58,8 +63,8 @@       lookupFail optionName err =         configError $ "config file access failed"                       `showFailure` (err, optionName, cfg)-      getOptionMaybe :: forall a. Read a => String -> Maybe a-      getOptionMaybe optionName =+      _getOptionMaybe :: forall a. Read a => String -> Maybe a+      _getOptionMaybe optionName =         let ms = Ini.getOption "ui" optionName cfg         in either (lookupFail optionName) id . readEither <$> ms       getOption :: forall a. Read a => String -> a@@ -68,69 +73,99 @@                 $ Ini.getOption "ui" optionName cfg         in either (lookupFail optionName) id $ readEither s       uVi = getOption "movementViKeys_hjklyubn"-      -- The option for Vi keys takes precendence,-      -- because the laptop keys are the default.-      uLaptop = not uVi && getOption "movementLaptopKeys_uk8o79jl"-      uGtkFontFamily = getOption "gtkFontFamily"-      uSdlFontFile = getOption "sdlFontFile"-      uSdlScalableSizeAdd = getOption "sdlScalableSizeAdd"-      uSdlBitmapSizeAdd = getOption "sdlBitmapSizeAdd"-      uScalableFontSize = getOption "scalableFontSize"-#ifdef USE_JSFILE-      -- Local storage quota exeeded on Chrome.-      uHistoryMax = getOption "historyMax" `div` 10-#else+      uLeftHand = getOption "movementLeftHandKeys_axwdqezc"+      uChosenFontset = getOption "chosenFontset"+      uAllFontsScale = getOption "allFontsScale"+      uScreen1PerLine = getOption "screenOneMessagePerLine"+      uHistory1PerLine = getOption "historyOneMessagePerLine"       uHistoryMax = getOption "historyMax"-#endif       uMaxFps = max 1 $ getOption "maxFps"       uNoAnim = getOption "noAnim"       uhpWarningPercent = getOption "hpWarningPercent"-      uMessageColors = getOptionMaybe "messageColors"-      uCmdline = words $ getOption "overrideCmdline"+      uMessageColors =+        map (second readError) $ Ini.allItems "message_colors" cfg+      uCmdline = glueSeed $ words $ getOption "overrideCmdline"+      uFonts =+        let toFont (ident, fontString) = (T.pack ident, readError fontString)+            section = Ini.allItems "fonts" cfg+        in map toFont section+      uFontsets =+        let toFontSet (ident, fontSetString) =+              (T.pack ident, readError fontSetString)+            section = Ini.allItems "fontsets" cfg+        in map toFontSet section+      uFullscreenMode = getOption "fullscreenMode"   in UIOptions{..} +glueSeed :: [String] -> [String]+glueSeed [] = []+glueSeed ("SMGen" : s1 : s2 : rest) =+  ("SMGen" ++ " " ++ s1 ++ " " ++ s2) : glueSeed rest+glueSeed (s : rest) = s : glueSeed rest+ -- | Read and parse UI config file.-mkUIOptions :: COps -> Bool -> IO UIOptions-mkUIOptions COps{corule} benchmark = do-  let cfgUIName = rcfgUIName corule-      sUIDefault = rcfgUIDefault corule-      cfgUIDefault =-        either (configError . ("Ini.parse sUIDefault" `showFailure`)) id-        $ Ini.parse sUIDefault+mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions+mkUIOptions corule clientOptions = do+  let benchmark = sbenchmark clientOptions+      cfgUIName = rcfgUIName corule+      (configString, cfgUIDefault) = rcfgUIDefault corule   dataDir <- appDataDir-  let userPath = dataDir </> cfgUIName+  let path bkp = dataDir </> bkp <> cfgUIName   cfgUser <- if benchmark then return Ini.emptyConfig else do-    cpExists <- doesFileExist userPath+    cpExists <- doesFileExist (path "")     if not cpExists       then return Ini.emptyConfig       else do-        sUser <- readFile userPath+        sUser <- readFile (path "")         return $! either (configError . ("Ini.parse sUser" `showFailure`)) id                   $ Ini.parse sUser   let cfgUI = M.unionWith M.union cfgUser cfgUIDefault  -- user cfg preferred-      conf = parseConfig cfgUI-  -- Catch syntax errors in complex expressions ASAP.-  return $! deepseq conf conf+      vExe1 = rexeVersion corule+      vExe2 =+        let optionName = "version"+            -- Lenient to parse, and reject, old config files:+            s = fromMaybe "" $ Ini.getOption "version" optionName cfgUser+            dummyVersion = makeVersion []+        in case find ((== "") . snd) $ readP_to_S parseVersion s of+          Just (ver, "") -> ver+          _ -> dummyVersion+  if benchmark || compatibleVersion vExe1 vExe2 then do+    let conf = parseConfig cfgUI+    -- Catch syntax errors in complex expressions ASAP.+    return $! deepseq conf conf+  else do+    cpExists <- doesFileExist (path "")+    when cpExists $ do+      renameFile (path "") (path "bkp.")+      moveAside <- Save.bkpAllSaves corule clientOptions+      let msg = "Config file" <+> T.pack (path "")+                <+> "from an incompatible version '"+                <> T.pack (showVersion vExe2)+                <> "' detected while starting"+                <+> T.pack (showVersion vExe1)+                <+> "game."+                <+> if moveAside+                    then "The config file and savefiles have been moved aside."+                    else "The config file has been moved aside."+      delayPrint msg+    tryWriteFile (path "") configString+    let confDefault = parseConfig cfgUIDefault+    return confDefault  -- | Modify client options with UI options. applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions-applyUIOptions COps{corule} uioptions soptions =-     (\opts -> opts {sgtkFontFamily =-        sgtkFontFamily opts `mplus` Just (uGtkFontFamily uioptions)}) .-     (\opts -> opts {sdlFontFile =-        sdlFontFile opts `mplus` Just (uSdlFontFile uioptions)}) .-     (\opts -> opts {sdlScalableSizeAdd =-        sdlScalableSizeAdd opts `mplus` Just (uSdlScalableSizeAdd uioptions)}) .-     (\opts -> opts {sdlBitmapSizeAdd =-        sdlBitmapSizeAdd opts `mplus` Just (uSdlBitmapSizeAdd uioptions)}) .-     (\opts -> opts {sscalableFontSize =-        sscalableFontSize opts `mplus` Just (uScalableFontSize uioptions)}) .+applyUIOptions COps{corule} uioptions =+     (\opts -> opts {schosenFontset =+        schosenFontset opts `mplus` Just (uChosenFontset uioptions)}) .+     (\opts -> opts {sallFontsScale =+        sallFontsScale opts `mplus` Just (uAllFontsScale uioptions)}) .+     (\opts -> opts {sfonts = uFonts uioptions}) .+     (\opts -> opts {sfontsets = uFontsets uioptions}) .+     (\opts -> opts {sfullscreenMode =+        sfullscreenMode opts `mplus` Just (uFullscreenMode uioptions)}) .      (\opts -> opts {smaxFps =         smaxFps opts `mplus` Just (uMaxFps uioptions)}) .      (\opts -> opts {snoAnim =         snoAnim opts `mplus` Just (uNoAnim uioptions)}) .      (\opts -> opts {stitle =-        stitle opts `mplus` Just (rtitle corule)}) .-     (\opts -> opts {sfontDir =-        sfontDir opts `mplus` Just (rfontDir corule)})-     $ soptions+        stitle opts `mplus` Just (rtitle corule)})

engine-src/Game/LambdaHack/Common/Actor.hs view

@@ -1,12 +1,15 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric, TupleSections #-} -- | Actors in the game: heroes, monsters, etc. module Game.LambdaHack.Common.Actor   ( -- * The@ Acto@r type, its components and operations on them     Actor(..), ResDelta(..), ActorMaxSkills, Watchfulness(..)-  , deltasSerious, deltasHears, deltaBenign, deltaWasBenign, actorCanMelee+  , deltasSerious, deltasSeriousThisTurn+  , deltasHears, deltaBenign, deltaWasBenign+  , actorCanMelee, actorCanMeleeToHarm, actorWorthChasing, actorWorthKilling   , gearSpeed, actorTemplate, actorWaits, actorWaitsOrSleeps, actorDying-  , hpTooLow, calmEnough, hpEnough, hpFull, canSleep, prefersSleep+  , hpTooLow, calmEnough, calmFull, hpFull, canSleep, prefersSleep   , checkAdjacent, eqpOverfull, eqpFreeN+  , getCarriedIidsAndTrunk, getCarriedIidCStore     -- * Assorted   , ActorDict, monsterGenChance, smellTimeout   ) where@@ -21,15 +24,16 @@ import           Data.Ratio import           GHC.Generics (Generic) -import qualified Game.LambdaHack.Definition.Ability as Ability-import qualified Game.LambdaHack.Core.Dice as Dice import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Misc import           Game.LambdaHack.Common.Point-import           Game.LambdaHack.Core.Random import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector+import qualified Game.LambdaHack.Core.Dice as Dice+import           Game.LambdaHack.Core.Random+import qualified Game.LambdaHack.Definition.Ability as Ability+import           Game.LambdaHack.Definition.Defs  -- | Actor attributes that are changing throughout the game. -- If they appear to be dublets of aspects from actor kinds, e.g. HP,@@ -45,6 +49,8 @@ data Actor = Actor   { -- The trunk of the actor's body (present also in @borgan@ or @beqp@)     btrunk      :: ItemId       -- ^ the trunk organ of the actor's body+  , bnumber     :: Maybe Int    -- ^ continued team character identity+                                --   index number in this game      -- Resources   , bhp         :: Int64        -- ^ current hit points * 1M@@ -64,8 +70,8 @@     -- Items   , borgan      :: ItemBag      -- ^ organs   , beqp        :: ItemBag      -- ^ personal equipment-  , binv        :: ItemBag      -- ^ personal inventory pack   , bweapon     :: Int          -- ^ number of weapons among eqp and organs+  , bweapBenign :: Int          -- ^ number of benign items among weapons      -- Assorted   , bwatch      :: Watchfulness -- ^ state of the actor's watchfulness@@ -103,6 +109,9 @@ deltasSerious ResDelta{..} = fst resCurrentTurn <= minusM2                              || fst resPreviousTurn <= minusM2 +deltasSeriousThisTurn :: ResDelta -> Bool+deltasSeriousThisTurn ResDelta{..} = fst resCurrentTurn <= minusM2+ deltasHears :: ResDelta -> Bool deltasHears ResDelta{..} = fst resCurrentTurn == minusM1                            || fst resPreviousTurn == minusM1@@ -116,27 +125,62 @@   fst resPreviousTurn >= 0  -- only the previous one  actorCanMelee :: ActorMaxSkills -> ActorId -> Actor -> Bool+{-# INLINE actorCanMelee #-} actorCanMelee actorMaxSkills aid b =   let actorMaxSk = actorMaxSkills EM.! aid       condUsableWeapon = bweapon b > 0       canMelee = Ability.getSk Ability.SkMelee actorMaxSk > 0   in condUsableWeapon && canMelee +actorCanMeleeToHarm :: ActorMaxSkills -> ActorId -> Actor -> Bool+{-# INLINE actorCanMeleeToHarm #-}+actorCanMeleeToHarm actorMaxSkills aid b =+  let actorMaxSk = actorMaxSkills EM.! aid+      condUsableWeapon = bweapon b - bweapBenign b > 0+      canMelee = Ability.getSk Ability.SkMelee actorMaxSk > 0+  in condUsableWeapon && canMelee++-- Don't target/melee nonmoving actors, including sleeping, because nonmoving+-- can't be lured nor ambushed nor can chase us. However, do target+-- if they have loot or can attack at range or may become very powerful+-- through regeneration if left alone.+actorWorthChasing :: ActorMaxSkills -> ActorId -> Actor -> Bool+actorWorthChasing actorMaxSkills aid b =+  let hasLoot = not (EM.null $ beqp b)+        -- even consider "unreported inventory", for speed and KISS+      actorMaxSk = actorMaxSkills EM.! aid+  in bproj b+     || (Ability.getSk Ability.SkMove actorMaxSk > 0+         || bwatch b == WWake  -- probably will start moving very soon+         || hasLoot+         || Ability.getSk Ability.SkProject actorMaxSk > 0+         || bwatch b == WSleep+            && Ability.getSk Ability.SkMaxHP actorMaxSk > 30)+              -- too dangerous when regenerates through sleep;+              -- heroes usually fall into this category+        && bhp b > 0++-- Whether worth killing if already chased down.+actorWorthKilling :: ActorMaxSkills -> ActorId -> Actor -> Bool+actorWorthKilling actorMaxSkills aid b =+  actorWorthChasing actorMaxSkills aid b+  || actorCanMeleeToHarm actorMaxSkills aid b && bhp b > 0+ -- | The speed from organs and gear; being pushed is ignored. gearSpeed :: Ability.Skills -> Speed gearSpeed actorMaxSk = toSpeed $   max minSpeed (Ability.getSk Ability.SkSpeed actorMaxSk)  -- see @minimalSpeed@ -actorTemplate :: ItemId -> Int64 -> Int64 -> Point -> LevelId -> FactionId-              -> Bool+actorTemplate :: ItemId -> Maybe Int -> Int64 -> Int64 -> Point -> LevelId+              -> FactionId -> Bool               -> Actor-actorTemplate btrunk bhp bcalm bpos blid bfid bproj =+actorTemplate btrunk bnumber bhp bcalm bpos blid bfid bproj =   let btrajectory = Nothing       boldpos = Nothing       borgan = EM.empty       beqp = EM.empty-      binv = EM.empty       bweapon = 0+      bweapBenign = 0       bwatch = WWatch  -- overriden elsewhere, sometimes       bhpDelta = ResDelta (0, 0) (0, 0)       bcalmDelta = ResDelta (0, 0) (0, 0)@@ -155,23 +199,32 @@   WSleep -> True   _ -> False +-- | Projectile that ran out of steam or collided with obstacle, dies.+-- Even if it pierced through an obstacle, but lost its payload+-- while altering the obstacle during piercing, it dies, too. actorDying :: Actor -> Bool actorDying b = bhp b <= 0-               || bproj b && maybe True (null . fst) (btrajectory b)+               || bproj b && (maybe True (null . fst) (btrajectory b)+                              || EM.null (beqp b))  hpTooLow :: Actor -> Ability.Skills -> Bool hpTooLow b actorMaxSk =   5 * bhp b < xM (Ability.getSk Ability.SkMaxHP actorMaxSk) && bhp b <= xM 40   || bhp b <= oneM +-- | Check if actor calm enough to perform some actions.+--+-- If max Calm is zero, always holds, to permit removing disastrous+-- equipped items, which would otherwise be stuck forever. calmEnough :: Actor -> Ability.Skills -> Bool calmEnough b actorMaxSk =-  let calmMax = max 1 $ Ability.getSk Ability.SkMaxCalm actorMaxSk-  in 2 * xM calmMax <= 3 * bcalm b && bcalm b > xM 10+  let calmMax = Ability.getSk Ability.SkMaxCalm actorMaxSk+  in 2 * xM calmMax <= 3 * bcalm b -hpEnough :: Actor -> Ability.Skills -> Bool-hpEnough b actorMaxSk =-  xM (Ability.getSk Ability.SkMaxHP actorMaxSk) <= 2 * bhp b && bhp b > oneM+calmFull :: Actor -> Ability.Skills -> Bool+calmFull b actorMaxSk =+  let calmMax = Ability.getSk Ability.SkMaxCalm actorMaxSk+  in xM calmMax <= bcalm b  hpFull :: Actor -> Ability.Skills -> Bool hpFull b actorMaxSk = xM (Ability.getSk Ability.SkMaxHP actorMaxSk) <= bhp b@@ -181,11 +234,12 @@ canSleep actorMaxSk = Ability.getSk Ability.SkWait actorMaxSk >= 3                       && (Ability.getSk Ability.SkSight actorMaxSk > 0                           || Ability.getSk Ability.SkHearing actorMaxSk > 0)-                      && Ability.getSk Ability.SkAggression actorMaxSk < 2 --- | Can't loot, so sometimes prefers to sleep instead of exploring.+-- | Can't loot, not too aggresive, so sometimes prefers to sleep+-- instead of exploring. prefersSleep :: Ability.Skills -> Bool prefersSleep actorMaxSk = Ability.getSk Ability.SkMoveItem actorMaxSk <= 0+                          && Ability.getSk Ability.SkAggression actorMaxSk < 2  checkAdjacent :: Actor -> Actor -> Bool checkAdjacent sb tb = blid sb == blid tb && adjacent (bpos sb) (bpos tb)@@ -200,6 +254,18 @@              in assert (size <= 10 `blame` (b, size))                 $ 10 - size +getCarriedIidsAndTrunk :: Actor -> [ItemId]+getCarriedIidsAndTrunk b =+  -- The trunk is important for a case of spotting a caught projectile+  -- with a stolen projecting item. This actually does happen.+  let trunk = EM.singleton (btrunk b) quantSingle+  in EM.keys $ EM.unionsWith const [beqp b, borgan b, trunk]++getCarriedIidCStore :: Actor -> [(ItemId, CStore)]+getCarriedIidCStore b =+  let bagCarried (cstore, bag) = map (,cstore) $ EM.keys bag+  in concatMap bagCarried [(CEqp, beqp b), (COrgan, borgan b)]+ -- | Chance that a new monster is generated. Depends on the number -- of monsters already present, and on the level depth and its cave kind. monsterGenChance :: Dice.AbsDepth -> Dice.AbsDepth -> Int -> Int -> Rnd Bool@@ -219,7 +285,8 @@         -- Never spawn too rarely so that camping is never safe.         maxCoeff = 100 * 30  -- safe level after 30 spawns flattens out         coeff = min maxCoeff $ actorCoeff * (lvlSpawned - scaledDepth - 2)-    in chance $ 3%fromIntegral (coeff `max` 1)  -- 3 --- trebled+    in chance $ 3 % intCast (coeff `max` 1)+         -- 3 --- trebled  -- | How long until an actor's smell vanishes from a tile. smellTimeout :: Delta Time

engine-src/Game/LambdaHack/Common/ActorState.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE TupleSections #-} -- | Operations on the 'Actor' type, and related, that need the 'State' type, -- but not our custom monad types. module Game.LambdaHack.Common.ActorState@@ -6,20 +5,18 @@   , fidActorRegularIds, foeRegularAssocs, foeRegularList   , friendRegularAssocs, friendRegularList, bagAssocs, bagAssocsK   , posToBig, posToBigAssoc, posToProjs, posToProjAssocs-  , posToAids, posToAidAssocs-  , calculateTotal, itemPrice, mergeItemQuant, findIid-  , combinedGround, combinedOrgan, combinedEqp, combinedInv-  , combinedItems, combinedFromLore+  , posToAids, posToAidAssocs, calculateTotal, itemPrice, findIid+  , combinedGround, combinedOrgan, combinedEqp, combinedItems   , getActorBody, getActorMaxSkills, actorCurrentSkills, canTraverse-  , getCarriedAssocsAndTrunk, getCarriedIidCStore, getContainerBag-  , getFloorBag, getEmbedBag, getBodyStoreBag-  , mapActorItems_, getActorAssocs, getActorAssocsK-  , memActor, getLocalTime, regenCalmDelta, actorInAmbient, canDeAmbientList+  , getCarriedAssocsAndTrunk, getContainerBag+  , getFloorBag, getEmbedBag, getBodyStoreBag, getFactionStashBag+  , mapActorItems_, getActorAssocs+  , memActor, getLocalTime, regenCalmDelta, actorInAmbient   , dispEnemy, itemToFull, fullAssocs, kitAssocs   , getItemKindId, getIidKindId, getItemKind, getIidKind   , getItemKindIdServer, getIidKindIdServer, getItemKindServer, getIidKindServer-  , lidFromC, posFromC, anyFoeAdj, adjacentBigAssocs, adjacentProjAssocs-  , armorHurtBonus, inMelee+  , tileAlterable, lidFromC, posFromC, anyFoeAdj, anyHarmfulFoeAdj+  , adjacentBigAssocs, adjacentProjAssocs, armorHurtBonus, inMelee   ) where  import Prelude ()@@ -37,6 +34,7 @@ import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level import           Game.LambdaHack.Common.Misc+import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Time@@ -45,7 +43,6 @@ import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Content.TileKind as TK-import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs @@ -138,13 +135,10 @@  -- | Price an item, taking count into consideration. itemPrice :: Int -> IK.ItemKind -> Int-itemPrice jcount itemKind = case lookup "valuable" $ IK.ifreq itemKind of+itemPrice jcount itemKind = case lookup IK.VALUABLE $ IK.ifreq itemKind of   Just k -> jcount * k   Nothing -> 0 -mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant-mergeItemQuant (k2, it2) (k1, it1) = (k1 + k2, it1 ++ it2)- findIid :: ActorId -> FactionId -> ItemId -> State         -> [(ActorId, (Actor, CStore))] findIid leader fid iid s =@@ -153,7 +147,7 @@         let itemsOfCStore store =               let bag = getBodyStoreBag b store s               in map (\iid2 -> (iid2, (aid, (b, store)))) (EM.keys bag)-            stores = [CInv, CEqp, COrgan] ++ [CSha | aid == leader]+            stores = [CEqp, COrgan] ++ [CStash | aid == leader]         in concatMap itemsOfCStore stores       items = concatMap itemsOfActor actors   in map snd $ filter ((== iid) . fst) items@@ -175,32 +169,18 @@   let bs = inline fidActorNotProjGlobalAssocs fid s   in EM.unionsWith mergeItemQuant $ map (beqp . snd) bs -combinedInv :: FactionId -> State -> ItemBag-combinedInv fid s =-  let bs = inline fidActorNotProjGlobalAssocs fid s-  in EM.unionsWith mergeItemQuant $ map (binv . snd) bs- -- Trunk not considered (if stolen). combinedItems :: FactionId -> State -> ItemBag combinedItems fid s =-  let shaBag = gsha $ sfactionD s EM.! fid+  let stashBag = getFactionStashBag fid s       bs = map snd $ inline fidActorNotProjGlobalAssocs fid s-  in EM.unionsWith mergeItemQuant $ map binv bs ++ map beqp bs ++ [shaBag]--combinedFromLore :: SLore -> FactionId -> State -> ItemBag-combinedFromLore slore fid s = case slore of-  SItem -> combinedItems fid s-  SOrgan -> combinedOrgan fid s-  STrunk -> combinedOrgan fid s-  SCondition -> combinedOrgan fid s-  SBlast -> EM.empty-  SEmbed -> EM.empty+  in EM.unionsWith mergeItemQuant $ map beqp bs ++ [stashBag]  getActorBody :: ActorId -> State -> Actor {-# INLINE getActorBody #-} getActorBody aid s = sactorD s EM.! aid --- For now, faction and tactic skill modifiers only change+-- For now, faction and doctrine skill modifiers only change -- the stats that affect permitted actions (@SkMove..SkApply@), -- so the expensive @actorCurrentSkills@ operation doesn't need to be used -- when checking the other skills, e.g., for FOV calculations,@@ -215,10 +195,10 @@   let body = getActorBody aid s       actorMaxSk = getActorMaxSkills aid s       player = gplayer . (EM.! bfid body) . sfactionD $ s-      skillsFromTactic = Ability.tacticSkills $ ftactic player+      skillsFromDoctrine = Ability.doctrineSkills $ fdoctrine player       factionSkills         | Just aid == mleader = Ability.zeroSkills-        | otherwise = fskillsOther player `Ability.addSkills` skillsFromTactic+        | otherwise = fskillsOther player `Ability.addSkills` skillsFromDoctrine   in actorMaxSk `Ability.addSkills` factionSkills  -- Check that the actor can move, also between levels and through doors.@@ -239,13 +219,8 @@ getCarriedAssocsAndTrunk b s =   -- The trunk is important for a case of spotting a caught projectile   -- with a stolen projecting item. This actually does happen.-  let trunk = EM.singleton (btrunk b) (1, [])-  in bagAssocs s $ EM.unionsWith const [binv b, beqp b, borgan b, trunk]--getCarriedIidCStore :: Actor -> [(ItemId, CStore)]-getCarriedIidCStore b =-  let bagCarried (cstore, bag) = map (,cstore) $ EM.keys bag-  in concatMap bagCarried [(CInv, binv b), (CEqp, beqp b), (COrgan, borgan b)]+  let trunk = EM.singleton (btrunk b) quantSingle+  in bagAssocs s $ EM.unionsWith const [beqp b, borgan b, trunk]  getContainerBag :: Container -> State -> ItemBag getContainerBag c s = case c of@@ -269,11 +244,15 @@     CGround -> getFloorBag (blid b) (bpos b) s     COrgan -> borgan b     CEqp -> beqp b-    CInv -> binv b-    CSha -> gsha $ sfactionD s EM.! bfid b+    CStash -> getFactionStashBag (bfid b) s +getFactionStashBag :: FactionId -> State -> ItemBag+getFactionStashBag fid s = case gstash $ sfactionD s EM.! fid of+  Just (lid, pos) -> getFloorBag lid pos s+  Nothing -> EM.empty+ mapActorItems_ :: Monad m-               => (CStore -> ItemId -> ItemQuant -> m a) -> Actor -> State+               => (CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State                -> m () mapActorItems_ f b s = do   let notProcessed = [CGround]@@ -283,14 +262,9 @@         mapM_ (uncurry $ f cstore) $ EM.assocs bag   mapM_ g sts -getActorAssocs :: ActorId -> CStore -> State -> [(ItemId, Item)]+getActorAssocs :: ActorId -> CStore -> State -> [(ItemId, (Item, ItemQuant))] getActorAssocs aid cstore s =   let b = getActorBody aid s-  in bagAssocs s $ getBodyStoreBag b cstore s--getActorAssocsK :: ActorId -> CStore -> State -> [(ItemId, (Item, ItemQuant))]-getActorAssocsK aid cstore s =-  let b = getActorBody aid s   in bagAssocsK s $ getBodyStoreBag b cstore s  -- | Checks if the actor is present on the current level.@@ -340,18 +314,6 @@   let lvl = (EM.! blid b) . sdungeon $ s   in Tile.isLit (coTileSpeedup $ scops s) (lvl `at` bpos b) -canDeAmbientList :: Actor -> State -> [Point]-canDeAmbientList b s =-  let COps{coTileSpeedup} = scops s-      lvl = (EM.! blid b) . sdungeon $ s-      posDeAmbient p =-        let t = lvl `at` p-        in Tile.isWalkable coTileSpeedup t  -- no time to waste altering-           && not (Tile.isLit coTileSpeedup t)-  in if Tile.isLit coTileSpeedup (lvl `at` bpos b)-     then filter posDeAmbient (vicinityUnsafe $ bpos b)-     else []- -- Check whether an actor can displace another. We assume they are adjacent -- and they are foes. dispEnemy :: ActorId -> ActorId -> Ability.Skills -> State -> Bool@@ -363,12 +325,15 @@         in any friend adjAssocs       sb = getActorBody source s       tb = getActorBody target s-      dozes = bwatch tb `elem` [WSleep, WWake]+      tfact = sfactionD s EM.! bfid tb   in bproj tb      || not (actorDying tb              || actorWaits tb              || Ability.getSk Ability.SkMove actorMaxSk <= 0-                && not dozes  -- roots weak if the tree sleeps+                  -- sometimes this comes from sleep, but it's transient+                  -- and if we made exception for sleep, we would displace+                  -- immobile sleeping actors+             || Just (blid tb, bpos tb) == gstash tfact              || hasBackup sb && hasBackup tb)  -- solo actors are flexible  itemToFull :: ItemId -> State -> ItemFull@@ -377,14 +342,14 @@  fullAssocs :: ActorId -> [CStore] -> State -> [(ItemId, ItemFull)] fullAssocs aid cstores s =-  let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores+  let allAssocs = concatMap (\cstore -> getActorAssocs aid cstore s) cstores       iToFull (iid, (item, _kit)) =         (iid, itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid item)   in map iToFull allAssocs  kitAssocs :: ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)] kitAssocs aid cstores s =-  let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores+  let allAssocs = concatMap (\cstore -> getActorAssocs aid cstore s) cstores       iToFull (iid, (item, kit)) =         (iid, ( itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid item               , kit ))@@ -419,8 +384,19 @@ getIidKindServer :: ItemId -> State -> IK.ItemKind getIidKindServer iid s = getItemKindServer (getItemBody iid s) s --- | Determine the dungeon level of the container. If the item is in a shared--- stash, the level depends on which actor asks.+tileAlterable :: LevelId -> Point -> State -> Bool+tileAlterable lid pos s =+  let COps{coTileSpeedup} = scops s+      embeds = getEmbedBag lid pos s+      lvl = sdungeon s EM.! lid+      t = lvl `at` pos+      triggerable = any (\iid -> not $ null $ IK.ieffects $ getIidKind iid s)+                        (EM.keys embeds)+  in Tile.isModifiable coTileSpeedup t || triggerable++-- | Determine the dungeon level of the container. If the item is in+-- the shared stash, the level depends on which actor asks, not where+-- the stash is located physically. lidFromC :: Container -> State -> LevelId lidFromC (CFloor lid _) _ = lid lidFromC (CEmbed lid _) _ = lid@@ -433,6 +409,22 @@ posFromC (CActor aid _) s = bpos $ getActorBody aid s posFromC c@CTrunk{} _ = error $ "" `showFailure` c +vicinityFoeAdj :: ((ActorId, Actor) -> Bool) -> ActorId -> State -> Bool+{-# INLINE vicinityFoeAdj #-}+vicinityFoeAdj predicate aid s =+  let body = getActorBody aid s+      lvl = (EM.! blid body) . sdungeon $ s+      fact = (EM.! bfid body) . sfactionD $ s+      f !p = case posToBigLvl p lvl of+        Nothing -> False+        Just aid2 -> let b2 = getActorBody aid2 s+                     in isFoe (bfid body) fact (bfid b2)+                        && predicate (aid2, b2)+      h !p = case posToProjsLvl p lvl of+        [] -> False+        aid2 : _ -> isFoe (bfid body) fact . bfid $ getActorBody aid2 s+  in any (\p -> f p || h p) $ vicinityUnsafe $ bpos body+ -- | Require that any non-dying foe is adjacent. We include even -- projectiles that explode when stricken down, because they can be caught -- and then they don't explode, so it makes sense to focus on handling them.@@ -441,20 +433,11 @@ -- if the actor would need to flee instead of meleeing, but fleeing -- with *many* projectiles adjacent is a possible waste of a move anyway). anyFoeAdj :: ActorId -> State -> Bool-anyFoeAdj aid s =-  let body = getActorBody aid s-      lvl = (EM.! blid body) . sdungeon $ s-      fact = (EM.! bfid body) . sfactionD $ s-      f !p = case posToBigLvl p lvl of-        Nothing -> False-        Just aid2 -> g $ getActorBody aid2 s-      g !b = inline isFoe (bfid body) fact (bfid b)-             && bhp b > 0  -- uncommon-      h !p = case posToProjsLvl p lvl of-        [] -> False-        aid2 : _ -> g $ getActorBody aid2 s-  in any (\ p -> f p || h p) $ vicinityUnsafe $ bpos body+anyFoeAdj = vicinityFoeAdj (const True) +anyHarmfulFoeAdj :: ActorMaxSkills -> ActorId -> State -> Bool+anyHarmfulFoeAdj = vicinityFoeAdj . uncurry . actorWorthKilling+ adjacentBigAssocs :: Actor -> State -> [(ActorId, Actor)] {-# INLINE adjacentBigAssocs #-} adjacentBigAssocs body s =@@ -478,22 +461,31 @@       tMaxSk = getActorMaxSkills target s   in armorHurtCalculation (bproj sb) sMaxSk tMaxSk --- | Check if any non-dying foe (projectile or not) is adjacent--- to any of our normal actors (whether they can melee or just need to flee,--- in which case alert is needed so that they are not slowed down by others).+-- | Check if any non-dying foe is adjacent to any of our normal actors+-- and either can harm them via melee or can attack from a distance.+-- Otherwise no point meleeing him. Projectiles are ignored, because+-- they are not actively attempted to melee, see @meleeAny@.+-- This is regardless of whether our actor can melee or just needs to flee,+-- in which case alert is needed so that he is not slowed down by others.+-- However, if our actor can't move nor melee, no real combat is taking place. -- This is needed only by AI and computed as lazily as possible.-inMelee :: FactionId -> LevelId -> State -> Bool-inMelee !fid !lid s =+inMelee :: ActorMaxSkills -> FactionId -> LevelId -> State -> Bool+inMelee !actorMaxSkills !fid !lid s =   let fact = sfactionD s EM.! fid-      f !b = blid b == lid-             && inline isFoe fid fact (bfid b)  -- costly-             && bhp b > 0  -- uncommon-      allFoes = filter f $ EM.elems $ sactorD s-      g !b = bfid b == fid-             && blid b == lid-             && not (bproj b)-             && bhp b > 0-      allOurs = filter g $ EM.elems $ sactorD s+      f (!aid, !b) =+        blid b == lid+        && not (bproj b)+        && inline isFoe fid fact (bfid b)  -- costly+        && actorWorthKilling actorMaxSkills aid b+      allFoes = filter f $ EM.assocs $ sactorD s+      g (!aid, !b) = bfid b == fid+                     && blid b == lid+                     && not (bproj b)+                     && bhp b > 0+                     && let actorMaxSk = actorMaxSkills EM.! aid+                        in Ability.getSk Ability.SkMove actorMaxSk > 0+                           || actorCanMeleeToHarm actorMaxSkills aid b+      allOurs = filter g $ EM.assocs $ sactorD s       -- We assume foes are less numerous, even though they may come       -- from multiple factions and they contain projectiles,       -- because we see all our actors, while many foes may be hidden.@@ -505,6 +497,7 @@       -- thus increasing allocation a bit, but not by much, because       -- the set should be rather saturated.       -- If there are no foes in sight, we don't iterate at all.-      setFoeVicinity = ES.fromList $ concatMap (vicinityUnsafe . bpos) allFoes+      setFoeVicinity =+        ES.fromList $ concatMap (vicinityUnsafe . bpos . snd) allFoes   in not (ES.null setFoeVicinity)  -- shortcut-     && any (\b -> bpos b `ES.member` setFoeVicinity) allOurs+     && any (\(_, b) -> bpos b `ES.member` setFoeVicinity) allOurs

+ engine-src/Game/LambdaHack/Common/ClientOptions.hs view

@@ -0,0 +1,105 @@+{-# LANGUAGE DeriveGeneric #-}+-- | Options that affect the behaviour of the client.+module Game.LambdaHack.Common.ClientOptions+  ( FullscreenMode(..), ClientOptions(..), defClientOptions+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import Control.DeepSeq+import Data.Binary+import GHC.Generics (Generic)++import Game.LambdaHack.Common.Misc++-- | Kinds of fullscreen or windowed mode. See <https://hackage.haskell.org/package/sdl2-2.5.3.0/docs/SDL-Video.html#t:WindowMode>.+data FullscreenMode =+    NotFullscreen        -- ^ a normal window instead of fullscreen+  | BigBorderlessWindow  -- ^ fake fullscreen; window the size of the desktop;+                         --   this is the preferred one, if it works+  | ModeChange           -- ^ real fullscreen with a video mode change+  deriving (Show, Read, Eq, Generic)++instance NFData FullscreenMode++instance Binary FullscreenMode++-- | Options that affect the behaviour of the client (but not game rules).+data ClientOptions = ClientOptions+  { schosenFontset    :: Maybe Text+      -- ^ Font set chosen by the player for the whole UI.+  , sallFontsScale    :: Maybe Double+      -- ^ The scale applied to all fonts, resizing the whole UI.+  , sfonts            :: [(Text, FontDefinition)]+      -- ^ Available fonts as defined in config file.+  , sfontsets         :: [(Text, FontSet)]+      -- ^ Available font sets as defined in config file.+  , sfullscreenMode   :: Maybe FullscreenMode+      -- ^ Whether to start in fullscreen mode and in which one.+  , slogPriority      :: Maybe Int+      -- ^ How much to log (e.g., from SDL). 1 is all, 5 is errors, the default.+  , smaxFps           :: Maybe Double+      -- ^ Maximal frames per second.+      -- This is better low and fixed, to avoid jerkiness and delays+      -- that tell the player there are many intelligent enemies on the level.+      -- That's better than scaling AI sofistication down based+      -- on the FPS setting and machine speed.+  , sdisableAutoYes   :: Bool+      -- ^ Never auto-answer all prompts, even if under AI control.+  , snoAnim           :: Maybe Bool+      -- ^ Don't show any animations.+  , snewGameCli       :: Bool+      -- ^ Start a new game, overwriting the save file.+  , sbenchmark        :: Bool+      -- ^ Don't create directories and files and show time stats.+  , stitle            :: Maybe String+  , ssavePrefixCli    :: String+      -- ^ Prefix of the save game file name.+  , sfrontendTeletype :: Bool+      -- ^ Whether to use the stdout/stdin frontend.+  , sfrontendNull     :: Bool+      -- ^ Whether to use null (no input/output) frontend.+  , sfrontendLazy     :: Bool+      -- ^ Whether to use lazy (output not even calculated) frontend.+  , sdbgMsgCli        :: Bool+      -- ^ Show clients' internal debug messages.+  , sstopAfterSeconds :: Maybe Int+  , sstopAfterFrames  :: Maybe Int+  , sprintEachScreen  :: Bool+  , sexposePlaces     :: Bool+  , sexposeItems      :: Bool+  , sexposeActors     :: Bool+  }+  deriving (Show, Eq, Generic)++instance Binary ClientOptions++-- | Default value of client options.+defClientOptions :: ClientOptions+defClientOptions = ClientOptions+  { schosenFontset = Nothing+  , sallFontsScale = Nothing+  , sfonts = []+  , sfontsets = []+  , sfullscreenMode = Nothing+  , slogPriority = Nothing+  , smaxFps = Nothing+  , sdisableAutoYes = False+  , snoAnim = Nothing+  , snewGameCli = False+  , sbenchmark = False+  , stitle = Nothing+  , ssavePrefixCli = ""+  , sfrontendTeletype = False+  , sfrontendNull = False+  , sfrontendLazy = False+  , sdbgMsgCli = False+  , sstopAfterSeconds = Nothing+  , sstopAfterFrames = Nothing+  , sprintEachScreen = False+  , sexposePlaces = False+  , sexposeItems = False+  , sexposeActors = False+  }

engine-src/Game/LambdaHack/Common/Faction.hs view

@@ -4,10 +4,10 @@ module Game.LambdaHack.Common.Faction   ( FactionDict, Faction(..), Diplomacy(..)   , Status(..), Challenge(..)-  , gleader, isHorrorFact, noRunWithMulti, isAIFact, autoDungeonLevel-  , automatePlayer, isFoe, isFriend+  , tshowChallenge, gleader, isHorrorFact, noRunWithMulti, isAIFact+  , autoDungeonLevel, automatePlayer, isFoe, isFriend   , difficultyBound, difficultyDefault, difficultyCoeff, difficultyInverse-  , defaultChallenge, possibleActorFactions+  , defaultChallenge, possibleActorFactions, ppContainer #ifdef EXPOSE_INTERNAL     -- * Internal operations   , Dipl@@ -21,9 +21,10 @@ import           Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.IntMap.Strict as IM+import qualified Data.Text as T import           GHC.Generics (Generic) -import           Game.LambdaHack.Common.Item+import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK@@ -40,12 +41,17 @@   { gname     :: Text            -- ^ individual name   , gcolor    :: Color.Color     -- ^ color of actors or their frames   , gplayer   :: Player          -- ^ the player spec for this faction+  , gteamCont :: Maybe TeamContinuity+                                 -- ^ identity of this faction across games+                                 --   and scenarios   , ginitial  :: [(Int, Int, GroupName ItemKind)]  -- ^ initial actors   , gdipl     :: Dipl            -- ^ diplomatic standing   , gquit     :: Maybe Status    -- ^ cause of game end/exit   , _gleader  :: Maybe ActorId   -- ^ the leader of the faction; don't use                                  --   in place of sleader on clients-  , gsha      :: ItemBag         -- ^ faction's shared inventory+  , gstash    :: Maybe (LevelId, Point)+                                 -- ^ level and position of faction's+                                 --   shared inventory stash   , gvictims  :: EM.EnumMap (ContentId ItemKind) Int  -- ^ members killed   , gvictimsD :: EM.EnumMap (ContentId ModeKind)                             (IM.IntMap (EM.EnumMap (ContentId ItemKind) Int))@@ -61,7 +67,7 @@   | Neutral   | Alliance   | War-  deriving (Show, Eq, Ord, Enum, Generic)+  deriving (Show, Eq, Enum, Generic)  instance Binary Diplomacy @@ -78,15 +84,30 @@  instance Binary Status +-- | The difficulty level influencess HP of either the human player or the AI.+-- The challenges restrict some abilities of the human player only. data Challenge = Challenge-  { cdiff :: Int   -- ^ game difficulty level (HP bonus or malus)-  , cwolf :: Bool  -- ^ lone wolf challenge (only one starting character)-  , cfish :: Bool  -- ^ cold fish challenge (no healing from enemies)+  { cdiff   :: Int   -- ^ game difficulty level (HP bonus or malus)+  , cfish   :: Bool  -- ^ cold fish challenge (no healing from enemies)+  , cgoods  :: Bool  -- ^ ready goods challenge (crafting disabled)+  , cwolf   :: Bool  -- ^ lone wolf challenge (only one starting character)+  , ckeeper :: Bool  -- ^ finder keeper challenge (ranged attacks disabled)   }   deriving (Show, Eq, Ord, Generic)  instance Binary Challenge +tshowChallenge :: Challenge -> Text+tshowChallenge Challenge{..} =+  "("+  <> T.intercalate ", "+    (["difficulty" <+> tshow cdiff | cdiff /= difficultyDefault]+     ++ ["cold fish" | cfish]+     ++ ["ready goods" | cgoods]+     ++ ["lone wolf" | cwolf]+     ++ ["finder keeper" | ckeeper])+  <> ")"+ gleader :: Faction -> Maybe ActorId gleader = _gleader @@ -98,7 +119,7 @@ -- In every game, either all factions for which summoning items exist -- should be present or a horror player should be added to host them. isHorrorFact :: Faction -> Bool-isHorrorFact fact = horrorGroup `elem` fgroups (gplayer fact)+isHorrorFact fact = IK.HORROR `elem` fgroups (gplayer fact)  -- A faction where other actors move at once or where some of leader change -- is automatic can't run with multiple actors at once. That would be@@ -168,8 +189,10 @@  defaultChallenge :: Challenge defaultChallenge = Challenge { cdiff = difficultyDefault+                             , cfish = False+                             , cgoods = False                              , cwolf = False-                             , cfish = False }+                             , ckeeper = False }  possibleActorFactions :: ItemKind -> FactionDict -> [(FactionId, Faction)] possibleActorFactions itemKind factionD =@@ -179,3 +202,16 @@   in if null fidFactsRaw      then filter (isHorrorFact . snd) $ EM.assocs factionD  -- fall back      else fidFactsRaw++ppContainer :: FactionDict -> Container -> Text+ppContainer factionD (CFloor lid p) =+  let f fact = case gstash fact of+        Just (slid, sp) | slid == lid && sp == p -> Just $ gname fact+        _ -> Nothing+  in case mapMaybe f $ EM.elems factionD of+    [] -> "nearby"+    [t] -> "in the shared inventory stash of" <+> t+    _ -> "in a shared zone of interests"+ppContainer _ CEmbed{} = "embedded nearby"+ppContainer _ (CActor _ cstore) = ppCStoreIn cstore+ppContainer _ c@CTrunk{} = error $ "" `showFailure` c

engine-src/Game/LambdaHack/Common/HighScore.hs view

@@ -2,7 +2,8 @@ -- | High score table operations. module Game.LambdaHack.Common.HighScore   ( ScoreTable, ScoreDict-  , empty, register, showScore, showAward, getTable, unTable, getRecord+  , empty, register, showScore, showAward+  , getTable, unTable, getRecord, getStatus, getDate #ifdef EXPOSE_INTERNAL     -- * Internal operations   , ScoreRecord, insertPos@@ -25,8 +26,7 @@ import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Time import Game.LambdaHack.Content.ItemKind (ItemKind)-import Game.LambdaHack.Content.ModeKind (HiCondPoly, HiIndeterminant (..),-                                         ModeKind, Outcome (..))+import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Definition.Defs  -- | A single score record. Records are ordered in the highscore table,@@ -41,7 +41,7 @@   , ourVictims   :: EM.EnumMap (ContentId ItemKind) Int  -- ^ allies lost   , theirVictims :: EM.EnumMap (ContentId ItemKind) Int  -- ^ foes killed   }-  deriving (Show, Eq, Ord, Generic)+  deriving (Eq, Ord, Generic)  instance Binary ScoreRecord @@ -82,19 +82,19 @@          -> (Bool, (ScoreTable, Int)) register table total dungeonTotal time status@Status{stOutcome}          date challenge gplayerName ourVictims theirVictims hiCondPoly =-  let turnsSpent = fromIntegral $ timeFitUp time timeTurn+  let turnsSpent = intToDouble $ timeFitUp time timeTurn       hiInValue (hi, c) = assert (total <= dungeonTotal) $ case hi of         HiConst -> c         HiLoot | dungeonTotal == 0 -> c  -- a fluke; no gold generated-        HiLoot -> c * fromIntegral total / fromIntegral dungeonTotal+        HiLoot -> c * intToDouble total / intToDouble dungeonTotal         HiSprint -> -- Up to -c turns matter.                     max 0 (-c - turnsSpent)         HiBlitz -> -- Up to 1000000/-c turns matter.                    sqrt $ max 0 (1000000 + c * turnsSpent)         HiSurvival -> -- Up to 1000000/c turns matter.                       sqrt $ max 0 (min 1000000 $ c * turnsSpent)-        HiKill -> c * fromIntegral (sum (EM.elems theirVictims))-        HiLoss -> c * fromIntegral (sum (EM.elems ourVictims))+        HiKill -> c * intToDouble (sum (EM.elems theirVictims))+        HiLoss -> c * intToDouble (sum (EM.elems ourVictims))       hiPolynomialValue = sum . map hiInValue       hiSummandValue (hiPoly, outcomes) =         if stOutcome `elem` outcomes@@ -102,7 +102,7 @@         else 0       hiCondValue = sum . map hiSummandValue       -- Other challenges than HP difficulty are not reflected in score.-      points = (ceiling :: Double -> Int)+      points = ceiling                $ hiCondValue hiCondPoly                  * 1.5 ^^ (- (difficultyCoeff (cdiff challenge)))       negTime = absoluteTimeNegate time@@ -113,13 +113,9 @@ showScore :: TimeZone -> Int -> ScoreRecord -> [Text] showScore tz pos score =   let Status{stOutcome, stDepth} = status score-      died = case stOutcome of-        Killed   -> "perished on level" <+> tshow (abs stDepth)-        Defeated -> "got defeated"-        Camping  -> "set camp"-        Conquer  -> "slew all opposition"-        Escape   -> "emerged victorious"-        Restart  -> "resigned prematurely"+      died = nameOutcomePast stOutcome <+> case stOutcome of+        Killed -> "on level" <+> tshow (abs stDepth)+        _ -> ""       curDate = T.take 19 . tshow . utcToLocalTime tz                 . posixSecondsToUTCTime . date $ score       turns = absoluteTimeNegate (negTime score) `timeFitUp` timeTurn@@ -128,14 +124,15 @@       victims = let nkilled = sum $ EM.elems $ theirVictims score                     nlost = sum $ EM.elems $ ourVictims score                 in "killed" <+> tshow nkilled <> ", lost" <+> tshow nlost-      diff = cdiff $ challenge score-      diffText | diff == difficultyDefault = ""-               | otherwise = "difficulty" <+> tshow diff <> ", "+      -- This may overfill the screen line, but with default fonts+      -- it's very unlikely and not a big problem in any case.+      chalText | challenge score == defaultChallenge = ""+               | otherwise = tshowChallenge (challenge score)       tturns = makePhrase [MU.CarWs turns "turn"]   in [ tpos <> "." <+> tscore <+> gplayerName score        <+> died <> "," <+> victims <> ","-     , "            "-       <> diffText <> "after" <+> tturns <+> "on" <+> curDate <> "."+     , "           "+       <> "after" <+> tturns <+> chalText <+> "on" <+> curDate <> "."      ]  getTable :: ContentId ModeKind -> ScoreDict -> ScoreTable@@ -143,8 +140,14 @@  getRecord :: Int -> ScoreTable -> ScoreRecord getRecord pos (ScoreTable table) =-  fromMaybe (error $ "" `showFailure` (pos, table))+  fromMaybe (error $ "" `showFailure` pos)   $ listToMaybe $ drop (pred pos) table++getStatus :: ScoreRecord -> Status+getStatus = status++getDate :: ScoreRecord -> POSIXTime+getDate = date  showAward :: Int        -- ^ number of (3-line) scores to be shown           -> ScoreTable -- ^ current score table

engine-src/Game/LambdaHack/Common/Item.hs view

@@ -4,13 +4,16 @@   ( Item(..), ItemIdentity(..)   , ItemKindIx, ItemDisco(..), ItemFull(..), ItemFullKit   , DiscoveryKind, DiscoveryAspect, ItemIxMap, Benefit(..), DiscoveryBenefit-  , ItemTimer, ItemQuant, ItemBag, ItemDict-  , itemToFull6, aspectRecordFull, strongestSlot, ncharges, hasCharge+  , ItemTimer, ItemTimers, ItemQuant, ItemBag, ItemDict+  , toItemKindIx, quantSingle, itemToFull6, aspectRecordFull, strongestSlot+  , itemTimerZero, createItemTimer, shiftItemTimer+  , deltaOfItemTimer, charging, ncharges, hasCharge   , strongestMelee, unknownMeleeBonus, unknownSpeedBonus   , conditionMeleeBonus, conditionSpeedBonus, armorHurtCalculation+  , mergeItemQuant, listToolsToConsume, subtractIidfromGrps #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , valueAtEqpSlot, unknownAspect+  , valueAtEqpSlot, unknownAspect, countIidConsumed #endif   ) where @@ -23,7 +26,6 @@ import qualified Data.EnumSet as ES import           Data.Hashable (Hashable) import qualified Data.Ix as Ix-import qualified Data.Ord as Ord import           GHC.Generics (Generic)  import qualified Game.LambdaHack.Common.ItemAspect as IA@@ -58,8 +60,6 @@   }   deriving (Show, Eq, Generic) -instance Hashable Item- instance Binary Item  -- | Either the explicit obvious kind of the item or the kind it's hidden under,@@ -73,7 +73,7 @@  instance Binary ItemIdentity --- | The map of item ids to item aspect reocrd. The full map is known+-- | The map of item ids to item aspect record. The full map is known -- by the server. type DiscoveryAspect = EM.EnumMap ItemId IA.AspectRecord @@ -91,7 +91,7 @@ data ItemDisco =     ItemDiscoFull IA.AspectRecord   | ItemDiscoMean IA.KindMean- deriving (Show, Eq, Ord)+ deriving (Show, Ord, Eq)  -- No speedup from making fields non-strict. -- | Full information about an item.@@ -119,7 +119,7 @@ type ItemIxMap = EM.EnumMap ItemKindIx (ES.EnumSet ItemId)  -- | The fields are, in order:--- 1. whether the item should be kept in equipment (not in pack nor stash)+-- 1. whether the item should be kept in equipment (not in stash) -- 2. the total benefit from picking the item up (to use or to put in equipment) -- 3. the benefit of applying the item to self -- 4. the (usually negative, for him) value of hitting a foe in melee with it@@ -137,21 +137,45 @@  type DiscoveryBenefit = EM.EnumMap ItemId Benefit -type ItemTimer = [Time]+-- | The absolute level's local time at which an item's copy becomes+-- operational again. Even if item is not identified and so its timeout+-- unknown, it's enough to compare this to the local level time+-- to learn whether an item is recharged.+--+-- This schema causes timeout jumps for items in stash, but timeout+-- is reset when items move, so this is a minor problem.+-- Global time can't be used even only for items in stash,+-- or exploit would be possible when an actor on a desolate level waits+-- to recharge items for actors on a busy level. It's probably+-- impossible to avoid such exploits or, otherwise, timeout jumps,+-- particularly for faction where many actors move on many levels+-- and so an item in stash is not used by a single actor at a time.+newtype ItemTimer = ItemTimer {itemTimer :: Time}+  deriving (Show, Eq, Binary) +type ItemTimers = [ItemTimer]+ -- | Number of items in a bag, together with recharging timer, in case of -- items that need recharging, exists only temporarily or auto-activate--- at regular intervals.-type ItemQuant = (Int, ItemTimer)+-- at regular intervals. Data invariant: the length of the timer+-- should be less or equal to the number of items.+type ItemQuant = (Int, ItemTimers)  -- | A bag of items, e.g., one of the stores of an actor or the items -- on a particular floor position or embedded in a particular map tile. type ItemBag = EM.EnumMap ItemId ItemQuant --- | All items in the dungeon (including in actor inventories),+-- | All items in the dungeon (including those carried by actors), -- indexed by item identifier. type ItemDict = EM.EnumMap ItemId Item +toItemKindIx :: Word16 -> ItemKindIx+{-# INLINE toItemKindIx #-}+toItemKindIx = ItemKindIx++quantSingle :: ItemQuant+quantSingle = (1, [])+ itemToFull6 :: COps -> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item             -> ItemFull itemToFull6 COps{coitem, coItemSpeedup} discoKind discoAspect iid itemBase =@@ -176,7 +200,7 @@     ItemDiscoFull itemAspect -> itemAspect     ItemDiscoMean itemAspectMean -> IA.kmMean itemAspectMean --- This ignores items that don't go into equipment, as determined in @inEqp@.+-- This ignores items that don't go into equipment, as determined in @benInEqp@. -- They are removed from equipment elsewhere via @harmful@. strongestSlot :: DiscoveryBenefit -> Ability.EqpSlot -> [(ItemId, ItemFullKit)]               -> [(Int, (ItemId, ItemFullKit))]@@ -199,8 +223,14 @@                        -- The backup is ready in the slot above, after all.                        ceiling (- benMelee)                    _ -> valueAtEqpSlot eqpSlot $ aspectRecordFull itemFull-             in (ben, (iid, (itemFull, kit)))-  in sortBy (flip $ Ord.comparing fst) $ mapMaybe f is+                 idBonus = if itemSuspect itemFull then 1000 else 0+                 arItem = aspectRecordFull itemFull+                 -- Equip good uniques for flavour and fun from unique effects.+                 uniqueBonus = if IA.checkFlag Ability.Unique arItem && ben > 20+                               then 1000+                               else 0+             in (ben + idBonus + uniqueBonus, (iid, (itemFull, kit)))+  in sortBy (flip $ comparing fst) $ mapMaybe f is  valueAtEqpSlot :: EqpSlot -> IA.AspectRecord -> Int valueAtEqpSlot eqpSlot arItem@IA.AspectRecord{..} =@@ -231,57 +261,77 @@     EqpSlotWeaponFast -> error $ "" `showFailure` arItem  -- sum of all benefits     EqpSlotWeaponBig -> error $ "" `showFailure` arItem  -- sum of all benefits -ncharges :: Time -> ItemFull -> ItemQuant -> Int-ncharges localTime itemFull (itemK, itemTimer) =-  let timeout = IA.aTimeout $ aspectRecordFull itemFull-      timeoutTurns = timeDeltaScale (Delta timeTurn) timeout-      charging startT = timeShift startT timeoutTurns > localTime-      it1 = filter charging itemTimer-  in itemK - length it1+itemTimerZero :: ItemTimer+itemTimerZero = ItemTimer timeZero -hasCharge :: Time -> ItemFull -> ItemQuant -> Bool-hasCharge localTime itemFull (itemK, itemTimer) =-  ncharges localTime itemFull (itemK, itemTimer) > 0+createItemTimer :: Time -> Delta Time -> ItemTimer+createItemTimer localTime delta = ItemTimer $ localTime `timeShift` delta +shiftItemTimer :: Delta Time -> ItemTimer -> ItemTimer+shiftItemTimer delta t = ItemTimer $ itemTimer t `timeShift` delta++deltaOfItemTimer :: Time -> ItemTimer -> Delta Time+deltaOfItemTimer localTime t = timeDeltaToFrom (itemTimer t) localTime++charging :: Time -> ItemTimer -> Bool+charging localTime = (> localTime) . itemTimer++ncharges :: Time -> ItemQuant -> Int+ncharges localTime (itemK, itemTimers) =+  itemK - length (filter (charging localTime) itemTimers)++hasCharge :: Time -> ItemQuant -> Bool+hasCharge localTime kit = ncharges localTime kit > 0+ strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time                -> [(ItemId, ItemFullKit)]-               -> [(Double, (Int, (ItemId, ItemFullKit)))]+               -> [(Double, Bool, Int, Int, ItemId, ItemFullKit)] strongestMelee _ _ _ [] = [] strongestMelee ignoreCharges mdiscoBenefit localTime kitAss =   -- For fighting, as opposed to equipping, we value weapon only for   -- its raw damage and harming effects and at this very moment only,   -- not in the future. Hehce, we exclude discharged weapons.-  let f (iid, (itemFull, kit)) =+  let f (iid, ifk@(itemFull, kit)) =         let rawDmg = IK.damageUsefulness $ itemKind itemFull-            knownOrConstantAspects = case itemDisco itemFull of-              ItemDiscoMean IA.KindMean{kmConst} -> kmConst-              ItemDiscoFull{} -> True-            unIDedBonus | knownOrConstantAspects-                          || isNothing mdiscoBenefit = 0-                        | otherwise = 1000  -- == exceptionally strong weapon+            unIDedBonus = if itemSuspect itemFull then 1000 else 0             totalValue = case mdiscoBenefit of               Just discoBenefit ->                 let Benefit{benMelee} = discoBenefit EM.! iid-                in - benMelee + unIDedBonus-              Nothing -> rawDmg  -- special case: not interested about ID-            ncha = ncharges localTime itemFull kit-        in ( if ignoreCharges || ncha > 0-             then totalValue-             else -100000-           , (ncha, (iid, (itemFull, kit))) )+                in benMelee - unIDedBonus+              Nothing -> - rawDmg  -- special case: not interested about ID+            arItem = aspectRecordFull itemFull+            timeout = IA.aTimeout arItem+            -- This is crucial for weapons for which AI is too silly+            -- to value the effects at more than 0, even though they are strong+            -- and also to prefer weapons with burn or wound over pure damage,+            -- which is a good rule of thumb before late game at least.+            hasEffect = any (\eff -> IK.forApplyEffect eff)+                            (IK.ieffects $ itemKind itemFull)+            ncha = ncharges localTime kit+        in if ignoreCharges || ncha > 0+           then Just (totalValue, hasEffect, timeout, ncha, iid, ifk)+           else Nothing   -- We can't filter out weapons that are not harmful to victim   -- (@benMelee >= 0), because actors use them if nothing else available,   -- e.g., geysers, bees. This is intended and fun.-  in sortBy (flip $ Ord.comparing fst)-     $ filter ((> -100000) . fst) $ map f kitAss+  in sortOn (\(value, hasEffect, timeout, _, _, (itemFull, _)) ->+                -- Weapon with higher timeout activated first to increase+                -- the chance of using it again during this fight.+                -- No timeout is ever better, because no wait incurred.+                -- Optimal packing problem: start with the biggest.+                let timN = if timeout == 0 then -99999 else - timeout+                in (value, not hasEffect, timN, itemKindId itemFull))+            (mapMaybe f kitAss)  unknownAspect :: (IK.Aspect -> [Dice.Dice]) -> ItemFull -> Bool-unknownAspect f ItemFull{itemKind=IK.ItemKind{iaspects}, ..} =+unknownAspect f itemFull@ItemFull{itemKind=IK.ItemKind{iaspects}, ..} =   case itemDisco of     ItemDiscoMean IA.KindMean{kmConst} ->-      let unknown x = let (minD, maxD) = Dice.infsupDice x+      let arItem = aspectRecordFull itemFull+          unknown x = let (minD, maxD) = Dice.infsupDice x                       in minD /= maxD-      in itemSuspect || not kmConst && or (concatMap (map unknown . f) iaspects)+      in itemSuspect && not (IA.checkFlag Ability.MinorAspects arItem)+         || not kmConst && or (concatMap (map unknown . f) iaspects)     ItemDiscoFull{} -> False  -- all known  -- We assume @SkHurtMelee@ never appears inside @Odds@. If it does,@@ -320,6 +370,13 @@            else k   in foldr f 0 kitAss +-- | Damage calculation. The armor and hurt skills are additive.+-- They can't be multiplicative, because then 100% armor would minimize+-- damage regardless of even 200% hurt skill.+-- However, additive skills make the relative effectiveness of weapons+-- dependent on the enemy, so even with -100% hurt skill a kinetic weapon+-- can't be removed from the list, because an enemy may have+-- negative armor skill. This is bad, but also KISS. armorHurtCalculation :: Bool -> Ability.Skills -> Ability.Skills -> Int armorHurtCalculation proj sMaxSk tMaxSk =   let trim200 n = min 200 $ max (-200) n@@ -328,4 +385,71 @@         - if proj           then trim200 (Ability.getSk Ability.SkArmorRanged tMaxSk)           else trim200 (Ability.getSk Ability.SkArmorMelee tMaxSk)-  in 100 + min 99 (max (-99) itemBonus)  -- at least 1% of damage gets through+  in 100 + max (-95) itemBonus  -- at least 5% of damage gets through++mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant+mergeItemQuant (k2, it2) (k1, it1) = (k1 + k2, it1 ++ it2)++listToolsToConsume :: [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]+                   -> [((CStore, Bool), (ItemId, ItemFullKit))]+listToolsToConsume kitAssG kitAssE =+  let isDurable = IA.checkFlag Ability.Durable+                  . aspectRecordFull . fst . snd+      (kitAssGT, kitAssGF) = partition isDurable kitAssG+      (kitAssET, kitAssEF) = partition isDurable kitAssE+      -- Non-durable tools take precedence, because durable+      -- are applied and, usually being weapons,+      -- may be harmful or may have unintended effects.+      -- CGround takes precedence, too.+  in zip (repeat (CGround, False)) kitAssGF+     ++ zip (repeat (CEqp, False)) kitAssEF+     ++ zip (repeat (CGround, True)) kitAssGT+     ++ zip (repeat (CEqp, True)) kitAssET++countIidConsumed :: ItemFullKit+                 -> [(Bool, Int, GroupName IK.ItemKind)]+                 -> (Int, Int, [(Bool, Int, GroupName IK.ItemKind)])+countIidConsumed (ItemFull{itemKind}, (k, _)) grps0 =+  let hasGroup grp =+        maybe False (> 0) $ lookup grp $ IK.ifreq itemKind+      matchGroup (nToApplyIfDurable, nToDestroyAlways, grps)+                 (destroyAlways, n, grp) =+        if hasGroup grp+        then let mkn = min k n  -- even if durable, use each copy only once+                 grps2 = if n - mkn > 0+                         then (destroyAlways, n - mkn, grp) : grps+                         else grps+             in if destroyAlways+                then ( nToApplyIfDurable+                     , max nToDestroyAlways mkn+                     , grps2 )+                else ( max nToApplyIfDurable mkn+                     , nToDestroyAlways+                     , grps2 )+        else ( nToApplyIfDurable+             , nToDestroyAlways+             , (destroyAlways, n, grp) : grps )+  in foldl' matchGroup (0, 0, []) grps0++subtractIidfromGrps :: ( EM.EnumMap CStore ItemBag+                       , [(CStore, (ItemId, ItemFull))]+                       , [(Bool, Int, GroupName IK.ItemKind)] )+                    -> ((CStore, Bool), (ItemId, ItemFullKit))+                    -> ( EM.EnumMap CStore ItemBag+                       , [(CStore, (ItemId, ItemFull))]+                       , [(Bool, Int, GroupName IK.ItemKind)] )+subtractIidfromGrps (bagsToLose1, iidsToApply1, grps1)+                    ((store, durable), (iid, itemFullKit@(itemFull, (_, it)))) =+  let (nToApplyIfDurable, nToDestroyAlways, grps2) =+        countIidConsumed itemFullKit grps1+      (nToApply, nToDestroy) = if durable+                               then (nToApplyIfDurable, nToDestroyAlways)+                               else (0, max nToApplyIfDurable nToDestroyAlways)+  in ( if nToDestroy == 0+       then bagsToLose1  -- avoid vacuus @UpdDestroyItem@+       else let kit2 = (nToDestroy, take nToDestroy it)+                removedBags = EM.singleton store $ EM.singleton iid kit2+            in EM.unionWith (EM.unionWith mergeItemQuant)+                            removedBags bagsToLose1+     , replicate nToApply (store, (iid, itemFull)) ++ iidsToApply1+     , grps2 )

engine-src/Game/LambdaHack/Common/ItemAspect.hs view

@@ -5,7 +5,7 @@   , emptyAspectRecord, addMeanAspect, castAspect, aspectsRandom   , aspectRecordToList, rollAspectRecord, getSkill, checkFlag, meanAspect   , onlyMinorEffects, itemTrajectory, totalRange, isHumanTrinket-  , goesIntoEqp, goesIntoInv, goesIntoSha, loreFromMode, loreFromContainer+  , goesIntoEqp, loreFromMode, loreFromContainer #ifdef EXPOSE_INTERNAL     -- * Internal operations   , ceilingMeanDice@@ -22,14 +22,14 @@ import           Data.Hashable (Hashable) import qualified Data.Text as T import           GHC.Generics (Generic)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM +import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs@@ -37,13 +37,13 @@ -- | Record of skills conferred by an item as well as of item flags -- and other item aspects. data AspectRecord = AspectRecord-  { aTimeout :: Int-  , aSkills  :: Ability.Skills-  , aFlags   :: Ability.Flags-  , aELabel  :: Text-  , aToThrow :: IK.ThrowMod-  , aHideAs  :: Maybe (GroupName IK.ItemKind)-  , aEqpSlot :: Maybe Ability.EqpSlot+  { aTimeout   :: Int+  , aSkills    :: Ability.Skills+  , aFlags     :: Ability.Flags+  , aELabel    :: Text+  , aToThrow   :: IK.ThrowMod+  , aPresentAs :: Maybe (GroupName IK.ItemKind)+  , aEqpSlot   :: Maybe Ability.EqpSlot   }   deriving (Show, Eq, Ord, Generic) @@ -59,16 +59,16 @@   { kmConst :: Bool  -- ^ whether the item doesn't need second identification   , kmMean  :: AspectRecord  -- ^ mean value of item's possible aspect records   }-  deriving (Show, Eq, Ord, Generic)+  deriving (Show, Eq, Ord)  emptyAspectRecord :: AspectRecord emptyAspectRecord = AspectRecord   { aTimeout = 0-  , aSkills  = Ability.zeroSkills-  , aFlags   = Ability.Flags ES.empty-  , aELabel  = ""+  , aSkills = Ability.zeroSkills+  , aFlags = Ability.Flags ES.empty+  , aELabel = ""   , aToThrow = IK.ThrowMod 100 100 1-  , aHideAs  = Nothing+  , aPresentAs = Nothing   , aEqpSlot = Nothing   } @@ -89,7 +89,7 @@                              $ ES.insert feat (Ability.flags $ aFlags ar)}     IK.ELabel t -> return $! ar {aELabel = t}     IK.ToThrow tt -> return $! ar {aToThrow = tt}-    IK.HideAs ha -> return $! ar {aHideAs = Just ha}+    IK.PresentAs ha -> return $! ar {aPresentAs = Just ha}     IK.EqpSlot slot -> return $! ar {aEqpSlot = Just slot}     IK.Odds d aspects1 aspects2 -> do       pick1 <- oddsDice ldepth totalDepth d@@ -103,7 +103,7 @@   let rollM depth =         foldlM' (castAspect (Dice.AbsDepth depth) (Dice.AbsDepth 10))                 emptyAspectRecord ass-      gen = R.mkStdGen 0+      gen = SM.mkSMGen 0       (ar0, gen0) = St.runState (rollM 0) gen       (ar1, gen1) = St.runState (rollM 10) gen0   in show gen /= show gen0 || show gen /= show gen1 || ar0 /= ar1@@ -123,7 +123,7 @@       ar {aFlags = Ability.Flags $ ES.insert feat (Ability.flags $ aFlags ar)}     IK.ELabel t -> ar {aELabel = t}     IK.ToThrow tt -> ar {aToThrow = tt}-    IK.HideAs ha -> ar {aHideAs = Just ha}+    IK.PresentAs ha -> ar {aPresentAs = Just ha}     IK.EqpSlot slot -> ar {aEqpSlot = Just slot}     IK.Odds{} -> ar  -- can't tell, especially since we don't know the level @@ -138,7 +138,7 @@   ++ [IK.SetFlag feat | feat <- ES.elems $ Ability.flags aFlags]   ++ [IK.ELabel aELabel | not $ T.null aELabel]   ++ [IK.ToThrow aToThrow | not $ aToThrow == IK.ThrowMod 100 100 1]-  ++ maybe [] (\ha -> [IK.HideAs ha]) aHideAs+  ++ maybe [] (\ha -> [IK.PresentAs ha]) aPresentAs   ++ maybe [] (\slot -> [IK.EqpSlot slot]) aEqpSlot  rollAspectRecord :: [IK.Aspect] -> Dice.AbsDepth -> Dice.AbsDepth@@ -168,7 +168,7 @@ onlyMinorEffects :: AspectRecord -> IK.ItemKind -> Bool onlyMinorEffects ar kind =   checkFlag Ability.MinorEffects ar  -- override-  || not (any (not . IK.onSmashEffect) $ IK.ieffects kind)+  || not (any (not . IK.alwaysDudEffect) $ IK.ieffects kind)        -- exhibits no major effects  itemTrajectory :: AspectRecord -> IK.ItemKind -> [Point]@@ -182,19 +182,13 @@  isHumanTrinket :: IK.ItemKind -> Bool isHumanTrinket itemKind =-  maybe False (> 0) $ lookup "valuable" $ IK.ifreq itemKind+  maybe False (> 0) $ lookup IK.VALUABLE $ IK.ifreq itemKind     -- risk from treasure hunters  goesIntoEqp :: AspectRecord -> Bool goesIntoEqp ar = checkFlag Ability.Equipable ar                  || checkFlag Ability.Meleeable ar -goesIntoInv :: AspectRecord -> Bool-goesIntoInv ar = not (checkFlag Ability.Precious ar) && not (goesIntoEqp ar)--goesIntoSha :: AspectRecord -> Bool-goesIntoSha ar = checkFlag Ability.Precious ar && not (goesIntoEqp ar)- loreFromMode :: ItemDialogMode -> SLore loreFromMode c = case c of   MStore COrgan -> SOrgan@@ -204,6 +198,7 @@   MSkills -> undefined  -- artificial slots   MLore slore -> slore   MPlaces -> undefined  -- artificial slots+  MModes -> undefined  -- artificial slots  loreFromContainer :: AspectRecord -> Container -> SLore loreFromContainer arItem c = case c of

engine-src/Game/LambdaHack/Common/JSFile.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE JavaScriptFFI #-} -- | Saving/loading to JS storeage, mimicking operations on files. module Game.LambdaHack.Common.JSFile   ( encodeEOF, strictDecodeEOF@@ -10,18 +11,24 @@  import           Data.Binary import qualified Data.ByteString.Lazy.Char8 as LBS-import qualified Data.Text as T import           Data.Text.Encoding (decodeLatin1) import           Data.Version++import qualified Data.JSString as JSString+import           Data.JSString.Text (textToJSString) import           GHCJS.DOM (currentWindow) import           GHCJS.DOM.Storage (getItem, removeItem, setItem)-import           GHCJS.DOM.Types (runDOM)+import           GHCJS.DOM.Types (JSString, runDOM) import           GHCJS.DOM.Window (getLocalStorage) --- | Serialize and save data with an EOF marker. In JS we don't have access--- to the zlib library, so we don't compress here. We treat the bytestring--- as Latin1 characters and so lose half of the storage space by ignoring--- the other half of the JS UTF16 characters, but in this way we ensure+foreign import javascript safe "$r = LZString.compressToUTF16($1);"+  compressToUTF16 :: JSString -> IO JSString++foreign import javascript safe "$r = LZString.decompressFromUTF16($1);"+  decompressFromUTF16 :: JSString -> IO JSString++-- | Serialize and save data with an EOF marker, compressing.+-- We treat the bytestring as Latin1 characters and so ensure -- we never run into illegal characters in the aribtrary binary data, -- unlike when treating it as UTF16 characters. This is also reasonably fast. -- The @OK@ is used as an EOF marker to ensure any apparent problems with@@ -30,21 +37,24 @@ encodeEOF path v b = flip runDOM undefined $ do   Just win <- currentWindow   storage <- getLocalStorage win-  setItem storage path $ decodeLatin1 $ LBS.toStrict-                       $ encode (v, (encode b, "OK" :: String))+  let t = decodeLatin1 $ LBS.toStrict $ encode (v, (encode b, "OK" :: String))+  item <- compressToUTF16 $ textToJSString t+  setItem storage path item  -- | Read and deserialize data with an EOF marker. -- The @OK@ EOF marker ensures any easily detectable file corruption -- is discovered and reported before any value is decoded from -- the second component. -- OTOH, binary encoding corruption is not discovered until a version--- check elswere ensures that binary formats are compatible.+-- check elsewhere ensures that binary formats are compatible. strictDecodeEOF :: Binary b => FilePath -> IO (Version, b) strictDecodeEOF path = flip runDOM undefined $ do   Just win <- currentWindow   storage <- getLocalStorage win   Just item <- getItem storage path-  let c1 = LBS.pack $ T.unpack item+  t <- decompressFromUTF16 item+  -- TODO: is @LBS.toLazy . encodeUtf8 . textFromJSString@ faster and correct?+  let c1 = LBS.pack $ JSString.unpack t       (v1, (c2, s)) = decode c1   return $! if s == ("OK" :: String)             then (v1, decode c2)

engine-src/Game/LambdaHack/Common/Kind.hs view

@@ -80,30 +80,35 @@ -- | A lot of tabulated maps from tile kind identifier to a property -- of the tile kind. data TileSpeedup = TileSpeedup-  { isClearTab         :: Tab Bool-  , isLitTab           :: Tab Bool-  , isWalkableTab      :: Tab Bool-  , isDoorTab          :: Tab Bool-  , isChangableTab     :: Tab Bool-  , isSuspectTab       :: Tab Bool-  , isHideAsTab        :: Tab Bool-  , consideredByAITab  :: Tab Bool-  , isVeryOftenItemTab :: Tab Bool-  , isCommonItemTab    :: Tab Bool-  , isOftenActorTab    :: Tab Bool-  , isNoItemTab        :: Tab Bool-  , isNoActorTab       :: Tab Bool-  , isEasyOpenTab      :: Tab Bool-  , isEmbedTab         :: Tab Bool-  , isAquaticTab       :: Tab Bool-  , alterMinSkillTab   :: Tab Word8-  , alterMinWalkTab    :: Tab Word8+  { isClearTab          :: Tab Bool+  , isLitTab            :: Tab Bool+  , isHideoutTab        :: Tab Bool+  , isWalkableTab       :: Tab Bool+  , isDoorTab           :: Tab Bool+  , isOpenableTab       :: Tab Bool+  , isClosableTab       :: Tab Bool+  , isChangableTab      :: Tab Bool+  , isModifiableWithTab :: Tab Bool+  , isSuspectTab        :: Tab Bool+  , isHideAsTab         :: Tab Bool+  , consideredByAITab   :: Tab Bool+  , isVeryOftenItemTab  :: Tab Bool+  , isCommonItemTab     :: Tab Bool+  , isOftenActorTab     :: Tab Bool+  , isNoItemTab         :: Tab Bool+  , isNoActorTab        :: Tab Bool+  , isEasyOpenTab       :: Tab Bool+  , isEmbedTab          :: Tab Bool+  , isAquaticTab        :: Tab Bool+  , alterMinSkillTab    :: Tab Word8+  , alterMinWalkTab     :: Tab Word8   }  -- Vectors of booleans can be slower than arrays, because they are not packed, -- but with growing cache sizes they may as well turn out faster at some point. -- The advantage of vectors are exposed internals, in particular unsafe -- indexing. Also, in JS, bool arrays are obviously not packed.+-- An option: https://github.com/Bodigrim/bitvec -- | A map morally indexed by @ContentId TileKind@. newtype Tab a = Tab (U.Vector a) @@ -111,7 +116,8 @@ emptyTileSpeedup = TileSpeedup emptyTab emptyTab emptyTab emptyTab emptyTab                                emptyTab emptyTab emptyTab emptyTab emptyTab                                emptyTab emptyTab emptyTab emptyTab emptyTab-                               emptyTab emptyTab emptyTab+                               emptyTab emptyTab emptyTab emptyTab emptyTab+                               emptyTab emptyTab  emptyTab :: U.Unbox a => Tab a emptyTab = Tab $! U.empty

engine-src/Game/LambdaHack/Common/Level.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies #-} -- | Inhabited dungeon levels and the operations to query and change them -- as the game progresses. module Game.LambdaHack.Common.Level@@ -12,13 +11,13 @@     -- * Level query   , at   , posToBigLvl, occupiedBigLvl, posToProjsLvl, occupiedProjLvl, posToAidsLvl-  , findPosTry, findPosTry2, nearbyFreePoints+  , findPosTry, findPosTry2, nearbyPassablePoints, nearbyFreePoints     -- * Misc   , sortEmbeds #ifdef EXPOSE_INTERNAL     -- * Internal operations   , EntryMap-  , nearbyPassablePoints, assertSparseItems, assertSparseProjectiles+  , assertSparseItems, assertSparseProjectiles #endif   ) where @@ -33,6 +32,8 @@ import           Game.LambdaHack.Common.Area import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Kind+import           Game.LambdaHack.Common.Point+import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types@@ -43,8 +44,6 @@ import           Game.LambdaHack.Content.RuleKind import           Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Core.Random import           Game.LambdaHack.Definition.Defs @@ -149,12 +148,19 @@   assert (EM.null (EM.filter EM.null m)           `blame` "null floors found" `swith` m) m +hashConsSingle :: ItemFloor -> ItemFloor+hashConsSingle m =+  EM.map (EM.map (\case+                    (1, []) -> quantSingle+                    kit -> kit)) m+ assertSparseProjectiles :: ProjectileMap -> ProjectileMap assertSparseProjectiles m =   assert (EM.null (EM.filter null m)           `blame` "null projectile lists found" `swith` m) m  updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level+{-# INLINE updateFloor #-}  -- just in case inliner goes hiwire updateFloor f lvl = lvl {lfloor = f (lfloor lvl)}  updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level@@ -164,6 +170,7 @@ updateBigMap f lvl = lvl {lbig = f (lbig lvl)}  updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level+{-# INLINE updateProjMap #-} updateProjMap f lvl = lvl {lproj = f (lproj lvl)}  updateTile :: (TileMap -> TileMap) -> Level -> Level@@ -239,7 +246,7 @@          where           search 0 = go tl           search !k = do-            pxyRelative <- randomR (0, xspan * yspan - 1)+            pxyRelative <- randomR0 (xspan * yspan - 1)             -- Here we can't use @fromEnum@ and/or work with the @Int@             -- representation, because the span is different than @rXmax@.             let Point{..} = punindex xspan pxyRelative@@ -261,7 +268,14 @@ nearbyPassablePoints :: COps -> Level -> Point -> [Point] nearbyPassablePoints cops@COps{corule=RuleContent{rXmax, rYmax}} lvl start =   let passable p = Tile.isEasyOpen (coTileSpeedup cops) (lvl `at` p)-      passableVic p = filter passable $ vicinityBounded rXmax rYmax p+      -- The error is mostly probably caused by place content creating+      -- enclosed spaces in conjunction with map edges. To verify,+      -- change the error to @l@ and run with the same seed.+      semiRandomWrap l = if null l then error "nearbyPassablePoints: blocked"+                         else let offset = fromEnum start `mod` length l+                              in drop offset l ++ take offset l+      passableVic p = semiRandomWrap $ filter passable+                      $ vicinityBounded rXmax rYmax p       siftSingle :: Point                  -> (ES.EnumSet Point, [Point])                  -> (ES.EnumSet Point, [Point])@@ -291,17 +305,17 @@                && null (posToAidsLvl p lvl)   in filter good $ nearbyPassablePoints cops lvl start --- We assume there are no stray embeds, not mentioned in the tile kind.+-- We ignore stray embeds, not mentioned in the tile kind. -- OTOH, some of those mentioned may be used up and so not in the bag -- and it's OK.-sortEmbeds :: COps -> (ItemId -> IK.ItemKind) -> ContentId TileKind -> ItemBag+sortEmbeds :: COps -> ContentId TileKind -> [(IK.ItemKind, (ItemId, ItemQuant))]            -> [(ItemId, ItemQuant)]-sortEmbeds COps{cotile} getKind tk embedBag =-  let itemKindList = map (\(iid, kit) -> (getKind iid, (iid, kit)))-                         (EM.assocs embedBag)-      grpList = Tile.embeddedItems cotile tk-      f grp (itemKind, _) = fromMaybe 0 (lookup grp $ IK.ifreq itemKind) > 0-  in map snd $ mapMaybe (\grp -> find (f grp) itemKindList) grpList+sortEmbeds COps{cotile} tk embedKindList =+  let grpList = Tile.embeddedItems cotile tk+      -- Greater or equal 0 to also cover template UNKNOWN items+      -- not yet identified by the client.+      f grp (itemKind, _) = fromMaybe (-1) (lookup grp $ IK.ifreq itemKind) >= 0+  in map snd $ mapMaybe (\grp -> find (f grp) embedKindList) grpList  instance Binary Level where   put Level{..} = do@@ -324,8 +338,8 @@   get = do     lkind <- get     ldepth <- get-    lfloor <- get-    lembed <- get+    lfloor <- hashConsSingle <$> get+    lembed <- hashConsSingle <$> get     lbig <- get     lproj <- get     ltile <- get

engine-src/Game/LambdaHack/Common/Misc.hs view

@@ -1,6 +1,8 @@+{-# LANGUAGE DeriveGeneric #-} -- | Hacks that haven't found their home yet. module Game.LambdaHack.Common.Misc-  ( makePhrase, makeSentence, squashedWWandW+  ( FontDefinition(..), HintingMode(..), FontSet(..)+  , makePhrase, makeSentence, squashedWWandW   , appDataDir   , xM, xD, minusM, minusM1, minusM2, oneM, tenthM   , show64With2@@ -12,14 +14,49 @@ import Game.LambdaHack.Core.Prelude  import           Control.Concurrent+import           Control.DeepSeq+import           Data.Binary import qualified Data.Char as Char import           Data.Int (Int64) import qualified Data.Map as M+import           GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU import           System.Directory (getAppUserDataDirectory) import           System.Environment (getProgName) import           System.IO.Unsafe (unsafePerformIO) +data FontDefinition =+    FontProportional Text Int HintingMode  -- ^ filename, size, hinting mode+  | FontMonospace Text Int HintingMode+  | FontMapScalable Text Int HintingMode Int  -- ^ extra cell extension+  | FontMapBitmap Text Int  -- ^ size ignored for bitmap fonts and no hinting+  deriving (Show, Eq, Read, Generic)++instance NFData FontDefinition++instance Binary FontDefinition++data HintingMode =+    HintingHeavy  -- ^ current libfreetype6 default, thin, large letter spacing+  | HintingLight  -- ^ mimics OTF, blurry, thick, tight tracking, accurate shape+  deriving (Show, Eq, Read, Generic)++instance NFData HintingMode++instance Binary HintingMode++data FontSet = FontSet+  { fontMapScalable :: Text+  , fontMapBitmap   :: Text+  , fontPropRegular :: Text+  , fontPropBold    :: Text+  , fontMono        :: Text }+  deriving (Show, Eq, Read, Generic)++instance NFData FontSet++instance Binary FontSet+ -- | Re-exported English phrase creation functions, applied to our custom -- irregular word sets. makePhrase, makeSentence :: [MU.Part] -> Text@@ -31,7 +68,8 @@   { irrPlural =       M.fromList         [ ("merchandise", "merchandise")-        , ("Merchandise", "Merchandise") ]+        , ("Merchandise", "Merchandise")+        , ("stomach", "stomachs") ]             -- this is both countable and uncountable, but I use it here             -- only as uncountable, do I overwrite the default       `M.union` MU.irrPlural MU.defIrregular@@ -65,7 +103,7 @@   getAppUserDataDirectory name  xM :: Int -> Int64-xM k = fromIntegral k * 1000000+xM k = intCast k * 1000000  xD :: Double -> Double xD k = k * 1000000@@ -79,7 +117,7 @@  show64With2 :: Int64 -> Text show64With2 n =-  let k = 100 * n `div` oneM+  let k = 100 * n `divUp` oneM       l = k `div` 100       x = k - l * 100       y = x `div` 10

engine-src/Game/LambdaHack/Common/MonadStateRead.hs view

@@ -10,21 +10,20 @@ import Game.LambdaHack.Core.Prelude  import qualified Data.EnumMap.Strict as EM-import           Data.Text (Text) -import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Faction-import           Game.LambdaHack.Core.Frequency import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level-import           Game.LambdaHack.Common.Types-import           Game.LambdaHack.Core.Random import           Game.LambdaHack.Common.ReqFailure import           Game.LambdaHack.Common.State+import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Content.ModeKind+import           Game.LambdaHack.Core.Frequency+import           Game.LambdaHack.Core.Random+import qualified Game.LambdaHack.Definition.Ability as Ability  -- | Monad for reading game state. A state monad with state modification -- disallowed (another constraint is needed to permit that).@@ -43,13 +42,13 @@ getGameMode :: MonadStateRead m => m ModeKind getGameMode = do   COps{comode} <- getsState scops-  t <- getsState sgameModeId-  return $! okind comode t+  gameModeId <- getsState sgameModeId+  return $! okind comode gameModeId  isNoConfirmsGame :: MonadStateRead m => m Bool isNoConfirmsGame = do   gameMode <- getGameMode-  return $! maybe False (> 0) $ lookup "no confirms" $ mfreq gameMode+  return $! maybe False (> 0) $ lookup NO_CONFIRMS $ mfreq gameMode  getEntryArena :: MonadStateRead m => Faction -> m LevelId getEntryArena fact = do@@ -62,7 +61,7 @@ pickWeaponM :: MonadStateRead m             => Bool -> Maybe DiscoveryBenefit             -> [(ItemId, ItemFullKit)] -> Ability.Skills -> ActorId-            -> m [(Double, (Int, (ItemId, ItemFullKit)))]+            -> m [(Double, Bool, Int, Int, ItemId, ItemFullKit)] pickWeaponM ignoreCharges mdiscoBenefit kitAss actorSk source = do   sb <- getsState $ getActorBody source   localTime <- getsState $ getLocalTime (blid sb)@@ -74,7 +73,8 @@       permAssocs = filter (preferredPrecious . fst . snd) kitAss       strongest = strongestMelee ignoreCharges mdiscoBenefit                                  localTime permAssocs-  return $! if | forced -> map (\ii -> (1, (1, ii))) kitAss+  return $! if | forced -> map (\(iid, itemFullKit) ->+                                  (-1, False, 0, 1, iid, itemFullKit)) kitAss                | Ability.getSk Ability.SkMelee actorSk <= 0 -> []                | otherwise -> strongest @@ -123,7 +123,8 @@             | canBrace -> braceEasy             | otherwise -> [(1, ("something", "hum silently"))]   else return $!-    if | canApply -> ("somebody", "holler a taunt")+    if | bproj b -> ("something", "ping")+       | canApply -> ("somebody", "holler a taunt")        | canHear -> ("somebody", "growl menacingly")        | canBrace -> ("something", "stomp repeatedly")        | otherwise -> ("something", "buzz angrily")

engine-src/Game/LambdaHack/Common/Point.hs view

@@ -51,15 +51,15 @@   show (Point x y) = show (x, y)  instance Binary Point where-  put = put . (fromIntegral :: Int -> Int32) . fromEnum-  get = fmap (toEnum . (fromIntegral :: Int32 -> Int)) get+  put = put . (toIntegralCrash :: Int -> Int32) . fromEnum+  get = fmap (toEnum . (intCast :: Int32 -> Int)) get  -- Note that @Ord@ on @Int@ is not monotonic wrt @Ord@ on @Point@. -- We need to keep it that way, because we want close xs to have close indexes, -- e.g., adjacent points in line to have adjacent enumerations, -- because some of the screen layout and most of processing is line-by-line.--- Consequently, one can use EM.fromAscList on @(1, 8)..(10, 8)@, but not on--- @(1, 7)..(10, 9)@.+-- Consequently, one can use EM.fromDistinctAscList+-- on @(1, 8)..(10, 8)@, but not on @(1, 7)..(10, 9)@. instance Enum Point where   fromEnum Point{..} =     let !xsize = PA.indexPrimArray speedupHackXSize 0@@ -121,7 +121,7 @@       walk w xy = xy : walk (tail w) (step (head w) xy)   in map (uncurry Point) $ walk bw (x0, y0) --- | See <http://roguebasin.roguelikedevelopment.org/index.php/Digital_lines>.+-- | See <http://roguebasin.roguelikedevelopment.org/index.php/index.php?title=Digital_lines>. balancedWord :: Int -> Int -> Int -> [Int] balancedWord p q eps | eps + p < q = 0 : balancedWord p q (eps + p) balancedWord p q eps               = 1 : balancedWord p q (eps + p - q)

engine-src/Game/LambdaHack/Common/PointArray.hs view

@@ -2,12 +2,10 @@ -- | Arrays, based on Data.Vector.Unboxed, indexed by @Point@. module Game.LambdaHack.Common.PointArray   ( UnboxRepClass(..), Array(..)-  , empty, (!), accessI, (//), unsafeUpdateA, unsafeWriteA, unsafeWriteManyA-  , replicateA, replicateMA, generateA, generateMA, unfoldrNA, sizeA-  , foldrA, foldrA', foldlA', ifoldrA, ifoldrA', ifoldlA', foldMA', ifoldMA'-  , mapA, imapA, imapMA_, safeSetA, unsafeSetA-  , minIndexA, minLastIndexA, minIndexesA, maxIndexA, maxIndexByA, maxLastIndexA-  , forceA, fromListA, toListA+  , empty, (!), accessI, (//), replicateA, unfoldrNA+  , foldrA, foldrA', foldlA', ifoldlA', ifoldrA', foldMA'+  , mapA, imapA, imapMA_, minIndexesA, maxIndexA, maxIndexByA, maxLastIndexA+  , toListA #ifdef EXPOSE_INTERNAL     -- * Internal operations   , toUnboxRep@@ -18,13 +16,11 @@  import Game.LambdaHack.Core.Prelude -import           Control.Monad.ST.Strict import           Data.Binary import           Data.Vector.Binary () import qualified Data.Vector.Fusion.Bundle as Bundle import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as VM  import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Color as Color@@ -108,27 +104,27 @@ (//) Array{..} l = let v = avector U.// map (fromEnum *** toUnboxRep) l                    in Array{avector = v, ..} -unsafeUpdateA :: UnboxRepClass c => Array c -> [(Point, c)] -> ()-{-# INLINE unsafeUpdateA #-}-unsafeUpdateA Array{..} l = runST $ do-  vThawed <- U.unsafeThaw avector-  mapM_ (\(p, c) -> VM.write vThawed (fromEnum p) (toUnboxRep c)) l-  void $ U.unsafeFreeze vThawed+-- unsafeUpdateA :: UnboxRepClass c => Array c -> [(Point, c)] -> ()+-- {-# INLINE unsafeUpdateA #-}+-- unsafeUpdateA Array{..} l = runST $ do+--   vThawed <- U.unsafeThaw avector+--   mapM_ (\(p, c) -> VM.write vThawed (fromEnum p) (toUnboxRep c)) l+--   void $ U.unsafeFreeze vThawed -unsafeWriteA :: UnboxRepClass c => Array c -> Point -> c -> ()-{-# INLINE unsafeWriteA #-}-unsafeWriteA Array{..} p c = runST $ do-  vThawed <- U.unsafeThaw avector-  VM.write vThawed (fromEnum p) (toUnboxRep c)-  void $ U.unsafeFreeze vThawed+-- unsafeWriteA :: UnboxRepClass c => Array c -> Point -> c -> ()+-- {-# INLINE unsafeWriteA #-}+-- unsafeWriteA Array{..} p c = runST $ do+--   vThawed <- U.unsafeThaw avector+--   VM.write vThawed (fromEnum p) (toUnboxRep c)+--   void $ U.unsafeFreeze vThawed -unsafeWriteManyA :: UnboxRepClass c => Array c -> [Point] -> c -> ()-{-# INLINE unsafeWriteManyA #-}-unsafeWriteManyA Array{..} l c = runST $ do-  vThawed <- U.unsafeThaw avector-  let d = toUnboxRep c-  mapM_ (\p -> VM.write vThawed (fromEnum p) d) l-  void $ U.unsafeFreeze vThawed+-- unsafeWriteManyA :: UnboxRepClass c => Array c -> [Point] -> c -> ()+-- {-# INLINE unsafeWriteManyA #-}+-- unsafeWriteManyA Array{..} l c = runST $ do+--   vThawed <- U.unsafeThaw avector+--   let d = toUnboxRep c+--   mapM_ (\p -> VM.write vThawed (fromEnum p) d) l+--   void $ U.unsafeFreeze vThawed  -- | Create an array from a replicated element. replicateA :: UnboxRepClass c => X -> Y -> c -> Array c@@ -136,28 +132,28 @@ replicateA axsize aysize c =   Array{avector = U.replicate (axsize * aysize) $ toUnboxRep c, ..} --- | Create an array from a replicated monadic action.-replicateMA :: (Monad m, UnboxRepClass c) => X -> Y -> m c -> m (Array c)-{-# INLINE replicateMA #-}-replicateMA axsize aysize m = do-  v <- U.replicateM (axsize * aysize) $ liftM toUnboxRep m-  return $! Array{avector = v, ..}+-- -- | Create an array from a replicated monadic action.+-- replicateMA :: (Monad m, UnboxRepClass c) => X -> Y -> m c -> m (Array c)+-- {-# INLINE replicateMA #-}+-- replicateMA axsize aysize m = do+--   v <- U.replicateM (axsize * aysize) $ liftM toUnboxRep m+--   return $! Array{avector = v, ..} --- | Create an array from a function.-generateA :: UnboxRepClass c => X -> Y -> (Point -> c) -> Array c-{-# INLINE generateA #-}-generateA axsize aysize f =-  let g n = toUnboxRep $ f $ toEnum n-  in Array{avector = U.generate (axsize * aysize) g, ..}+-- -- | Create an array from a function.+-- generateA :: UnboxRepClass c => X -> Y -> (Point -> c) -> Array c+-- {-# INLINE generateA #-}+-- generateA axsize aysize f =+--   let g n = toUnboxRep $ f $ toEnum n+--   in Array{avector = U.generate (axsize * aysize) g, ..} --- | Create an array from a monadic function.-generateMA :: (Monad m, UnboxRepClass c)-           => X -> Y -> (Point -> m c) -> m (Array c)-{-# INLINE generateMA #-}-generateMA axsize aysize fm = do-  let gm n = liftM toUnboxRep $ fm $ toEnum n-  v <- U.generateM (axsize * aysize) gm-  return $! Array{avector = v, ..}+-- -- | Create an array from a monadic function.+-- generateMA :: (Monad m, UnboxRepClass c)+--            => X -> Y -> (Point -> m c) -> m (Array c)+-- {-# INLINE generateMA #-}+-- generateMA axsize aysize fm = do+--   let gm n = liftM toUnboxRep $ fm $ toEnum n+--   v <- U.generateM (axsize * aysize) gm+--   return $! Array{avector = v, ..}  unfoldrNA :: UnboxRepClass c => X -> Y -> (b -> (c, b)) -> b -> Array c {-# INLINE unfoldrNA #-}@@ -166,22 +162,20 @@       v = U.unfoldrN (axsize * aysize) gm b   in Array {avector = v, ..} --- | Content identifiers array size.-sizeA :: Array c -> (X, Y)-{-# INLINE sizeA #-}-sizeA Array{..} = (axsize, aysize)+-- -- | Content identifiers array size.+-- sizeA :: Array c -> (X, Y)+-- {-# INLINE sizeA #-}+-- sizeA Array{..} = (axsize, aysize)  -- | Fold right over an array. foldrA :: UnboxRepClass c => (c -> a -> a) -> a -> Array c -> a {-# INLINE foldrA #-}-foldrA f z0 Array{..} =-  U.foldr (\c a-> f (fromUnboxRep c) a) z0 avector+foldrA f z0 Array{..} = U.foldr (f . fromUnboxRep) z0 avector  -- | Fold right strictly over an array. foldrA' :: UnboxRepClass c => (c -> a -> a) -> a -> Array c -> a {-# INLINE foldrA' #-}-foldrA' f z0 Array{..} =-  U.foldr' (\c a-> f (fromUnboxRep c) a) z0 avector+foldrA' f z0 Array{..} = U.foldr' (f . fromUnboxRep) z0 avector  -- | Fold left strictly over an array. foldlA' :: UnboxRepClass c => (a -> c -> a) -> a -> Array c -> a@@ -196,12 +190,12 @@ ifoldlA' f z0 Array{..} =   U.ifoldl' (\a n c -> f a (toEnum n) (fromUnboxRep c)) z0 avector --- | Fold right over an array--- (function applied to each element and its index).-ifoldrA :: UnboxRepClass c => (Point -> c -> a -> a) -> a -> Array c -> a-{-# INLINE ifoldrA #-}-ifoldrA f z0 Array{..} =-  U.ifoldr (\n c a -> f (toEnum n) (fromUnboxRep c) a) z0 avector+-- -- | Fold right over an array+-- -- (function applied to each element and its index).+-- ifoldrA :: UnboxRepClass c => (Point -> c -> a -> a) -> a -> Array c -> a+-- {-# INLINE ifoldrA #-}+-- ifoldrA f z0 Array{..} =+--   U.ifoldr (\n c a -> f (toEnum n) (fromUnboxRep c) a) z0 avector  -- | Fold right strictly over an array -- (function applied to each element and its index).@@ -216,13 +210,13 @@ foldMA' f z0 Array{..} =   U.foldM' (\a c -> f a (fromUnboxRep c)) z0 avector --- | Fold monadically strictly over an array--- (function applied to each element and its index).-ifoldMA' :: (Monad m, UnboxRepClass c)-         => (a -> Point -> c -> m a) -> a -> Array c -> m a-{-# INLINE ifoldMA' #-}-ifoldMA' f z0 Array{..} =-  U.ifoldM' (\a n c -> f a (toEnum n) (fromUnboxRep c)) z0 avector+-- -- | Fold monadically strictly over an array+-- -- (function applied to each element and its index).+-- ifoldMA' :: (Monad m, UnboxRepClass c)+--          => (a -> Point -> c -> m a) -> a -> Array c -> m a+-- {-# INLINE ifoldMA' #-}+-- ifoldMA' f z0 Array{..} =+--   U.ifoldM' (\a n c -> f a (toEnum n) (fromUnboxRep c)) z0 avector  -- | Map over an array. mapA :: (UnboxRepClass c, UnboxRepClass d) => (c -> d) -> Array c -> Array d@@ -246,37 +240,37 @@ imapMA_ f Array{..} =   U.imapM_ (\n c -> f (toEnum n) (fromUnboxRep c)) avector --- | Set all elements to the given value, in place.-unsafeSetA :: UnboxRepClass c => c -> Array c -> Array c-{-# INLINE unsafeSetA #-}-unsafeSetA c Array{..} = runST $ do-  vThawed <- U.unsafeThaw avector-  VM.set vThawed (toUnboxRep c)-  vFrozen <- U.unsafeFreeze vThawed-  return $! Array{avector = vFrozen, ..}+-- -- | Set all elements to the given value, in place.+-- unsafeSetA :: UnboxRepClass c => c -> Array c -> Array c+-- {-# INLINE unsafeSetA #-}+-- unsafeSetA c Array{..} = runST $ do+--   vThawed <- U.unsafeThaw avector+--   VM.set vThawed (toUnboxRep c)+--   vFrozen <- U.unsafeFreeze vThawed+--   return $! Array{avector = vFrozen, ..} --- | Set all elements to the given value, in place, if possible.-safeSetA :: UnboxRepClass c => c -> Array c -> Array c-{-# INLINE safeSetA #-}-safeSetA c Array{..} =-  Array{avector = U.modify (\v -> VM.set v (toUnboxRep c)) avector, ..}+-- -- | Set all elements to the given value, in place, if possible.+-- safeSetA :: UnboxRepClass c => c -> Array c -> Array c+-- {-# INLINE safeSetA #-}+-- safeSetA c Array{..} =+--   Array{avector = U.modify (\v -> VM.set v (toUnboxRep c)) avector, ..} --- | Yield the point coordinates of a minimum element of the array.--- The array may not be empty.-minIndexA :: UnboxRepClass c => Array c -> Point-{-# INLINE minIndexA #-}-minIndexA Array{..} = toEnum $ U.minIndex avector+-- -- | Yield the point coordinates of a minimum element of the array.+-- -- The array may not be empty.+-- minIndexA :: UnboxRepClass c => Array c -> Point+-- {-# INLINE minIndexA #-}+-- minIndexA Array{..} = toEnum $ U.minIndex avector --- | Yield the point coordinates of the last minimum element of the array.--- The array may not be empty.-minLastIndexA :: UnboxRepClass c => Array c -> Point-{-# INLINE minLastIndexA #-}-minLastIndexA Array{..} =-  toEnum-  $ fst . Bundle.foldl1' imin . Bundle.indexed . G.stream-  $ avector- where-  imin (i, x) (j, y) = i `seq` j `seq` if x >= y then (j, y) else (i, x)+-- -- | Yield the point coordinates of the last minimum element of the array.+-- -- The array may not be empty.+-- minLastIndexA :: UnboxRepClass c => Array c -> Point+-- {-# INLINE minLastIndexA #-}+-- minLastIndexA Array{..} =+--   toEnum+--   $ fst . Bundle.foldl1' imin . Bundle.indexed . G.stream+--   $ avector+--  where+--   imin (i, x) (j, y) = i `seq` j `seq` if x >= y then (j, y) else (i, x)  -- | Yield the point coordinates of all the minimum elements of the array. -- The array may not be empty.@@ -316,15 +310,15 @@  where   imax (i, x) (j, y) = i `seq` j `seq` if x <= y then (j, y) else (i, x) --- | Force the array not to retain any extra memory.-forceA :: UnboxRepClass c => Array c -> Array c-{-# INLINE forceA #-}-forceA Array{..} = Array{avector = U.force avector, ..}+-- -- | Force the array not to retain any extra memory.+-- forceA :: UnboxRepClass c => Array c -> Array c+-- {-# INLINE forceA #-}+-- forceA Array{..} = Array{avector = U.force avector, ..} -fromListA :: UnboxRepClass c => X -> Y -> [c] -> Array c-{-# INLINE fromListA #-}-fromListA axsize aysize l =-  Array{avector = U.fromListN (axsize * aysize) $ map toUnboxRep l, ..}+-- fromListA :: UnboxRepClass c => X -> Y -> [c] -> Array c+-- {-# INLINE fromListA #-}+-- fromListA axsize aysize l =+--   Array{avector = U.fromListN (axsize * aysize) $ map toUnboxRep l, ..}  toListA :: UnboxRepClass c => Array c -> [c] {-# INLINE toListA #-}

engine-src/Game/LambdaHack/Common/ReqFailure.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} -- | Possible causes of failure of request. module Game.LambdaHack.Common.ReqFailure   ( ReqFailure(..)@@ -13,22 +12,22 @@  import Game.LambdaHack.Core.Prelude -import Data.Binary-import GHC.Generics (Generic)- import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import           Game.LambdaHack.Common.Time import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Definition.Ability as Ability+import           Game.LambdaHack.Definition.Defs  -- | Possible causes of failure of request. data ReqFailure =     MoveUnskilled+  | MoveUnskilledAsleep   | MoveNothing   | MeleeUnskilled   | MeleeSelf   | MeleeDistant+  | MeleeNotWeapon   | DisplaceUnskilled   | DisplaceDistant   | DisplaceAccess@@ -43,6 +42,10 @@   | AlterBlockActor   | AlterBlockItem   | AlterNothing+  | CloseDistant+  | CloseClosed+  | CloseNothing+  | CloseNonClosable   | WaitUnskilled   | YellUnskilled   | MoveItemUnskilled@@ -57,6 +60,7 @@   | ApplyNoEffects   | ItemNothing   | ItemNotCalm+  | ItemOverStash   | NotCalmPrecious   | ProjectUnskilled   | ProjectAimOnself@@ -64,19 +68,19 @@   | ProjectBlockActor   | ProjectLobable   | ProjectOutOfReach-  | TriggerNothing+  | ProjectFinderKeeper   | NoChangeDunLeader-  deriving (Show, Eq, Generic)--instance Binary ReqFailure+  deriving (Show, Eq)  impossibleReqFailure :: ReqFailure -> Bool impossibleReqFailure reqFailure = case reqFailure of   MoveUnskilled -> False  -- unidentified skill items+  MoveUnskilledAsleep -> False  -- unidentified skill items   MoveNothing -> True   MeleeUnskilled -> False  -- unidentified skill items   MeleeSelf -> True   MeleeDistant -> True+  MeleeNotWeapon -> False  -- unidentified items   DisplaceUnskilled -> False  -- unidentified skill items   DisplaceDistant -> True   DisplaceAccess -> True@@ -90,7 +94,11 @@   AlterDistant -> True   AlterBlockActor -> True  -- adjacent actor always visible   AlterBlockItem -> True  -- adjacent item always visible-  AlterNothing -> True+  AlterNothing -> True  -- if tile known, its properties known+  CloseDistant -> True+  CloseClosed -> True+  CloseNothing -> True+  CloseNonClosable -> True   WaitUnskilled -> False  -- unidentified skill items   YellUnskilled -> False  -- unidentified skill items   MoveItemUnskilled -> False  -- unidentified skill items@@ -105,6 +113,7 @@   ApplyNoEffects -> False  -- if effects unknown, can't prevent it   ItemNothing -> True   ItemNotCalm -> False  -- unidentified skill items+  ItemOverStash -> True   NotCalmPrecious -> False  -- unidentified skill items   ProjectUnskilled -> False  -- unidentified skill items   ProjectAimOnself -> True@@ -112,16 +121,18 @@   ProjectBlockActor -> True  -- adjacent actor always visible   ProjectLobable -> False  -- unidentified skill items   ProjectOutOfReach -> True-  TriggerNothing -> True  -- terrain underneath always visible+  ProjectFinderKeeper -> False   NoChangeDunLeader -> True  showReqFailure :: ReqFailure -> Text showReqFailure reqFailure = case reqFailure of-  MoveUnskilled -> "too low movement stat"+  MoveUnskilled -> "too low movement stat; use equipment menu to take off stat draining gear or switch to another teammate or wait until a stat draining condition passes as seen in organ menu"+  MoveUnskilledAsleep -> "actor asleep; yawn to wake up"   MoveNothing -> "wasting time on moving into obstacle"   MeleeUnskilled -> "too low melee combat stat"   MeleeSelf -> "trying to melee oneself"   MeleeDistant -> "trying to melee a distant foe"+  MeleeNotWeapon -> "trying to melee with not a weapon"   DisplaceUnskilled -> "too low actor displacing stat"   DisplaceDistant -> "trying to displace a distant actor"   DisplaceAccess -> "trying to switch places without access"@@ -129,35 +140,40 @@   DisplaceDying -> "trying to displace a dying foe"   DisplaceBraced -> "trying to displace a braced foe"   DisplaceImmobile -> "trying to displace an immobile foe"-  DisplaceSupported -> "trying to displace a foe supported by teammates"-  AlterUnskilled -> "alter stat is needed to search or exploit terrain"-  AlterUnwalked -> "too low altering stat to enter or exploit terrain"-  AlterDistant -> "trying to alter distant terrain"+  DisplaceSupported -> "trying to displace a foe supported by teammates or supply stash"+  AlterUnskilled -> "modify stat is needed to search or activate or transform terrain"+  AlterUnwalked -> "too low modify stat to enter or activate or transform terrain; find and equip gear that improves the stat or try with a teammate whose skill menu shows a higher stat"+  AlterDistant -> "trying to modify distant terrain"   AlterBlockActor -> "blocked by an actor"   AlterBlockItem -> "jammed by an item"-  AlterNothing -> "wasting time on altering nothing"+  AlterNothing -> "wasting time on modifying nothing"+  CloseDistant -> "trying to close a distant terrain"+  CloseClosed -> "already closed"+  CloseNothing -> "no adjacent terrain can be closed"+  CloseNonClosable -> "cannot be closed"   WaitUnskilled -> "too low wait stat"   YellUnskilled -> "actors unskilled in waiting cannot yell/yawn"   MoveItemUnskilled -> "too low item moving stat"   EqpOverfull -> "cannot equip any more items"   EqpStackFull -> "cannot equip the whole item stack"-  ApplyUnskilled -> "too low item applying stat"-  ApplyFood -> "eating food requires apply stat 2"-  ApplyRead -> "activating cultural artifacts requires apply stat 3"-  ApplyPeriodic -> "manually activating periodic items requires apply stat 4"-  ApplyOutOfReach -> "cannot apply an item out of reach"-  ApplyCharging -> "cannot apply an item that is still charging"-  ApplyNoEffects -> "cannot apply an item that produces no effect"+  ApplyUnskilled -> "too low item triggering stat"+  ApplyFood -> "trigger stat 1 is enough only to eat food from the ground and trigger simple appendages"+  ApplyRead -> "activating cultural artifacts requires trigger stat 3"+  ApplyPeriodic -> "manually activating periodic items requires trigger stat 4"+  ApplyOutOfReach -> "cannot trigger an item out of reach"+  ApplyCharging -> "cannot trigger an item that is still charging"+  ApplyNoEffects -> "cannot trigger an item that produces no effect"   ItemNothing -> "wasting time on void item manipulation"-  ItemNotCalm -> "you are too alarmed to use the shared stash"-  NotCalmPrecious -> "you are too alarmed to handle such an exquisite item"+  ItemNotCalm -> "you try to focus on your equipment but your calm fails you"+  ItemOverStash -> "you roll in your hoard a little"+  NotCalmPrecious -> "you are too distracted to handle such an exquisite item"   ProjectUnskilled -> "too low item flinging stat"   ProjectAimOnself -> "cannot aim at oneself"   ProjectBlockTerrain -> "aiming obstructed by terrain"   ProjectBlockActor -> "aiming blocked by an actor"   ProjectLobable -> "flinging a lobable item that stops at target position requires fling stat 3"   ProjectOutOfReach -> "cannot aim an item out of reach"-  TriggerNothing -> "wasting time on triggering nothing"+  ProjectFinderKeeper -> "flinging any projectile you've found is out of the question; you prefer to keep them pristine and safe"   NoChangeDunLeader -> "no manual level change for your team"  -- The item should not be applied nor thrown because it's too delicate@@ -171,7 +187,8 @@      else Right $ IA.checkFlag Ability.Durable arItem                   || case itemDisco of                        ItemDiscoFull{} -> True-                       _ -> not isPrecious+                       ItemDiscoMean itemAspectMean ->+                         IA.kmConst itemAspectMean || not isPrecious  -- Simplified, faster version, for inner AI loop. permittedPreciousAI :: Bool -> ItemFull -> Bool@@ -182,7 +199,8 @@      && IA.checkFlag Ability.Durable arItem         || case itemDisco of              ItemDiscoFull{} -> True-             _ -> not isPrecious+             ItemDiscoMean itemAspectMean ->+               IA.kmConst itemAspectMean || not isPrecious  permittedProject :: Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool permittedProject forced skill calmE itemFull =@@ -191,15 +209,7 @@        | not forced          && IA.checkFlag Ability.Lobable arItem          && skill < 3 -> Left ProjectLobable-       | otherwise -> case permittedPrecious forced calmE itemFull of-           Left failure -> Left failure-           Right False -> Right False-           Right True -> Right $-             let badSlot = case IA.aEqpSlot arItem of-                   Just Ability.EqpSlotShine -> False-                   Just _ -> True-                   Nothing -> IA.goesIntoEqp arItem-             in not badSlot+       | otherwise -> permittedPrecious forced calmE itemFull  -- Simplified, faster and more permissive version, for inner AI loop. permittedProjectAI :: Int -> Bool -> ItemFull -> Bool@@ -210,25 +220,29 @@          && skill < 3 -> False        | otherwise -> permittedPreciousAI calmE itemFull -permittedApply :: Time -> Int -> Bool-> ItemFull -> ItemQuant+permittedApply :: Time -> Int -> Bool -> Maybe CStore -> ItemFull -> ItemQuant                -> Either ReqFailure Bool-permittedApply localTime skill calmE+permittedApply localTime skill calmE mstore                itemFull@ItemFull{itemKind, itemSuspect} kit =   if | skill < 1 -> Left ApplyUnskilled-     | skill < 2 && IK.isymbol itemKind `notElem` [',', '"'] -> Left ApplyFood+     | skill < 2+       && IK.isymbol itemKind /= '"'+       && (IK.isymbol itemKind /= ','+           || mstore /= Just CGround) -> Left ApplyFood      | skill < 3 && IK.isymbol itemKind == '?' -> Left ApplyRead      | skill < 4        && let arItem = aspectRecordFull itemFull           in IA.checkFlag Ability.Periodic arItem -> Left ApplyPeriodic      -- If the item is discharged, neither the kinetic hit nor-     -- any effects activate, so there's no point applying.+     -- any effects activate, so there's no point triggering.      -- Note that if client doesn't know the timeout, here we may leak the fact      -- that the item is still charging, but the client risks destruction      -- if the item is, in fact, recharged and is not durable      -- (likely in case of jewellery). So it's OK (the message may be      -- somewhat alarming though).-     | not $ hasCharge localTime itemFull kit -> Left ApplyCharging+     | not $ hasCharge localTime kit -> Left ApplyCharging      | otherwise ->-       if null (IK.ieffects itemKind) && not itemSuspect+       if null (IK.ieffects itemKind)+          && (not itemSuspect || IA.isHumanTrinket itemKind)        then Left ApplyNoEffects        else permittedPrecious False calmE itemFull

engine-src/Game/LambdaHack/Common/RingBuffer.hs view

@@ -2,7 +2,7 @@ -- | Ring buffers. module Game.LambdaHack.Common.RingBuffer   ( RingBuffer-  , empty, cons, uncons, toList, length+  , empty, cons, toList, length   ) where  import Prelude ()@@ -36,14 +36,6 @@   let incNext = (rbNext + 1) `mod` rbMaxSize       incLength = min rbMaxSize $ rbLength + 1   in RingBuffer (Seq.update rbNext a rbCarrier) rbMaxSize incNext incLength--uncons :: RingBuffer a -> Maybe (a, RingBuffer a)-uncons RingBuffer{..} =-  let decNext = (rbNext - 1) `mod` rbMaxSize-  in if rbLength == 0-     then Nothing-     else Just ( Seq.index rbCarrier decNext-               , RingBuffer rbCarrier rbMaxSize decNext (rbLength - 1) )  toList :: RingBuffer a -> [a] toList RingBuffer{..} =

engine-src/Game/LambdaHack/Common/Save.hs view

@@ -1,10 +1,11 @@ -- | Saving and restoring game state, used by both server and clients. module Game.LambdaHack.Common.Save-  ( ChanSave, saveToChan, wrapInSaves, restoreGame, saveNameCli, saveNameSer-  , compatibleVersion+  ( ChanSave, saveToChan, wrapInSaves, restoreGame+  , compatibleVersion, delayPrint+  , saveNameCli, saveNameSer, bkpAllSaves #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , loopSave, delayPrint+  , loopSave #endif   ) where @@ -16,19 +17,20 @@ import           Control.Concurrent.Async import qualified Control.Exception as Ex import           Data.Binary-import           Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import           Data.Version import           System.FilePath import           System.IO (hFlush, stdout)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM +import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.RuleKind+import Game.LambdaHack.Core.Random  type ChanSave a = MVar (Maybe a) @@ -95,13 +97,14 @@  -- | Restore a saved game, if it exists. Initialize directory structure -- and copy over data files, if needed.-restoreGame :: Binary a => COps -> FilePath -> IO (Maybe a)-restoreGame cops fileName = do+restoreGame :: Binary a+            => RuleContent -> ClientOptions -> FilePath -> IO (Maybe a)+restoreGame corule clientOptions fileName = do   -- Create user data directory and copy files, if not already there.   dataDir <- appDataDir   tryCreateDir dataDir-  let path bkp = dataDir </> "saves" </> bkp <> fileName-  saveExists <- doesFileExist (path "")+  let path = dataDir </> "saves" </> fileName+  saveExists <- doesFileExist path   -- If the savefile exists but we get IO or decoding errors,   -- we show them and start a new game. If the savefile was randomly   -- corrupted or made read-only, that should solve the problem.@@ -109,12 +112,12 @@   -- terminate the program with an exception.   res <- Ex.try $     if saveExists then do-      let vExe1 = rexeVersion $ corule cops-      (vExe2, s) <- strictDecodeEOF (path "")+      let vExe1 = rexeVersion corule+      (vExe2, s) <- strictDecodeEOF path       if compatibleVersion vExe1 vExe2-      then return $ Just s+      then return $! s `seq` Just s       else do-        let msg = "Savefile" <+> T.pack (path "")+        let msg = "Savefile" <+> T.pack path                   <+> "from an incompatible version"                   <+> T.pack (showVersion vExe2)                   <+> "detected while trying to restore"@@ -124,10 +127,14 @@     else return Nothing   let handler :: Ex.SomeException -> IO (Maybe a)       handler e = do-        let msg = "Restore failed. The old file moved aside. The error message is:"+        moveAside <- bkpAllSaves corule clientOptions+        let msg = "Restore failed."+                  <+> (if moveAside+                      then "The wrong file has been moved aside."+                      else "")+                  <+> "The error message is:"                   <+> (T.unwords . T.lines) (tshow e)         delayPrint msg-        renameFile (path "") (path "bkp.")         return Nothing   either handler return res @@ -137,16 +144,17 @@  delayPrint :: Text -> IO () delayPrint t = do-  delay <- R.randomRIO (0, 1000000)-  threadDelay delay  -- try not to interleave saves with other clients-  T.hPutStrLn stdout t+  smgen <- SM.newSMGen+  let (delay, _) = nextRandom 10000 smgen+  threadDelay $ 100 * delay  -- try not to interleave saves with other clients+  T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough   hFlush stdout -saveNameCli :: COps -> FactionId -> String-saveNameCli COps{corule} side =+saveNameCli :: RuleContent -> FactionId -> String+saveNameCli corule side =   let gameShortName =-        case T.words $ rtitle corule of-          w : _ -> T.unpack w+        case words $ rtitle corule of+          w : _ -> w           _ -> "Game"       n = fromEnum side  -- we depend on the numbering hack to number saves   in gameShortName@@ -155,10 +163,27 @@          else ".computer_" ++ show (-n))      ++ ".sav" -saveNameSer :: COps -> String-saveNameSer COps{corule} =+saveNameSer :: RuleContent -> String+saveNameSer corule =   let gameShortName =-        case T.words $ rtitle corule of-          w : _ -> T.unpack w+        case words $ rtitle corule of+          w : _ -> w           _ -> "Game"   in gameShortName ++ ".server.sav"++bkpAllSaves :: RuleContent -> ClientOptions -> IO Bool+bkpAllSaves corule clientOptions = do+  dataDir <- appDataDir+  let benchmark = sbenchmark clientOptions+      defPrefix = ssavePrefixCli defClientOptions+      moveAside = not benchmark && ssavePrefixCli clientOptions == defPrefix+      bkpOneSave name = do+        let pathSave bkp = dataDir </> "saves" </> bkp <> defPrefix <> name+        b <- doesFileExist (pathSave "")+        when b $ renameFile (pathSave "") (pathSave "bkp.")+      bkpAll = do+        bkpOneSave $ saveNameSer corule+        forM_ [-199..199] $ \n ->+          bkpOneSave $ saveNameCli corule (toEnum n)+  when moveAside bkpAll+  return moveAside

engine-src/Game/LambdaHack/Common/State.hs view

@@ -27,11 +27,8 @@ import           Data.Binary import qualified Data.EnumMap.Strict as EM -import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.Area-import           Game.LambdaHack.Definition.Defs-import qualified Game.LambdaHack.Core.Dice as Dice import           Game.LambdaHack.Common.Faction import qualified Game.LambdaHack.Common.HighScore as HighScore import           Game.LambdaHack.Common.Item@@ -45,7 +42,11 @@ import           Game.LambdaHack.Content.CaveKind (CaveKind) import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.RuleKind-import           Game.LambdaHack.Content.TileKind (TileKind, unknownId)+import           Game.LambdaHack.Content.TileKind (TileKind)+import qualified Game.LambdaHack.Content.TileKind as TK+import qualified Game.LambdaHack.Core.Dice as Dice+import qualified Game.LambdaHack.Definition.Ability as Ability+import           Game.LambdaHack.Definition.Defs  -- | View on the basic game state. -- The @remembered@ fields, in client copies of the state, carry only@@ -72,7 +73,7 @@   , _sdiscoAspect    :: DiscoveryAspect                                    -- ^ item aspect data; could be recomputed   , _sactorMaxSkills :: ActorMaxSkills-                                   -- ^ actor aspect records; is recomputed+                                   -- ^ actor maximal skills; is recomputed   }   deriving (Show, Eq) @@ -154,7 +155,7 @@              -> Level unknownLevel COps{corule, cotile}              lkind ldepth larea lstair lescape lexpl lnight =-  let outerId = ouniqGroup cotile "unknown outer fence"+  let outerId = ouniqGroup cotile TK.S_UNKNOWN_OUTER_FENCE   in Level { lkind            , ldepth            , lfloor = EM.empty@@ -175,7 +176,7 @@  unknownTileMap :: Area -> ContentId TileKind -> X -> Y -> TileMap unknownTileMap larea outerId rXmax rYmax =-  let unknownMap = PointArray.replicateA rXmax rYmax unknownId+  let unknownMap = PointArray.replicateA rXmax rYmax TK.unknownId       outerUpdate = zip (areaInnerBorder larea) $ repeat outerId   in unknownMap PointArray.// outerUpdate @@ -239,10 +240,12 @@  -- | Update the actor dictionary. updateActorD :: (ActorDict -> ActorDict) -> State -> State+{-# INLINE updateActorD #-}  -- just in case inliner goes hiwire updateActorD f s = s {_sactorD = f (_sactorD s)}  -- | Update the item dictionary. updateItemD :: (ItemDict -> ItemDict) -> State -> State+{-# INLINE updateItemD #-} updateItemD f s = s {_sitemD = f (_sitemD s)}  -- | Update the item kind index map.@@ -255,6 +258,7 @@  -- | Update global time within state. updateTime :: (Time -> Time) -> State -> State+{-# INLINE updateTime #-} updateTime f s = s {_stime = f (_stime s)}  -- | Update content data within state and recompute the cached data.

engine-src/Game/LambdaHack/Common/Tile.hs view

@@ -16,14 +16,15 @@   ( -- * Construction of tile property lookup speedup tables     speedupTile     -- * Sped up property lookups-  , isClear, isLit, isWalkable, isDoor, isChangable+  , isClear, isLit, isHideout, isWalkable, isDoor, isChangable   , isSuspect, isHideAs, consideredByAI, isExplorable   , isVeryOftenItem, isCommonItem, isOftenActor, isNoItem, isNoActor   , isEasyOpen, isEmbed, isAquatic, alterMinSkill, alterMinWalk     -- * Slow property lookups-  , kindHasFeature, hasFeature, openTo, closeTo, embeddedItems, revealAs+  , kindHasFeature, openTo, closeTo, embeddedItems, revealAs   , obscureAs, hideAs, buildAs   , isEasyOpenKind, isOpenable, isClosable, isModifiable+  , TileAction (..), parseTileAction #ifdef EXPOSE_INTERNAL     -- * Internal operations   , createTab, createTabWithKey, accessTab, alterMinSkillKind, alterMinWalkKind@@ -37,8 +38,11 @@ import qualified Data.Vector.Unboxed as U import           Data.Word (Word8) +import           Game.LambdaHack.Common.Item import           Game.LambdaHack.Common.Kind+import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Content.ItemKind (ItemKind)+import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace) import qualified Game.LambdaHack.Content.TileKind as TK import           Game.LambdaHack.Core.Random@@ -69,16 +73,34 @@                  | otherwise = createTab cotile                                $ kindHasFeature TK.Clear       isLitTab = createTab cotile $ not . kindHasFeature TK.Dark+      isHideoutTab = createTab cotile $ \tk ->+        kindHasFeature TK.Walkable tk  -- implies not unknown+        && kindHasFeature TK.Dark tk       isWalkableTab = createTab cotile $ kindHasFeature TK.Walkable       isDoorTab = createTab cotile $ \tk ->-        let getTo TK.OpenTo{} = True-            getTo TK.CloseTo{} = True-            getTo _ = False-        in any getTo $ TK.tfeature tk+        let getTo (TK.OpenTo grp) acc = grp : acc+            getTo _ acc = acc+        in case foldr getTo [] $ TK.tfeature tk of+          [grp] | oisSingletonGroup cotile grp ->+            TK.isClosableKind $ okind cotile $ ouniqGroup cotile grp+          _ -> let getTo2 (TK.CloseTo grp) acc = grp : acc+                   getTo2 _ acc = acc+               in case foldr getTo2 [] $ TK.tfeature tk of+                 [grp] | oisSingletonGroup cotile grp ->+                   TK.isOpenableKind $ okind cotile $ ouniqGroup cotile grp+                 _ -> False+      isOpenableTab = createTab cotile TK.isOpenableKind+      isClosableTab = createTab cotile TK.isClosableKind       isChangableTab = createTab cotile $ \tk ->         let getTo TK.ChangeTo{} = True             getTo _ = False         in any getTo $ TK.tfeature tk+      isModifiableWithTab = createTab cotile $ \tk ->+        let getTo TK.OpenWith{} = True+            getTo TK.CloseWith{} = True+            getTo TK.ChangeWith{} = True+            getTo _ = False+        in any getTo $ TK.tfeature tk       isSuspectTab = createTab cotile TK.isSuspectKind       isHideAsTab = createTab cotile $ \tk ->         let getTo TK.HideAs{} = True@@ -97,7 +119,7 @@             getTo _ = False         in any getTo $ TK.tfeature tk       isAquaticTab = createTab cotile $ \tk ->-        maybe False (> 0) $ lookup "aquatic" $ TK.tfreq tk+        maybe False (> 0) $ lookup TK.AQUATIC $ TK.tfreq tk       alterMinSkillTab = createTabWithKey cotile alterMinSkillKind       alterMinWalkTab = createTabWithKey cotile alterMinWalkKind   in TileSpeedup {..}@@ -112,6 +134,9 @@   let getTo TK.OpenTo{} = True       getTo TK.CloseTo{} = True       getTo TK.ChangeTo{} = True+      getTo TK.OpenWith{} = True+      getTo TK.CloseWith{} = True+      getTo TK.ChangeWith{} = True       getTo TK.HideAs{} = True  -- in case tile swapped, but server sends hidden       getTo TK.RevealAs{} = True       getTo TK.ObscureAs{} = True@@ -130,6 +155,10 @@ alterMinWalkKind :: ContentId TileKind -> TileKind -> Word8 alterMinWalkKind k tk =   let getTo TK.OpenTo{} = True+-- enable when AI and humans can cope with unreachable areas+--      getTo TK.OpenWith{} = True+--        -- opening this may not be possible, but AI has to try, for there may+--        -- be no other path       getTo TK.RevealAs{} = True       getTo TK.ObscureAs{} = True       getTo _ = False@@ -150,6 +179,11 @@ {-# INLINE isLit #-} isLit TileSpeedup{isLitTab} = accessTab isLitTab +-- | Whether a tile is a good hideout: walkable and dark.+isHideout :: TileSpeedup -> ContentId TileKind -> Bool+{-# INLINE isHideout #-}+isHideout TileSpeedup{isHideoutTab} = accessTab isHideoutTab+ -- | Whether actors can walk into a tile. -- Essential for efficiency of pathfinding, hence tabulated. isWalkable :: TileSpeedup -> ContentId TileKind -> Bool@@ -162,11 +196,27 @@ {-# INLINE isDoor #-} isDoor TileSpeedup{isDoorTab} = accessTab isDoorTab +-- | Whether a tile kind (specified by its id) has an @OpenTo@ feature.+isOpenable :: TileSpeedup -> ContentId TileKind -> Bool+{-# INLINE isOpenable #-}+isOpenable TileSpeedup{isOpenableTab} = accessTab isOpenableTab++-- | Whether a tile kind (specified by its id) has a @CloseTo@ feature.+isClosable :: TileSpeedup -> ContentId TileKind -> Bool+{-# INLINE isClosable #-}+isClosable TileSpeedup{isClosableTab} = accessTab isClosableTab+ -- | Whether a tile is changable. isChangable :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isChangable #-} isChangable TileSpeedup{isChangableTab} = accessTab isChangableTab +-- | Whether a tile is modifiable with some items.+isModifiableWith :: TileSpeedup -> ContentId TileKind -> Bool+{-# INLINE isModifiableWith #-}+isModifiableWith TileSpeedup{isModifiableWithTab} =+  accessTab isModifiableWithTab+ -- | Whether a tile is suspect. -- Essential for efficiency of pathfinding, hence tabulated. isSuspect :: TileSpeedup -> ContentId TileKind -> Bool@@ -184,9 +234,9 @@ -- | Whether one can easily explore a tile, possibly finding a treasure, -- either spawned there or dropped there by a (dying from poison) foe. -- Doors can't be explorable since revealing a secret tile--- should not change it's (walkable and) explorable status.--- Door status should not depend on whether they are open or not--- so that a foe opening a door doesn't force us to backtrack to explore it.+-- should not change it's explorable status. Also, door explorable status+-- should not depend on whether they are open or not, so that+-- a foe opening a door doesn't force us to backtrack to explore it. -- Still, a foe that digs through a wall will affect our exploration counter -- and if content lets walls contain threasure, such backtraking makes sense. isExplorable :: TileSpeedup -> ContentId TileKind -> Bool@@ -242,11 +292,6 @@ {-# INLINE kindHasFeature #-} kindHasFeature f t = f `elem` TK.tfeature t --- | Whether a tile kind (specified by its id) has the given feature.-hasFeature :: ContentData TileKind -> TK.Feature -> ContentId TileKind -> Bool-{-# INLINE hasFeature #-}-hasFeature cotile f t = kindHasFeature f (okind cotile t)- openTo :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind) openTo cotile t = do   let getTo (TK.OpenTo grp) acc = grp : acc@@ -301,9 +346,7 @@   let getTo TK.HideAs{} = True       getTo _ = False   in case find getTo $ TK.tfeature $ okind cotile t of-       Just (TK.HideAs grp) ->-         let tHidden = ouniqGroup cotile grp-         in assert (tHidden /= t) $ Just tHidden+       Just (TK.HideAs grp) -> Just $ ouniqGroup cotile grp        _ -> Nothing  buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind@@ -321,15 +364,46 @@       getTo _ = False   in TK.talter tk < 10 && any getTo (TK.tfeature tk) --- | Whether a tile kind (specified by its id) has an OpenTo feature.-isOpenable :: ContentData TileKind -> ContentId TileKind -> Bool-isOpenable cotile t = TK.isOpenableKind $ okind cotile t---- | Whether a tile kind (specified by its id) has a CloseTo feature.-isClosable :: ContentData TileKind -> ContentId TileKind -> Bool-isClosable cotile t = TK.isClosableKind $ okind cotile t- isModifiable :: TileSpeedup -> ContentId TileKind -> Bool-isModifiable coTileSpeedup t = isDoor coTileSpeedup t+isModifiable coTileSpeedup t = isOpenable coTileSpeedup t+                               || isClosable coTileSpeedup t                                || isChangable coTileSpeedup t+                               || isModifiableWith coTileSpeedup t                                || isSuspect coTileSpeedup t++data TileAction =+    EmbedAction (ItemId, ItemQuant)+  | ToAction (GroupName TK.TileKind)+  | WithAction [(Int, GroupName ItemKind)] (GroupName TK.TileKind)+  deriving Show++parseTileAction :: Bool -> Bool -> [(IK.ItemKind, (ItemId, ItemQuant))]+                -> TK.Feature+                -> Maybe TileAction+parseTileAction bproj underFeet embedKindList feat = case feat of+  TK.Embed igroup ->+      -- Greater or equal 0 to also cover template UNKNOWN items+      -- not yet identified by the client.+    let f (itemKind, _) =+          fromMaybe (-1) (lookup igroup $ IK.ifreq itemKind) >= 0+    in case find f embedKindList of+      Nothing -> Nothing+      Just (_, iidkit) -> Just $ EmbedAction iidkit+  TK.OpenTo tgroup | not (underFeet || bproj) -> Just $ ToAction tgroup+  TK.CloseTo tgroup | not (underFeet || bproj) -> Just $ ToAction tgroup+  TK.ChangeTo tgroup | not bproj -> Just $ ToAction tgroup+  TK.OpenWith proj grps tgroup | not underFeet ->+    if proj == TK.ProjNo && bproj+    then Nothing+    else Just $ WithAction grps tgroup+  TK.CloseWith proj grps tgroup | not underFeet ->+    -- Not when standing on tile, not to autoclose doors under actor+    -- or close via dropping an item inside.+    if proj == TK.ProjNo && bproj+    then Nothing+    else Just $ WithAction grps tgroup+  TK.ChangeWith proj grps tgroup ->+    if proj == TK.ProjNo && bproj+    then Nothing+    else Just $ WithAction grps tgroup+  _ -> Nothing

engine-src/Game/LambdaHack/Common/Time.hs view

@@ -4,13 +4,12 @@   ( Time, timeTicks   , timeZero, timeEpsilon, timeClip, timeTurn, timeSecond, clipsInTurn   , absoluteTimeAdd, absoluteTimeSubtract, absoluteTimeNegate-  , timeFit, timeFitUp+  , timeFit, timeFitUp, timeRecent5   , Delta(..), timeShift, timeDeltaToFrom, timeDeltaAdd, timeDeltaSubtract   , timeDeltaReverse, timeDeltaScale, timeDeltaPercent, timeDeltaDiv   , timeDeltaToDigit, timeDeltaInSecondsText   , Speed, toSpeed, fromSpeed, minSpeed, displaySpeed-  , speedZero, speedWalk, speedLimp, speedThrust, modifyDamageBySpeed-  , speedScale, speedAdd+  , speedWalk, speedLimp, speedThrust, modifyDamageBySpeed, speedScale, speedAdd   , ticksPerMeter, speedFromWeight, rangeFromSpeedAndLinger #ifdef EXPOSE_INTERNAL     -- * Internal operations@@ -104,6 +103,10 @@ {-# INLINE timeFitUp #-} timeFitUp (Time t1) (Time t2) = fromEnum $ t1 `divUp` t2 +timeRecent5 :: Time -> Time -> Bool+timeRecent5 localTime time = timeDeltaToFrom localTime time+                             < timeDeltaScale (Delta timeTurn) 5+ -- | One-dimentional vectors. Introduced to tell apart the 2 uses of Time: -- as an absolute game time and as an increment. newtype Delta a = Delta a@@ -139,18 +142,18 @@ -- | Scale the time vector by an @Int@ scalar value. timeDeltaScale :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaScale #-}-timeDeltaScale (Delta (Time t)) s = Delta (Time (t * fromIntegral s))+timeDeltaScale (Delta (Time t)) s = Delta (Time (t * intCast s))  -- | Take the given percent of the time vector. timeDeltaPercent :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaPercent #-} timeDeltaPercent (Delta (Time t)) s =-  Delta (Time (t * fromIntegral s `div` 100))+  Delta (Time (t * intCast s `div` 100))  -- | Divide a time vector. timeDeltaDiv :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaDiv #-}-timeDeltaDiv (Delta (Time t)) n = Delta (Time (t `div` fromIntegral n))+timeDeltaDiv (Delta (Time t)) n = Delta (Time (t `div` intCast n))  -- | Represent the main 10 thresholds of a time range by digits, -- given the total length of the time range.@@ -187,7 +190,7 @@ -- | Constructor for content definitions. toSpeed :: Int -> Speed {-# INLINE toSpeed #-}-toSpeed s = Speed $ fromIntegral s * sInMs `div` 10+toSpeed s = Speed $ intCast s * sInMs `div` 10  -- | Readable representation of speed in the format used in content definitions. fromSpeed :: Speed -> Int@@ -206,6 +209,7 @@   in show l      <> (if x == 0 then "" else "." <> show x)      <> "m/s"+ -- | The minimal speed is half a meter (half a step across a tile) -- per second (two standard turns, which the time span during which -- projectile moves, unless it has modified linger value).@@ -222,10 +226,6 @@   let Speed msp = toSpeed minSpeed   in assert (msp == sInMs `div` 2) msp --- | No movement possible at that speed.-speedZero :: Speed-speedZero = Speed 0- -- | Fast walk speed (2 m/s) that suffices to move one tile in one turn. speedWalk :: Speed speedWalk = Speed $ 2 * sInMs@@ -252,13 +252,17 @@ modifyDamageBySpeed :: Int64 -> Speed -> Int64 modifyDamageBySpeed dmg (Speed s) =   let Speed sThrust = speedThrust-  in round (fromIntegral dmg * fromIntegral s ^ (2 :: Int)  -- overflows Int64-            / fromIntegral sThrust ^ (2 :: Int) :: Double)+  in if s <= minimalSpeed+     then 0  -- needed mostly not to display useless ranged damage+     else round $  -- Double, because overflows Int64+       int64ToDouble dmg * int64ToDouble s ^ (2 :: Int)+       / int64ToDouble sThrust ^ (2 :: Int) --- | Scale speed by an @Int@ scalar value.+-- | Scale speed by a scalar value. speedScale :: Rational -> Speed -> Speed {-# INLINE speedScale #-}-speedScale s (Speed v) = Speed (round $ fromIntegral v * s)+speedScale s (Speed v) =+  Speed (round $ (fromIntegralWrap :: Int64 -> Rational) v * s)  -- | Speed addition. speedAdd :: Speed -> Speed -> Speed@@ -277,12 +281,12 @@ -- See <https://github.com/LambdaHack/LambdaHack/wiki/Item-statistics>. speedFromWeight :: Int -> Int -> Speed speedFromWeight !weight !throwVelocity =-  let w = fromIntegral weight+  let w = intCast weight       mpMs | w < 250 = sInMs * 20            | w < 1500 = sInMs * 20 * 1250 `div` (w + 1000)-           | w < 10500 = sInMs * (11000 - w) `div` 1000+           | w < 10500 = sInMs * (11500 - w) `div` 1000            | otherwise = minimalSpeed * 2  -- move one step and drop-      v = mpMs * fromIntegral throwVelocity `div` 100+      v = mpMs * intCast throwVelocity `div` 100       -- We round down to the nearest multiple of 2M (unless the speed       -- is very low), to ensure both turns of flight cover the same distance       -- and that the speed matches the distance traveled exactly.

engine-src/Game/LambdaHack/Common/Types.hs view

@@ -5,7 +5,7 @@ -- among modules. module Game.LambdaHack.Common.Types   ( ItemId, FactionId, LevelId, ActorId-  , Container(..), ppContainer+  , Container(..)   ) where  import Prelude ()@@ -48,9 +48,3 @@   deriving (Show, Eq, Ord, Generic)  instance Binary Container--ppContainer :: Container -> Text-ppContainer CFloor{} = "nearby"-ppContainer CEmbed{} = "embedded nearby"-ppContainer (CActor _ cstore) = ppCStoreIn cstore-ppContainer c@CTrunk{} = error $ "" `showFailure` c

engine-src/Game/LambdaHack/Common/Vector.hs view

@@ -3,7 +3,7 @@ -- and not monotonic @Enum@ instance. module Game.LambdaHack.Common.Vector   ( Vector(..), VectorI-  , isUnit, isDiagonal, neg, chessDistVector, euclidDistSqVector+  , isUnit, neg, chessDistVector, euclidDistSqVector   , moves, movesCardinal, movesCardinalI, movesDiagonal, movesDiagonalI   , compassText, vicinityBounded, vicinityUnsafe   , vicinityCardinal, vicinityCardinalUnsafe, squareUnsafeSet@@ -12,7 +12,7 @@   , RadianAngle, rotate, towards #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , _moveTexts, longMoveTexts, movesSquare, pathToTrajectory+  , longMoveTexts, movesSquare, pathToTrajectory   , normalize, normalizeVector #endif   ) where@@ -44,8 +44,8 @@   deriving (Show, Read, Eq, Ord, Generic)  instance Binary Vector where-  put = put . (fromIntegral :: Int -> Int32) . fromEnum-  get = fmap (toEnum . (fromIntegral :: Int32 -> Int)) get+  put = put . (toIntegralCrash :: Int -> Int32) . fromEnum+  get = fmap (toEnum . (intCast :: Int32 -> Int)) get  -- Note that the conversion is not monotonic wrt the natural @Ord@ instance, -- to keep it in sync with Point.@@ -72,13 +72,6 @@ {-# INLINE isUnit #-} isUnit v = chessDistVector v == 1 --- | Checks whether a unit vector is a diagonal direction,--- as opposed to cardinal. If the vector is not unit,--- it checks that the vector is not horizontal nor vertical.-isDiagonal :: Vector -> Bool-{-# INLINE isDiagonal #-}-isDiagonal (Vector x y) = x * y /= 0- -- | Reverse an arbirary vector. neg :: Vector -> Vector {-# INLINE neg #-}@@ -116,9 +109,8 @@ movesDiagonalI :: [VectorI] movesDiagonalI = map fromEnum movesDiagonal --- | Currently unused.-_moveTexts :: [Text]-_moveTexts = ["NW", "N", "NE", "E", "SE", "S", "SW", "W"]+-- moveTexts :: [Text]+-- moveTexts = ["NW", "N", "NE", "E", "SE", "S", "SW", "W"]  longMoveTexts :: [Text] longMoveTexts = [ "northwest", "north", "northeast", "east"@@ -226,8 +218,8 @@ -- direction. rotate :: RadianAngle -> Vector -> Vector rotate angle (Vector x' y') =-  let x = fromIntegral x'-      y = fromIntegral y'+  let x = intToDouble x'+      y = intToDouble y'       -- Minus before the angle comes from our coordinates being       -- mirrored along the X axis (Y coordinates grow going downwards).       dx = x * cos (-angle) - y * sin (-angle)@@ -255,7 +247,7 @@  normalizeVector :: Vector -> Vector normalizeVector v@(Vector vx vy) =-  let res = normalize (fromIntegral vx) (fromIntegral vy)+  let res = normalize (intToDouble vx) (intToDouble vy)   in assert (not (isUnit v) || v == res              `blame` "unit vector gets untrivially normalized"              `swith` (v, res))

engine-src/Game/LambdaHack/Server/BroadcastAtomic.hs view

@@ -7,7 +7,8 @@   ( handleAndBroadcast, sendPer, handleCmdAtomicServer #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , hearUpdAtomic, hearSfxAtomic, filterHear, atomicForget, atomicRemember+  , cmdItemsFromIids, hearUpdAtomic, hearSfxAtomic, filterHear, atomicForget+  , atomicRemember #endif   ) where @@ -17,23 +18,25 @@  import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES+import qualified NLP.Miniutter.English as MU  import           Game.LambdaHack.Atomic import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.Faction 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           Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.TileKind (isUknownSpace) import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Server.MonadServer@@ -47,10 +50,11 @@ --    $ Nothing   -- undoCmdAtomic atomic  handleCmdAtomicServer :: MonadServerAtomic m-                       => UpdAtomic -> m (PosAtomic, [UpdAtomic], Bool)+                      => UpdAtomic -> m (PosAtomic, [UpdAtomic], Bool) handleCmdAtomicServer cmd = do   ps <- posUpdAtomic cmd   atomicBroken <- breakUpdAtomic cmd+    -- needs to be done before the states are changed and may make no sense   executedOnServer <- if seenAtomicSer ps                       then execUpdAtomicSer cmd                       else return False@@ -70,83 +74,115 @@   knowEvents <- getsServer $ sknowEvents . soptions   sperFidOld <- getsServer sperFid   -- Send some actions to the clients, one faction at a time.-  let sendAtomic fid (UpdAtomic cmd) = sendUpdate fid cmd-      sendAtomic fid (SfxAtomic sfx) = sendSfx fid sfx-      breakSend lid fid perFidLid = do-        let send2 (cmd2, ps2) =-              when (seenAtomicCli knowEvents fid perFidLid ps2) $-                sendUpdate fid cmd2-        psBroken <- mapM posUpdAtomic atomicBroken-        case psBroken of-          _ : _ -> mapM_ send2 $ zip atomicBroken psBroken-          [] -> do  -- hear only here; broken commands are never loud-            -- At most @minusM@ applied total over a single actor move,-            -- to avoid distress as if wounded (which is measured via deltas).-            -- So, if faction hits an enemy and it yells, hearnig yell will-            -- not decrease calm over the decrease from hearing strike.-            -- This may accumulate over time, though, to eventually wake up-            -- sleeping actors.-            let drainCalmOnce aid = do-                  b <- getsState $ getActorBody aid-                  when (deltaBenign $ bcalmDelta b) $-                    execUpdAtomic $ UpdRefillCalm aid minusM-            -- Projectiles never hear, for speed and simplicity,-            -- even though they sometimes see. There are flying cameras,-            -- but no microphones --- drones make too much noise themselves.-            as <- getsState $ fidActorRegularAssocs fid lid-            case atomic of-              UpdAtomic cmd -> do-                maids <- hearUpdAtomic as cmd-                case maids of-                  Nothing -> return ()-                  Just aids -> do-                    sendUpdate fid $ UpdHearFid fid-                                   $ HearUpd (not $ null aids) cmd-                    mapM_ drainCalmOnce aids-              SfxAtomic cmd -> do-                mhear <- hearSfxAtomic as cmd-                case mhear of-                  Nothing -> return ()-                  Just (hearMsg, aids) -> do-                    sendUpdate fid $ UpdHearFid fid hearMsg-                    mapM_ drainCalmOnce aids+  let sendAtomic fid (UpdAtomic cmd) = do+        let iids = iidUpdAtomic cmd+        s <- getState+        sClient <- getsServer $ (EM.! fid) . sclientStates+        mapM_ (sendUpdateCheck fid) $ cmdItemsFromIids iids sClient s+        sendUpdate fid cmd+      sendAtomic fid (SfxAtomic sfx) = do+        let iids = iidSfxAtomic sfx+        s <- getState+        sClient <- getsServer $ (EM.! fid) . sclientStates+        mapM_ (sendUpdateCheck fid) $ cmdItemsFromIids iids sClient s+        sendSfx fid sfx+      breakSend fid perFid = case lidOfPos ps of+        Nothing -> return ()+        Just lidOriginal -> do+          psBroken <- mapM posUpdAtomic atomicBroken+          case psBroken of+            _ : _ -> do+              let send2 (cmd2, ps2) =+                    when (seenAtomicCli knowEvents fid perFid ps2) $+                      sendAtomic fid (UpdAtomic cmd2)+              mapM_ send2 $ zip atomicBroken psBroken+            [] -> do  -- hear only here; broken commands are never loud+              -- At most @minusM@ applied total over a single actor move,+              -- to avoid distress as if wounded (which is measured via deltas).+              -- So, if faction hits an enemy and it yells, hearnig yell will+              -- not decrease calm over the decrease from hearing strike.+              -- This may accumulate over time, though, to eventually wake up+              -- sleeping actors.+              let drainCalmOnce aid = do+                    b <- getsState $ getActorBody aid+                    when (deltaBenign $ bcalmDelta b) $+                      execUpdAtomic $ UpdRefillCalm aid minusM+                  leaderDistance pos = do+                    mleader <- getsState $ gleader . (EM.! fid) . sfactionD+                    case mleader of+                      Nothing -> return Nothing+                      Just leader -> do+                        b <- getsState $ getActorBody leader+                        -- Leader's hearing as relevant as of any other actor,+                        -- which prevents changing leader just to get hearing+                        -- intel. However, leader's position affects accuracy+                        -- of the distance to noise hints.+                        return $ Just $ min 5 $ chessDist pos (bpos b) `div` 10+              -- Projectiles never hear, for speed and simplicity,+              -- even though they sometimes see. There are flying cameras,+              -- but no microphones --- drones make too much noise themselves.+              as <- getsState $ fidActorRegularAssocs fid lidOriginal+              case atomic of+                UpdAtomic cmd -> do+                  (profound, mpos) <- hearUpdAtomic cmd+                  case mpos of+                    Nothing | profound ->+                      sendUpdate fid $ UpdHearFid fid Nothing+                                     $ HearUpd cmd+                    Nothing -> return ()+                    Just pos -> do+                      aids <- filterHear pos as+                      if null aids && not profound+                      then return ()+                      else do+                        distance <- if null aids+                                    then return Nothing+                                    else leaderDistance pos+                        sendUpdate fid $ UpdHearFid fid distance $ HearUpd cmd+                        mapM_ drainCalmOnce aids+                SfxAtomic cmd -> do+                  mhear <- hearSfxAtomic cmd+                  case mhear of+                    Nothing -> return ()+                    Just (hearMsg, profound, pos) -> do+                      aids <- filterHear pos as+                      if null aids && not profound+                      then return ()+                      else do+                        distance <- if null aids+                                    then return Nothing+                                    else leaderDistance pos+                        sendUpdate fid $ UpdHearFid fid distance hearMsg+                        mapM_ drainCalmOnce aids       -- We assume players perceive perception change before the action,       -- so the action is perceived in the new perception,       -- even though the new perception depends on the action's outcome       -- (e.g., new actor created).-      anySend lid fid perFidLid =-        if seenAtomicCli knowEvents fid perFidLid ps+      send fid = do+        let perFid = sperFidOld EM.! fid+        if seenAtomicCli knowEvents fid perFid ps         then sendAtomic fid atomic-        else breakSend lid fid perFidLid-      posLevel lid fid =-        anySend lid fid $ sperFidOld EM.! fid EM.! lid-      send fid = case ps of-        PosSight lid _ -> posLevel lid fid-        PosFidAndSight _ lid _ -> posLevel lid fid-        PosFidAndSer (Just lid) _ -> posLevel lid fid-        PosSmell lid _ -> posLevel lid fid-        PosFid fid2 -> when (fid == fid2) $ sendAtomic fid atomic-        PosFidAndSer Nothing fid2 ->-          when (fid == fid2) $ sendAtomic fid atomic-        PosSer -> return ()-        PosAll -> sendAtomic fid atomic-        PosNone -> error $ "" `showFailure` (fid, atomic)+        else breakSend fid perFid   -- Factions that are eliminated by the command are processed as well,   -- because they are not deleted from @sfactionD@.   factionD <- getsState sfactionD   mapM_ send $ EM.keys factionD +cmdItemsFromIids :: [ItemId] -> State -> State -> [UpdAtomic]+cmdItemsFromIids iids sClient s =+  let iidsUnknown = filter (\iid -> EM.notMember iid $ sitemD sClient) iids+      items = map (\iid -> (iid, sitemD s EM.! iid)) iidsUnknown+  in [UpdRegisterItems items | not $ null items]+ -- | Messages for some unseen atomic commands. hearUpdAtomic :: MonadStateRead m-              => [(ActorId, Actor)] -> UpdAtomic-              -> m (Maybe [ActorId])-hearUpdAtomic as cmd = do+              => UpdAtomic -> m (Bool, Maybe Point)+hearUpdAtomic cmd = do   COps{coTileSpeedup} <- getsState scops   case cmd of-    UpdDestroyActor _ body _ | not $ bproj body -> do-      aids <- filterHear (bpos body) as-      return $ Just aids  -- profound-    UpdCreateItem iid item _ (CActor aid cstore) -> do+    UpdDestroyActor _ body _ | not $ bproj body ->+      return (True, Just $ bpos body)+    UpdCreateItem True iid item _ (CActor aid cstore) -> do       -- Kinetic damage implies the explosion is loud enough to cause noise.       itemKind <- getsState $ getItemKindServer item       discoAspect <- getsState sdiscoAspect@@ -155,54 +191,59 @@          || IA.checkFlag Ability.Blast arItem             && Dice.supDice (IK.idamage itemKind) > 0 then do         body <- getsState $ getActorBody aid-        aids <- filterHear (bpos body) as-        return $ Just aids  -- profound-      else return Nothing+        return (True, Just $ bpos body)+      else return (False, Nothing)     UpdTrajectory aid (Just (l, _)) Nothing | not (null l) -> do-      -- Non-blast actor hits a non-walkable tile.+      -- Non-blast projectile hits a non-walkable tile.       b <- getsState $ getActorBody aid       discoAspect <- getsState sdiscoAspect       let arTrunk = discoAspect EM.! btrunk b-      aids <- filterHear (bpos b) as-      return $! if bproj b && IA.checkFlag Ability.Blast arTrunk || null aids-                then Nothing-                else Just aids-    UpdAlterTile _ p _ toTile -> do-      aids <- filterHear p as-      return $! if Tile.isDoor coTileSpeedup toTile && null aids-                then Nothing-                else Just aids  -- profound-    UpdAlterExplorable{} -> return $ Just []  -- profound-    _ -> return Nothing+      return $! ( False, if not (bproj b) || IA.checkFlag Ability.Blast arTrunk+                         then Nothing+                         else Just $ bpos b )+    UpdAlterTile _ p _ toTile ->+      return (not $ Tile.isDoor coTileSpeedup toTile, Just p)+    UpdAlterExplorable{} -> return (True, Nothing)+    _ -> return (False, Nothing)  -- | Messages for some unseen sfx. hearSfxAtomic :: MonadServer m-              => [(ActorId, Actor)] -> SfxAtomic-              -> m (Maybe (HearMsg, [ActorId]))-hearSfxAtomic as cmd =+              => SfxAtomic -> m (Maybe (HearMsg, Bool, Point))+hearSfxAtomic cmd =   case cmd of-    SfxStrike aid _ iid _ -> do+    SfxStrike aid _ iid -> do       -- Only the attacker position considered, for simplicity.       b <- getsState $ getActorBody aid       discoAspect <- getsState sdiscoAspect       let arItem = discoAspect EM.! iid-      aids <- filterHear (bpos b) as       itemKindId <- getsState $ getIidKindIdServer iid       -- Loud explosions cause enough noise, so ignoring particle hit spam.-      return $! if IA.checkFlag Ability.Blast arItem || null aids+      return $! if IA.checkFlag Ability.Blast arItem                 then Nothing-                else Just (HearStrike itemKindId, aids)-    SfxEffect _ aid (IK.Summon grp p) _ -> do+                else Just (HearStrike itemKindId, False, bpos b)+    SfxEffect _ aid _ (IK.Summon grp p) _ -> do       b <- getsState $ getActorBody aid-      aids <- filterHear (bpos b) as-      return $! if null aids-                then Nothing-                else Just (HearSummon (bproj b) grp p, aids)+      return $ Just (HearSummon (bproj b) grp p, False, bpos b)+    SfxEffect _ aid _ (IK.VerbMsg verb ending) _ -> do+      b <- getsState $ getActorBody aid+      discoAspect <- getsState sdiscoAspect+      let arTrunk = discoAspect EM.! btrunk b+          subject = "noises of someone that"+          phrase = makePhrase [MU.SubjectVerbSg subject (MU.Text verb)]+                   <> ending+      return $! if IA.checkFlag Ability.Unique arTrunk+                then Just (HearTaunt phrase, True, bpos b)+                else Nothing+    SfxCollideTile _ p ->+      return $ Just (HearCollideTile, False, p)     SfxTaunt voluntary aid -> do       b <- getsState $ getActorBody aid-      aids <- filterHear (bpos b) as       (subject, verb) <- displayTaunt voluntary rndToAction aid-      return $ Just (HearTaunt $ subject <+> verb, aids)  -- intentional+      discoAspect <- getsState sdiscoAspect+      let arTrunk = discoAspect EM.! btrunk b+          unique = if IA.checkFlag Ability.Unique arTrunk then "big" else ""+          phrase = subject <+> unique <+> verb <> "."+      return $ Just (HearTaunt phrase, True, bpos b)  -- intentional     _ -> return Nothing  filterHear :: MonadStateRead m => Point -> [(ActorId, Actor)] -> m [ActorId]@@ -219,7 +260,6 @@ sendPer :: (MonadServerAtomic m, MonadServerComm m)         => FactionId -> LevelId -> Perception -> Perception -> Perception         -> m ()-{-# INLINE sendPer #-} sendPer fid lid outPer inPer perNew = do   knowEvents <- getsServer $ sknowEvents . soptions   unless knowEvents $ do  -- inconsistencies would quickly manifest@@ -227,15 +267,18 @@     sClient <- getsServer $ (EM.! fid) . sclientStates     let forget = atomicForget fid lid outPer sClient     remember <- getsState $ atomicRemember lid inPer sClient-    let seenNew = seenAtomicCli False fid perNew-    psRem <- mapM posUpdAtomic remember-    -- Verify that we remember only currently seen things.+    let seenNew = seenAtomicCli False fid (EM.singleton lid perNew)+        onLevel UpdRegisterItems{} = True+        onLevel UpdLoseStashFaction{} = True+        onLevel _ = False+    psRem <- mapM posUpdAtomic $ filter (not . onLevel) remember+    -- Verify that we remember the currently seen things.     let !_A = assert (allB seenNew psRem) ()     mapM_ (sendUpdateCheck fid) forget     mapM_ (sendUpdate fid) remember --- Remembered items, map tiles and smells are not wiped out when they get--- out of FOV. Clients remember them. Only actors are forgotten.+-- Remembered items, map tiles, smells and stashes are not wiped out+-- when they get out of FOV. Clients remember them. Only actors are forgotten. atomicForget :: FactionId -> LevelId -> Perception -> State              -> [UpdAtomic] atomicForget side lid outPer sClient =@@ -246,7 +289,7 @@         -- perception, but still visible, if they belong to our faction,         -- e.g., if they teleport to outside of current perception         -- or if they have disabled senses.-        UpdLoseActor aid b $ getCarriedAssocsAndTrunk b sClient+        UpdLoseActor aid b           -- this command always succeeds, the actor can be always removed,           -- because the actor is taken from the state       outPrioBig = mapMaybe (\p -> posToBigAssoc p lid sClient)@@ -255,10 +298,31 @@                     $ ES.elems outFov   in map fActor $ filter ((/= side) . bfid . snd) outPrioBig ++ outPrioProj +-- The second argument are the points newly in FOV. atomicRemember :: LevelId -> Perception -> State -> State -> [UpdAtomic] {-# INLINE atomicRemember #-} atomicRemember lid inPer sClient s =   let COps{cotile, coTileSpeedup} = scops s+      locateStash ((fidClient, factClient), (fid, fact)) =+        assert (fidClient == fid)+        $ case (gstash factClient, gstash fact) of+            (Just (lidStash, pos), Nothing)+              | lidStash == lid && pos `ES.member` totalVisible inPer ->+                [UpdLoseStashFaction False fid lid pos]+            (Nothing, Just (lidStash, pos))+              | lidStash == lid && pos `ES.member` totalVisible inPer ->+                [UpdSpotStashFaction True fid lid pos]+            (Just (lidStash1, pos1), Just (lidStash2, pos2))+              | gstash factClient /= gstash fact ->+                if | lidStash2 == lid && pos2 `ES.member` totalVisible inPer ->+                     [ UpdLoseStashFaction False fid lidStash1 pos1+                     , UpdSpotStashFaction True fid lid pos2 ]+                   | lidStash1 == lid && pos1 `ES.member` totalVisible inPer ->+                     [UpdLoseStashFaction False fid lid pos1]+                   | otherwise -> []+            _ -> []+      atomicStash = concatMap locateStash $ zip (EM.assocs $ sfactionD sClient)+                                                (EM.assocs $ sfactionD s)       inFov = ES.elems $ totalVisible inPer       lvl = sdungeon s EM.! lid       -- Wipe out remembered items on tiles that now came into view@@ -268,28 +332,22 @@         let f p = case (EM.lookup p bagEM, EM.lookup p bagEMClient) of               (Nothing, Nothing) -> []  -- most common, no items ever               (Just bag, Nothing) ->  -- common, client unaware-                let ais = map (\iid -> (iid, getItemBody iid s))-                              (EM.keys bag)-                in [UpdSpotItemBag (fc lid p) bag ais | allow p]+                cmdItemsFromIids (EM.keys bag) sClient s+                ++ [UpdSpotItemBag True (fc lid p) bag | allow p]               (Nothing, Just bagClient) ->  -- uncommon, all items vanished                 -- We don't check @allow@, because client sees items there,                 -- so we assume he's aware of the tile enough to notice.-               let aisClient = map (\iid -> (iid, getItemBody iid sClient))-                                    (EM.keys bagClient)-                in [UpdLoseItemBag (fc lid p) bagClient aisClient]+                [UpdLoseItemBag True (fc lid p) bagClient]               (Just bag, Just bagClient) ->                 -- We don't check @allow@, because client sees items there,                 -- so we assume he's aware of the tile enough to see new items.                 if bag == bagClient                 then []  -- common, nothing has changed, so optimized-                else  -- uncommon, surprise; because it's rare, we send-                      -- whole bags and don't optimize by sending only delta-                  let aisClient = map (\iid -> (iid, getItemBody iid sClient))-                                      (EM.keys bagClient)-                      ais = map (\iid -> (iid, getItemBody iid s))-                                (EM.keys bag)-                  in [ UpdLoseItemBag (fc lid p) bagClient aisClient-                     , UpdSpotItemBag (fc lid p) bag ais ]+                else -- uncommon, surprise; because it's rare, we send+                     -- whole bags and don't optimize by sending only delta+                     cmdItemsFromIids (EM.keys bag) sClient s+                     ++ [ UpdLoseItemBag True (fc lid p) bagClient+                        , UpdSpotItemBag True (fc lid p) bag ]         in concatMap f inFov       inFloor = inContainer (const True) CFloor (lfloor lvl) (lfloor lvlClient)       -- Check that client may be shown embedded items, assuming he's not seeing@@ -335,15 +393,16 @@       -- For now clients act as if this was the case, not peeking into old.       inSmellFov = ES.elems $ totalSmelled inPer       inSm = mapMaybe (\p -> (p,) <$> EM.lookup p (lsmell lvlClient)) inSmellFov-      inSmell = if null inSm then [] else [UpdLoseSmell lid inSm]+      inSmell = [UpdLoseSmell lid inSm | not $ null inSm]       -- Spot smells.       inSm2 = mapMaybe (\p -> (p,) <$> EM.lookup p (lsmell lvl)) inSmellFov-      atomicSmell = if null inSm2 then [] else [UpdSpotSmell lid inSm2]+      atomicSmell = [UpdSpotSmell lid inSm2 | not $ null inSm2]       -- Actors come last to report the environment they land on.       inAssocs = concatMap (\p -> posToAidAssocs p lid s) inFov       -- Here, the actor may be already visible, e.g., when teleporting,       -- so the exception is caught in @sendUpdate@ above.-      fActor (aid, b) = let ais = getCarriedAssocsAndTrunk b s-                        in UpdSpotActor aid b ais-      inActor = map fActor inAssocs-  in atomicTile ++ inFloor ++ inEmbed ++ inSmell ++ atomicSmell ++ inActor+      fActor (aid, b) = cmdItemsFromIids (getCarriedIidsAndTrunk b) sClient s+                        ++ [UpdSpotActor aid b]+      inActor = concatMap fActor inAssocs+  in atomicStash ++ inActor ++ inSmell ++ atomicSmell ++ inFloor+     ++ atomicTile ++ inEmbed

engine-src/Game/LambdaHack/Server/Commandline.hs view

@@ -18,16 +18,16 @@ import qualified Data.Text as T import           Data.Version import           Options.Applicative-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  -- 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.Definition.Defs+import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Content.ModeKind+import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.ServerOptions  -- | Parser for server options from commandline arguments.@@ -45,6 +45,7 @@ serverOptionsP = do   ~(snewGameSer, scurChalSer)                     <- serToChallenge <$> newGameP+  sfullscreenMode   <- fullscreenModeP   knowMap           <- knowMapP   knowEvents        <- knowEventsP   knowItems         <- knowItemsP@@ -60,18 +61,16 @@   skeepAutomated    <- keepAutomatedP   sstopAfterSeconds <- stopAfterSecsP   sstopAfterFrames  <- stopAfterFramesP+  sstopAfterGameOver <- stopAfterGameOverP   sprintEachScreen  <- printEachScreenP   sbenchmark        <- benchmarkP   sdungeonRng       <- setDungeonRngP   smainRng          <- setMainRngP   sdumpInitRngs     <- dumpInitRngsP   sdbgMsgSer        <- dbgMsgSerP-  sgtkFontFamily    <- gtkFontFamilyP-  sdlFontFile       <- sdlFontFileP-  sdlScalableSizeAdd <- sdlScalableSizeAddP-  sdlBitmapSizeAdd  <- sdlBitmapSizeAddP-  sscalableFontSize <- scalableFontSizeP-  sfontDir          <- fontDirP+  sassertExplored   <- assertExploredP+  schosenFontset    <- chosenFontsetP+  sallFontsScale    <- allFontsScaleP   slogPriority      <- logPriorityP   smaxFps           <- maxFpsP   sdisableAutoYes   <- disableAutoYesP@@ -85,7 +84,9 @@   pure ServerOptions     {       sclientOptions = ClientOptions-        { stitle         = Nothing+        { sfonts         = []  -- comes only from config file+        , sfontsets      = []  -- comes only from config file+        , stitle         = Nothing         , snewGameCli    = snewGameSer         , ssavePrefixCli = ssavePrefixSer         , ..@@ -134,7 +135,7 @@ showItemSamplesP :: Parser Bool showItemSamplesP =   switch (  long "showItemSamples"-         <> help "At game over show samples of all items (--sknowEvents disables this)" )+         <> help "At game over show samples of all items (--knowEvents disables this)" )  sniffP :: Parser Bool sniffP =@@ -153,12 +154,19 @@  gameModeP :: Parser (Maybe (GroupName ModeKind)) gameModeP = optional $ toGameMode <$>-  strOption (  long "gameMode"+  option nonEmptyStr+         (  long "gameMode"             <> metavar "MODE"             <> help "Start next game in the scenario indicated by MODE" )  where+  -- This ignores all but the first word of a game mode name+  -- and assumes the fist word is present among its frequencies.   toGameMode :: String -> GroupName ModeKind-  toGameMode = toGroupName . T.pack+  toGameMode = GroupName . head . T.words . T.pack+  nonEmptyStr :: ReadM String+  nonEmptyStr = eitherReader $ \case+    "" -> Left "name of game mode cannot be empty"+    ns -> Right ns  automateAllP :: Parser Bool automateAllP =@@ -171,23 +179,35 @@          <> help "Keep factions automated after game over" )  newGameP :: Parser (Maybe Int)-newGameP = optional $+newGameP = optional $ max 1 <$> min difficultyBound <$>   option auto (  long "newGame"               <> help "Start a new game, overwriting the save file, with difficulty for all UI players set to N"               <> metavar "N" ) +fullscreenModeP :: Parser (Maybe FullscreenMode)+fullscreenModeP = optional $+  option auto (  long "fullscreenMode"+              <> short 'f'+              <> metavar "MODE"+              <> help "Display in MODE, one of NotFullscreen (default), BigBorderlessWindow (preferred), ModeChange" )+ stopAfterSecsP :: Parser (Maybe Int)-stopAfterSecsP = optional $+stopAfterSecsP = optional $ max 0 <$>   option auto (  long "stopAfterSeconds"               <> help "Exit game session after around N seconds"               <> metavar "N" )  stopAfterFramesP :: Parser (Maybe Int)-stopAfterFramesP = optional $+stopAfterFramesP = optional $ max 0 <$>   option auto (  long "stopAfterFrames"               <> help "Exit game session after around N frames"               <> metavar "N" ) +stopAfterGameOverP :: Parser Bool+stopAfterGameOverP =+  switch (  long "stopAfterGameOver"+         <> help "Exit the application after game over" )+ printEachScreenP :: Parser Bool printEachScreenP =   switch (  long "printEachScreen"@@ -198,13 +218,13 @@   switch (  long "benchmark"          <> help "Restrict file IO, print timing stats" ) -setDungeonRngP :: Parser (Maybe R.StdGen)+setDungeonRngP :: Parser (Maybe SM.SMGen) setDungeonRngP = optional $   option auto (  long "setDungeonRng"               <> metavar "RNG_SEED"               <> help "Set dungeon generation RNG seed to string RNG_SEED" ) -setMainRngP :: Parser (Maybe R.StdGen)+setMainRngP :: Parser (Maybe SM.SMGen) setMainRngP = optional $   option auto (  long "setMainRng"               <> metavar "RNG_SEED"@@ -220,53 +240,46 @@   switch (  long "dbgMsgSer"          <> help "Emit extra internal server debug messages" ) -gtkFontFamilyP :: Parser (Maybe Text)-gtkFontFamilyP = optional $ T.pack <$>-  strOption (  long "gtkFontFamily"-            <> metavar "FONT_FAMILY"-            <> help "Use FONT_FAMILY for the main game window in GTK frontend" )--sdlFontFileP :: Parser (Maybe Text)-sdlFontFileP = optional $ T.pack <$>-  strOption (  long "sdlFontFile"-            <> metavar "FONT_FILE"-            <> help "Use FONT_FILE for the main game window in SDL2 frontend" )--sdlScalableSizeAddP :: Parser (Maybe Int)-sdlScalableSizeAddP = optional $-  option auto (  long "sdlScalableSizeAdd"-              <> metavar "N"-              <> help "Enlarge map cells by N over scalable font max height in SDL2 frontend (N may be negative)" )--sdlBitmapSizeAddP :: Parser (Maybe Int)-sdlBitmapSizeAddP = optional $-  option auto (  long "sdlBitmapSizeAdd"-              <> metavar "N"-              <> help "Enlarge map cells by N on top of bitmap font max height in SDL2 frontend (N may be negative)" )+assertExploredP :: Parser (Maybe Int)+assertExploredP = optional $ max 1 <$>+  option auto (  long "assertExplored"+              <> help "Check that when the session ends, the indicated level has been explored"+              <> metavar "N" ) -scalableFontSizeP :: Parser (Maybe Int)-scalableFontSizeP = optional $-  option auto (  long "scalableFontSize"-              <> metavar "N"-              <> help "Use font size of N pixels for the main game window (interpreted differently by different graphical frontends; ignored for bitmap fonts)" )+chosenFontsetP :: Parser (Maybe Text)+chosenFontsetP = optional $ T.pack <$>+  strOption (  long "fontset"+            <> metavar "FONTSET_ID"+            <> help "Render UI using the given fontset from config file" ) -fontDirP :: Parser (Maybe FilePath)-fontDirP = optional $-  option auto (  long "fontDir"-              <> metavar "FILEPATH"-              <> help "Take font files for the SDL2 frontend from FILEPATH" )+allFontsScaleP :: Parser (Maybe Double)+allFontsScaleP = optional $ max 0 <$>+  option auto (  long "allFontsScale"+              <> metavar "D"+              <> help "Scale all fonts by D, resizing the whole UI" ) -maxFpsP :: Parser (Maybe Int)-maxFpsP = optional $ max 1 <$>+maxFpsP :: Parser (Maybe Double)+maxFpsP = optional $ max 0 <$>   option auto (  long "maxFps"-              <> metavar "N"-              <> help "Display at most N frames per second" )+              <> metavar "D"+              <> help "Display at most D frames per second" )  logPriorityP :: Parser (Maybe Int)-logPriorityP = optional $ max 0 <$>-  option auto (  long "logPriority"-              <> metavar "N"-              <> help "Log only messages of priority at least N, where 1 (all) is the lowest and 5 (errors only) is the default." )+logPriorityP = optional $+  option (auto >>= verifyLogPriority) $+       long "logPriority"+    <> showDefault+    <> value 5+    <> metavar "N"+    <> help ( "Log only messages of priority at least N, where 1 (all) is "+           ++ "the lowest and 5 logs errors only; use value 0 for testing on "+           ++ "CIs without graphics access; setting priority to 0 causes "+           ++ "SDL frontend to init and quit at once" )+  where+    verifyLogPriority n =+      if n >= 0 && n <= 5+      then return n+      else readerError "N has to be 0 or a positive integer not larger than 5"  disableAutoYesP :: Parser Bool disableAutoYesP =@@ -283,6 +296,7 @@ savePrefixP =   strOption (  long "savePrefix"             <> metavar "PREFIX"+            <> showDefault             <> value ""             <> help "Prepend PREFIX to all savefile names" )

engine-src/Game/LambdaHack/Server/CommonM.hs view

@@ -1,17 +1,16 @@ {-# LANGUAGE TupleSections #-} -- | Server operations common to many modules. module Game.LambdaHack.Server.CommonM-  ( revealItems, moveStores, generalMoveItem-  , deduceQuits, deduceKilled, electLeader, setFreshLeader-  , updatePer, recomputeCachePer, projectFail-  , addActorFromGroup, registerActor, discoverIfMinorEffects+  ( revealItems, generalMoveItem, deduceQuits, writeSaveAll, verifyCaches+  , deduceKilled, electLeader, setFreshLeader, updatePer, recomputeCachePer+  , projectFail, addActorFromGroup, registerActor, discoverIfMinorEffects   , pickWeaponServer, currentSkillsServer, allGroupItems   , addCondition, removeConditionSingle, addSleep, removeSleepSingle   , addKillToAnalytics #ifdef EXPOSE_INTERNAL     -- * Internal operations   , containerMoveItem, quitF, keepArenaFact, anyActorsAlive, projectBla-  , addProjectile, addActorIid, getCacheLucid, getCacheTotal+  , addProjectile, addNonProjectile, addActorIid, getCacheLucid, getCacheTotal #endif   ) where @@ -20,14 +19,14 @@ import Game.LambdaHack.Core.Prelude  import qualified Data.EnumMap.Strict as EM-import qualified Data.Ord as Ord+import qualified Data.IntMap.Strict as IM import           Data.Ratio  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client (ClientOptions (..)) import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Analytics+import           Game.LambdaHack.Common.ClientOptions import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA@@ -36,6 +35,7 @@ import           Game.LambdaHack.Common.Misc import           Game.LambdaHack.Common.MonadStateRead import           Game.LambdaHack.Common.Perception+import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Common.ReqFailure import           Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile@@ -45,7 +45,6 @@ import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.ModeKind import           Game.LambdaHack.Content.RuleKind-import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs@@ -61,30 +60,33 @@   COps{coitem} <- getsState scops   ServerOptions{sclientOptions} <- getsServer soptions   discoAspect <- getsState sdiscoAspect-  let discover aid store iid _ = do+  let keptSecret kind ar = IA.isHumanTrinket kind+                           || IA.checkFlag Ability.MetaGame ar+      discover aid store iid _ = do         itemKindId <- getsState $ getIidKindIdServer iid         let arItem = discoAspect EM.! iid             c = CActor aid store             itemKind = okind coitem itemKindId-        unless (IA.isHumanTrinket itemKind) $  -- a hack+        unless (keptSecret itemKind arItem) $  -- a hack           execUpdAtomic $ UpdDiscover c iid itemKindId arItem       f (aid, b) =-        -- CSha is IDed for each actor of each faction, which is fine,+        -- CStash is IDed for each actor of each faction, which is fine,         -- even though it may introduce a slight lag at gameover.         join $ getsState $ mapActorItems_ (discover aid) b   -- Don't ID projectiles, their items are not really owned by the party.   aids <- getsState $ fidActorNotProjGlobalAssocs fid   mapM_ f aids   dungeon <- getsState sdungeon-  let minLid = fst $ minimumBy (Ord.comparing (ldepth . snd))+  let minLid = fst $ minimumBy (comparing (ldepth . snd))                    $ EM.assocs dungeon       discoverSample iid = do         itemKindId <- getsState $ getIidKindIdServer iid         let arItem = discoAspect EM.! iid             cdummy = CTrunk fid minLid originPoint  -- only @fid@ matters here             itemKind = okind coitem itemKindId-        unless (IA.isHumanTrinket itemKind) $  -- a hack-          execUpdAtomic $ UpdDiscover cdummy iid itemKindId arItem+        execUpdAtomic $ if keptSecret itemKind arItem  -- a hack+                        then UpdSpotItem False iid quantSingle cdummy+                        else UpdDiscover cdummy iid itemKindId arItem   generationAn <- getsServer sgenerationAn   getKindId <- getsState $ flip getIidKindIdServer   let kindsEqual iid iid2 = getKindId iid == getKindId iid2 && iid /= iid2@@ -107,23 +109,14 @@   mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SCondition   mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SBlast -moveStores :: MonadServerAtomic m-           => Bool -> ActorId -> CStore -> CStore -> m ()-moveStores verbose aid fromStore toStore = do-  b <- getsState $ getActorBody aid-  let g iid (k, _) = do-        move <- generalMoveItem verbose iid k (CActor aid fromStore)-                                              (CActor aid toStore)-        mapM_ execUpdAtomic move-  mapActorCStore_ fromStore g b- -- | Generate the atomic updates that jointly perform a given item move. generalMoveItem :: MonadStateRead m                 => Bool -> ItemId -> Int -> Container -> Container                 -> m [UpdAtomic]-generalMoveItem _ iid k (CActor aid1 cstore1) (CActor aid2 cstore2)-  | aid1 == aid2 && cstore1 /= CSha && cstore2 /= CSha-  = return [UpdMoveItem iid k aid1 cstore1 cstore2]+generalMoveItem _ iid k (CActor aid1 cstore1) c2@(CActor aid2 cstore2)+  | aid1 == aid2 = do+    moveStash <- moveStashIfNeeded c2+    return $! moveStash ++ [UpdMoveItem iid k aid1 cstore1 cstore2] generalMoveItem verbose iid k c1 c2 = containerMoveItem verbose iid k c1 c2  containerMoveItem :: MonadStateRead m@@ -134,9 +127,10 @@   case iid `EM.lookup` bag of     Nothing -> error $ "" `showFailure` (iid, k, c1, c2)     Just (_, it) -> do-      item <- getsState $ getItemBody iid-      return [ UpdLoseItem verbose iid item (k, take k it) c1-             , UpdSpotItem verbose iid item (k, take k it) c2 ]+      moveStash <- moveStashIfNeeded c2+      return $ [UpdLoseItem verbose iid (k, take k it) c1]+               ++ moveStash+               ++ [UpdSpotItem verbose iid (k, take k it) c2]  quitF :: MonadServerAtomic m => Status -> FactionId -> m () quitF status fid = do@@ -153,18 +147,11 @@       manalytics <-         if fhasUI $ gplayer fact then do           keepAutomated <- getsServer $ skeepAutomated . soptions-          -- Try to remove AI control of the UI faction, to show endgame info.+          -- Try to remove AI control of the UI faction, to show gameover info.           when (isAIFact fact                 && fleaderMode (gplayer fact) /= LeaderNull                 && not keepAutomated) $             execUpdAtomic $ UpdAutoFaction fid False-          itemD <- getsState sitemD-          dungeon <- getsState sdungeon-          let ais = EM.assocs itemD-              minLid = fst $ minimumBy (Ord.comparing (ldepth . snd))-                           $ EM.assocs dungeon-          execUpdAtomic $ UpdSpotItemBag (CTrunk fid minLid originPoint)-                                         EM.empty ais           revealItems fid           -- Likely, by this time UI faction is no longer AI-controlled,           -- so the score will get registered.@@ -229,6 +216,57 @@        mapQuitF $ zip (repeat Escape) victors ++ zip (repeat Defeated) losers      | otherwise -> quitF status fid0 +-- | Save game on server and all clients.+writeSaveAll :: MonadServerAtomic m => Bool -> Bool -> m ()+writeSaveAll uiRequested evenForNoConfirmGames= do+  bench <- getsServer $ sbenchmark . sclientOptions . soptions+  noConfirmsGame <- isNoConfirmsGame+  when (uiRequested+        || not bench && (not noConfirmsGame || evenForNoConfirmGames)) $ do+    execUpdAtomic UpdWriteSave+    saveServer+#ifdef WITH_EXPENSIVE_ASSERTIONS+    -- This check is sometimes repeated in @gameExit@, but we don't care about+    -- speed of shutdown and even more so in WITH_EXPENSIVE_ASSERTIONS mode.+    verifyCaches+#endif++verifyCaches :: MonadServer m => m ()+verifyCaches = do+  sperCacheFid <- getsServer sperCacheFid+  sperValidFid <- getsServer sperValidFid+  sactorMaxSkills2 <- getsState sactorMaxSkills+  sfovLucidLid <- getsServer sfovLucidLid+  sfovClearLid <- getsServer sfovClearLid+  sfovLitLid <- getsServer sfovLitLid+  sperFid <- getsServer sperFid+  actorMaxSkills <- getsState maxSkillsInDungeon+  ( fovLitLid, fovClearLid, fovLucidLid+   ,perValidFid, perCacheFid, perFid ) <- getsState perFidInDungeon+  rngs <- getsServer srngs  -- initial display may scroll off terminal memory+  let !_A7 = assert (sfovLitLid == fovLitLid+                     `blame` "wrong accumulated sfovLitLid"+                     `swith` (sfovLitLid, fovLitLid, rngs)) ()+      !_A6 = assert (sfovClearLid == fovClearLid+                     `blame` "wrong accumulated sfovClearLid"+                     `swith` (sfovClearLid, fovClearLid, rngs)) ()+      !_A5 = assert (sactorMaxSkills2 == actorMaxSkills+                     `blame` "wrong accumulated sactorMaxSkills"+                     `swith` (sactorMaxSkills2, actorMaxSkills, rngs)) ()+      !_A4 = assert (sfovLucidLid == fovLucidLid+                     `blame` "wrong accumulated sfovLucidLid"+                     `swith` (sfovLucidLid, fovLucidLid, rngs)) ()+      !_A3 = assert (sperValidFid == perValidFid+                     `blame` "wrong accumulated sperValidFid"+                     `swith` (sperValidFid, perValidFid, rngs)) ()+      !_A2 = assert (sperCacheFid == perCacheFid+                     `blame` "wrong accumulated sperCacheFid"+                     `swith` (sperCacheFid, perCacheFid, rngs)) ()+      !_A1 = assert (sperFid == perFid+                     `blame` "wrong accumulated perception"+                     `swith` (sperFid, perFid, rngs)) ()+  return ()+ -- | Tell whether a faction that we know is still in game, keeps arena. -- Keeping arena means, if the faction is still in game, -- it always has a leader in the dungeon somewhere.@@ -269,7 +307,7 @@     let candidates = filter (\(_, b) -> bwatch b /= WSleep) onThisLevel                      ++ awake ++ sleeping ++ negative         mleaderNew =-          listToMaybe $ filter (/= aidToReplace) $ map fst $ candidates+          listToMaybe $ filter (/= aidToReplace) $ map fst candidates     execUpdAtomic $ UpdLeadFaction fid mleader mleaderNew  setFreshLeader :: MonadServerAtomic m => FactionId -> ActorId -> m ()@@ -302,8 +340,8 @@ recomputeCachePer fid lid = do   total <- getCacheTotal fid lid   fovLucid <- getCacheLucid lid-  let perNew = perceptionFromPTotal fovLucid total-      fper = EM.adjust (EM.insert lid perNew) fid+  perNew <- getsState $ perceptionFromPTotal fid lid fovLucid total+  let fper = EM.adjust (EM.insert lid perNew) fid   modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser}   return perNew @@ -311,35 +349,36 @@ -- went into effect (no failure occured). projectFail :: MonadServerAtomic m             => ActorId    -- ^ actor causing the projection-            -> ActorId    -- ^ actor projecting the item (is on current lvl)+            -> ActorId    -- ^ actor projecting the item (is on current level)+            -> Point      -- ^ starting position of the projectile;+                          --   usually, but not always, position of @origin@             -> Point      -- ^ target position of the projectile             -> Int        -- ^ digital line parameter-            -> Bool       -- ^ whether to start at the source position+            -> Bool       -- ^ whether to start at the origin's position             -> ItemId     -- ^ the item to be projected-            -> CStore     -- ^ whether the items comes from floor or inventory+            -> CStore     -- ^ which store the items comes from             -> Bool       -- ^ whether the item is a blast             -> m (Maybe ReqFailure)-projectFail propeller source tpxy eps center iid cstore blast = do+projectFail propeller origin oxy tpxy eps center iid cstore blast = do   COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops-  sb <- getsState $ getActorBody source-  let lid = blid sb-      spos = bpos sb+  body <- getsState $ getActorBody origin+  let lid = blid body   lvl <- getLevel lid-  case bla rXmax rYmax eps spos tpxy of+  case bla rXmax rYmax eps oxy tpxy of     Nothing -> return $ Just ProjectAimOnself     Just [] -> error $ "projecting from the edge of level"-                       `showFailure` (spos, tpxy)+                       `showFailure` (oxy, tpxy)     Just (pos : restUnlimited) -> do-      bag <- getsState $ getBodyStoreBag sb cstore+      bag <- getsState $ getBodyStoreBag body cstore       case EM.lookup iid bag of         Nothing -> return $ Just ProjectOutOfReach         Just _kit -> do           itemFull <- getsState $ itemToFull iid-          actorSk <- currentSkillsServer source-          actorMaxSk <- getsState $ getActorMaxSkills source+          actorSk <- currentSkillsServer origin+          actorMaxSk <- getsState $ getActorMaxSkills origin           let skill = Ability.getSk Ability.SkProject actorSk-              forced = blast || bproj sb-              calmE = calmEnough sb actorMaxSk+              forced = blast || bproj body+              calmE = calmEnough body actorMaxSk               legal = permittedProject forced skill calmE itemFull               arItem = aspectRecordFull itemFull           case legal of@@ -347,26 +386,35 @@             Right _ -> do               let lobable = IA.checkFlag Ability.Lobable arItem                   rest = if lobable-                         then take (chessDist spos tpxy - 1) restUnlimited+                         then take (chessDist oxy tpxy - 1) restUnlimited                          else restUnlimited                   t = lvl `at` pos               if | not $ Tile.isWalkable coTileSpeedup t ->                    return $ Just ProjectBlockTerrain                  | occupiedBigLvl pos lvl ->-                   if blast && bproj sb then do-                      -- Hit the blocking actor.-                      projectBla propeller source spos (pos:rest)-                                 iid cstore blast-                      return Nothing+                   if blast then do+                     -- Hit the blocking actor by starting the explosion+                     -- particle where the projectile landed, not a step away.+                     -- The same when the spot has the explosive embed,+                     -- regardless if it's walkable (@pos@ is, that's enough).+                     -- No problem even if there's a big actor where+                     -- the projectile starts, though it's wierd it may get+                     -- away unharmed sometimes.+                     projectBla propeller origin oxy (pos:rest)+                                iid cstore blast+                     return Nothing                    else return $ Just ProjectBlockActor                  | otherwise -> do-                   -- Make the explosion less regular and weaker at edges.-                   if blast && bproj sb && center then-                     -- Start in the center, not around.-                     projectBla propeller source spos (pos:rest)+                   -- Make the explosion less regular and weaker at the edges.+                   if blast && center then+                     -- Start in the center, not around, even if the center+                     -- is a non-walkable tile with the exploding embed+                     -- or if a big actor is there.+                     projectBla propeller origin oxy (pos:rest)                                 iid cstore blast                    else-                     projectBla propeller source pos rest iid cstore blast+                     projectBla propeller origin pos rest+                                iid cstore blast                    return Nothing  projectBla :: MonadServerAtomic m@@ -375,40 +423,41 @@            -> Point      -- ^ starting point of the projectile            -> [Point]    -- ^ rest of the trajectory of the projectile            -> ItemId     -- ^ the item to be projected-           -> CStore     -- ^ whether the items comes from floor or inventory+           -> CStore     -- ^ which store the items comes from            -> Bool       -- ^ whether the item is a blast            -> m ()-projectBla propeller source pos rest iid cstore blast = do-  sb <- getsState $ getActorBody source-  let lid = blid sb+projectBla propeller origin pos rest iid cstore blast = do+  body <- getsState $ getActorBody origin+  let lid = blid body   localTime <- getsState $ getLocalTime lid-  unless blast $ execSfxAtomic $ SfxProject source iid cstore-  bag <- getsState $ getBodyStoreBag sb cstore-  ItemFull{itemBase, itemKind} <- getsState $ itemToFull iid+  unless blast $ execSfxAtomic $ SfxProject origin iid+  bag <- getsState $ getBodyStoreBag body cstore+  ItemFull{itemKind} <- getsState $ itemToFull iid   case iid `EM.lookup` bag of-    Nothing -> error $ "" `showFailure` (source, pos, rest, iid, cstore)+    Nothing -> error $ "" `showFailure` (origin, pos, rest, iid, cstore)     Just kit@(_, it) -> do       let delay =             if IK.iweight itemKind == 0             then timeTurn  -- big delay at start, e.g., to easily read hologram             else timeZero  -- avoid running into own projectiles           btime = absoluteTimeAdd delay localTime-      addProjectile propeller pos rest iid kit lid (bfid sb) btime-      let c = CActor source cstore-      execUpdAtomic $ UpdLoseItem False iid itemBase (1, take 1 it) c+      addProjectile propeller pos rest iid kit lid (bfid body) btime+      let c = CActor origin cstore+      execUpdAtomic $ UpdLoseItem False iid (1, take 1 it) c  addActorFromGroup :: MonadServerAtomic m                   => GroupName ItemKind -> FactionId -> Point -> LevelId -> Time                   -> m (Maybe ActorId)-addActorFromGroup actorGroup bfid pos lid time = do+addActorFromGroup actorGroup fid pos lid time = do   -- We bootstrap the actor by first creating the trunk of the actor's body   -- that contains the fixed properties of all actors of that kind.   freq <- prepareItemKind 0 lid [(actorGroup, 1)]   m2 <- rollItemAspect freq lid   case m2 of-    Nothing -> return Nothing-    Just (itemKnown, itemFullKit) ->-      Just <$> registerActor False itemKnown itemFullKit bfid pos lid time+    NoNewItem -> return Nothing+    NewItem itemKnown itemFull itemQuant -> do+      let itemFullKit = (itemFull, itemQuant)+      Just <$> registerActor False itemKnown itemFullKit fid pos lid time  registerActor :: MonadServerAtomic m               => Bool -> ItemKnown -> ItemFullKit@@ -420,16 +469,17 @@       jfid = Just bfid       itemKnown = ItemKnown kindIx ar jfid       itemFull = itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}}-  trunkId <- registerItem (itemFull, kit) itemKnown container False+  trunkId <- registerItem False (itemFull, kit) itemKnown container   aid <- addNonProjectile summoned trunkId (itemFull, kit) bfid pos lid time   fact <- getsState $ (EM.! bfid) . sfactionD   actorMaxSk <- getsState $ getActorMaxSkills aid   condAnyFoeAdj <- getsState $ anyFoeAdj aid-  when (canSleep actorMaxSk &&-        not condAnyFoeAdj+  when (canSleep actorMaxSk+        && not condAnyFoeAdj         && not summoned         && not (fhasGender (gplayer fact))) $ do  -- heroes never start asleep-    let sleepOdds = if prefersSleep actorMaxSk then 9%10 else 1%2+    -- A lot of actors will wake up at once anyway, so let most start sleeping.+    let sleepOdds = if prefersSleep actorMaxSk then 19%20 else 2%3     sleeps <- rndToAction $ chance sleepOdds     when sleeps $ addSleep aid   return aid@@ -485,19 +535,40 @@             -> m ActorId addActorIid trunkId ItemFull{itemBase, itemKind, itemDisco=ItemDiscoFull arItem}             bproj fid pos lid tweakBody = do+  COps{coitem} <- getsState scops   -- Initial HP and Calm is based only on trunk and ignores organs.   let trunkMaxHP = max 2 $ IA.getSkill Ability.SkMaxHP arItem       hp = xM trunkMaxHP `div` 2-      -- Hard to auto-id items that refill Calm, but reduced sight at game-      -- start is more confusing and frustrating:-      calm = xM (max 0 $ IA.getSkill Ability.SkMaxCalm arItem)+      -- Slightly reduced starting Calm to auto-id items that refill Calm+      -- and to let animals do some initial exploration before going to sleep.+      -- Higher reduction would cause confusingly low sight range at game+      -- start and even inability to handle equipment.+      calm = xM (max 1 $ IA.getSkill Ability.SkMaxCalm arItem - 10)   -- Create actor.   factionD <- getsState sfactionD   curChalSer <- getsServer $ scurChalSer . soptions+  let fact = factionD EM.! fid+  bnumberTeam <- case gteamCont fact of+    Just teamContinuity | not bproj -> do+      stcounter <- getsServer stcounter+      let number = EM.findWithDefault 0 teamContinuity stcounter+      modifyServer $ \ser -> ser {stcounter =+        EM.insert teamContinuity (succ number) stcounter}+      return $ Just (number, teamContinuity)+    _ -> return Nothing+  let bnumber = fst <$> bnumberTeam   -- If difficulty is below standard, HP is added to the UI factions,   -- otherwise HP is added to their enemies.   -- If no UI factions, their role is taken by the escapees (for testing).   let diffBonusCoeff = difficultyCoeff $ cdiff curChalSer+      -- For most projectiles (exceptions are, e.g.,  maxHP boosting rings),+      -- SkMaxHP is zero, which means they drop after one hit regardless+      -- of extra bhp they have due to piercing. That is fine.+      -- If we want armoured missiles, that should not be done via piercing,+      -- but via SkMaxHP of the thrown items. Rings that are piercing+      -- by coincidence are harmless, too. However, piercing should not be+      -- added to missiles via SkMaxHP or equipping them would be beneficial+      -- in a hard to balance way (e.g., one bullet adds 10 SkMaxHP).       boostFact = not bproj                   && if diffBonusCoeff > 0                      then any (fhasUI . gplayer . snd)@@ -509,32 +580,79 @@       finalHP | boostFact = min (xM 899)  -- no more than UI can stand                                 (hp * 2 ^ abs diffBonusCoeff)               | otherwise = hp+      -- Prevent too high max HP resulting in panic when low HP/max HP ratio.       maxHP = min (finalHP + xM 100) (2 * finalHP)-        -- prevent too high max HP resulting in panic when low HP/max HP ratio       bonusHP = fromEnum (maxHP `div` oneM) - trunkMaxHP-      healthOrgans = [ (Just bonusHP, ("bonus HP", COrgan))-                     | bonusHP /= 0 && not bproj ]-      b = actorTemplate trunkId finalHP calm pos lid fid bproj+      healthOrgans = [(Just bonusHP, (IK.S_BONUS_HP, COrgan)) | bonusHP /= 0]+      b = actorTemplate trunkId bnumber finalHP calm pos lid fid bproj       withTrunk =-        b {bweapon = if IA.checkFlag Ability.Meleeable arItem then 1 else 0}+        b { bweapon = if IA.checkFlag Ability.Meleeable arItem then 1 else 0+          , bweapBenign =+              if IA.checkFlag Ability.Meleeable arItem+                 && IA.checkFlag Ability.Benign arItem then 1 else 0 }       bodyTweaked = tweakBody withTrunk   aid <- getsServer sacounter   modifyServer $ \ser -> ser {sacounter = succ aid}   execUpdAtomic $ UpdCreateActor aid bodyTweaked [(trunkId, itemBase)]-  -- Create, register and insert all initial actor items, including-  -- the bonus health organs from difficulty setting.-  forM_ (healthOrgans ++ map (Nothing,) (IK.ikit itemKind))-        $ \(mk, (ikText, cstore)) -> do-    let container = CActor aid cstore-        itemFreq = [(ikText, 1)]-    mIidEtc <- rollAndRegisterItem lid itemFreq container False mk-    case mIidEtc of-      Nothing -> error $ "" `showFailure` (lid, itemFreq, container, mk)-      Just (iid, (itemFull2, _)) ->-        when (cstore /= CGround) $-          -- The items are created in inventory, so won't be picked up,-          -- so we have to discover them now, if eligible.-          discoverIfMinorEffects container iid (itemKindId itemFull2)+  unless bproj $ do+    steamGearCur <- getsServer steamGearCur+    let gearList = case bnumberTeam of+          Nothing -> []+          Just (number, teamContinuity) ->+            case teamContinuity `EM.lookup` steamGearCur of+              Nothing -> []+              Just im -> IM.findWithDefault [] number im+    -- Create, register and insert all initial actor items, including+    -- the bonus health organs from difficulty setting.+    forM_ (healthOrgans ++ map (Nothing,) (IK.ikit itemKind))+          $ \(mk, (ikGrp, cstore)) -> do+     -- TODO: remove ASAP. This is a hack that prevents AI from stealing+     -- backstories until there is enough of the in Allure.+     -- Instead, pre-generate 20 player heroes to make sure all unique+     -- backstories are available to the player and so that the order+     -- of games played doesn't affect their avilability.+     if ikGrp == GroupName "backstory"+        && isJust bnumberTeam+        && (snd <$> bnumberTeam) /= Just teamExplorer+     then return ()+     else do+      let container = CActor aid cstore+      mIidEtc <- case lookup ikGrp gearList of+        Nothing -> do+          let itemFreq = [(ikGrp, 1)]+          -- Power depth of new items unaffected by number of spawned actors.+          freq <- prepareItemKind 0 lid itemFreq+          mIidEtc <- rollAndRegisterItem False lid freq container mk+          case (bnumberTeam, mIidEtc) of+            (Just (number, teamContinuity), Just (_, (itemFull2, _))) -> do+              let arItem2 = aspectRecordFull itemFull2+                  inMetaGame = IA.checkFlag Ability.MetaGame arItem2+                  itemKindId2 = itemKindId itemFull2+              when inMetaGame $ do+                let altInner ml = Just $ (ikGrp, itemKindId2) : fromMaybe [] ml+                    alt mim =+                      Just $ IM.alter altInner number $ fromMaybe IM.empty mim+                modifyServer $ \ser ->+                  ser {steamGear = EM.alter alt teamContinuity $ steamGear ser}+            _ -> return ()+          return mIidEtc+        Just itemKindId2 -> do+          let gearListNew = delete (ikGrp, itemKindId2) gearList+              (number, teamContinuity) = fromJust bnumberTeam+              alt mim =+                Just $ IM.insert number gearListNew $ fromMaybe IM.empty mim+          modifyServer $ \ser ->+            ser {steamGearCur = EM.alter alt teamContinuity steamGearCur}+          let itemKind2 = okind coitem itemKindId2+              freq = pure (itemKindId2, itemKind2)+          rollAndRegisterItem False lid freq container mk+      case mIidEtc of+        Nothing -> error $ "" `showFailure` (lid, ikGrp, container, mk)+        Just (iid, (itemFull2, _)) ->+          when (cstore /= CGround) $+            -- The items are created owned by actors, so won't be picked up,+            -- so we have to discover them now, if eligible.+            discoverIfMinorEffects container iid (itemKindId itemFull2)   return aid addActorIid _ _ _ _ _ _ _ = error "addActorIid: server ignorant about an item" @@ -563,14 +681,20 @@                  filter (IA.checkFlag Ability.Meleeable                          . aspectRecordFull . fst . snd) kitAssRaw   -- Server ignores item effects or it would leak item discovery info.-  -- In particular, it even uses weapons that would heal opponent,-  -- and not only in case of projectiles.+  -- Hence, weapons with powerful burning or wouding are undervalued.+  -- In particular, it even uses weapons that would heal an opponent.+  -- But server decides only in exceptiona cases, e.g. projectile collision+  -- or melee in place of an impossible displace. Otherwise, client decides.   strongest <- pickWeaponM False Nothing kitAss actorSk source   case strongest of     [] -> return Nothing-    iis@((maxS, _) : _) -> do-      let maxIis = map snd $ takeWhile ((== maxS) . fst) iis-      (_, (iid, _)) <- rndToAction $ oneOf maxIis+    iis@((value1, hasEffect1, timeout1, _, _, _) : _) -> do+      let minIis = takeWhile (\(value, hasEffect, timeout, _, _, _) ->+                                 value == value1+                                 && hasEffect == hasEffect1+                                 && timeout == timeout1)+                             iis+      (_, _, _, _, iid, _) <- rndToAction $ oneOf minIis       let cstore = if isJust (lookup iid bodyAssocs) then COrgan else CEqp       return $ Just (iid, cstore) @@ -624,18 +748,23 @@               => CStore -> GroupName ItemKind -> ActorId               -> m [(ItemId, ItemQuant)] allGroupItems store grp target = do+  COps{coitem} <- getsState scops   b <- getsState $ getActorBody target-  getKind <- getsState $ flip getIidKindServer-  let hasGroup (iid, _) =-        maybe False (> 0) $ lookup grp $ IK.ifreq $ getKind iid   assocsCStore <- getsState $ EM.assocs . getBodyStoreBag b store-  return $! filter hasGroup assocsCStore+  getKindId <- getsState $ flip getIidKindIdServer+  let assocsKindId = map (\as@(iid, _) -> (getKindId iid, as)) assocsCStore+      hasGroup (itemKindId, _) =+        maybe False (> 0) $ lookup grp $ IK.ifreq $ okind coitem itemKindId+  return $! map snd $ sortBy (comparing fst) $ filter hasGroup assocsKindId -addCondition :: MonadServerAtomic m => GroupName ItemKind -> ActorId -> m ()-addCondition name aid = do+addCondition :: MonadServerAtomic m+             => Bool -> GroupName ItemKind -> ActorId -> m ()+addCondition verbose name aid = do   b <- getsState $ getActorBody aid   let c = CActor aid COrgan-  mresult <- rollAndRegisterItem (blid b) [(name, 1)] c False Nothing+  -- Power depth of new items unaffected by number of spawned actors.+  freq <- prepareItemKind 0 (blid b) [(name, 1)]+  mresult <- rollAndRegisterItem verbose (blid b) freq c Nothing   assert (isJust mresult) $ return ()  removeConditionSingle :: MonadServerAtomic m@@ -645,20 +774,19 @@   is <- allGroupItems COrgan name aid   case is of     [(iid, (nAll, itemTimer))] -> do-      itemBase <- getsState $ getItemBody iid-      execUpdAtomic $ UpdLoseItem False iid itemBase (1, itemTimer) c+      execUpdAtomic $ UpdLoseItem False iid (1, itemTimer) c       return $ nAll - 1     _ -> error $ "missing or multiple item" `showFailure` (name, is)  addSleep :: MonadServerAtomic m => ActorId -> m () addSleep aid = do   b <- getsState $ getActorBody aid-  addCondition "asleep" aid+  addCondition True IK.S_ASLEEP aid   execUpdAtomic $ UpdWaitActor aid (bwatch b) WSleep  removeSleepSingle :: MonadServerAtomic m => ActorId -> m () removeSleepSingle aid = do-  nAll <- removeConditionSingle "asleep" aid+  nAll <- removeConditionSingle IK.S_ASLEEP aid   when (nAll == 0) $     execUpdAtomic $ UpdWaitActor aid WWake WWatch

engine-src/Game/LambdaHack/Server/DebugM.hs view

@@ -20,9 +20,9 @@ import Game.LambdaHack.Client (Response (..)) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Time+import Game.LambdaHack.Common.Types import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.State @@ -44,7 +44,7 @@     d <- debugAid aid "UpdCreateActor"     serverPrint d     debugPretty fid "RespUpdAtomic" cmd-  RespUpdAtomic _ cmd@(UpdSpotActor aid _ _) -> do+  RespUpdAtomic _ cmd@(UpdSpotActor aid _) -> do     d <- debugAid aid "UpdSpotActor"     serverPrint d     debugPretty fid "RespUpdAtomic" cmd

engine-src/Game/LambdaHack/Server/DungeonGen.hs view

@@ -22,16 +22,13 @@ import qualified Data.Text.IO as T import           System.IO (hFlush, stdout) import           System.IO.Unsafe (unsafePerformIO)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  import           Game.LambdaHack.Common.Area-import           Game.LambdaHack.Definition.Defs-import qualified Game.LambdaHack.Core.Dice as Dice import           Game.LambdaHack.Common.Kind import           Game.LambdaHack.Common.Level import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray-import           Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types@@ -41,6 +38,9 @@ import           Game.LambdaHack.Content.RuleKind import           Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Content.TileKind as TK+import qualified Game.LambdaHack.Core.Dice as Dice+import           Game.LambdaHack.Core.Random+import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Server.DungeonGen.AreaRnd import           Game.LambdaHack.Server.DungeonGen.Cave import           Game.LambdaHack.Server.DungeonGen.Place@@ -51,10 +51,10 @@                 -> Rnd TileMap convertTileMaps COps{corule=RuleContent{rXmax, rYmax}, cotile, coTileSpeedup}                 areAllWalkable cdefTile mpickPassable darea ltile = do-  let outerId = ouniqGroup cotile "unknown outer fence"-      runCdefTile :: (R.StdGen, (Int, [(Int, ContentId TileKind)]))+  let outerId = ouniqGroup cotile TK.S_UNKNOWN_OUTER_FENCE+      runCdefTile :: (SM.SMGen, (Int, [(Int, ContentId TileKind)]))                   -> ( ContentId TileKind-                     , (R.StdGen, (Int, [(Int, ContentId TileKind)])) )+                     , (SM.SMGen, (Int, [(Int, ContentId TileKind)])) )       runCdefTile (gen1, (pI, assocs)) =         let p = toEnum pI         in if p `inside` darea@@ -64,7 +64,7 @@                   in (tile, (gen2, (pI + 1, assocs)))            else (outerId, (gen1, (pI + 1, assocs)))       runUnfold gen =-        let (gen1, gen2) = R.split gen+        let (gen1, gen2) = SM.splitSMGen gen         in (PointArray.unfoldrNA               rXmax rYmax runCdefTile               (gen1, (0, IM.assocs $ EM.enumMapToIntMap ltile)), gen2)@@ -73,7 +73,7 @@     _ | areAllWalkable -> return converted1  -- all walkable; passes OK     Nothing -> return converted1  -- no walkable tiles for filling the map     Just pickPassable -> do  -- some tiles walkable, so ensure connectivity-      let passes p@Point{..} array =+      let passes p array =             Tile.isWalkable coTileSpeedup (array PointArray.! p)           -- If no point blocks on both ends, then I can eventually go           -- from bottom to top of the map and from left to right@@ -128,19 +128,18 @@                 -- symmetry kept for @cfenceApart@ caves, to save real estate  -- Create a level from a cave.-buildLevel :: COps -> ServerOptions -> Int -> GroupName CaveKind-           -> Int -> Dice.AbsDepth -> [(Point, Text)]+buildLevel :: COps -> ServerOptions+           -> LevelId -> ContentId CaveKind -> CaveKind -> Int -> Int+           -> Dice.AbsDepth -> [(Point, Text)]            -> Rnd (Level, [(Point, Text)])-buildLevel cops@COps{cocave, coplace, corule=RuleContent{..}} serverOptions-           ln genName minD totalDepth lstairPrev = do-  dkind <- fromMaybe (error $ "" `showFailure` genName)-           <$> opick cocave genName (const True)-  let kc = okind cocave dkind-      d = if cfenceApart kc then 1 else 0-      -- Simple rule for now: level @ln@ has depth (difficulty) @abs ln@.-      ldepth = Dice.AbsDepth $ abs ln+buildLevel cops@COps{coplace, corule=RuleContent{..}} serverOptions+           lid dkind kc doubleDownStairs singleDownStairs+           totalDepth stairsFromUp = do+  let d = if cfenceApart kc then 1 else 0+      -- Simple rule for now: level @lid@ has depth (difficulty) @abs lid@.+      ldepth = Dice.AbsDepth $ abs $ fromEnum lid       darea =-        let (lxPrev, lyPrev) = unzip $ map (px . fst &&& py . fst) lstairPrev+        let (lxPrev, lyPrev) = unzip $ map ((px &&& py) . fst) stairsFromUp             -- Stairs take some space, hence the additions.             lxMin = max 0                     $ -4 - d + minimum (rXmax - 1 : lxPrev)@@ -153,21 +152,11 @@             -- Pick minimal cave size that fits all previous stairs.             xspan = max (lxMax - lxMin + 1) $ cXminSize kc             yspan = max (lyMax - lyMin + 1) $ cYminSize kc-            x0 = min lxMin $ max (lxMax - xspan + 1) $ (rXmax - xspan) `div` 2-            y0 = min lyMin $ max (lyMax - yspan + 1) $ (rYmax - yspan) `div` 2+            x0 = min lxMin (rXmax - xspan)+            y0 = min lyMin (rYmax - yspan)         in fromMaybe (error $ "" `showFailure` kc)            $ toArea (x0, y0, x0 + xspan - 1, y0 + yspan - 1)-  -- Any stairs coming from above are considered extra stairs-  -- and if they don't exceed @extraStairs@,-  -- the amount is filled up with single downstairs.-  -- If they do exceed @extraStairs@, some of them end here.-  extraStairs <- castDice ldepth totalDepth $ cextraStairs kc-  let (abandonedStairs, remainingStairsDown) =-        if ln == minD then (length lstairPrev, 0)-        else let double = min (length lstairPrev) extraStairs-                 single = max 0 $ extraStairs - double-             in (length lstairPrev - double, single)-      (lstairsSingleUp, lstairsDouble) = splitAt abandonedStairs lstairPrev+      (lstairsDouble, lstairsSingleUp) = splitAt doubleDownStairs stairsFromUp       pstairsSingleUp = map fst lstairsSingleUp       pstairsDouble = map fst lstairsDouble       pallUpStairs = pstairsDouble ++ pstairsSingleUp@@ -184,7 +173,7 @@       -- Allowing corners and generating before stars, because they are more       -- important that stairs (except the first stairs, but they are guaranteed       -- unless the level has no incoming stairs, but if so, plenty of space).-      mepos <- placeDownStairs "escape" True serverOptions ln+      mepos <- placeDownStairs "escape" True serverOptions lid                                kc darea pallUpStairs boot       case mepos of         Just epos -> return [(epos, escapeFreq)]@@ -194,22 +183,22 @@       addSingleDown :: [Point] -> Int -> Rnd [Point]       addSingleDown acc 0 = return acc       addSingleDown acc k = do-        mpos <- placeDownStairs "stairs" False serverOptions ln+        mpos <- placeDownStairs "stairs" False serverOptions lid                                 kc darea (pallUpAndEscape ++ acc) boot         case mpos of           Just pos -> addSingleDown (pos : acc) (k - 1)           Nothing -> return acc  -- calling again won't change anything-  pstairsSingleDown <- addSingleDown [] remainingStairsDown+  pstairsSingleDown <- addSingleDown [] singleDownStairs   let freqDouble carried =         filter (\(gn, _) -> carried `elem` T.words (fromGroupName gn))         $ cstairFreq kc ++ cstairAllowed kc       fixedStairsDouble = map (second freqDouble) lstairsDouble       freqUp carried =-        map (first (\gn -> toGroupName $ fromGroupName gn <+> "up"))+        map (first (\gn -> GroupName $ fromGroupName gn <+> "up"))         $ freqDouble carried       fixedStairsUp = map (second freqUp) lstairsSingleUp       freqDown =-        map (first (\gn -> toGroupName $ fromGroupName gn <+> "down"))+        map (first (\gn -> GroupName $ fromGroupName gn <+> "down"))         $ cstairFreq kc       fixedStairsDown = map (, freqDown) pstairsSingleDown       pallExits = pallUpAndEscape ++ pstairsSingleDown@@ -218,23 +207,28 @@   -- Avoid completely uniform levels (e.g., uniformly merged places).   bootExtra <- if EM.null fixedCenters then do                  mpointExtra <--                   placeDownStairs "extra boot" False serverOptions ln+                   placeDownStairs "extra boot" False serverOptions lid                                    kc darea pallExits boot                  -- With sane content, @Nothing@ should never appear.                  return $! maybeToList mpointExtra                else return []   let posUp Point{..} = Point (px - 1) py       posDn Point{..} = Point (px + 1) py-      lstair = ( map posUp $ pstairsSingleUp ++ pstairsDouble+      -- This and other places ensure there is always a continuous+      -- staircase from bottom to top. This makes moving between empty+      -- level much less boring. For new levels, it may be blocked by enemies+      -- or not offer enough cover, so other staircases may be preferable.+      lstair = ( map posUp $ pstairsDouble ++ pstairsSingleUp                , map posDn $ pstairsDouble ++ pstairsSingleDown )   cellSize <- castDiceXY ldepth totalDepth $ ccellSize kc   let subArea = fromMaybe (error $ "" `showFailure` kc) $ shrink darea       area = if cfenceApart kc then subArea else darea       (lgr, gs) = grid fixedCenters (boot ++ bootExtra) area cellSize-  dsecret <- randomR (1, maxBound)+  dsecret <- randomWord32   cave <- buildCave cops ldepth totalDepth darea dsecret dkind lgr gs bootExtra   cmap <- buildTileMap cops cave-  let lvl = levelFromCave cops cave ldepth cmap lstair pescape+  -- The bang is needed to prevent caves memory drag until levels used.+  let !lvl = levelFromCave cops cave ldepth cmap lstair pescape       stairCarried p0 =         let Place{qkind} = dstairs cave EM.! p0             freq = map (first $ T.words . tshow)@@ -261,20 +255,27 @@  -- Places yet another staircase (or escape), taking into account only -- the already existing stairs.-placeDownStairs :: Text -> Bool -> ServerOptions -> Int+placeDownStairs :: Text -> Bool -> ServerOptions -> LevelId                 -> CaveKind -> Area -> [Point] -> [Point]                 -> Rnd (Maybe Point)-placeDownStairs object cornerPermitted serverOptions ln+placeDownStairs object cornerPermitted serverOptions lid                 CaveKind{cminStairDist, cfenceApart} darea ps boot = do   let dist cmin p = all (\pos -> chessDist p pos > cmin) ps       (x0, y0, x1, y1) = fromArea darea       -- Stairs in corners often enlarge next caves, so refrain from       -- generating stairs, if only corner available (escapes special-cased).+      -- The bottom-right corner is exempt, becuase far from messages+      -- Also, avoid generating stairs at all on upper and left margins+      -- to keep subsequent small levels away from messages on top-right.+      rx = 9  -- enough to fit smallest stairs+      ry = 6  -- enough to fit smallest stairs+      wx = x1 - x0 + 1+      wy = y1 - y0 + 1       notInCorner Point{..} =         cornerPermitted-        || x1 - x0 + 1 < 40 || y1 - y0 + 1 < 20  -- everything is a corner-        || px > x0 + 9 && px < x1 - 9  -- enough to fit smallest stairs-        || py > y0 + 6 && py < y1 - 6  -- enough to fit smallest stairs+        || wx < 3 * rx + 3 || wy < 3 * ry + 3  -- everything is a corner+        || px > x0 + (wx - 3) `div` 3+           && py > y0 + (wy - 3) `div` 3       f p = case snapToStairList 0 ps p of         Left{} -> Nothing         Right np -> let nnp = either id id $ snapToStairList 0 boot np@@ -295,7 +296,7 @@            then unsafePerformIO $ do              T.hPutStrLn stdout $                 "Failed to place" <+> object <+> "on level"-                <+> tshow ln <> ", in" <+> tshow darea+                <+> tshow lid <> ", in" <+> tshow darea              hFlush stdout -- Not really expensive, but shouldn't disrupt normal testing nor play. #ifdef WITH_EXPENSIVE_ASSERTIONS@@ -339,28 +340,77 @@  -- | Generate the dungeon for a new game. dungeonGen :: COps -> ServerOptions -> Caves -> Rnd FreshDungeon-dungeonGen cops serverOptions caves = do-  let keys = concatMap fst caves+dungeonGen cops@COps{cocave} serverOptions caves = do+  let shuffleSegment :: ([Int], [GroupName CaveKind])+                     -> Rnd [(Int, GroupName CaveKind)]+      shuffleSegment (ns, l) = assert (length ns == length l) $ do+        lShuffled <- shuffle l+        return $! zip ns lShuffled+  cavesShuffled <- mapM shuffleSegment caves+  let cavesFlat = concat cavesShuffled+      keys = map fst cavesFlat       minD = minimum keys       maxD = maximum keys       freshTotalDepth = assert (signum minD == signum maxD)                         $ Dice.AbsDepth                         $ max 10 $ max (abs minD) (abs maxD)-      placeCaveGroup :: ([(LevelId, Level)], [(Point, Text)])-                     -> (Int, GroupName CaveKind)+      getCaveKindNum :: (Int, GroupName CaveKind)+                     -> Rnd ((LevelId, ContentId CaveKind, CaveKind), Int)+      getCaveKindNum (ln, genName) = do+        dkind <- fromMaybe (error $ "" `showFailure` genName)+                 <$> opick cocave genName (const True)+        let kc = okind cocave dkind+            ldepth = Dice.AbsDepth $ abs ln+        maxStairsNum <- castDice ldepth freshTotalDepth $ cmaxStairsNum kc+        return ((toEnum ln, dkind, kc), maxStairsNum)+  caveKindNums <- mapM getCaveKindNum cavesFlat+  let (caveKinds, caveNums) = unzip caveKindNums+      caveNumNexts = zip caveNums $ drop 1 caveNums ++ [0]+      placeStairs :: ([(Int, Int, Int)], Int)+                  -> (Int, Int)+                  -> ([(Int, Int, Int)], Int)+      placeStairs (acc, nstairsFromUp) (maxStairsNum, maxStairsNumNext) =+        let !_A1 = assert (nstairsFromUp <= maxStairsNum) ()+            -- Any stairs coming from above are kept and if they exceed+            -- @maxStairsNumNext@, the remainder ends here.+            -- If they don't exceed the minimum of @maxStairsNum@+            -- and @maxStairsNumNext@, the difference is filled up+            -- with single downstairs. The computation below maximizes+            -- the number of stairs at the cost of breaking some long+            -- staircases, except for the first one, which is always kept.+            -- Even without this exception, sometimes @maxStairsNum@+            -- could not be reached.+            doubleKept =+              minimum [1, nstairsFromUp, maxStairsNum, maxStairsNumNext]+            nstairsFromUp1 = nstairsFromUp - doubleKept+            maxStairsNum1 = maxStairsNum - doubleKept+            maxStairsNumNext1 = maxStairsNumNext - doubleKept+            singleDownStairs =+              min maxStairsNumNext1 $ maxStairsNum1 - nstairsFromUp1+            remainingNext = maxStairsNumNext1 - singleDownStairs+            doubleDownStairs = doubleKept+                               + min nstairsFromUp1 remainingNext+            !_A2 = assert (singleDownStairs >= 0) ()+            !_A3 = assert (doubleDownStairs >= doubleKept) ()+        in ( (nstairsFromUp, doubleDownStairs, singleDownStairs) : acc+           , doubleDownStairs + singleDownStairs )+      (caveStairs, nstairsFromUpLast) = foldl' placeStairs ([], 0) caveNumNexts+      caveZipped = assert (nstairsFromUpLast == 0)+                   $ zip caveKinds (reverse caveStairs)+      placeCaveKind :: ([(LevelId, Level)], [(Point, Text)])+                     -> ( (LevelId, ContentId CaveKind, CaveKind)+                        , (Int, Int, Int) )                      -> Rnd ([(LevelId, Level)], [(Point, Text)])-      placeCaveGroup (lvls, ldown) (n, genName) = do+      placeCaveKind (lvls, stairsFromUp)+                    ( (lid, dkind, kc)+                    , (nstairsFromUp, doubleDownStairs, singleDownStairs) ) = do+        let !_A = assert (length stairsFromUp == nstairsFromUp) ()         (newLevel, ldown2) <-           -- lstairUp for the next level is lstairDown for the current level-          buildLevel cops serverOptions n genName minD freshTotalDepth ldown-        return ((toEnum n, newLevel) : lvls, ldown2)-      buildLvls :: ([(LevelId, Level)], [(Point, Text)])-                -> ([Int], [GroupName CaveKind])-                -> Rnd ([(LevelId, Level)], [(Point, Text)])-      buildLvls (lvls, ldown) (ns, l) = assert (length ns == length l) $ do-        lShuffled <- shuffle l-        let nsl = zip ns lShuffled-        foldlM' placeCaveGroup (lvls, ldown) nsl-  (levels, _) <- foldlM' buildLvls ([], []) caves-  let freshDungeon = EM.fromList levels+          buildLevel cops serverOptions+                     lid dkind kc doubleDownStairs singleDownStairs+                     freshTotalDepth stairsFromUp+        return ((lid, newLevel) : lvls, ldown2)+  (levels, stairsFromUpLast) <- foldlM' placeCaveKind ([], []) caveZipped+  let freshDungeon = assert (null stairsFromUpLast) $ EM.fromList levels   return $! FreshDungeon{..}

engine-src/Game/LambdaHack/Server/DungeonGen/AreaRnd.hs view

@@ -23,11 +23,11 @@ import qualified Data.IntSet as IS  import Game.LambdaHack.Common.Area-import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Common.Point-import Game.LambdaHack.Core.Random import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.PlaceKind+import Game.LambdaHack.Core.Random+import Game.LambdaHack.Definition.Defs  -- Doesn't respect minimum sizes, because staircases are specified verbatim, -- so can't be arbitrarily scaled up.@@ -49,7 +49,7 @@ pointInArea :: Area -> Rnd Point pointInArea area = do   let (Point x0 y0, xspan, yspan) = spanArea area-  pxy <- randomR (0, xspan * yspan - 1)+  pxy <- randomR0 (xspan * yspan - 1)   let Point{..} = punindex xspan pxy   return $! Point (x0 + px) (y0 + py) @@ -72,11 +72,11 @@           Nothing -> fallback       gsearch 0 = fsearch (xspan * yspan * 10)       gsearch count = do-        pxy <- randomR (0, xspan * yspan - 1)+        pxy <- randomR0 (xspan * yspan - 1)         checkPoint g (gsearch (count - 1)) pxy       fsearch 0 = return $! runIdentity $ searchAll (xspan * yspan - 1)       fsearch count = do-        pxy <- randomR (0, xspan * yspan - 1)+        pxy <- randomR0 (xspan * yspan - 1)         checkPoint f (fsearch (count - 1)) pxy       searchAll (-1) = pure Nothing       searchAll pxyRelative =@@ -120,7 +120,7 @@                                            | y <- [0..ny-1], x <- [0..nx-1] ]   -- Candidates are neighbours that are still unconnected. We start with   -- a random choice.-  p <- oneOf $ ES.toList $ unconnected ES.\\ voidPlaces+  p <- oneOf $ ES.elems $ unconnected ES.\\ voidPlaces   let candidates = ES.singleton p   connectGrid' voidPlaces (nx, ny) unconnected candidates [] @@ -132,7 +132,7 @@   | unconnected `ES.isSubsetOf` voidPlaces = return acc   | otherwise = do       let candidatesBest = candidates ES.\\ voidPlaces-      c <- oneOf $ ES.toList $ if ES.null candidatesBest+      c <- oneOf $ ES.elems $ if ES.null candidatesBest                                then candidates                                else candidatesBest       -- potential new candidates:@@ -143,7 +143,7 @@       new <- if ES.null ds              then return id              else do-               d <- oneOf (ES.toList ds)+               d <- oneOf (ES.elems ds)                return (sortPoint (c, d) :)       connectGrid' voidPlaces (nx, ny) nu         (ES.delete c (candidates `ES.union` nc)) (new acc)@@ -160,12 +160,12 @@   rb <- oneOf [False, True]   if rb && nx > 1   then do-    rx <- randomR (0, nx-2)-    ry <- randomR (0, ny-1)+    rx <- randomR0 (nx - 2)+    ry <- randomR0 (ny - 1)     return (Point rx ry, Point (rx+1) ry)   else do-    rx <- randomR (0, nx-1)-    ry <- randomR (0, ny-2)+    rx <- randomR0 (nx - 1)+    ry <- randomR0 (ny - 2)     return (Point rx ry, Point rx (ry+1))  -- Plotting individual corridors between two areas

engine-src/Game/LambdaHack/Server/DungeonGen/Cave.hs view

@@ -14,16 +14,17 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import           Data.Key (mapWithKeyM)+import           Data.Word (Word32)  import           Game.LambdaHack.Common.Area import           Game.LambdaHack.Common.Kind+import           Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.Tile as Tile import           Game.LambdaHack.Common.Vector import           Game.LambdaHack.Content.CaveKind import           Game.LambdaHack.Content.PlaceKind import           Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Common.Point import           Game.LambdaHack.Core.Random import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Server.DungeonGen.AreaRnd@@ -68,7 +69,7 @@           -> Dice.AbsDepth       -- ^ depth of the level to generate           -> Dice.AbsDepth       -- ^ absolute depth           -> Area                -- ^ map area of the cave-          -> Int                 -- ^ secret tile seed+          -> Word32              -- ^ secret tile seed           -> ContentId CaveKind  -- ^ cave kind to use for generation           -> (X, Y)              -- ^ the dimensions of the grid of places           -> EM.EnumMap Point SpecialArea  -- ^ pos of stairs, etc.@@ -162,7 +163,8 @@         voidPlaces <- do           let gridArea = fromMaybe (error $ "" `showFailure` lgr)                          $ toArea (0, 0, gx - 1, gy - 1)-              voidNum = round $ cmaxVoid * fromIntegral (EM.size gs2)+              voidNum = round $+                cmaxVoid * (fromIntegralWrap :: Int -> Rational) (EM.size gs2)               isOrdinaryArea p = case p `EM.lookup` gs2 of                 Just SpecialArea{} -> True                 _ -> False@@ -200,7 +202,7 @@                     return ( EM.unions [qmap place, qfence place, m]                            , EM.insert i (place, ar) qls                            , qstairs )-                SpecialFixed p@Point{..} placeFreq ar -> do+                SpecialFixed p placeFreq ar -> do                   -- Reserved for corridors and the global fence.                   let innerArea = fromMaybe (error $ "" `showFailure` (i, ar))                                   $ shrink ar@@ -234,7 +236,8 @@         connects <- connectGrid voidPlaces lgrid         addedConnects <- do           let cauxNum =-                round $ cauxConnects * fromIntegral (fst lgrid * snd lgrid)+                round $ cauxConnects * (fromIntegralWrap :: Int -> Rational)+                                         (fst lgrid * snd lgrid)           cns <- map head . group . sort                  <$> replicateM cauxNum (randomConnection lgrid)           -- This allows connections through a single void room,@@ -301,19 +304,22 @@         if pfence (okind coplace qkind) `elem` [FFloor, FGround]         then EM.map (const $ PAround qkind) qfence         else EM.empty+      pickRepresentant Place{..} =+        let (representant, _, _) = spanArea qarea+        in EM.singleton representant $ PExists qkind       dentry = EM.unions $-        EM.map (\(_, _, pk) -> PEntry pk) interCor-        : map (\(place, _) -> aroundFence place) (EM.elems dplaces)-        ++  -- for @FNone@ fences with walkable tiles on the edges-         [EM.map (\(_, _, pk) -> PEnd pk) $-            let mergeCorAlways pl (cor, pk) = (pl, cor, pk)-            in EM.intersectionWith mergeCorAlways lplaces lplcorOuter]+        [EM.map (\(_, _, pk) -> PEntry pk) interCor]+        ++ map (\(place, _) -> aroundFence place) (EM.elems dplaces)+        ++ -- for @FNone@ fences with walkable tiles on the edges+           -- that may have no intersection with corridots,+           -- particularly if @X@ is used+           map (\(place, _) -> pickRepresentant place) (EM.elems dplaces)       dmap = EM.unions [doorMap, lplacesObscured, lcorOuter, lcorInner, fence]         -- order matters   return $! Cave {..}  pickOpening :: COps -> CaveKind -> TileMapEM -> ContentId TileKind-            -> Int -> Point+            -> Word32 -> Point             -> (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)             -> Rnd (ContentId TileKind) pickOpening COps{cotile, coTileSpeedup}@@ -338,9 +344,9 @@     let hidden = Tile.buildAs cotile pl     doorTrappedId <- Tile.revealAs cotile hidden     let !_A = assert (Tile.buildAs cotile doorTrappedId == doorTrappedId) ()-    -- Not all solid tiles can hide a door, so @doorTrappedId@ may in fact-    -- not be a door at all, hence the check.-    if Tile.isDoor coTileSpeedup doorTrappedId then do  -- door created+    -- Not all solid tiles can hide a door (or any other openable tile),+    -- so @doorTrappedId@ may in fact not be a door at all, hence the check.+    if Tile.isOpenable coTileSpeedup doorTrappedId then do  -- door created       ro <- chance copenChance       if ro       then Tile.openTo cotile doorTrappedId@@ -348,6 +354,6 @@            then return $! doorTrappedId  -- server will hide it            else do              doorOpenId <- Tile.openTo cotile doorTrappedId-             Tile.closeTo cotile doorOpenId+             Tile.closeTo cotile doorOpenId  -- mail do nothing; OK     else return $! doorTrappedId  -- assume this is what content enforces   else return $! nicerCorridor

engine-src/Game/LambdaHack/Server/DungeonGen/Place.hs view

@@ -17,6 +17,7 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Text as T+import           Data.Word (Word32)  import           Game.LambdaHack.Common.Area import           Game.LambdaHack.Common.Kind@@ -110,7 +111,7 @@            -> ContentId TileKind  -- ^ lit fence tile, if fence hollow            -> Dice.AbsDepth       -- ^ current level depth            -> Dice.AbsDepth       -- ^ absolute depth-           -> Int                 -- ^ secret tile seed+           -> Word32              -- ^ secret tile seed            -> Area                -- ^ whole area of the place, fence included            -> Maybe Area          -- ^ whole inner area of the grid cell            -> Freqs PlaceKind     -- ^ optional fixed place freq@@ -182,12 +183,16 @@                        dark (pfence kr) qarea   return $! Place {..} -isChancePos :: Int -> Int -> Int -> Point -> Bool-isChancePos k n dsecret (Point x y) = k > 0 && n > 0 &&-  let z = dsecret `Bits.rotateR` x `Bits.xor` y + x+isChancePos :: Int -> Int -> Word32 -> Point -> Bool+isChancePos k' n' dsecret (Point x' y') = k' > 0 && n' > 0 &&+  let k = toEnum k'+      n = toEnum n'+      x = toEnum x'+      y = toEnum y'+      z = dsecret `Bits.rotateR` x' `Bits.xor` y + x   in if k < n      then z `mod` ((n + k) `divUp` k) == 0-     else z `mod` ((k + n) `divUp` n) /= 0+     else z `mod` ((n + k) `divUp` n) /= 0  -- | Roll a legend of a place plan: a map from plan symbols to tile kinds. olegend :: COps -> GroupName TileKind@@ -277,7 +282,7 @@       allTheSame = all (== cfenceTileN) [cfenceTileE, cfenceTileS, cfenceTileW]       fenceIdRnd couterFenceTile (xf, yf) = do         let isCorner x y = x `elem` [x0-1, x1+1] && y `elem` [y0-1, y1+1]-            tileGroup | isCorner xf yf && not allTheSame = "basic outer fence"+            tileGroup | isCorner xf yf && not allTheSame = TK.S_BASIC_OUTER_FENCE                       | otherwise = couterFenceTile         fenceId <- fromMaybe (error $ "" `showFailure` tileGroup)                    <$> opick cotile tileGroup (const True)

− engine-src/Game/LambdaHack/Server/EndM.hs

@@ -1,154 +0,0 @@--- | Server operations used when ending game and deciding whether to end.-module Game.LambdaHack.Server.EndM-  ( endOrLoop, dieSer, writeSaveAll-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , gameExit-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Core.Prelude--import qualified Data.EnumMap.Strict as EM--import Game.LambdaHack.Atomic-import Game.LambdaHack.Client (sbenchmark)-import Game.LambdaHack.Common.Actor-import Game.LambdaHack.Common.ActorState-import Game.LambdaHack.Common.Faction-import Game.LambdaHack.Common.MonadStateRead-import Game.LambdaHack.Common.State-import Game.LambdaHack.Common.Types-import Game.LambdaHack.Content.ModeKind-import Game.LambdaHack.Definition.Defs-import Game.LambdaHack.Server.CommonM-import Game.LambdaHack.Server.Fov-import Game.LambdaHack.Server.HandleEffectM-import Game.LambdaHack.Server.MonadServer-import Game.LambdaHack.Server.ProtocolM-import Game.LambdaHack.Server.ServerOptions-import Game.LambdaHack.Server.State---- | Continue or exit or restart the game.-endOrLoop :: (MonadServerAtomic m, MonadServerComm m)-          => m () -> (Maybe (GroupName ModeKind) -> m ())-          -> m ()-endOrLoop loop restart = do-  factionD <- getsState sfactionD-  let inGame fact = case gquit fact of-        Nothing -> True-        Just Status{stOutcome=Camping} -> True-        _ -> False-      gameOver = not $ any inGame $ EM.elems factionD-  let getQuitter fact = case gquit fact of-        Just Status{stOutcome=Restart, stNewGame} -> stNewGame-        _ -> Nothing-      quitters = mapMaybe getQuitter $ EM.elems factionD-      restartNeeded = gameOver || not (null quitters)-  let isCamper fact = case gquit fact of-        Just Status{stOutcome=Camping} -> True-        _ -> False-      campers = filter (isCamper . snd) $ EM.assocs factionD-  -- Wipe out the quit flag for the savegame files.-  mapM_ (\(fid, fact) ->-    execUpdAtomic $ UpdQuitFaction fid (gquit fact) Nothing Nothing) campers-  swriteSave <- getsServer swriteSave-  when swriteSave $ do-    modifyServer $ \ser -> ser {swriteSave = False}-    writeSaveAll True-  if | restartNeeded -> do-       execSfxAtomic SfxRestart-       restart (listToMaybe quitters)-     | not $ null campers -> gameExit  -- and @loop@ is not called-     | otherwise -> loop  -- continue current game--gameExit :: (MonadServerAtomic m, MonadServerComm m) => m ()-gameExit = do---  debugPossiblyPrint "Server: Verifying all perceptions."-  -- Verify that the possibly not saved caches are equal to future-  -- reconstructed. Otherwise, save/restore would change game state.-  -- This is done even in released binaries, because it only prolongs-  -- game shutdown a bit. The same checks at each periodic game save-  -- would icrease the game saving lag, so they are normally avoided.-  verifyCaches-  -- Kill all clients, including those that did not take part-  -- in the current game.-  -- Clients exit not now, but after they print all ending screens.---  debugPossiblyPrint "Server: Killing all clients."-  killAllClients---  debugPossiblyPrint "Server: All clients killed."-  return ()--verifyCaches :: MonadServer m => m ()-verifyCaches = do-  sperCacheFid <- getsServer sperCacheFid-  sperValidFid <- getsServer sperValidFid-  sactorMaxSkills2 <- getsState sactorMaxSkills-  sfovLucidLid <- getsServer sfovLucidLid-  sfovClearLid <- getsServer sfovClearLid-  sfovLitLid <- getsServer sfovLitLid-  sperFid <- getsServer sperFid-  actorMaxSkills <- getsState maxSkillsInDungeon-  ( fovLitLid, fovClearLid, fovLucidLid-   ,perValidFid, perCacheFid, perFid ) <- getsState perFidInDungeon-  let !_A7 = assert (sfovLitLid == fovLitLid-                     `blame` "wrong accumulated sfovLitLid"-                     `swith` (sfovLitLid, fovLitLid)) ()-      !_A6 = assert (sfovClearLid == fovClearLid-                     `blame` "wrong accumulated sfovClearLid"-                     `swith` (sfovClearLid, fovClearLid)) ()-      !_A5 = assert (sactorMaxSkills2 == actorMaxSkills-                     `blame` "wrong accumulated sactorMaxSkills"-                     `swith` (sactorMaxSkills2, actorMaxSkills)) ()-      !_A4 = assert (sfovLucidLid == fovLucidLid-                     `blame` "wrong accumulated sfovLucidLid"-                     `swith` (sfovLucidLid, fovLucidLid)) ()-      !_A3 = assert (sperValidFid == perValidFid-                     `blame` "wrong accumulated sperValidFid"-                     `swith` (sperValidFid, perValidFid)) ()-      !_A2 = assert (sperCacheFid == perCacheFid-                     `blame` "wrong accumulated sperCacheFid"-                     `swith` (sperCacheFid, perCacheFid)) ()-      !_A1 = assert (sperFid == perFid-                     `blame` "wrong accumulated perception"-                     `swith` (sperFid, perFid)) ()-  return ()--dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()-dieSer aid b = do-  b2 <- if bproj b then return b else do-    kindId <- getsState $ getIidKindIdServer $ btrunk b-    execUpdAtomic $ UpdRecordKill aid kindId 1-    -- At this point the actor's body exists and his items are not dropped.-    deduceKilled aid-    -- Most probabaly already done, but just in case (e.g., when actor-    -- created with 0 HP):-    electLeader (bfid b) (blid b) aid-    fact <- getsState $ (EM.! bfid b) . sfactionD-    -- Prevent faction's stash from being lost in case they are not spawners.-    -- Projectiles can't drop stash, because they are blind and so the faction-    -- would not see the actor that drops the stash, leading to a crash.-    -- But this is OK; projectiles can't be leaders, so stash dropped earlier.-    when (isNothing $ gleader fact) $ moveStores False aid CSha CInv-    getsState $ getActorBody aid-  -- If the actor was a projectile and no effect was triggered by hitting-  -- an enemy, the item still exists and @OnSmash@ effects will be triggered:-  dropAllItems aid b2-  b3 <- getsState $ getActorBody aid-  execUpdAtomic $ UpdDestroyActor aid b3 []---- | Save game on server and all clients.-writeSaveAll :: MonadServerAtomic m => Bool -> m ()-writeSaveAll uiRequested = do-  bench <- getsServer $ sbenchmark . sclientOptions . soptions-  noConfirmsGame <- isNoConfirmsGame-  when (uiRequested || not bench && not noConfirmsGame) $ do-    execUpdAtomic UpdWriteSave-    saveServer-#ifdef WITH_EXPENSIVE_ASSERTIONS-    -- This check is sometimes repeated in @gameExit@, but we don't care about-    -- speed of shutdown and even more so in WITH_EXPENSIVE_ASSERTIONS mode.-    verifyCaches-#endif

engine-src/Game/LambdaHack/Server/Fov.hs view

@@ -15,8 +15,9 @@   , totalFromPerActor, lucidFromLevel, perFidInDungeon #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , cacheBeforeLucidFromActor, shineFromLevel, floorLightSources, lucidFromItems-  , litFromLevel, litInDungeon, clearFromLevel, clearInDungeon, lucidInDungeon+  , perceptionFromPTotalNoStash, cacheBeforeLucidFromActor, shineFromLevel+  , floorLightSources, lucidFromItems, litFromLevel+  , litInDungeon, clearFromLevel, clearInDungeon, lucidInDungeon   , perLidFromFaction, perceptionCacheFromLevel   , Matrix, fullscan #endif@@ -34,6 +35,7 @@  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@@ -57,6 +59,9 @@   deriving (Show, Eq)  -- | Main perception validity map, for all factions.+--+-- The inner type is not a set, due to an unbenchmarked theory+-- that a constant shape map is faster. type PerValidFid = EM.EnumMap FactionId (EM.EnumMap LevelId Bool)  -- | Visually reachable positions (light passes through them to the actor).@@ -129,8 +134,19 @@ -- light source, e.g,, carried by an actor. A reachable and lucid position -- is visible. Additionally, positions directly adjacent to an actor are -- assumed to be visible to him (through sound, touch, noctovision, whatever).-perceptionFromPTotal :: FovLucid -> CacheBeforeLucid -> Perception-perceptionFromPTotal FovLucid{fovLucid} ptotal =+perceptionFromPTotal :: FactionId -> LevelId+                     -> FovLucid -> CacheBeforeLucid -> State+                     -> Perception+perceptionFromPTotal fid lidPer fovLucid ptotal s =+  let per = perceptionFromPTotalNoStash fovLucid ptotal+  in case gstash $ sfactionD s EM.! fid of+       Just (lid, pos) | lid == lidPer ->+         per {psight = (psight per) {pvisible = ES.insert pos+                                                $ pvisible (psight per)}}+       _ -> per++perceptionFromPTotalNoStash :: FovLucid -> CacheBeforeLucid -> Perception+perceptionFromPTotalNoStash FovLucid{fovLucid} ptotal =   let nocto = pvisible $ cnocto ptotal       reach = preachable $ creachable ptotal       psight = PerVisible $ nocto `ES.union` (reach `ES.intersection` fovLucid)@@ -172,17 +188,27 @@  totalFromPerActor :: PerActor -> CacheBeforeLucid totalFromPerActor perActor =-  let as = map (\case-                   FovValid x -> x-                   FovInvalid -> error $ "" `showFailure` perActor)-           $ EM.elems perActor-  in CacheBeforeLucid-       { creachable = PerReachable-                      $ ES.unions $ map (preachable . creachable) as-       , cnocto = PerVisible-                  $ ES.unions $ map (pvisible . cnocto) as-       , csmell = PerSmelled-                  $ ES.unions $ map (psmelled . csmell) as }+  let fromValid = \case+        FovValid x -> x+        FovInvalid -> error $ "" `showFailure` perActor+      addCacheBeforeLucid x cbl1 =+        let cbl2 = fromValid x+        in CacheBeforeLucid+          { creachable = PerReachable+                         $ ES.union (preachable $ creachable cbl1)+                                    (preachable $ creachable cbl2)+          , cnocto = PerVisible+                     $ ES.union (pvisible $ cnocto cbl1)+                                (pvisible $ cnocto cbl2)+          , csmell = PerSmelled+                     $ ES.union (psmelled $ csmell cbl1)+                                (psmelled $ csmell cbl2)+          }+      emptyCacheBeforeLucid = CacheBeforeLucid+        { creachable = PerReachable ES.empty+        , cnocto = PerVisible ES.empty+        , csmell = PerSmelled ES.empty }+  in foldr addCacheBeforeLucid emptyCacheBeforeLucid $ EM.elems perActor  -- | Update lights on the level. This is needed every (even enemy) -- actor move to show thrown torches.@@ -292,9 +318,9 @@         _ -> error $ "" `showFailure` (lid, fovLucidLid)       getValid (FovValid pc) = pc       getValid FovInvalid = error $ "" `showFailure` fid-  in ( EM.mapWithKey (\lid pc ->-         perceptionFromPTotal (fovLucid lid) (getValid (ptotal pc))) em-     , em )+      per lid pc = perceptionFromPTotal+                     fid lid (fovLucid lid) (getValid (ptotal pc)) s+  in (EM.mapWithKey per em, em)  perceptionCacheFromLevel :: FovClearLid -> FactionId -> LevelId -> State                          -> PerceptionCache

engine-src/Game/LambdaHack/Server/HandleAtomicM.hs view

@@ -4,6 +4,7 @@   ( cmdAtomicSemSer #ifdef EXPOSE_INTERNAL     -- * Internal operations+  , validateFloor, validateFloorBag, levelOfStash   , invalidateArenas, updateSclear, updateSlit   , invalidateLucidLid, invalidateLucidAid   , actorHasShine, itemAffectsShineRadius, itemAffectsPerRadius@@ -22,16 +23,17 @@ import           Game.LambdaHack.Atomic 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.MonadStateRead+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.Types import           Game.LambdaHack.Content.TileKind (TileKind)-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Server.Fov@@ -43,6 +45,7 @@ -- (except where the supplied @oldState@ is used). cmdAtomicSemSer :: MonadServer m => State -> UpdAtomic -> m () cmdAtomicSemSer oldState cmd = case cmd of+  UpdRegisterItems{} -> return ()   UpdCreateActor aid b _ -> do     actorMaxSkills <- getsState sactorMaxSkills     when (actorHasShine actorMaxSkills aid) $ invalidateLucidLid $ blid b@@ -59,30 +62,38 @@           , strajPushedBy = EM.delete aid (strajPushedBy ser)           , sactorAn = EM.delete aid (sactorAn ser)           , sactorStasis = ES.delete aid (sactorStasis ser) }-  UpdCreateItem iid _ _ (CFloor lid _) -> do-    discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid-  UpdCreateItem iid _ _ (CActor aid store) -> do+  UpdCreateItem _ iid _ _ (CFloor lid _) -> validateFloor iid lid+  UpdCreateItem _ iid _ _ (CActor aid CStash) -> do+    lid <- levelOfStash aid+    validateFloor iid lid+  UpdCreateItem _ iid _ _ (CActor aid CGround) -> do+    lid <- getsState $ blid . getActorBody aid+    validateFloor iid lid+  UpdCreateItem _ iid _ _ (CActor aid _) -> do     discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid [store]) $+    when (itemAffectsShineRadius discoAspect iid) $       invalidateLucidAid aid-    when (store `elem` [CEqp, COrgan]) $-      when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid-  UpdDestroyItem iid _ _ (CFloor lid _) -> do-    discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid-  UpdDestroyItem iid _ _ (CActor aid store) -> do+    when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid+  UpdCreateItem{} -> return ()+  UpdDestroyItem _ iid _ _ (CFloor lid _) -> validateFloor iid lid+  UpdDestroyItem _ iid _ _  (CActor aid CStash) -> do+    lid <- levelOfStash aid+    validateFloor iid lid+  UpdDestroyItem _ iid _ _ (CActor aid CGround) -> do+    lid <- getsState $ blid . getActorBody aid+    validateFloor iid lid+  UpdDestroyItem _ iid _ _ (CActor aid _) -> do     discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid [store]) $+    when (itemAffectsShineRadius discoAspect iid) $       invalidateLucidAid aid-    when (store `elem` [CEqp, COrgan]) $-      when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid-  UpdSpotActor aid b _ -> do+    when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid+  UpdDestroyItem{} -> return ()+  UpdSpotActor aid b -> do     -- On server, it does't affect aspects, but does affect lucid (Ascend).     actorMaxSkills <- getsState sactorMaxSkills     when (actorHasShine actorMaxSkills aid) $ invalidateLucidLid $ blid b     addPerActor aid b-  UpdLoseActor aid b _ -> do+  UpdLoseActor aid b -> do     -- On server, it does't affect aspects, but does affect lucid (Ascend).     let actorMaxSkillsOld = sactorMaxSkills oldState     when (actorHasShine actorMaxSkillsOld aid) $ invalidateLucidLid $ blid b@@ -95,54 +106,67 @@           , strajPushedBy = EM.delete aid (strajPushedBy ser)           , sactorAn = EM.delete aid (sactorAn ser)           , sactorStasis = ES.delete aid (sactorStasis ser) }-  UpdSpotItem _ iid _ _ (CFloor lid _) -> do-    discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid-  UpdSpotItem _ iid _ _ (CActor aid store) -> do+  UpdSpotItem _ iid _ (CFloor lid _) -> validateFloor iid lid+  UpdSpotItem _ iid _  (CActor aid CStash) -> do+    lid <- levelOfStash aid+    validateFloor iid lid+  UpdSpotItem _ iid _ (CActor aid CGround) -> do+    lid <- getsState $ blid . getActorBody aid+    validateFloor iid lid+  UpdSpotItem _ iid _ (CActor aid _) -> do     discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid [store]) $+    when (itemAffectsShineRadius discoAspect iid) $       invalidateLucidAid aid-    when (store `elem` [CEqp, COrgan]) $-      when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid-  UpdLoseItem _ iid _ _ (CFloor lid _) -> do-    discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid-  UpdLoseItem _ iid _ _ (CActor aid store) -> do+    when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid+  UpdSpotItem{} -> return ()+  UpdLoseItem _ iid _ (CFloor lid _) -> validateFloor iid lid+  UpdLoseItem _ iid _ (CActor aid CStash) -> do+    lid <- levelOfStash aid+    validateFloor iid lid+  UpdLoseItem _ iid _ (CActor aid CGround) -> do+    lid <- getsState $ blid . getActorBody aid+    validateFloor iid lid+  UpdLoseItem _ iid _ (CActor aid _) -> do     discoAspect <- getsState sdiscoAspect-    when (itemAffectsShineRadius discoAspect iid [store]) $+    when (itemAffectsShineRadius discoAspect iid) $       invalidateLucidAid aid-    when (store `elem` [CEqp, COrgan]) $-      when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid-  UpdSpotItemBag (CFloor lid _) bag _ais -> do-    discoAspect <- getsState sdiscoAspect-    let iids = EM.keys bag-    when (any (\iid -> itemAffectsShineRadius discoAspect iid []) iids) $-      invalidateLucidLid lid-  UpdSpotItemBag (CActor aid store) bag _ais -> do+    when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid+  UpdLoseItem{} -> return ()+  UpdSpotItemBag _ (CFloor lid _) bag  -> validateFloorBag bag lid+  UpdSpotItemBag _ (CActor aid CStash) bag -> do+    lid <- levelOfStash aid+    validateFloorBag bag lid+  UpdSpotItemBag _ (CActor aid CGround) bag -> do+    lid <- getsState $ blid . getActorBody aid+    validateFloorBag bag lid+  UpdSpotItemBag _ (CActor aid _) bag -> do     discoAspect <- getsState sdiscoAspect     let iids = EM.keys bag-    when (any (\iid -> itemAffectsShineRadius discoAspect iid [store]) iids) $+    when (any (itemAffectsShineRadius discoAspect) iids) $       invalidateLucidAid aid-    when (store `elem` [CEqp, COrgan]) $-      when (any (itemAffectsPerRadius discoAspect) iids) $-        reconsiderPerActor aid-  UpdLoseItemBag (CFloor lid _) bag _ais -> do-    discoAspect <- getsState sdiscoAspect-    let iids = EM.keys bag-    when (any (\iid -> itemAffectsShineRadius discoAspect iid []) iids) $-      invalidateLucidLid lid-  UpdLoseItemBag (CActor aid store) bag _ais -> do+    when (any (itemAffectsPerRadius discoAspect) iids) $+      reconsiderPerActor aid+  UpdSpotItemBag{} -> return ()+  UpdLoseItemBag _ (CFloor lid _) bag -> validateFloorBag bag lid+  UpdLoseItemBag _ (CActor aid CStash) bag -> do+    lid <- levelOfStash aid+    validateFloorBag bag lid+  UpdLoseItemBag _ (CActor aid CGround) bag -> do+    lid <- levelOfStash aid+    validateFloorBag bag lid+  UpdLoseItemBag _ (CActor aid _) bag -> do     discoAspect <- getsState sdiscoAspect     let iids = EM.keys bag-    when (any (\iid -> itemAffectsShineRadius discoAspect iid [store]) iids) $+    when (any (itemAffectsShineRadius discoAspect) iids) $       invalidateLucidAid aid-    when (store `elem` [CEqp, COrgan]) $-      when (any (itemAffectsPerRadius discoAspect) iids) $-        reconsiderPerActor aid+    when (any (itemAffectsPerRadius discoAspect) iids) $+      reconsiderPerActor aid+  UpdLoseItemBag{} -> return ()   UpdMoveActor aid _ _ -> do     actorMaxSkills <- getsState sactorMaxSkills     when (actorHasShine actorMaxSkills aid) $ invalidateLucidAid aid     invalidatePerActor aid+  UpdWaitActor{} -> return ()   UpdDisplaceActor aid1 aid2 -> do     actorMaxSkills <- getsState sactorMaxSkills     when (actorHasShine actorMaxSkills aid1@@ -151,25 +175,13 @@     invalidatePerActor aid1     invalidatePerActor aid2   UpdMoveItem iid _k aid s1 s2 -> do-    discoAspect <- getsState sdiscoAspect-    let itemAffectsPer = itemAffectsPerRadius discoAspect iid-        invalidatePer = when itemAffectsPer $ reconsiderPerActor aid-        itemAffectsShine = itemAffectsShineRadius discoAspect iid [s1, s2]-        invalidateLucid = when itemAffectsShine $ invalidateLucidAid aid-    case s1 of-      CEqp -> case s2 of-        COrgan -> return ()-        _ -> do-          invalidateLucid-          invalidatePer-      COrgan -> case s2 of-        CEqp -> return ()-        _ -> do-          invalidateLucid-          invalidatePer-      _ -> do-        invalidateLucid  -- from itemAffects, s2 provides light or s1 is CGround-        when (s2 `elem` [CEqp, COrgan]) invalidatePer+    let dummyVerbose = False+        dummyKit = quantSingle+    cmdAtomicSemSer oldState $+      UpdLoseItem dummyVerbose iid dummyKit (CActor aid s1)+    cmdAtomicSemSer oldState $+      UpdSpotItem dummyVerbose iid dummyKit (CActor aid s2)+  UpdRefillHP{} -> return ()   UpdRefillCalm aid _ -> do     actorMaxSk <- getsState $ getActorMaxSkills aid     body <- getsState $ getActorBody aid@@ -178,15 +190,71 @@         radiusOld = boundSightByCalm sight (bcalm oldBody)         radiusNew = boundSightByCalm sight (bcalm body)     when (radiusOld /= radiusNew) $ invalidatePerActor aid+  UpdTrajectory{} -> return ()+  UpdQuitFaction{} -> return ()+  UpdSpotStashFaction _ fid lid _ -> invalidatePerFidLid fid lid+  UpdLoseStashFaction _ fid lid _ -> invalidatePerFidLid fid lid   UpdLeadFaction{} -> invalidateArenas+  UpdDiplFaction{} -> return ()+  UpdDoctrineFaction{} -> return ()+  UpdAutoFaction{} -> return ()   UpdRecordKill{} -> invalidateArenas   UpdAlterTile lid pos fromTile toTile -> do     clearChanged <- updateSclear lid pos fromTile toTile     litChanged <- updateSlit lid pos fromTile toTile     when (clearChanged || litChanged) $ invalidateLucidLid lid     when clearChanged $ invalidatePerLid lid-  _ -> return ()+  UpdAlterExplorable{} -> return ()+  UpdAlterGold{} -> return ()+  UpdSearchTile{} -> return ()+  UpdHideTile{} -> return ()+  UpdSpotTile{} -> return ()+  UpdLoseTile{} -> return ()+  UpdSpotEntry{} -> return ()+  UpdLoseEntry{} -> return ()+  UpdAlterSmell{} -> return ()+  UpdSpotSmell{} -> return ()+  UpdLoseSmell{} -> return ()+  UpdTimeItem{} -> return ()+  UpdAgeGame{} -> return ()+  UpdUnAgeGame{} -> return ()+  UpdDiscover{} -> return ()+  UpdCover{} -> return ()+  UpdDiscoverKind{} -> return ()+  UpdCoverKind{} -> return ()+  UpdDiscoverAspect{} -> return ()+  UpdCoverAspect{} -> return ()+  UpdDiscoverServer{} -> return ()+  UpdCoverServer{} -> return ()+  UpdPerception{} -> return ()+  UpdRestart{} -> return ()+  UpdRestartServer{} -> return ()+  UpdResume{} -> return ()+  UpdResumeServer{} -> return ()+  UpdKillExit{} -> return ()+  UpdWriteSave{} -> return ()+  UpdHearFid{} -> return () +validateFloor :: MonadServer m => ItemId -> LevelId -> m ()+validateFloor iid lid = do+  discoAspect <- getsState sdiscoAspect+  when (itemAffectsShineRadius discoAspect iid) $ invalidateLucidLid lid++validateFloorBag :: MonadServer m => ItemBag -> LevelId -> m ()+validateFloorBag bag lid = do+  discoAspect <- getsState sdiscoAspect+  let iids = EM.keys bag+  when (any (itemAffectsShineRadius discoAspect) iids) $+    invalidateLucidLid lid++levelOfStash :: MonadStateRead m => ActorId -> m LevelId+levelOfStash aid = do+  b <- getsState $ getActorBody aid+  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+  case mstash of+    Just (lid, _) -> return lid+    Nothing -> error $ "" `showFailure` (aid, b)+ invalidateArenas :: MonadServer m => m () invalidateArenas = modifyServer $ \ser -> ser {svalidArenas = False} @@ -233,12 +301,10 @@   Just actorMaxSk -> Ability.getSk Ability.SkShine actorMaxSk > 0   Nothing -> error $ "" `showFailure` aid -itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> [CStore] -> Bool-itemAffectsShineRadius discoAspect iid stores =-  (null stores || not (null $ intersect stores [CEqp, COrgan, CGround]))-  && case EM.lookup iid discoAspect of-    Just arItem -> IA.getSkill Ability.SkShine arItem /= 0-    Nothing -> error $ "" `showFailure` iid+itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> Bool+itemAffectsShineRadius discoAspect iid = case EM.lookup iid discoAspect of+  Just arItem -> IA.getSkill Ability.SkShine arItem /= 0+  Nothing -> error $ "" `showFailure` iid  itemAffectsPerRadius :: DiscoveryAspect -> ItemId -> Bool itemAffectsPerRadius discoAspect iid =@@ -325,3 +391,9 @@         g _ valid = valid     in ser { sperCacheFid = perCacheFidNew            , sperValidFid = EM.mapWithKey g $ sperValidFid ser }++invalidatePerFidLid :: MonadServer m => FactionId -> LevelId -> m ()+invalidatePerFidLid fid lid = do+  let adj = EM.insert lid False+  modifyServer $ \ser ->+    ser {sperValidFid = EM.adjust adj fid $ sperValidFid ser}

engine-src/Game/LambdaHack/Server/HandleEffectM.hs view

@@ -2,1897 +2,2299 @@ -- | Handle effects. They are most often caused by requests sent by clients -- but sometimes also caused by projectiles or periodically activated items. module Game.LambdaHack.Server.HandleEffectM-  ( applyItem, kineticEffectAndDestroy, effectAndDestroyAndAddKill-  , itemEffectEmbedded, highestImpression, dominateFidSfx-  , dropAllItems, pickDroppable-#ifdef EXPOSE_INTERNAL-    -- * Internal operations-  , UseResult(..)-  , applyKineticDamage, refillHP, cutCalm, effectAndDestroy, imperishableKit-  , itemEffectDisco, effectSem-  , effectBurn, effectExplode, effectRefillHP, effectRefillCalm, effectDominate-  , dominateFid, effectImpress, effectPutToSleep, effectYell, effectSummon-  , effectAscend, findStairExit, switchLevels1, switchLevels2, effectEscape-  , effectParalyze, paralyze, effectParalyzeInWater, effectInsertMove-  , effectTeleport, effectCreateItem, effectDropItem, dropCStoreItem-  , effectPolyItem, effectRerollItem, effectDupItem, effectIdentify-  , identifyIid, effectDetect, effectDetectX, effectSendFlying-  , sendFlyingVector, effectDropBestWeapon, effectActivateInv-  , effectTransformContainer, effectApplyPerfume, effectOneOf-  , effectVerbNoLonger, effectVerbMsg, effectComposite-#endif-  ) where--import Prelude ()--import Game.LambdaHack.Core.Prelude--import           Data.Bits (xor)-import qualified Data.EnumMap.Strict as EM-import qualified Data.EnumSet as ES-import qualified Data.HashMap.Strict as HM-import           Data.Int (Int64)-import           Data.Key (mapWithKeyM_)-import qualified Data.Ord as Ord-import qualified Data.Text as T--import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Common.Actor-import           Game.LambdaHack.Common.ActorState-import           Game.LambdaHack.Common.Analytics-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           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.Types-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.RuleKind-import qualified Game.LambdaHack.Core.Dice as Dice-import           Game.LambdaHack.Core.Random-import qualified Game.LambdaHack.Definition.Ability as Ability-import           Game.LambdaHack.Definition.Defs-import           Game.LambdaHack.Server.CommonM-import           Game.LambdaHack.Server.ItemM-import           Game.LambdaHack.Server.ItemRev-import           Game.LambdaHack.Server.MonadServer-import           Game.LambdaHack.Server.PeriodicM-import           Game.LambdaHack.Server.ServerOptions-import           Game.LambdaHack.Server.State---- * Semantics of effects--data UseResult = UseDud | UseId | UseUp- deriving (Eq, Ord)--applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m ()-applyItem aid iid cstore = do-  execSfxAtomic $ SfxApply aid iid cstore-  let c = CActor aid cstore-  -- Treated as if the actor hit himself with the item as a weapon,-  -- incurring both the kinetic damage and effect, hence the same call-  -- as in @reqMelee@.-  kineticEffectAndDestroy True aid aid aid iid c True--applyKineticDamage :: MonadServerAtomic m-                   => ActorId -> ActorId -> ItemId -> m Bool-applyKineticDamage source target iid = do-  itemKind <- getsState $ getIidKindServer iid-  if IK.idamage itemKind == 0 then return False else do  -- speedup-    sb <- getsState $ getActorBody source-    hurtMult <- getsState $ armorHurtBonus source target-    totalDepth <- getsState stotalDepth-    Level{ldepth} <- getLevel (blid sb)-    dmg <- rndToAction $ castDice ldepth totalDepth $ IK.idamage itemKind-    let rawDeltaHP = fromIntegral hurtMult * xM dmg `divUp` 100-        speedDeltaHP = case btrajectory sb of-          Just (_, speed) | bproj sb -> - modifyDamageBySpeed rawDeltaHP speed-          _ -> - rawDeltaHP-    if speedDeltaHP < 0 then do  -- damage the target, never heal-      refillHP source target speedDeltaHP-      return True-    else return False--refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m ()-refillHP source target speedDeltaHP = assert (speedDeltaHP /= 0) $ do-  tbOld <- getsState $ getActorBody target-  actorMaxSk <- getsState $ getActorMaxSkills target-  -- We don't ignore even tiny HP drains, because they can be very weak-  -- enemy projectiles and so will recur and in total can be deadly-  -- and also AI should rather be stupidly aggressive than stupidly lethargic.-  let serious = source /= target && not (bproj tbOld)-      hpMax = Ability.getSk Ability.SkMaxHP actorMaxSk-      deltaHP0 | serious && speedDeltaHP < minusM =-                 -- If overfull, at least cut back to max, unless minor drain.-                 min speedDeltaHP (xM hpMax - bhp tbOld)-               | otherwise = speedDeltaHP-      deltaHP = if | deltaHP0 > 0 && bhp tbOld > xM 999 ->  -- UI limit-                     tenthM  -- avoid nop, to avoid loops-                   | deltaHP0 < 0 && bhp tbOld < - xM 999 ->-                     -tenthM-                   | otherwise -> deltaHP0-  execUpdAtomic $ UpdRefillHP target deltaHP-  when serious $ cutCalm target-  tb <- getsState $ getActorBody target-  fact <- getsState $ (EM.! bfid tb) . sfactionD-  unless (bproj tb || fleaderMode (gplayer fact) == LeaderNull) $-    -- If leader just lost all HP, change the leader early (not when destroying-    -- the actor), to let players rescue him, especially if he's slowed-    -- by the attackers.-    when (bhp tb <= 0 && bhp tbOld > 0) $ do-      -- If all other party members dying, leadership will switch-      -- to one of them, which seems questionable, but it's rare-      -- and the disruption servers to underline the dire circumstance.-      electLeader (bfid tb) (blid tb) target-      mleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD-      -- If really nobody else in the party, make him the leader back again-      -- on the oft chance that he gets revived by a projectile, etc.-      when (isNothing mleader) $-        execUpdAtomic $ UpdLeadFaction (bfid tb) Nothing $ Just target--cutCalm :: MonadServerAtomic m => ActorId -> m ()-cutCalm target = do-  tb <- getsState $ getActorBody target-  actorMaxSk <- getsState $ getActorMaxSkills target-  let upperBound = if hpTooLow tb actorMaxSk-                   then 2  -- to trigger domination on next attack, etc.-                   else xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk-      deltaCalm = min minusM2 (upperBound - bcalm tb)-  -- HP loss decreases Calm by at least @minusM2@ to avoid "hears something",-  -- which is emitted when decreasing Calm by @minusM1@.-  updateCalm target deltaCalm---- Here kinetic damage is applied. This is necessary so that the same--- AI benefit calculation may be used for flinging and for applying items.-kineticEffectAndDestroy :: MonadServerAtomic m-                        => Bool -> ActorId -> ActorId -> ActorId-                        -> ItemId -> Container -> Bool-                        -> m ()-kineticEffectAndDestroy voluntary killer source target iid c mayDestroy = do-  bag <- getsState $ getContainerBag c-  case iid `EM.lookup` bag of-    Nothing -> error $ "" `showFailure` (source, target, iid, c)-    Just kit -> do-      itemFull <- getsState $ itemToFull iid-      tbOld <- getsState $ getActorBody target-      localTime <- getsState $ getLocalTime (blid tbOld)-      let recharged = hasCharge localTime itemFull kit-      -- If neither kinetic hit nor any effect is activated, there's no chance-      -- the items can be destroyed or even timeout changes, so we abort early.-      when recharged $ do-        kineticPerformed <- applyKineticDamage source target iid-        tb <- getsState $ getActorBody target-        -- Sometimes victim heals just after we registered it as killed,-        -- but that's OK, an actor killed two times is similar enough-        -- to two killed.-        when (kineticPerformed  -- speedup-              && bhp tb <= 0 && bhp tbOld > 0) $ do-          sb <- getsState $ getActorBody source-          arWeapon <- getsState $ (EM.! iid) . sdiscoAspect-          let killHow | not (bproj sb) =-                        if voluntary then KillKineticMelee else KillKineticPush-                      | IA.checkFlag Ability.Blast arWeapon = KillKineticBlast-                      | otherwise = KillKineticRanged-          addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)-        effectAndDestroyAndAddKill-          voluntary killer False (fst kit <= 1) kineticPerformed-          source target iid c False itemFull mayDestroy--effectAndDestroyAndAddKill :: MonadServerAtomic m-                           => Bool -> ActorId -> Bool -> Bool-                           -> Bool -> ActorId -> ActorId -> ItemId -> Container-                           -> Bool -> ItemFull -> Bool-                           -> m ()-effectAndDestroyAndAddKill voluntary killer onSmashOnly useAllCopies-                           kineticPerformed source target iid container-                           periodic itemFull mayDestroy = do-  tbOld <- getsState $ getActorBody target-  effectAndDestroy onSmashOnly useAllCopies kineticPerformed source target-                   iid container periodic itemFull mayDestroy-  tb <- getsState $ getActorBody target-  -- Sometimes victim heals just after we registered it as killed,-  -- but that's OK, an actor killed two times is similar enough to two killed.-  when (bhp tb <= 0 && bhp tbOld > 0) $ do-    sb <- getsState $ getActorBody source-    arWeapon <- getsState $ (EM.! iid) . sdiscoAspect-    let killHow | not (bproj sb) =-                  if voluntary then KillOtherMelee else KillOtherPush-                | IA.checkFlag Ability.Blast arWeapon = KillOtherBlast-                | otherwise = KillOtherRanged-    addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)--effectAndDestroy :: MonadServerAtomic m-                 => Bool -> Bool -> Bool-                 -> ActorId -> ActorId -> ItemId -> Container-                 -> Bool -> ItemFull -> Bool-                 -> m ()-effectAndDestroy onSmashOnly useAllCopies kineticPerformed-                 source target iid container periodic-                 itemFull@ItemFull{itemBase, itemDisco, itemKindId, itemKind}-                 mayDestroy = do-  bag <- getsState $ getContainerBag container-  let (itemK, itemTimer) = bag EM.! iid-      effs = if onSmashOnly-             then IK.strengthOnSmash itemKind-             else IK.ieffects itemKind-      arItem = case itemDisco of-        ItemDiscoFull itemAspect -> itemAspect-        _ -> error "effectAndDestroy: server ignorant about an item"-      timeout = IA.aTimeout arItem-  lid <- getsState $ lidFromC container-  localTime <- getsState $ getLocalTime lid-  let it1 = let timeoutTurns = timeDeltaScale (Delta timeTurn) timeout-                charging startT = timeShift startT timeoutTurns > localTime-            in filter charging itemTimer-      len = length it1-      recharged = len < itemK || onSmashOnly-  -- If the item has no charges and the effects are not @OnSmash@-  -- we speed up by shortcutting early, because we don't need to activate-  -- effects and we know kinetic hit was not performed (no charges to do so-  -- and in case of @OnSmash@, only effects are triggered).-  when recharged $ do-    let it2 = if timeout /= 0 && recharged-              then if periodic && IA.checkFlag Ability.Fragile arItem-                   then replicate (itemK - length it1) localTime ++ it1-                           -- copies are spares only; one fires, all discharge-                   else localTime : it1-                           -- copies all fire, turn by turn; one discharges-              else itemTimer-        kit2 = (1, take 1 it2)-        !_A = assert (len <= itemK `blame` (source, target, iid, container)) ()-    -- We use up the charge even if eventualy every effect fizzles. Tough luck.-    -- At least we don't destroy the item in such case.-    -- Also, we ID it regardless.-    unless (itemTimer == it2) $-      execUpdAtomic $ UpdTimeItem iid container itemTimer it2-    -- We have to destroy the item before the effect affects the item-    -- or affects the actor holding it or standing on it (later on we could-    -- lose track of the item and wouldn't be able to destroy it) .-    -- This is OK, because we don't remove the item type from various-    -- item dictionaries, just an individual copy from the container,-    -- so, e.g., the item can be identified after it's removed.-    let imperishable = not mayDestroy || imperishableKit periodic itemFull-    unless imperishable $-      execUpdAtomic $ UpdLoseItem False iid itemBase kit2 container-    -- At this point, the item is potentially no longer in container-    -- @container@, therefore beware of assuming so in the code below.-    -- If the item activation is not periodic, but the item itself is,-    -- only the first effect gets activated (and the item may be destroyed,-    -- unlike with periodic activations).-    let effsManual = if not periodic-                        && IA.checkFlag Ability.Periodic arItem-                        && not (IA.checkFlag Ability.Condition arItem)-                     then take 1 effs  -- may be empty-                     else effs-    triggeredEffect <- itemEffectDisco useAllCopies kineticPerformed-                                       source target iid itemKindId itemKind-                                       container periodic effsManual-    let triggered = if kineticPerformed then UseUp else triggeredEffect-    sb <- getsState $ getActorBody source-    -- Announce no effect, which is rare and wastes time, so noteworthy.-    unless (triggered == UseUp  -- effects triggered; feedback comes from them-            || periodic  -- don't spam via fizzled periodic effects-            || bproj sb  -- don't spam, projectiles can be very numerous-            ) $-      execSfxAtomic $ SfxMsgFid (bfid sb) $-        if any IK.forApplyEffect effsManual-        then SfxFizzles  -- something didn't work, despite promising effects-        else SfxNothingHappens  -- fully expected-    -- If none of item's effects nor a kinetic hit were performed,-    -- we recreate the item (assuming we deleted the item above).-    -- Regardless, we don't rewind the time, because some info is gained-    -- (that the item does not exhibit any effects in the given context).-    unless (imperishable || triggered == UseUp) $-      execUpdAtomic $ UpdSpotItem False iid itemBase kit2 container--imperishableKit :: Bool -> ItemFull -> Bool-imperishableKit periodic itemFull =-  let arItem = aspectRecordFull itemFull-  in IA.checkFlag Ability.Durable arItem-     || periodic && not (IA.checkFlag Ability.Fragile arItem)---- The item is triggered exactly once. If there are more copies,--- they are left to be triggered next time.-itemEffectEmbedded :: MonadServerAtomic m-                   => Bool -> ActorId -> LevelId -> Point -> ItemId -> m ()-itemEffectEmbedded voluntary aid lid tpos iid = do-  -- First embedded item may move actor to another level, so @lid@-  -- may be unequal to @blid sb@.-  let c = CEmbed lid tpos-  -- Treated as if the actor hit himself with the embedded item as a weapon,-  -- incurring both the kinetic damage and effect, hence the same call-  -- as in @reqMelee@. Information whether this happened due to being pushed-  -- is preserved, but how did the pushing is lost, so we blame the victim.-  kineticEffectAndDestroy voluntary aid aid aid iid c True---- | The source actor affects the target actor, with a given item.--- If any of the effects fires up, the item gets identified.--- Even using raw damage (beating the enemy with the magic wand,--- for example) identifies the item. This means a costly @UpdDiscover@--- is processed for each random timeout weapon hit and for most projectiles,--- but at least not for most explosion particles nor plain organs.--- And if not needed, the @UpdDiscover@ are eventually not sent to clients.--- So, enemy missiles that hit us are no longer mysterious until picked up,--- which is for the better, because the client knows their charging status--- and so can generate accurate messages in the case when not recharged.--- This also means that thrown consumables in flasks sturdy enough to cause--- damage are always identified at hit, even if no effect activated.--- So throwing them at foes is a better identification method than applying.------ Note that if we activate a durable non-passive item, e.g., a spiked shield,--- from the ground, it will get identified, which is perfectly fine,--- until we want to add sticky armor that can't be easily taken off--- (and, e.g., has some maluses).-itemEffectDisco :: MonadServerAtomic m-                => Bool -> Bool-> ActorId -> ActorId -> ItemId-                -> ContentId ItemKind -> ItemKind-                -> Container -> Bool -> [IK.Effect]-                -> m UseResult-itemEffectDisco useAllCopies kineticPerformed-                source target iid itemKindId itemKind-                c periodic effs = do-  urs <- mapM (effectSem useAllCopies source target iid c periodic) effs-  let ur = case urs of-        [] -> UseDud  -- there was no effects-        _ -> maximum urs-  -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary.-  when (ur >= UseId || kineticPerformed) $-    identifyIid iid c itemKindId itemKind-  return ur---- | Source actor affects target actor, with a given effect and it strength.--- Both actors are on the current level and can be the same actor.--- The item may or may not still be in the container.-effectSem :: MonadServerAtomic m-          => Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool-          -> IK.Effect-          -> m UseResult-effectSem useAllCopies source target iid c periodic effect = do-  let recursiveCall = effectSem useAllCopies source target iid c periodic-  sb <- getsState $ getActorBody source-  pos <- getsState $ posFromC c-  -- @execSfx@ usually comes last in effect semantics, but not always-  -- and we are likely to introduce more variety.-  let execSfx = execSfxAtomic $ SfxEffect (bfid sb) target effect 0-      execSfxSource = execSfxAtomic $ SfxEffect (bfid sb) source effect 0-  case effect of-    IK.Burn nDm -> effectBurn nDm source target-    IK.Explode t -> effectExplode execSfx t source target-    IK.RefillHP p -> effectRefillHP p source target-    IK.RefillCalm p -> effectRefillCalm execSfx p source target-    IK.Dominate -> effectDominate source target-    IK.Impress -> effectImpress recursiveCall execSfx source target-    IK.PutToSleep -> effectPutToSleep execSfx target-    IK.Yell -> effectYell execSfx target-    IK.Summon grp nDm -> effectSummon grp nDm iid source target periodic-    IK.Ascend p -> effectAscend recursiveCall execSfx p source target pos-    IK.Escape{} -> effectEscape execSfx source target-    IK.Paralyze nDm -> effectParalyze execSfx nDm source target-    IK.ParalyzeInWater nDm -> effectParalyzeInWater execSfx nDm source target-    IK.InsertMove nDm -> effectInsertMove execSfx nDm source target-    IK.Teleport nDm -> effectTeleport execSfx nDm source target-    IK.CreateItem store grp tim ->-      effectCreateItem (Just $ bfid sb) Nothing source target store grp tim-    IK.DropItem n k store grp -> effectDropItem execSfx iid n k store grp target-    IK.PolyItem -> effectPolyItem execSfx iid target-    IK.RerollItem -> effectRerollItem execSfx iid target-    IK.DupItem -> effectDupItem execSfx iid target-    IK.Identify -> effectIdentify execSfx iid target-    IK.Detect d radius -> effectDetect execSfx d radius target pos-    IK.SendFlying tmod ->-      effectSendFlying execSfx tmod source target c Nothing-    IK.PushActor tmod ->-      effectSendFlying execSfx tmod source target c (Just True)-    IK.PullActor tmod ->-      effectSendFlying execSfx tmod source target c (Just False)-    IK.DropBestWeapon -> effectDropBestWeapon execSfx iid target-    IK.ActivateInv symbol -> effectActivateInv execSfx iid source target symbol-    IK.ApplyPerfume -> effectApplyPerfume execSfx target-    IK.OneOf l -> effectOneOf recursiveCall l-    IK.OnSmash _ -> return UseDud  -- ignored under normal circumstances-    IK.VerbNoLonger _ -> effectVerbNoLonger useAllCopies execSfxSource source-    IK.VerbMsg _ -> effectVerbMsg execSfxSource source-    IK.Composite l -> effectComposite recursiveCall l---- * Individual semantic functions for effects---- ** Burn---- Damage from fire. Not affected by armor.-effectBurn :: MonadServerAtomic m-           => Dice.Dice -> ActorId -> ActorId -> m UseResult-effectBurn nDm source target = do-  tb <- getsState $ getActorBody target-  totalDepth <- getsState stotalDepth-  Level{ldepth} <- getLevel (blid tb)-  n0 <- rndToAction $ castDice ldepth totalDepth nDm-  let n = max 1 n0  -- avoid 0 and negative burn-      deltaHP = - xM n-  sb <- getsState $ getActorBody source-  -- Display the effect more accurately.-  let reportedEffect = IK.Burn $ Dice.intToDice n-  execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP-  refillHP source target deltaHP-  return UseUp---- ** Explode--effectExplode :: MonadServerAtomic m-              => m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult-effectExplode execSfx cgroup source target = do-  execSfx-  tb <- getsState $ getActorBody target-  let itemFreq = [(cgroup, 1)]-      -- Explosion particles are placed among organs of the victim:-      container = CActor target COrgan-  m2 <- rollAndRegisterItem (blid tb) itemFreq container False Nothing-  let (iid, (ItemFull{itemBase, itemKind}, (itemK, _))) =-        fromMaybe (error $ "" `showFailure` cgroup) m2-      Point x y = bpos tb-      semirandom = T.length (IK.idesc itemKind)-      projectN k100 n = do-        -- We pick a point at the border, not inside, to have a uniform-        -- distribution for the points the line goes through at each distance-        -- from the source. Otherwise, e.g., the points on cardinal-        -- and diagonal lines from the source would be more common.-        let veryrandom = (k100 `xor` (semirandom + n)) `mod` 5-            fuzz = 5 + veryrandom-            k | n < 16 && n >= 12 = 12-              | n < 12 && n >= 8 = 8-              | n < 8 && n >= 4 = 4-              | otherwise = min n 16  -- fire in groups of 16 including old duds-            psDir4 =-              [ Point (x - 12) (y + 12)-              , Point (x + 12) (y + 12)-              , Point (x - 12) (y - 12)-              , Point (x + 12) (y - 12) ]-            psDir8 =-              [ Point (x - 12) y-              , Point (x + 12) y-              , Point x (y + 12)-              , Point x (y - 12) ]-            psFuzz =-              [ Point (x - 12) $ y + fuzz-              , Point (x + 12) $ y + fuzz-              , Point (x - 12) $ y - fuzz-              , Point (x + 12) $ y - fuzz-              , flip Point (y - 12) $ x + fuzz-              , flip Point (y + 12) $ x + fuzz-              , flip Point (y - 12) $ x - fuzz-              , flip Point (y + 12) $ x - fuzz ]-            randomReverse = if veryrandom `mod` 2 == 0 then id else reverse-            ps = take k $ concat $-              randomReverse-                [ zip (repeat True)  -- diagonal particles don't reach that far-                  $ take 4 (drop ((k100 + itemK + fuzz) `mod` 4) $ cycle psDir4)-                , zip (repeat False)  -- only some cardinal reach far-                  $ take 4 (drop ((k100 + n) `mod` 4) $ cycle psDir8) ]-              ++ [zip (repeat True)-                  $ take 8 (drop ((k100 + fuzz) `mod` 8) $ cycle psFuzz)]-        forM_ ps $ \(centerRaw, tpxy) -> do-          let center = centerRaw && itemK >= 8  -- if few, keep them regular-          mfail <- projectFail source target tpxy veryrandom center-                               iid COrgan True-          case mfail of-            Nothing -> return ()-            Just ProjectBlockTerrain -> return ()-            Just ProjectBlockActor | not $ bproj tb -> return ()-            Just failMsg ->-              execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnexpected failMsg-      tryFlying 0 = return ()-      tryFlying k100 = do-        -- Explosion particles were placed among organs of the victim:-        bag2 <- getsState $ borgan . getActorBody target-        -- We stop bouncing old particles when less than half remains,-        -- to prevent hoarding explosives to use only in cramped spaces.-        case EM.lookup iid bag2 of-          Just (n2, _) | n2 >= itemK `div` 2 -> do-            projectN k100 n2-            tryFlying $ k100 - 1-          _ -> return ()-  -- Some of the particles that fail to take off, bounce off obstacles-  -- up to 100 times in total, trying to fly in different directions.-  tryFlying 100-  bag3 <- getsState $ borgan . getActorBody target-  let mn3 = EM.lookup iid bag3-  -- Give up and destroy the remaining particles, if any.-  maybe (return ()) (\kit -> execUpdAtomic-                             $ UpdLoseItem False iid itemBase kit container) mn3-  return UseUp  -- we neglect verifying that at least one projectile got off---- ** RefillHP---- Unaffected by armor.-effectRefillHP :: MonadServerAtomic m-               => Int -> ActorId -> ActorId -> m UseResult-effectRefillHP power0 source target = do-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  curChalSer <- getsServer $ scurChalSer . soptions-  fact <- getsState $ (EM.! bfid tb) . sfactionD-  let power = if power0 <= -1 then power0 else max 1 power0  -- avoid 0-      deltaHP = xM power-  if | cfish curChalSer && deltaHP > 0-       && fhasUI (gplayer fact) && bfid sb /= bfid tb -> do-       execSfxAtomic $ SfxMsgFid (bfid tb) SfxColdFish-       return UseId-     | otherwise -> do-       let reportedEffect = IK.RefillHP power-       execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP-       refillHP source target deltaHP-       return UseUp---- ** RefillCalm--effectRefillCalm :: MonadServerAtomic m-                 => m () -> Int -> ActorId -> ActorId -> m UseResult-effectRefillCalm execSfx power0 source target = do-  tb <- getsState $ getActorBody target-  actorMaxSk <- getsState $ getActorMaxSkills target-  let power = if power0 <= -1 then power0 else max 1 power0  -- avoid 0-      rawDeltaCalm = xM power-      calmMax = Ability.getSk Ability.SkMaxCalm actorMaxSk-      serious = rawDeltaCalm <= minusM2 && source /= target && not (bproj tb)-      deltaCalm0 | serious =  -- if overfull, at least cut back to max-                     min rawDeltaCalm (xM calmMax - bcalm tb)-                 | otherwise = rawDeltaCalm-      deltaCalm = if | deltaCalm0 > 0 && bcalm tb > xM 999 ->  -- UI limit-                       tenthM  -- avoid nop, to avoid loops-                     | deltaCalm0 < 0 && bcalm tb < - xM 999 ->-                       -tenthM-                     | otherwise -> deltaCalm0-  execSfx-  updateCalm target deltaCalm-  return UseUp---- ** Dominate---- The is another way to trigger domination (the normal way is by zeroed Calm).--- Calm is here irrelevant. The other conditions are the same.-effectDominate :: MonadServerAtomic m => ActorId -> ActorId -> m UseResult-effectDominate source target = do-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  if | bproj tb -> return UseDud-     | bfid tb == bfid sb -> return UseDud  -- accidental hit; ignore-     | otherwise -> do-       fact <- getsState $ (EM.! bfid tb) . sfactionD-       hiImpression <- highestImpression tb-       let permitted = case hiImpression of-             Nothing -> False  -- no impression, no domination-             Just (hiImpressionFid, hiImpressionK) ->-                hiImpressionFid == bfid sb-                  -- highest impression needs to be by us-                && (fleaderMode (gplayer fact) /= LeaderNull-                    || hiImpressionK >= 10)-                     -- to tame/hack animal/robot, impress them a lot first-       if permitted then do-         b <- dominateFidSfx source target (bfid sb)-         return $! if b then UseUp else UseDud-       else do-         execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxUnimpressed target-         when (source /= target) $-           execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnimpressed target-         return UseDud--highestImpression :: MonadServerAtomic m-                  => Actor -> m (Maybe (FactionId, Int))-highestImpression tb = do-  getKind <- getsState $ flip getIidKindServer-  getItem <- getsState $ flip getItemBody-  let isImpression iid =-        maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid-      impressions = EM.filterWithKey (\iid _ -> isImpression iid) $ borgan tb-      f (_, (k, _)) = k-      maxImpression = maximumBy (Ord.comparing f) $ EM.assocs impressions-  if EM.null impressions-  then return Nothing-  else case jfid $ getItem $ fst maxImpression of-    Nothing -> return Nothing-    Just fid -> assert (fid /= bfid tb)-                $ return $ Just (fid, fst $ snd maxImpression)--dominateFidSfx :: MonadServerAtomic m-               => ActorId ->  ActorId -> FactionId -> m Bool-dominateFidSfx source target fid = do-  tb <- getsState $ getActorBody target-  let !_A = assert (not $ bproj tb) ()-  -- Actors that don't move freely can't be dominated, for otherwise,-  -- when they are the last survivors, they could get stuck and the game-  -- wouldn't end. Also, they are a hassle to guide through the dungeon.-  canTra <- getsState $ canTraverse target-  -- Being pushed protects from domination, for simplicity.-  -- A possible interesting exploit, but much help from content would be needed-  -- to make it practical.-  if isNothing (btrajectory tb) && canTra && bhp tb > 0 then do-    let execSfx = execSfxAtomic $ SfxEffect fid target IK.Dominate 0-    execSfx  -- if actor ours, possibly the last occasion to see him-    dominateFid fid source target-    -- If domination resulted in game over, the message won't be seen-    -- before the end game screens, but at least it will be seen afterwards-    -- and browsable in history while inside subsequent game, revealing-    -- the cause of the previous game over. Better than no message at all.-    execSfx  -- see the actor as theirs, unless position not visible-    return True-  else-    return False--dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> ActorId -> m ()-dominateFid fid source target = do-  tb0 <- getsState $ getActorBody target-  -- Game over deduced very early, so no further animation nor message-  -- will appear before game end screens. This is good in that our last actor-  -- that yielded will still be on screen when end game messages roll.-  -- This is bad in that last enemy actor that got dominated by us-  -- may not be on screen and we have no clue how we won until-  -- we see history in the next game. Even worse if our ally dominated-  -- the enemy actor. Then we may never learn. Oh well, that's realism.-  deduceKilled target-  electLeader (bfid tb0) (blid tb0) target-  fact <- getsState $ (EM.! bfid tb0) . sfactionD-  -- Drop all items so that domiation is not too nasty, especially-  -- if the dominated hero runs off or teleports away with gold-  -- or starts hitting with the most potent artifact weapon in the game.-  -- Prevent the faction's stash from being lost in case they are-  -- not spawners. Drop items while still of the original faction-  -- to mark them on the map for other party members to collect.-  when (isNothing $ gleader fact) $ moveStores False target CSha CInv-  dropAllItems target tb0-  tb <- getsState $ getActorBody target-  ais <- getsState $ getCarriedAssocsAndTrunk tb-  actorMaxSk <- getsState $ getActorMaxSkills target-  getKind <- getsState $ flip getIidKindServer-  let isImpression iid =-        maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid-      dropAllImpressions = EM.filterWithKey (\iid _ -> not $ isImpression iid)-      borganNoImpression = dropAllImpressions $ borgan tb-  -- Actor is not pushed nor projectile, so @sactorTime@ suffices.-  btime <--    getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime-  execUpdAtomic $ UpdLoseActor target tb ais-  let maxCalm = Ability.getSk Ability.SkMaxCalm actorMaxSk-      maxHp = Ability.getSk Ability.SkMaxHP actorMaxSk-      bNew = tb { bfid = fid-                , bcalm = max (xM 10) $ xM maxCalm `div` 2-                , bhp = min (xM maxHp) $ bhp tb + xM 10-                , borgan = borganNoImpression}-  aisNew <- getsState $ getCarriedAssocsAndTrunk bNew-  modifyServer $ \ser ->-    ser {sactorTime = updateActorTime fid (blid tb) target btime-                      $ sactorTime ser}-  execUpdAtomic $ UpdSpotActor target bNew aisNew-  -- Focus on the dominated actor, by making him a leader.-  setFreshLeader fid target-  factionD <- getsState sfactionD-  let inGame fact2 = case gquit fact2 of-        Nothing -> True-        Just Status{stOutcome=Camping} -> True-        _ -> False-      gameOver = not $ any inGame $ EM.elems factionD-  -- Avoid the spam of identifying items, if game over.-  unless gameOver $ do-    -- Add some nostalgia for the old faction.-    void $ effectCreateItem (Just $ bfid tb) (Just 10) source target COrgan-                            "impressed" IK.timerNone-    -- Identify organs that won't get identified by use.-    getKindId <- getsState $ flip getIidKindIdServer-    let discoverIf (iid, cstore) = do-          let itemKindId = getKindId iid-              c = CActor target cstore-          assert (cstore /= CGround) $-            discoverIfMinorEffects c iid itemKindId-        aic = (btrunk tb, COrgan)-              : filter ((/= btrunk tb) . fst) (getCarriedIidCStore tb)-    mapM_ discoverIf aic---- | Drop all actor's items.-dropAllItems :: MonadServerAtomic m => ActorId -> Actor -> m ()-dropAllItems aid b = do-  mapActorCStore_ CInv (dropCStoreItem False CInv aid b maxBound) b-  mapActorCStore_ CEqp (dropCStoreItem False CEqp aid b maxBound) b---- ** Impress--effectImpress :: MonadServerAtomic m-              => (IK.Effect -> m UseResult) -> m () -> ActorId -> ActorId-              -> m UseResult-effectImpress recursiveCall execSfx source target = do-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  if | bproj tb -> return UseDud-     | bfid tb == bfid sb ->-       -- Unimpress wrt others, but only once. The recursive Sfx suffices.-       recursiveCall $ IK.DropItem 1 1 COrgan "impressed"-     | otherwise -> do-       -- Actors that don't move freely and so are stupid, can't be impressed.-       canTra <- getsState $ canTraverse target-       if canTra then do-         unless (bhp tb <= 0)-           execSfx  -- avoid spam just before death-         effectCreateItem (Just $ bfid sb) (Just 1) source target COrgan-                          "impressed" IK.timerNone-       else return UseDud  -- no message, because common and not crucial---- ** PutToSleep--effectPutToSleep :: MonadServerAtomic m => m () -> ActorId -> m UseResult-effectPutToSleep execSfx target = do-  tb <- getsState $ getActorBody target-  if | bproj tb -> return UseDud-     | bwatch tb `elem` [WSleep, WWake] -> return UseId  -- can't increase sleep-     | otherwise -> do-       actorMaxSk <- getsState $ getActorMaxSkills target-       let maxCalm = xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk-           deltaCalm = maxCalm - bcalm tb-       when (deltaCalm > 0) $-         updateCalm target deltaCalm  -- max Calm, but asleep vulnerability-       execSfx-       case bwatch tb of-         WWait n | n > 0 -> do-           nAll <- removeConditionSingle "braced" target-           let !_A = assert (nAll == 0) ()-           return ()-         _ -> return ()-       -- Forced sleep. No check if the actor can sleep naturally.-       addSleep target-       return UseUp---- ** Yell---- This is similar to 'reqYell', but also mentions that the actor is startled,--- because, presumably, he yells involuntarily. It doesn't wake him up--- via Calm instantly, just like yelling in a dream not always does.-effectYell :: MonadServerAtomic m => m () -> ActorId -> m UseResult-effectYell execSfx target = do-  tb <- getsState $ getActorBody target-  if bproj tb || bhp tb <= 0 then  -- avoid yelling projectiles or corpses-    return UseDud  -- the yell never manifested-  else do-    execSfx-    execSfxAtomic $ SfxTaunt False target-    when (deltaBenign $ bcalmDelta tb) $-      execUpdAtomic $ UpdRefillCalm target minusM-    return UseUp---- ** Summon---- Note that the Calm expended doesn't depend on the number of actors summoned.-effectSummon :: MonadServerAtomic m-             => GroupName ItemKind -> Dice.Dice -> ItemId-             -> ActorId -> ActorId -> Bool-             -> m UseResult-effectSummon grp nDm iid source target periodic = do-  -- Obvious effect, nothing announced.-  cops@COps{coTileSpeedup} <- getsState scops-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  sMaxSk <- getsState $ getActorMaxSkills source-  tMaxSk <- getsState $ getActorMaxSkills target-  totalDepth <- getsState stotalDepth-  lvl@Level{ldepth, lbig} <- getLevel (blid tb)-  nFriends <- getsState $ length . friendRegularAssocs (bfid sb) (blid sb)-  discoAspect <- getsState sdiscoAspect-  power0 <- rndToAction $ castDice ldepth totalDepth nDm-  let arItem = discoAspect EM.! iid-      power = max power0 1  -- KISS, always at least one summon-      -- We put @source@ instead of @target@ and @power@ instead of dice-      -- to make the message more accurate.-      effect = IK.Summon grp $ Dice.intToDice power-      durable = IA.checkFlag Ability.Durable arItem-      warnBothActors warning =-       unless (bproj sb) $ do-         execSfxAtomic $ SfxMsgFid (bfid sb) warning-         when (source /= target) $-           execSfxAtomic $ SfxMsgFid (bfid tb) warning-      deltaCalm = - xM 30-  -- Verify Calm only at periodic activations or if the item is durable.-  -- Otherwise summon uses up the item, which prevents summoning getting-  -- out of hand. I don't verify Calm otherwise, to prevent an exploit-  -- via draining one's calm on purpose when an item with good activation-  -- has a nasty summoning side-effect (the exploit still works on durables).-  if | (periodic || durable) && not (bproj sb)-       && (bcalm sb < - deltaCalm || not (calmEnough sb sMaxSk)) -> do-       warnBothActors $ SfxSummonLackCalm source-       return UseId-     | nFriends >= 20 -> do-       -- We assume the actor tries to summon his teammates or allies.-       -- As he repeats such summoning, he is going to bump into this limit.-       -- If he summons others, see the next condition.-       warnBothActors $ SfxSummonTooManyOwn source-       return UseId-     | EM.size lbig >= 200 -> do  -- lower than the 300 limit for spawning-       -- Even if the actor summons foes, he is prevented from exploiting it-       -- too many times and stopping natural monster spawning on the level-       -- (e.g., by filling the level with harmless foes).-       warnBothActors $ SfxSummonTooManyAll source-       return UseId-     | otherwise -> do-       unless (bproj sb) $ updateCalm source deltaCalm-       let validTile t = not $ Tile.isNoActor coTileSpeedup t-           ps = nearbyFreePoints cops lvl validTile (bpos tb)-       localTime <- getsState $ getLocalTime (blid tb)-       -- Make sure summoned actors start acting after the victim.-       let actorTurn = ticksPerMeter $ gearSpeed tMaxSk-           targetTime = timeShift localTime actorTurn-           afterTime = timeShift targetTime $ Delta timeClip-       when (length (take power ps) < power) $-          debugPossiblyPrint-            "Server: effectSummon: failed to find enough free positions"-       bs <- forM (take power ps) $ \p -> do-         -- Mark as summoned to prevent immediate chain summoning.-         -- Summon from current depth, not deeper due to many spawns already.-         maid <- addAnyActor True 0 [(grp, 1)] (blid tb) afterTime (Just p)-         case maid of-           Nothing -> return False  -- suspect content; server debug elsewhere-           Just aid -> do-             b <- getsState $ getActorBody aid-             mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD-             when (isNothing mleader) $ setFreshLeader (bfid b) aid-             return True-       if or bs then do-         execSfxAtomic $ SfxEffect (bfid sb) source effect 0-         return UseUp-       else do-         -- We don't display detailed warnings when @addAnyActor@ fails,-         -- e.g., because the actor groups can't be generated on a given level.-         -- However, we at least don't claim any summoning happened-         -- and we offer a general summoning failure messages.-         warnBothActors $ SfxSummonFailure source-         return UseId---- ** Ascend---- Note that projectiles can be teleported, too, for extra fun.-effectAscend :: MonadServerAtomic m-             => (IK.Effect -> m UseResult)-             -> m () -> Bool -> ActorId -> ActorId -> Point-             -> m UseResult-effectAscend recursiveCall execSfx up source target pos = do-  b1 <- getsState $ getActorBody target-  let lid1 = blid b1-  destinations <- getsState $ whereTo lid1 pos up . sdungeon-  sb <- getsState $ getActorBody source-  if | actorWaits b1 && source /= target -> do-       execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target-       when (source /= target) $-         execSfxAtomic $ SfxMsgFid (bfid b1) $ SfxBracedImmune target-       return UseId-     | null destinations -> do-       execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelNoMore-       when (source /= target) $-         execSfxAtomic $ SfxMsgFid (bfid b1) SfxLevelNoMore-       -- We keep it useful even in shallow dungeons.-       recursiveCall $ IK.Teleport 30  -- powerful teleport-     | otherwise -> do-       (lid2, pos2) <- rndToAction $ oneOf destinations-       execSfx-       mbtime_bOld <--         getsServer $ lookupActorTime (bfid b1) lid1 target . sactorTime-       mbtimeTraj_bOld <--         getsServer $ lookupActorTime (bfid b1) lid1 target . strajTime-       pos3 <- findStairExit (bfid sb) up lid2 pos2-       let switch1 = void $ switchLevels1 (target, b1)-           switch2 = do-             -- Make the initiator of the stair move the leader,-             -- to let him clear the stairs for others to follow.-             let mlead = if bproj b1 then Nothing else Just target-             -- Move the actor to where the inhabitants were, if any.-             switchLevels2 lid2 pos3 (target, b1)-                           mbtime_bOld mbtimeTraj_bOld mlead-       -- The actor will be added to the new level,-       -- but there can be other actors at his new position.-       inhabitants <- getsState $ posToAidAssocs pos3 lid2-       case inhabitants of-         [] -> do-           switch1-           switch2-         (_, b2) : _ -> do-           -- Alert about the switch.-           execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelPushed-           -- Only tell one pushed player, even if many actors, because then-           -- they are projectiles, so not too important.-           when (source /= target) $-             execSfxAtomic $ SfxMsgFid (bfid b2) SfxLevelPushed-           -- Move the actor out of the way.-           switch1-           -- Move the inhabitants out of the way and to where the actor was.-           let moveInh inh = do-                 -- Preserve the old leader, since the actor is pushed,-                 -- so possibly has nothing worhwhile to do on the new level-                 -- (and could try to switch back, if made a leader,-                 -- leading to a loop).-                 mbtime_inh <--                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)-                                . sactorTime-                 mbtimeTraj_inh <--                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)-                                . strajTime-                 inhMLead <- switchLevels1 inh-                 switchLevels2 lid1 (bpos b1) inh-                               mbtime_inh mbtimeTraj_inh inhMLead-           mapM_ moveInh inhabitants-           -- Move the actor to his destination.-           switch2-       return UseUp--findStairExit :: MonadStateRead m-              => FactionId -> Bool -> LevelId -> Point -> m Point-findStairExit side moveUp lid pos = do-  COps{coTileSpeedup} <- getsState scops-  fact <- getsState $ (EM.! side) . sfactionD-  lvl <- getLevel lid-  let defLanding = uncurry Vector $ if moveUp then (1, 0) else (-1, 0)-      center = uncurry Vector $ if moveUp then (-1, 0) else (1, 0)-      (mvs2, mvs1) = break (== defLanding) moves-      mvs = center : filter (/= center) (mvs1 ++ mvs2)-      ps = filter (Tile.isWalkable coTileSpeedup . (lvl `at`))-           $ map (shift pos) mvs-      posOcc :: State -> Int -> Point -> Bool-      posOcc s k p = case posToAidAssocs p lid s of-        [] -> k == 0-        (_, b) : _ | bproj b -> k == 3-        (_, b) : _ | isFoe side fact (bfid b) -> k == 1  -- non-proj foe-        _ -> k == 2  -- moving a non-projectile friend-  unocc <- getsState posOcc-  case concatMap (\k -> filter (unocc k) ps) [0..3] of-    [] -> error $ "" `showFailure` ps-    posRes : _ -> return posRes--switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId)-switchLevels1 (aid, bOld) = do-  let side = bfid bOld-  mleader <- getsState $ gleader . (EM.! side) . sfactionD-  -- Prevent leader pointing to a non-existing actor.-  mlead <--    if not (bproj bOld) && isJust mleader then do-      execUpdAtomic $ UpdLeadFaction side mleader Nothing-      return mleader-        -- outside of a client we don't know the real tgt of aid, hence fst-    else return Nothing-  -- Remove the actor from the old level.-  -- Onlookers see somebody disappear suddenly.-  -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead.-  ais <- getsState $ getCarriedAssocsAndTrunk bOld-  execUpdAtomic $ UpdLoseActor aid bOld ais-  return mlead--switchLevels2 ::MonadServerAtomic m-              => LevelId -> Point -> (ActorId, Actor)-              -> Maybe Time -> Maybe Time -> Maybe ActorId-              -> m ()-switchLevels2 lidNew posNew (aid, bOld) mbtime_bOld mbtimeTraj_bOld mlead = do-  let lidOld = blid bOld-      side = bfid bOld-  let !_A = assert (lidNew /= lidOld `blame` "stairs looped" `swith` lidNew) ()-  -- Sync actor's items' timeouts with the new local time of the level.-  -- We need to sync organs and equipment due to periodic activations,-  -- but also inventory pack (as well as some organs and equipment),-  -- due to timeouts after use, e.g., for some weapons (they recharge also-  -- in the pack; however, this doesn't encourage micromanagement for periodic-  -- items, because the timeout is randomised upon move to equipment).-  ---  -- We don't rebase timeouts for items in stash, because they are-  -- used by many actors on levels with different local times,-  -- so there is no single rebase that would match all.-  -- This is not a big problem: after a single use by an actor the timeout is-  -- set to his current local time, so further uses by that actor have-  -- not anomalously short or long recharge times. If the recharge time-  -- is very long, the player has an option of moving the item from stash-  -- to pack and back, to reset the timeout. An abuse is possible when recently-  -- used item is put from inventory to stash and at once used on another level-  -- taking advantage of local time difference, but this only works once-  -- and using the item back again at the original level makes the recharge-  -- time longer, in turn.-  timeOld <- getsState $ getLocalTime lidOld-  timeLastActive <- getsState $ getLocalTime lidNew-  let delta = timeLastActive `timeDeltaToFrom` timeOld-      shiftByDelta = (`timeShift` delta)-      computeNewTimeout :: ItemQuant -> ItemQuant-      computeNewTimeout (k, it) = (k, map shiftByDelta it)-      rebaseTimeout :: ItemBag -> ItemBag-      rebaseTimeout = EM.map computeNewTimeout-      bNew = bOld { blid = lidNew-                  , bpos = posNew-                  , boldpos = Just posNew  -- new level, new direction-                  , borgan = rebaseTimeout $ borgan bOld-                  , beqp = rebaseTimeout $ beqp bOld-                  , binv = rebaseTimeout $ binv bOld }-  ais <- getsState $ getCarriedAssocsAndTrunk bOld-  -- Sync the actor time with the level time.-  -- This time shift may cause a double move of a foe of the same speed,-  -- but this is OK --- the foe didn't have a chance to move-  -- before, because the arena went inactive, so he moves now one more time.-  maybe (return ())-        (\btime_bOld ->-    modifyServer $ \ser ->-      ser {sactorTime = updateActorTime (bfid bNew) lidNew aid-                                        (shiftByDelta btime_bOld)-                        $ sactorTime ser})-        mbtime_bOld-  maybe (return ())-        (\btime_bOld ->-    modifyServer $ \ser ->-      ser {strajTime = updateActorTime (bfid bNew) lidNew aid-                                       (shiftByDelta btime_bOld)-                       $ strajTime ser})-        mbtimeTraj_bOld-  -- Materialize the actor at the new location.-  -- Onlookers see somebody appear suddenly. The actor himself-  -- sees new surroundings and has to reset his perception.-  execUpdAtomic $ UpdCreateActor aid bNew ais-  case mlead of-    Nothing -> return ()-    Just leader ->-      -- The leader is fresh in the sense that he's on a new level-      -- and so doesn't have up to date Perception.-      setFreshLeader side leader---- ** Escape---- | The faction leaves the dungeon.-effectEscape :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult-effectEscape execSfx source target = do-  -- Obvious effect, nothing announced.-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  let fid = bfid tb-  fact <- getsState $ (EM.! fid) . sfactionD-  if | bproj tb ->-       return UseDud  -- basically a misfire-     | not (fcanEscape $ gplayer fact) -> do-       execSfxAtomic $ SfxMsgFid (bfid sb) SfxEscapeImpossible-       when (source /= target) $-         execSfxAtomic $ SfxMsgFid (bfid tb) SfxEscapeImpossible-       return UseId-     | otherwise -> do-       execSfx-       deduceQuits (bfid tb) $ Status Escape (fromEnum $ blid tb) Nothing-       return UseUp---- ** Paralyze---- | Advance target actor time by this many time clips. Not by actor moves,--- to hurt fast actors more.-effectParalyze :: MonadServerAtomic m-               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult-effectParalyze execSfx nDm source target = do-  tb <- getsState $ getActorBody target-  if bproj tb then return UseDud else  -- shortcut for speed-    paralyze execSfx nDm source target--paralyze :: MonadServerAtomic m-         => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult-paralyze execSfx nDm source target = do-  tb <- getsState $ getActorBody target-  totalDepth <- getsState stotalDepth-  Level{ldepth} <- getLevel (blid tb)-  power0 <- rndToAction $ castDice ldepth totalDepth nDm-  let power = max power0 1  -- KISS, avoid special case-  actorStasis <- getsServer sactorStasis-  if | ES.member target actorStasis -> do-       sb <- getsState $ getActorBody source-       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects-       when (source /= target) $-         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects-       return UseId-     | otherwise -> do-       execSfx-       let t = timeDeltaScale (Delta timeClip) power-       -- Only the normal time, not the trajectory time, is affected.-       modifyServer $ \ser ->-         ser { sactorTime = ageActor (bfid tb) (blid tb) target t-                            $ sactorTime ser-             , sactorStasis = ES.insert target (sactorStasis ser) }-                 -- actor's time warped, so he is in stasis,-                 -- immune to further warps-       return UseUp---- ** ParalyzeInWater---- | Advance target actor time by this many time clips. Not by actor moves,--- to hurt fast actors more. Due to water, so resistable.-effectParalyzeInWater :: MonadServerAtomic m-                      => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult-effectParalyzeInWater execSfx nDm source target = do-  tb <- getsState $ getActorBody target-  if bproj tb then return UseDud else do  -- shortcut for speed-    actorMaxSk <- getsState $ getActorMaxSkills target-    let swimmingOrFlying = max (Ability.getSk Ability.SkSwimming actorMaxSk)-                               (Ability.getSk Ability.SkFlying actorMaxSk)-    if Dice.supDice nDm > swimmingOrFlying-    then paralyze execSfx nDm source target  -- no help at all-    else  -- fully resisted-      -- Don't spam:-      -- sb <- getsState $ getActorBody source-      -- execSfxAtomic $ SfxMsgFid (bfid sb) SfxWaterParalysisResisted-      return UseId---- ** InsertMove---- | Give target actor the given number of tenths of extra move. Don't give--- an absolute amount of time units, to benefit slow actors more.-effectInsertMove :: MonadServerAtomic m-                 => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult-effectInsertMove execSfx nDm source target = do-  tb <- getsState $ getActorBody target-  actorMaxSk <- getsState $ getActorMaxSkills target-  totalDepth <- getsState stotalDepth-  Level{ldepth} <- getLevel (blid tb)-  actorStasis <- getsServer sactorStasis-  power0 <- rndToAction $ castDice ldepth totalDepth nDm-  let power = max power0 1  -- KISS, avoid special case-      actorTurn = ticksPerMeter $ gearSpeed actorMaxSk-      t = timeDeltaScale (timeDeltaPercent actorTurn 10) (-power)-  if | bproj tb -> return UseDud  -- shortcut for speed-     | ES.member target actorStasis -> do-       sb <- getsState $ getActorBody source-       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects-       when (source /= target) $-         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects-       return UseId-     | otherwise -> do-       execSfx-       -- Only the normal time, not the trajectory time, is affected.-       modifyServer $ \ser ->-         ser { sactorTime = ageActor (bfid tb) (blid tb) target t-                            $ sactorTime ser-             , sactorStasis = ES.insert target (sactorStasis ser) }-                 -- actor's time warped, so he is in stasis,-                 -- immune to further warps-       return UseUp---- ** Teleport---- | Teleport the target actor.--- Note that projectiles can be teleported, too, for extra fun.-effectTeleport :: MonadServerAtomic m-               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult-effectTeleport execSfx nDm source target = do-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  if actorWaits tb && source /= target-       -- immune only against not own effects, to enable teleport as beneficial-       -- necklace drawback; also consistent with sleep not protecting-  then do-    execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target-    when (source /= target) $-      execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target-    return UseId-  else do-    COps{coTileSpeedup} <- getsState scops-    totalDepth <- getsState stotalDepth-    lvl@Level{ldepth} <- getLevel (blid tb)-    range <- rndToAction $ castDice ldepth totalDepth nDm-    let spos = bpos tb-        dMinMax !delta !pos =-          let d = chessDist spos pos-          in d >= range - delta && d <= range + delta-        dist !delta !pos _ = dMinMax delta pos-    mtpos <- rndToAction $ findPosTry 200 lvl-      (\p !t -> Tile.isWalkable coTileSpeedup t-                && not (Tile.isNoActor coTileSpeedup t)-                && not (occupiedBigLvl p lvl)-                && not (occupiedProjLvl p lvl))-      [ dist 1-      , dist $ 1 + range `div` 9-      , dist $ 1 + range `div` 7-      , dist $ 1 + range `div` 5-      , dist 5-      , dist 7-      , dist 9-      ]-    case mtpos of-      Nothing -> do  -- really very rare, so debug-        debugPossiblyPrint-          "Server: effectTeleport: failed to find any free position"-        execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible-        when (source /= target) $-          execSfxAtomic $ SfxMsgFid (bfid tb) SfxTransImpossible-        return UseId-      Just tpos -> do-        execSfx-        execUpdAtomic $ UpdMoveActor target spos tpos-        return UseUp---- ** CreateItem--effectCreateItem :: MonadServerAtomic m-                 => Maybe FactionId -> Maybe Int -> ActorId -> ActorId -> CStore-                 -> GroupName ItemKind -> IK.TimerDice-                 -> m UseResult-effectCreateItem jfidRaw mcount source target store grp tim = do-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  totalDepth <- getsState stotalDepth-  Level{ldepth} <- getLevel (blid tb)-  let fscale unit nDm = do-        k0 <- rndToAction $ castDice ldepth totalDepth nDm-        let k = max 1 k0  -- KISS, don't freak out if dice permit 0-        return $! timeDeltaScale unit k-      fgame = fscale (Delta timeTurn)-      factor nDm = do-        actorMaxSk <- getsState $ getActorMaxSkills target-        -- A tiny bit added to make sure length 1 effect doesn't end before-        -- the end of first turn, which would make, e.g., speed, useless.-        let actorTurn =-              timeDeltaPercent (ticksPerMeter $ gearSpeed actorMaxSk) 101-        fscale actorTurn nDm-  delta <- IK.foldTimer (return $ Delta timeZero) fgame factor tim-  let c = CActor target store-  bagBefore <- getsState $ getBodyStoreBag tb store-  -- Power depth of new items unaffected by number of spawned actors.-  freq <- prepareItemKind 0 (blid tb) [(grp, 1)]-  m2 <- rollItemAspect freq (blid tb)-  let (itemKnownRaw, (itemFullRaw, kitRaw)) =-        fromMaybe (error $ "" `showFailure` (blid tb, freq, c)) m2-      -- Avoid too many different item identifiers (one for each faction)-      -- for blasts or common item generating tiles. Conditions are-      -- allowed to be duplicated, because they provide really useful info-      -- (perpetrator). However, if timer is none, they are not duplicated-      -- to make sure that, e.g., poisons stack with each other regardless-      -- of perpetrator and we don't get "no longer poisoned" message-      -- while still poisoned due to another faction. With timed aspects,-      -- e.g., slowness, the message is less misleading, and it's interesting-      -- that I'm twice slower due to aspects from two factions and not-      -- as deadly as being poisoned at twice the rate from two factions.-      jfid = if store == COrgan && not (IK.isTimerNone tim)-                || grp == "impressed"-             then jfidRaw-             else Nothing-      (itemKnown, itemFull) =-        let ItemKnown kindIx ar _ = itemKnownRaw-        in ( ItemKnown kindIx ar jfid-           , itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} )-      kitNew = case mcount of-        Just itemK -> (itemK, [])-        Nothing -> kitRaw-  itemRev <- getsServer sitemRev-  let mquant = case HM.lookup itemKnown itemRev of-        Nothing -> Nothing-        Just iid -> (iid,) <$> iid `EM.lookup` bagBefore-  case mquant of-    Just (iid, (_, afterIt@(timer : rest))) | not $ IK.isTimerNone tim -> do-      -- Already has such items and timer change requested, so only increase-      -- the timer of the first item by the delta, but don't create items.-      let newIt = timer `timeShift` delta : rest-      if afterIt /= newIt then do-        execUpdAtomic $ UpdTimeItem iid c afterIt newIt-        -- It's hard for the client to tell this timer change from charge use,-        -- timer reset on pickup, etc., so we create the msg manually.-        -- Sending to both involved factions lets the player notice-        -- both the extensions he caused and suffered. Other faction causing-        -- that on themselves or on others won't be noticed. TMI.-        execSfxAtomic $ SfxMsgFid (bfid sb)-                      $ SfxTimerExtended (blid tb) target iid store delta-        when (bfid sb /= bfid tb) $-          execSfxAtomic $ SfxMsgFid (bfid tb)-                        $ SfxTimerExtended (blid tb) target iid store delta-        return UseUp-      else return UseDud  -- probably incorrect content, but let it be-    _ -> do-      -- No such items or some items, but void delta, so create items.-      -- If it's, e.g., a periodic poison, the new items will stack with any-      -- already existing items.-      iid <- registerItem (itemFull, kitNew) itemKnown c True-      -- If created not on the ground, ID it, because it won't be on pickup.-      when (store /= CGround) $-        discoverIfMinorEffects c iid (itemKindId itemFull)-      -- Now, if timer change requested, change the timer, but in the new items,-      -- possibly increased in number wrt old items.-      when (not $ IK.isTimerNone tim) $ do-        tb2 <- getsState $ getActorBody target-        bagAfter <- getsState $ getBodyStoreBag tb2 store-        localTime <- getsState $ getLocalTime (blid tb)-        let newTimer = localTime `timeShift` delta-            (afterK, afterIt) =-              fromMaybe (error $ "" `showFailure` (iid, bagAfter, c))-                        (iid `EM.lookup` bagAfter)-            newIt = replicate afterK newTimer-        when (afterIt /= newIt) $-          execUpdAtomic $ UpdTimeItem iid c afterIt newIt-      return UseUp---- ** DropItem---- | Make the target actor drop items in a store from the given group.--- The item itself is immune (any copies).-effectDropItem :: MonadServerAtomic m-               => m () -> ItemId -> Int -> Int -> CStore-               -> GroupName ItemKind -> ActorId-               -> m UseResult-effectDropItem execSfx iidId ngroup kcopy store grp target = do-  tb <- getsState $ getActorBody target-  fact <- getsState $ (EM.! bfid tb) . sfactionD-  isRaw <- allGroupItems store grp target-  curChalSer <- getsServer $ scurChalSer . soptions-  factionD <- getsState sfactionD-  let is = filter ((/= iidId) . fst) isRaw-  if | bproj tb || null is -> return UseDud-     | ngroup == maxBound && kcopy == maxBound-       && store `elem` [CEqp, CInv, CSha]-       && fhasGender (gplayer fact)  -- hero in Allure's decontamination chamber-       && (cdiff curChalSer == 1     -- at lowest difficulty for its faction-           && any (fhasUI . gplayer . snd)-                  (filter (\(fi, fa) -> isFriend fi fa (bfid tb))-                          (EM.assocs factionD))-           || cdiff curChalSer == difficultyBound-              && any (fhasUI . gplayer  . snd)-                     (filter (\(fi, fa) -> isFoe fi fa (bfid tb))-                             (EM.assocs factionD))) ->-{--A hardwired hack, because AI heroes don't cope with Allure's decontamination-chamber; beginners may struggle too, so this is trigered by difficulty.-- AI heroes don't switch leader to the hero past laboratory to equip-weapons from stash between the in-lab hero picks up the loot pile-and himself enters the decontamination chamber-- all consumables always end up in a pack and the whole pack-is always left behind, because consumables are not shared among-actors via shared stash (yet); we could pack consumables to stash-by default, but it's too confusing and risky for beginner players-and doesn't work for heroes that have not enough Calm ATM and AI-would still need to learn to spread consumables from stash to packs afterwards-- the items of the last actor would be lost anyway, unless AI-is taught the foolproof solution of this puzzle, which is yet a bit more-specific than the two general abilities described as desirable above--}-       return UseUp-     | otherwise -> do-       unless (store == COrgan) execSfx-       mapM_ (uncurry (dropCStoreItem True store target tb kcopy))-             (take ngroup is)-       return UseUp---- | Drop a single actor's item (though possibly multiple copies).--- Note that if there are multiple copies, at most one explodes--- to avoid excessive carnage and UI clutter (let's say,--- the multiple explosions interfere with each other or perhaps--- larger quantities of explosives tend to be packaged more safely).--- Note also that @OnSmash@ effects are activated even if item discharged.-dropCStoreItem :: MonadServerAtomic m-               => Bool -> CStore -> ActorId -> Actor -> Int-               -> ItemId -> ItemQuant-               -> m ()-dropCStoreItem verbose store aid b kMax iid (k, _) = do-  itemFull@ItemFull{itemBase} <- getsState $ itemToFull iid-  let arItem = aspectRecordFull itemFull-      c = CActor aid store-      fragile = IA.checkFlag Ability.Fragile arItem-      durable = IA.checkFlag Ability.Durable arItem-      isDestroyed = bproj b && (bhp b <= 0 && not durable || fragile)-                    || IA.checkFlag Ability.Condition arItem-  if isDestroyed then do-    let -- We don't know if it's voluntary, so we conservatively assume-        -- it is and we blame @aid@.-        voluntary = True-        onSmashOnly = True-        useAllCopies = kMax >= k-    effectAndDestroyAndAddKill voluntary aid onSmashOnly useAllCopies False-                               aid aid iid c False itemFull True-    -- One copy was destroyed (or none if the item was discharged),-    -- so let's mop up.-    bag <- getsState $ getContainerBag c-    maybe (return ())-          (\(k1, it) ->-             let destroyedSoFar = k - k1-                 k2 = min (kMax - destroyedSoFar) k1-                 kit2 = (k2, take k2 it)-             in when (k2 > 0)-                $ execUpdAtomic $ UpdLoseItem False iid itemBase kit2 c)-          (EM.lookup iid bag)-  else do-    cDrop <- pickDroppable False aid b  -- drop over fog, etc.-    mvCmd <- generalMoveItem verbose iid (min kMax k) (CActor aid store) cDrop-    mapM_ execUpdAtomic mvCmd--pickDroppable :: MonadStateRead m => Bool -> ActorId -> Actor -> m Container-pickDroppable respectNoItem aid b = do-  cops@COps{coTileSpeedup} <- getsState scops-  lvl <- getLevel (blid b)-  let validTile t = not (respectNoItem && Tile.isNoItem coTileSpeedup t)-  if validTile $ lvl `at` bpos b-  then return $! CActor aid CGround-  else do-    let ps = nearbyFreePoints cops lvl validTile (bpos b)-    return $! case filter (adjacent $ bpos b) $ take 8 ps of-      [] -> CActor aid CGround  -- fallback; still correct, though not ideal-      pos : _ -> CFloor (blid b) pos---- ** PolyItem---- Can't apply to the item itself (any copies).-effectPolyItem :: MonadServerAtomic m-               => m () -> ItemId -> ActorId -> m UseResult-effectPolyItem execSfx iidId target = do-  tb <- getsState $ getActorBody target-  let cstore = CGround-  kitAss <- getsState $ kitAssocs target [cstore]-  case filter ((/= iidId) . fst) kitAss of-    [] -> do-      execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNothing-      -- Do not spam the source actor player about the failures.-      return UseId-    (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind}-          , (itemK, itemTimer) )) : _ -> do-      let arItem = aspectRecordFull itemFull-          maxCount = Dice.supDice $ IK.icount itemKind-      if | IA.checkFlag Ability.Unique arItem -> do-           execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeUnique-           return UseId-         | maybe True (<= 0) $ lookup "common item" $ IK.ifreq itemKind -> do-           execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNotCommon-           return UseId-         | itemK < maxCount -> do-           execSfxAtomic $ SfxMsgFid (bfid tb)-                         $ SfxPurposeTooFew maxCount itemK-           return UseId-         | otherwise -> do-           -- Only the required number of items is used up, not all of them.-           let c = CActor target cstore-               kit = (maxCount, take maxCount itemTimer)-           execSfx-           identifyIid iid c itemKindId itemKind-           execUpdAtomic $ UpdDestroyItem iid itemBase kit c-           effectCreateItem (Just $ bfid tb) Nothing-                            target target cstore "common item" IK.timerNone---- ** RerollItem---- Can't apply to the item itself (any copies).-effectRerollItem :: forall m . MonadServerAtomic m-                 => m () -> ItemId -> ActorId -> m UseResult-effectRerollItem execSfx iidId target = do-  COps{coItemSpeedup} <- getsState scops-  tb <- getsState $ getActorBody target-  let cstore = CGround  -- if ever changed, call @discoverIfMinorEffects@-  kitAss <- getsState $ kitAssocs target [cstore]-  case filter ((/= iidId) . fst) kitAss of-    [] -> do-      execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNothing-      -- Do not spam the source actor player about the failures.-      return UseId-    (iid, ( ItemFull{ itemBase, itemKindId, itemKind-                    , itemDisco=ItemDiscoFull itemAspect }-          , (_, itemTimer) )) : _ ->-      if | IA.kmConst $ getKindMean itemKindId coItemSpeedup -> do-           execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNotRandom-           return UseId-         | otherwise -> do-           let c = CActor target cstore-               kit = (1, take 1 itemTimer)  -- prevent micromanagement-               freq = pure (itemKindId, itemKind)-           execSfx-           identifyIid iid c itemKindId itemKind-           execUpdAtomic $ UpdDestroyItem iid itemBase kit c-           dungeon <- getsState sdungeon-           let maxLid = fst $ maximumBy (Ord.comparing (ldepth . snd))-                            $ EM.assocs dungeon-               roll100 :: Int -> m (ItemKnown, ItemFullKit)-               roll100 n = do-                 m2 <- rollItemAspect freq maxLid-                 case m2 of-                   Nothing ->-                     error "effectRerollItem: can't create rerolled item"-                   Just i2@(ItemKnown _ ar2 _, _) ->-                     if ar2 == itemAspect && n > 0-                     then roll100 (n - 1)-                     else return i2-           (itemKnown, (itemFull, _)) <- roll100 100-           void $ registerItem (itemFull, kit) itemKnown c True-           return UseUp-    _ -> error "effectRerollItem: server ignorant about an item"---- ** DupItem---- Can't apply to the item itself (any copies).-effectDupItem :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult-effectDupItem execSfx iidId target = do-  tb <- getsState $ getActorBody target-  let cstore = CGround  -- beware of other options, e.g., creating in eqp-                        -- and not setting timeout to a random value-  kitAss <- getsState $ kitAssocs target [cstore]-  case filter ((/= iidId) . fst) kitAss of-    [] -> do-      execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupNothing-      -- Do not spam the source actor player about the failures.-      return UseId-    (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind}-          , _ )) : _ -> do-      let arItem = aspectRecordFull itemFull-      if | IA.checkFlag Ability.Unique arItem -> do-           execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupUnique-           return UseId-         | maybe False (> 0) $ lookup "valuable" $ IK.ifreq itemKind -> do-           execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupValuable-           return UseId-         | otherwise -> do-           let c = CActor target cstore-           execSfx-           identifyIid iid c itemKindId itemKind-           execUpdAtomic $ UpdCreateItem iid itemBase (1, []) c-           return UseUp---- ** Identify--effectIdentify :: MonadServerAtomic m-               => m () -> ItemId -> ActorId -> m UseResult-effectIdentify execSfx iidId target = do-  COps{coItemSpeedup} <- getsState scops-  discoAspect <- getsState sdiscoAspect-  -- The actor that causes the application does not determine what item-  -- is identifiable, becuase it's the target actor that identifies-  -- his possesions.-  tb <- getsState $ getActorBody target-  sClient <- getsServer $ (EM.! bfid tb) . sclientStates-  let tryFull store as = case as of-        [] -> return False-        (iid, _) : rest | iid == iidId -> tryFull store rest  -- don't id itself-        (iid, ItemFull{itemBase, itemKindId, itemKind}) : rest -> do-          let arItem = discoAspect EM.! iid-              kindIsKnown = case jkind itemBase of-                IdentityObvious _ -> True-                IdentityCovered ix _ -> ix `EM.member` sdiscoKind sClient-          if iid `EM.member` sdiscoAspect sClient  -- already fully identified-             || IA.isHumanTrinket itemKind  -- hack; keep them non-identified-             || store == CGround && IA.onlyMinorEffects arItem itemKind-               -- will be identified when picked up, so don't bother-             || IA.kmConst (getKindMean itemKindId coItemSpeedup)-                && kindIsKnown-               -- constant aspects and known kind; no need to identify further;-               -- this should normally not be needed, since clients should-               -- identify such items for free-          then tryFull store rest-          else do-            let c = CActor target store-            execSfx-            identifyIid iid c itemKindId itemKind-            return True-      tryStore stores = case stores of-        [] -> do-          execSfxAtomic $ SfxMsgFid (bfid tb) SfxIdentifyNothing-          return UseId  -- the message tells it's ID effect-        store : rest -> do-          allAssocs <- getsState $ fullAssocs target [store]-          go <- tryFull store allAssocs-          if go then return UseUp else tryStore rest-  tryStore [CGround, CEqp, CInv, CSha]--identifyIid :: MonadServerAtomic m-            => ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()-identifyIid iid c itemKindId itemKind =-  unless (IA.isHumanTrinket itemKind) $ do-    discoAspect <- getsState sdiscoAspect-    execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid---- ** Detect--effectDetect :: MonadServerAtomic m-             => m () -> IK.DetectKind -> Int -> ActorId -> Point -> m UseResult-effectDetect execSfx d radius target pos = do-  COps{coitem, coTileSpeedup} <- getsState scops-  b <- getsState $ getActorBody target-  lvl <- getLevel $ blid b-  s <- getState-  getKind <- getsState $ flip getIidKindServer-  let lootPredicate p =-        p `EM.member` lfloor lvl-        || (case posToBigAssoc p (blid b) s of-              Nothing -> False-              Just (_, body) ->-                let belongings = EM.keys (beqp body) ++ EM.keys (binv body)-                      -- shared stash ignored, because hard to get-                in any belongingIsLoot belongings)-        || any embedHasLoot (EM.keys $ getEmbedBag (blid b) p s)-      itemKindIsLoot = isNothing . lookup "unreported inventory" . IK.ifreq-      belongingIsLoot iid = itemKindIsLoot $ getKind iid-      embedHasLoot iid = any effectHasLoot $ IK.ieffects $ getKind iid-      reported acc _ _ itemKind = acc && itemKindIsLoot itemKind-      effectHasLoot (IK.CreateItem cstore grp _) =-        cstore `elem` [CGround, CEqp, CInv, CSha]-        && ofoldlGroup' coitem grp reported True-      effectHasLoot IK.PolyItem = True-      effectHasLoot IK.RerollItem = True-      effectHasLoot IK.DupItem = True-      effectHasLoot (IK.OneOf l) = any effectHasLoot l-      effectHasLoot (IK.OnSmash eff) = effectHasLoot eff-      effectHasLoot (IK.Composite l) = any effectHasLoot l-      effectHasLoot _ = False-      (predicate, action) = case d of-        IK.DetectAll -> (const True, const $ return False)-        IK.DetectActor -> ((`EM.member` lbig lvl), const $ return False)-        IK.DetectLoot -> (lootPredicate, const $ return False)-        IK.DetectExit ->-          let (ls1, ls2) = lstair lvl-          in ((`elem` ls1 ++ ls2 ++ lescape lvl), const $ return False)-        IK.DetectHidden ->-          let predicateH p = Tile.isHideAs coTileSpeedup $ lvl `at` p-              revealEmbed p = do-                embeds <- getsState $ getEmbedBag (blid b) p-                unless (EM.null embeds) $ do-                  let ais = map (\iid -> (iid, getItemBody iid s))-                                (EM.keys embeds)-                  execUpdAtomic $ UpdSpotItemBag (CEmbed (blid b) p) embeds ais-              actionH l = do-                let f p = when (p /= pos) $ do-                      let t = lvl `at` p-                      execUpdAtomic $ UpdSearchTile target p t-                      -- This is safe searching; embedded items-                      -- are not triggered, but they are revealed.-                      revealEmbed p-                      case EM.lookup p $ lentry lvl of-                        Nothing -> return ()-                        Just entry ->-                          execUpdAtomic $ UpdSpotEntry (blid b) [(p, entry)]-                mapM_ f l-                return $! not $ null l  -- KISS, even if client knows all-          in (predicateH, actionH)-        IK.DetectEmbed -> ((`EM.member` lembed lvl), const $ return False)-  effectDetectX d predicate action execSfx radius target--effectDetectX :: MonadServerAtomic m-              => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool)-              -> m () -> Int -> ActorId -> m UseResult-effectDetectX d predicate action execSfx radius target = do-  COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops-  b <- getsState $ getActorBody target-  sperFidOld <- getsServer sperFid-  let perOld = sperFidOld EM.! bfid b EM.! blid b-      Point x0 y0 = bpos b-      perList = filter predicate-        [ Point x y-        | y <- [max 0 (y0 - radius) .. min (rYmax - 1) (y0 + radius)]-        , x <- [max 0 (x0 - radius) .. min (rXmax - 1) (x0 + radius)]-        ]-      extraPer = emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList}-      inPer = diffPer extraPer perOld-  unless (nullPer inPer) $ do-    -- Perception is modified on the server and sent to the client-    -- together with all the revealed info.-    let perNew = addPer inPer perOld-        fper = EM.adjust (EM.insert (blid b) perNew) (bfid b)-    modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser}-    execSendPer (bfid b) (blid b) emptyPer inPer perNew-  pointsModified <- action perList-  if not (nullPer inPer) || pointsModified then do-    execSfx-    -- Perception is reverted. This is necessary to ensure save and restore-    -- doesn't change game state.-    unless (nullPer inPer) $ do-      modifyServer $ \ser -> ser {sperFid = sperFidOld}-      execSendPer (bfid b) (blid b) inPer emptyPer perOld-  else-    execSfxAtomic $ SfxMsgFid (bfid b) $ SfxVoidDetection d-  return UseUp  -- even if nothing spotted, in itself it's still useful data---- ** SendFlying---- | Send the target actor flying like a projectile. If the actors are adjacent,--- the vector is directed outwards, if no, inwards, if it's the same actor,--- boldpos is used, if it can't, a random outward vector of length 10--- is picked.-effectSendFlying :: MonadServerAtomic m-                 => m () -> IK.ThrowMod -> ActorId -> ActorId -> Container-                 -> Maybe Bool-                 -> m UseResult-effectSendFlying execSfx IK.ThrowMod{..} source target c modePush = do-  v <- sendFlyingVector source target modePush-  sb <- getsState $ getActorBody source-  tb <- getsState $ getActorBody target-  let eps = 0-      fpos = bpos tb `shift` v-      isEmbed = case c of-        CEmbed{} -> True-        _ -> False-  if bhp tb <= 0  -- avoid dragging around corpses-     || bproj tb && isEmbed then  -- fyling projectiles can't slip on the floor-    return UseDud  -- the impact never manifested-  else if actorWaits tb-          && source /= target-          && isNothing (btrajectory tb) then do-    execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target-    when (source /= target) $-      execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target-    return UseUp  -- waste it to prevent repeated throwing at immobile actors-  else do-   COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops-   case bla rXmax rYmax eps (bpos tb) fpos of-    Nothing -> error $ "" `showFailure` (fpos, tb)-    Just [] -> error $ "projecting from the edge of level"-                       `showFailure` (fpos, tb)-    Just (pos : rest) -> do-      weightAssocs <- getsState $ fullAssocs target [CInv, CEqp, COrgan]-      let weight = sum $ map (IK.iweight . itemKind . snd) weightAssocs-          path = bpos tb : pos : rest-          (trajectory, (speed, _)) =-            -- Note that the @ThrowMod@ aspect of the actor's trunk is ignored.-            computeTrajectory weight throwVelocity throwLinger path-          ts = Just (trajectory, speed)-      if null trajectory-      then return UseId  -- e.g., actor is too heavy; but a jerk is noticeable-      else do-        execSfx-        -- Old and new trajectories are not added; the old one is replaced.-        unless (btrajectory tb == ts) $-          execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts-        -- If propeller is a projectile, it pushes involuntarily,-        -- so its originator is to blame.-        -- However, we can't easily see whether a pushed non-projectile actor-        -- pushed another due to colliding or voluntarily, so we assign-        -- blame to him.-        originator <- if bproj sb-                      then getsServer $ EM.findWithDefault source source-                                        . strajPushedBy-                      else return source-        modifyServer $ \ser ->-          ser {strajPushedBy = EM.insert target originator $ strajPushedBy ser}-        -- In case of pre-existing pushing, don't touch the time-        -- so that the pending @advanceTimeTraj@ can do its job-        -- (it will, because non-empty trajectory is here set, unless, e.g.,-        -- subsequent effects from the same item change the trajectory).-        when (isNothing $ btrajectory tb) $ do-          -- Set flying time to almost now, so that the push happens ASAP,-          -- because it's the first one, so almost no delay is needed.-          localTime <- getsState $ getLocalTime (blid tb)-          -- But add a slight overhead to avoid displace-slide loops-          -- of 3 actors in a line.-          let overheadTime = timeShift localTime (Delta timeClip)-          modifyServer $ \ser ->-            ser {strajTime =-                   updateActorTime (bfid tb) (blid tb) target overheadTime-                   $ strajTime ser}-        return UseUp--sendFlyingVector :: MonadServerAtomic m-                 => ActorId -> ActorId -> Maybe Bool -> m Vector-sendFlyingVector source target modePush = do-  sb <- getsState $ getActorBody source-  let boldpos_sb = fromMaybe (bpos sb) (boldpos sb)-  if source == target then-    if boldpos_sb == bpos sb then rndToAction $ do-      z <- randomR (-10, 10)-      oneOf [Vector 10 z, Vector (-10) z, Vector z 10, Vector z (-10)]-    else-      return $! vectorToFrom (bpos sb) boldpos_sb-  else do-    tb <- getsState $ getActorBody target-    let pushV = vectorToFrom (bpos tb) (bpos sb)-        pullV = vectorToFrom (bpos sb) (bpos tb)-    return $! case modePush of-                Just True -> pushV-                Just False -> pullV-                Nothing | adjacent (bpos sb) (bpos tb) -> pushV-                Nothing -> pullV---- ** DropBestWeapon---- | Make the target actor drop his best weapon.--- The item itself is immune (any copies).-effectDropBestWeapon :: MonadServerAtomic m-                     => m () -> ItemId -> ActorId -> m UseResult-effectDropBestWeapon execSfx iidId target = do-  tb <- getsState $ getActorBody target-  if bproj tb then return UseDud else do-    localTime <- getsState $ getLocalTime (blid tb)-    kitAssRaw <- getsState $ kitAssocs target [CEqp]-    let kitAss = filter (\(iid, (i, _)) ->-                          IA.checkFlag Ability.Meleeable (aspectRecordFull i)-                          && iid /= iidId) kitAssRaw-        ignoreCharges = True-    case strongestMelee ignoreCharges Nothing localTime kitAss of-      (_, (_, (iid, _))) : _ -> do-        execSfx-        let kit = beqp tb EM.! iid-        dropCStoreItem True CEqp target tb 1 iid kit  -- not the whole stack-        return UseUp-      [] ->-        return UseDud---- ** ActivateInv---- | Activate all items with the given symbol--- in the target actor's equipment (there's no variant that activates--- a random one, to avoid the incentive for carrying garbage).--- Only one item of each stack is activated (and possibly consumed).--- Won't activate the item itself (any copies).-effectActivateInv :: MonadServerAtomic m-                  => m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult-effectActivateInv execSfx iidId source target symbol = do-  let c = CActor target CInv-  effectTransformContainer execSfx iidId symbol c $ \iid _ ->-    -- We don't know if it's voluntary, so we conservatively assume it is-    -- and we blame @source@.-    kineticEffectAndDestroy True source target target iid c True--effectTransformContainer :: forall m. MonadServerAtomic m-                         => m () -> ItemId -> Char -> Container-                         -> (ItemId -> ItemQuant -> m ())-                         -> m UseResult-effectTransformContainer execSfx iidId symbol c m = do-  getKind <- getsState $ flip getIidKindServer-  let hasSymbol (iid, _kit) = do-        let jsymbol = IK.isymbol $ getKind iid-        return $! jsymbol == symbol-  assocsCStore <- getsState $ EM.assocs . getContainerBag c-  is <- filter ((/= iidId) . fst) <$> if symbol == ' '-                                      then return assocsCStore-                                      else filterM hasSymbol assocsCStore-  if null is-  then return UseDud-  else do-    execSfx-    mapM_ (uncurry m) is-    -- Even if no item produced any visible effect, rummaging through-    -- the inventory uses up the effect and produced discernible vibrations.-    return UseUp---- ** ApplyPerfume--effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult-effectApplyPerfume execSfx target = do-  tb <- getsState $ getActorBody target-  Level{lsmell} <- getLevel $ blid tb-  unless (EM.null lsmell) $ do-    execSfx-    let f p fromSm = execUpdAtomic $ UpdAlterSmell (blid tb) p fromSm timeZero-    mapWithKeyM_ f lsmell-  return UseUp  -- even if no smell before, the perfume is noticeable---- ** OneOf--effectOneOf :: MonadServerAtomic m-            => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult-effectOneOf recursiveCall l = do-  let call1 = do-        ef <- rndToAction $ oneOf l-        recursiveCall ef-      call99 = replicate 99 call1-      f call result = do-        ur <- call-        -- We avoid 99 calls to a fizzling effect that only prints-        -- a failure message and IDs the item.-        if ur == UseDud then result else return ur-  foldr f (return UseDud) call99-  -- no @execSfx@, because individual effects sent them---- ** VerbNoLonger--effectVerbNoLonger :: MonadServerAtomic m-                   => Bool -> m () -> ActorId -> m UseResult-effectVerbNoLonger useAllCopies execSfx source = do-  b <- getsState $ getActorBody source-  when (useAllCopies  -- @UseUp@ below ensures that if all used, all destroyed-        && not (bproj b)) $  -- no spam when projectiles activate-    execSfx  -- announce that all copies have run out (or whatever message)-  return UseUp  -- help to destroy the copy, even if not all used up---- ** VerbMsg--effectVerbMsg :: MonadServerAtomic m => m () -> ActorId -> m UseResult-effectVerbMsg execSfx source = do-  b <- getsState $ getActorBody source-  unless (bproj b) execSfx  -- don't spam when projectiles activate-  return UseUp  -- announcing always successful and this helps-                -- to destroy the item---- ** Composite--effectComposite :: forall m. MonadServerAtomic m-                => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult-effectComposite recursiveCall l = do-  let f :: IK.Effect -> m UseResult -> m UseResult-      f eff result = do-        ur <- recursiveCall eff-        when (ur == UseUp) $ void result  -- UseResult comes from the first-        return ur-  foldr f (return UseDud) l-  -- no @execSfx@, because individual effects sent them+  ( UseResult(..), EffToUse(..), EffApplyFlags(..)+  , applyItem, cutCalm, kineticEffectAndDestroy, effectAndDestroyAndAddKill+  , itemEffectEmbedded, highestImpression, dominateFidSfx+  , dropAllEquippedItems, pickDroppable, consumeItems, dropCStoreItem+#ifdef EXPOSE_INTERNAL+    -- * Internal operations+  , applyKineticDamage, refillHP, effectAndDestroy, imperishableKit+  , itemEffectDisco, effectSem+  , effectBurn, effectExplode, effectRefillHP, effectRefillCalm+  , effectDominate, dominateFid, effectImpress, effectPutToSleep, effectYell+  , effectSummon, effectAscend, findStairExit, switchLevels1, switchLevels2+  , effectEscape, effectParalyze, paralyze, effectParalyzeInWater+  , effectInsertMove, effectTeleport, effectCreateItem+  , effectDestroyItem, effectDropItem, effectConsumeItems+  , effectRecharge, effectPolyItem, effectRerollItem, effectDupItem+  , effectIdentify, identifyIid, effectDetect, effectDetectX, effectSendFlying+  , sendFlyingVector, effectApplyPerfume, effectAtMostOneOf, effectOneOf+  , effectAndEffect, effectAndEffectSem, effectOrEffect, effectSeqEffect+  , effectWhen, effectUnless, effectIfThenElse+  , effectVerbNoLonger, effectVerbMsg, effectVerbMsgFail+#endif+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import           Data.Bits (xor)+import qualified Data.EnumMap.Strict as EM+import qualified Data.EnumSet as ES+import qualified Data.HashMap.Strict as HM+import           Data.Int (Int64)+import           Data.Key (mapWithKeyM_)+import qualified Data.Text as T++import           Game.LambdaHack.Atomic+import           Game.LambdaHack.Common.Actor+import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.Analytics+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           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.Types+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.RuleKind+import qualified Game.LambdaHack.Core.Dice as Dice+import           Game.LambdaHack.Core.Random+import           Game.LambdaHack.Definition.Ability (ActivationFlag (..))+import qualified Game.LambdaHack.Definition.Ability as Ability+import           Game.LambdaHack.Definition.Defs+import           Game.LambdaHack.Server.CommonM+import           Game.LambdaHack.Server.ItemM+import           Game.LambdaHack.Server.ItemRev+import           Game.LambdaHack.Server.MonadServer+import           Game.LambdaHack.Server.PeriodicM+import           Game.LambdaHack.Server.ServerOptions+import           Game.LambdaHack.Server.State++-- * Semantics of effects++data UseResult = UseDud | UseId | UseUp+  deriving (Eq, Ord)++data EffToUse = EffBare | EffBareAndOnCombine | EffOnCombine+  deriving Eq++data EffApplyFlags = EffApplyFlags+  { effToUse            :: EffToUse+  , effVoluntary        :: Bool+  , effUseAllCopies     :: Bool+  , effKineticPerformed :: Bool+  , effActivation       :: Ability.ActivationFlag+  , effMayDestroy       :: Bool+  }++applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m ()+applyItem aid iid cstore = do+  execSfxAtomic $ SfxApply aid iid+  let c = CActor aid cstore+  -- Treated as if the actor hit himself with the item as a weapon,+  -- incurring both the kinetic damage and effect, hence the same call+  -- as in @reqMelee@.+  let effApplyFlags = EffApplyFlags+        { effToUse            = EffBareAndOnCombine+        , effVoluntary        = True+        , effUseAllCopies     = False+        , effKineticPerformed = False+        , effActivation       = ActivationTrigger+        , effMayDestroy       = True+        }+  void $ kineticEffectAndDestroy effApplyFlags aid aid aid iid c++applyKineticDamage :: MonadServerAtomic m+                   => ActorId -> ActorId -> ItemId -> m Bool+applyKineticDamage source target iid = do+  itemKind <- getsState $ getIidKindServer iid+  if IK.idamage itemKind == 0 then return False else do  -- speedup+    sb <- getsState $ getActorBody source+    hurtMult <- getsState $ armorHurtBonus source target+    totalDepth <- getsState stotalDepth+    Level{ldepth} <- getLevel (blid sb)+    dmg <- rndToAction $ castDice ldepth totalDepth $ IK.idamage itemKind+    let rawDeltaHP = intCast hurtMult * xM dmg `divUp` 100+        speedDeltaHP = case btrajectory sb of+          Just (_, speed) | bproj sb -> - modifyDamageBySpeed rawDeltaHP speed+          _ -> - rawDeltaHP+    if speedDeltaHP < 0 then do  -- damage the target, never heal+      refillHP source target speedDeltaHP+      return True+    else return False++refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m ()+refillHP source target speedDeltaHP = assert (speedDeltaHP /= 0) $ do+  tbOld <- getsState $ getActorBody target+  actorMaxSk <- getsState $ getActorMaxSkills target+  -- We don't ignore even tiny HP drains, because they can be very weak+  -- enemy projectiles and so will recur and in total can be deadly+  -- and also AI should rather be stupidly aggressive than stupidly lethargic.+  let serious = source /= target && not (bproj tbOld)+      hpMax = Ability.getSk Ability.SkMaxHP actorMaxSk+      deltaHP0 | serious && speedDeltaHP < minusM =+                 -- If overfull, at least cut back to max, unless minor drain.+                 min speedDeltaHP (xM hpMax - bhp tbOld)+               | otherwise = speedDeltaHP+      deltaHP = if | deltaHP0 > 0 && bhp tbOld > xM 999 ->  -- UI limit+                     tenthM  -- avoid nop, to avoid loops+                   | deltaHP0 < 0 && bhp tbOld < - xM 999 ->+                     -tenthM+                   | otherwise -> deltaHP0+  execUpdAtomic $ UpdRefillHP target deltaHP+  when serious $ cutCalm target+  tb <- getsState $ getActorBody target+  fact <- getsState $ (EM.! bfid tb) . sfactionD+  unless (bproj tb || fleaderMode (gplayer fact) == LeaderNull) $+    -- If leader just lost all HP, change the leader early (not when destroying+    -- the actor), to let players rescue him, especially if he's slowed+    -- by the attackers.+    when (bhp tb <= 0 && bhp tbOld > 0) $ do+      -- If all other party members dying, leadership will switch+      -- to one of them, which seems questionable, but it's rare+      -- and the disruption servers to underline the dire circumstance.+      electLeader (bfid tb) (blid tb) target+      mleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD+      -- If really nobody else in the party, make him the leader back again+      -- on the oft chance that he gets revived by a projectile, etc.+      when (isNothing mleader) $+        execUpdAtomic $ UpdLeadFaction (bfid tb) Nothing $ Just target++cutCalm :: MonadServerAtomic m => ActorId -> m ()+cutCalm target = do+  tb <- getsState $ getActorBody target+  actorMaxSk <- getsState $ getActorMaxSkills target+  let upperBound = if hpTooLow tb actorMaxSk+                   then 2  -- to trigger domination on next attack, etc.+                   else xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk+      deltaCalm = min minusM2 (upperBound - bcalm tb)+  -- HP loss decreases Calm by at least @minusM2@ to avoid "hears something",+  -- which is emitted when decreasing Calm by @minusM1@.+  updateCalm target deltaCalm++-- Here kinetic damage is applied. This is necessary so that the same+-- AI benefit calculation may be used for flinging and for applying items.+kineticEffectAndDestroy :: MonadServerAtomic m+                        => EffApplyFlags+                        -> ActorId -> ActorId -> ActorId -> ItemId -> Container+                        -> m UseResult+kineticEffectAndDestroy effApplyFlags0@EffApplyFlags{..}+                        killer source target iid c = do+  bag <- getsState $ getContainerBag c+  case iid `EM.lookup` bag of+    Nothing -> error $ "" `showFailure` (source, target, iid, c)+    Just kit -> do+      itemFull <- getsState $ itemToFull iid+      tbOld <- getsState $ getActorBody target+      localTime <- getsState $ getLocalTime (blid tbOld)+      let recharged = hasCharge localTime kit+      -- If neither kinetic hit nor any effect is activated, there's no chance+      -- the items can be destroyed or even timeout changes, so we abort early.+      if not recharged then return UseDud else do+        effKineticPerformed2 <- applyKineticDamage source target iid+        tb <- getsState $ getActorBody target+        -- Sometimes victim heals just after we registered it as killed,+        -- but that's OK, an actor killed two times is similar enough+        -- to two killed.+        when (effKineticPerformed2  -- speedup+              && bhp tb <= 0 && bhp tbOld > 0) $ do+          sb <- getsState $ getActorBody source+          arWeapon <- getsState $ (EM.! iid) . sdiscoAspect+          let killHow | not (bproj sb) =+                        if effVoluntary+                        then KillKineticMelee+                        else KillKineticPush+                      | IA.checkFlag Ability.Blast arWeapon = KillKineticBlast+                      | otherwise = KillKineticRanged+          addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)+        let effApplyFlags = effApplyFlags0+              { effUseAllCopies     = fst kit <= 1+              , effKineticPerformed = effKineticPerformed2+              }+        effectAndDestroyAndAddKill effApplyFlags+                                   killer source target iid c itemFull++effectAndDestroyAndAddKill :: MonadServerAtomic m+                           => EffApplyFlags+                           -> ActorId -> ActorId -> ActorId -> ItemId+                           -> Container -> ItemFull+                           -> m UseResult+effectAndDestroyAndAddKill effApplyFlags0@EffApplyFlags{..}+                           killer source target iid c itemFull = do+  tbOld <- getsState $ getActorBody target+  triggered <- effectAndDestroy effApplyFlags0 source target iid c itemFull+  tb <- getsState $ getActorBody target+  -- Sometimes victim heals just after we registered it as killed,+  -- but that's OK, an actor killed two times is similar enough to two killed.+  when (bhp tb <= 0 && bhp tbOld > 0) $ do+    sb <- getsState $ getActorBody source+    arWeapon <- getsState $ (EM.! iid) . sdiscoAspect+    let killHow | not (bproj sb) =+                  if effVoluntary then KillOtherMelee else KillOtherPush+                | IA.checkFlag Ability.Blast arWeapon = KillOtherBlast+                | otherwise = KillOtherRanged+    addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)+  return triggered++effectAndDestroy :: MonadServerAtomic m+                 => EffApplyFlags+                 -> ActorId -> ActorId -> ItemId -> Container -> ItemFull+                 -> m UseResult+effectAndDestroy effApplyFlags0@EffApplyFlags{..} source target iid container+                 itemFull@ItemFull{itemDisco, itemKindId, itemKind} = do+  bag <- getsState $ getContainerBag container+  let (itemK, itemTimers) = bag EM.! iid+      effs = case effToUse of+        EffBare -> if effActivation == ActivationOnSmash+                   then IK.strengthOnSmash itemKind+                   else IK.ieffects itemKind+        EffBareAndOnCombine ->+          IK.ieffects itemKind ++ IK.strengthOnCombine itemKind+        EffOnCombine -> IK.strengthOnCombine itemKind+      arItem = case itemDisco of+        ItemDiscoFull itemAspect -> itemAspect+        _ -> error "effectAndDestroy: server ignorant about an item"+      timeout = IA.aTimeout arItem+  lid <- getsState $ lidFromC container+  localTime <- getsState $ getLocalTime lid+  let it1 = filter (charging localTime) itemTimers+      len = length it1+      recharged = len < itemK+                  || effActivation `elem` [ActivationOnSmash, ActivationConsume]+  -- If the item has no charges and the special cases don't apply+  -- we speed up by shortcutting early, because we don't need to activate+  -- effects and we know kinetic hit was not performed (no charges to do so+  -- and in case of @OnSmash@ and @ActivationConsume@,+  -- only effects are triggered).+  if not recharged then return UseDud else do+    let timeoutTurns = timeDeltaScale (Delta timeTurn) timeout+        newItemTimer = createItemTimer localTime timeoutTurns+        it2 = if timeout /= 0 && recharged+              then if effActivation == ActivationPeriodic+                      && IA.checkFlag Ability.Fragile arItem+                   then replicate (itemK - length it1) newItemTimer ++ it1+                           -- copies are spares only; one fires, all discharge+                   else take (itemK - length it1) [newItemTimer] ++ it1+                           -- copies all fire, turn by turn; <= 1 discharges+              else itemTimers+        kit2 = (1, take 1 it2)+        !_A = assert (len <= itemK `blame` (source, target, iid, container)) ()+    -- We use up the charge even if eventualy every effect fizzles. Tough luck.+    -- At least we don't destroy the item in such case.+    -- Also, we ID it regardless.+    unless (itemTimers == it2) $+      execUpdAtomic $ UpdTimeItem iid container itemTimers it2+    -- We have to destroy the item before the effect affects the item+    -- or affects the actor holding it or standing on it (later on we could+    -- lose track of the item and wouldn't be able to destroy it) .+    -- This is OK, because we don't remove the item type from various+    -- item dictionaries, just an individual copy from the container,+    -- so, e.g., the item can be identified after it's removed.+    let imperishable = not effMayDestroy+                       || imperishableKit effActivation itemFull+    unless imperishable $+      execUpdAtomic $ UpdLoseItem False iid kit2 container+    -- At this point, the item is potentially no longer in container+    -- @container@, therefore beware of assuming so in the code below.+    triggeredEffect <- itemEffectDisco effApplyFlags0 source target iid+                                       itemKindId itemKind container effs+    sb <- getsState $ getActorBody source+    let triggered = if effKineticPerformed then UseUp else triggeredEffect+        mEmbedPos = case container of+          CEmbed _ p -> Just p+          _ -> Nothing+    -- Announce no effect, which is rare and wastes time, so noteworthy.+    if | triggered == UseUp+         && mEmbedPos /= Just (bpos sb)  -- treading water, etc.+         && effActivation `notElem` [ActivationTrigger, ActivationMeleeable]+              -- do not repeat almost the same msg+         && (effActivation /= ActivationOnSmash  -- only tells condition ends+             && effActivation /= ActivationPeriodic+             || not (IA.checkFlag Ability.Condition arItem)) ->+           -- Effects triggered; main feedback comes from them,+           -- but send info so that clients can log it.+           execSfxAtomic $ SfxItemApplied iid container+       | triggered /= UseUp+         && effActivation /= ActivationOnSmash+         && effActivation /= ActivationPeriodic+              -- periodic effects repeat and so spam+         && effActivation+            `notElem` [ActivationUnderRanged, ActivationUnderMelee]+              -- and so do effects under attack+         && not (bproj sb)  -- projectiles can be very numerous+         && isNothing mEmbedPos  ->  -- embeds may be just flavour+           execSfxAtomic $ SfxMsgFid (bfid sb) $+             if any IK.forApplyEffect effs+             then SfxFizzles iid container+                    -- something didn't work despite promising effects+             else SfxNothingHappens iid container  -- fully expected+       | otherwise -> return ()+    -- If none of item's effects nor a kinetic hit were performed,+    -- we recreate the item (assuming we deleted the item above).+    -- Regardless, we don't rewind the time, because some info is gained+    -- (that the item does not exhibit any effects in the given context).+    unless (imperishable || triggered == UseUp) $+      execUpdAtomic $ UpdSpotItem False iid kit2 container+    return triggered++imperishableKit :: ActivationFlag -> ItemFull -> Bool+imperishableKit effActivation itemFull =+  let arItem = aspectRecordFull itemFull+  in IA.checkFlag Ability.Durable arItem+     || effActivation == ActivationPeriodic+        && not (IA.checkFlag Ability.Fragile arItem)++-- The item is triggered exactly once. If there are more copies,+-- they are left to be triggered next time.+-- If the embed no longer exists at the given position, effect fizzles.+itemEffectEmbedded :: MonadServerAtomic m+                   => EffToUse -> Bool -> ActorId -> LevelId -> Point -> ItemId+                   -> m UseResult+itemEffectEmbedded effToUse effVoluntary aid lid tpos iid = do+  embeds2 <- getsState $ getEmbedBag lid tpos+    -- might have changed due to other embedded items invocations+  if iid `EM.notMember` embeds2+  then return UseDud+  else do+    -- First embedded item may move actor to another level, so @lid@+    -- may be unequal to @blid sb@.+    let c = CEmbed lid tpos+    -- Treated as if the actor hit himself with the embedded item as a weapon,+    -- incurring both the kinetic damage and effect, hence the same call+    -- as in @reqMelee@. Information whether this happened due to being pushed+    -- is preserved, but how did the pushing is lost, so we blame the victim.+    let effApplyFlags = EffApplyFlags+          { effToUse+          , effVoluntary+          , effUseAllCopies     = False+          , effKineticPerformed = False+          , effActivation       = if effToUse == EffOnCombine+                                  then ActivationOnCombine+                                  else ActivationEmbed+          , effMayDestroy       = True+          }+    kineticEffectAndDestroy effApplyFlags aid aid aid iid c++-- | The source actor affects the target actor, with a given item.+-- If any of the effects fires up, the item gets identified.+-- Even using raw damage (beating the enemy with the magic wand,+-- for example) identifies the item. This means a costly @UpdDiscover@+-- is processed for each random timeout weapon hit and for most projectiles,+-- but at least not for most explosion particles nor plain organs.+-- And if not needed, the @UpdDiscover@ are eventually not sent to clients.+-- So, enemy missiles that hit us are no longer mysterious until picked up,+-- which is for the better, because the client knows their charging status+-- and so can generate accurate messages in the case when not recharged.+-- This also means that thrown consumables in flasks sturdy enough to cause+-- damage are always identified at hit, even if no effect activated.+-- So throwing them at foes is a better identification method than applying.+--+-- Note that if we activate a durable non-passive item, e.g., a spiked shield,+-- from the ground, it will get identified, which is perfectly fine,+-- until we want to add sticky armor that can't be easily taken off+-- (and, e.g., has some maluses).+itemEffectDisco :: MonadServerAtomic m+                => EffApplyFlags+                -> ActorId -> ActorId -> ItemId+                -> ContentId ItemKind -> ItemKind -> Container -> [IK.Effect]+                -> m UseResult+itemEffectDisco effApplyFlags0@EffApplyFlags{..}+                source target iid itemKindId itemKind c effs = do+  urs <- mapM (effectSem effApplyFlags0 source target iid c) effs+  let ur = case urs of+        [] -> UseDud  -- there was no effects+        _ -> maximum urs+  -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary.+  when (ur >= UseId || effKineticPerformed) $+    identifyIid iid c itemKindId itemKind+  return ur++-- | Source actor affects target actor, with a given effect and it strength.+-- Both actors are on the current level and can be the same actor.+-- The item may or may not still be in the container.+effectSem :: MonadServerAtomic m+          => EffApplyFlags+          -> ActorId -> ActorId -> ItemId -> Container -> IK.Effect+          -> m UseResult+effectSem effApplyFlags0@EffApplyFlags{..}+          source target iid c effect = do+  let recursiveCall = effectSem effApplyFlags0 source target iid c+  sb <- getsState $ getActorBody source+  -- @execSfx@ usually comes last in effect semantics, but not always+  -- and we are likely to introduce more variety.+  let execSfx = execSfxAtomic $ SfxEffect (bfid sb) target iid effect 0+      execSfxSource = execSfxAtomic $ SfxEffect (bfid sb) source iid effect 0+  case effect of+    IK.Burn nDm -> effectBurn nDm source target iid+    IK.Explode t -> effectExplode execSfx t source target c+    IK.RefillHP p -> effectRefillHP p source target iid+    IK.RefillCalm p -> effectRefillCalm execSfx p source target+    IK.Dominate -> effectDominate source target iid+    IK.Impress -> effectImpress recursiveCall execSfx source target+    IK.PutToSleep -> effectPutToSleep execSfx target+    IK.Yell -> effectYell execSfx target+    IK.Summon grp nDm -> effectSummon grp nDm iid source target effActivation+    IK.Ascend p -> effectAscend recursiveCall execSfx p source target c+    IK.Escape{} -> effectEscape execSfx source target+    IK.Paralyze nDm -> effectParalyze execSfx nDm source target+    IK.ParalyzeInWater nDm -> effectParalyzeInWater execSfx nDm source target+    IK.InsertMove nDm -> effectInsertMove execSfx nDm source target+    IK.Teleport nDm -> effectTeleport execSfx nDm source target+    IK.CreateItem mcount store grp tim ->+      effectCreateItem (Just $ bfid sb) mcount source target (Just iid)+                       store grp tim+    IK.DestroyItem n k store grp ->+      effectDestroyItem execSfx n k store target grp+    IK.ConsumeItems tools raw -> effectConsumeItems execSfx iid target tools raw+    IK.DropItem n k store grp -> effectDropItem execSfx iid n k store grp target+    IK.Recharge n dice -> effectRecharge True execSfx iid n dice target+    IK.Discharge n dice -> effectRecharge False execSfx iid n dice target+    IK.PolyItem -> effectPolyItem execSfx iid target+    IK.RerollItem -> effectRerollItem execSfx iid target+    IK.DupItem -> effectDupItem execSfx iid target+    IK.Identify -> effectIdentify execSfx iid target+    IK.Detect d radius -> effectDetect execSfx d radius target c+    IK.SendFlying tmod ->+      effectSendFlying execSfx tmod source target c Nothing+    IK.PushActor tmod ->+      effectSendFlying execSfx tmod source target c (Just True)+    IK.PullActor tmod ->+      effectSendFlying execSfx tmod source target c (Just False)+    IK.ApplyPerfume -> effectApplyPerfume execSfx target+    IK.AtMostOneOf l -> effectAtMostOneOf recursiveCall l+    IK.OneOf l -> effectOneOf recursiveCall l+    IK.OnSmash _ -> return UseDud  -- ignored under normal circumstances+    IK.OnCombine _ -> return UseDud  -- ignored under normal circumstances+    IK.OnUser eff -> effectSem effApplyFlags0 source source iid c eff+    IK.NopEffect -> return UseDud  -- all there is+    IK.AndEffect eff1 eff2 -> effectAndEffect recursiveCall source eff1 eff2+    IK.OrEffect eff1 eff2 -> effectOrEffect recursiveCall (bfid sb) eff1 eff2+    IK.SeqEffect effs -> effectSeqEffect recursiveCall effs+    IK.When cond eff ->+      effectWhen recursiveCall source cond eff effActivation+    IK.Unless cond eff ->+      effectUnless recursiveCall source cond eff effActivation+    IK.IfThenElse cond eff1 eff2 ->+      effectIfThenElse recursiveCall source cond eff1 eff2 effActivation+    IK.VerbNoLonger{} -> effectVerbNoLonger effUseAllCopies execSfxSource source+    IK.VerbMsg{} -> effectVerbMsg execSfxSource source+    IK.VerbMsgFail{} -> effectVerbMsgFail execSfxSource source++conditionSem :: MonadServer m+             => ActorId -> IK.Condition -> ActivationFlag -> m Bool+conditionSem source cond effActivation = do+  sb <- getsState $ getActorBody source+  return $! case cond of+    IK.HpLeq n -> bhp sb <= xM n+    IK.HpGeq n -> bhp sb >= xM n+    IK.CalmLeq n -> bcalm sb <= xM n+    IK.CalmGeq n -> bcalm sb >= xM n+    IK.TriggeredBy activationFlag -> activationFlag == effActivation++-- * Individual semantic functions for effects++-- ** Burn++-- Damage from fire. Not affected by armor.+effectBurn :: MonadServerAtomic m+           => Dice.Dice -> ActorId -> ActorId -> ItemId -> m UseResult+effectBurn nDm source target iid = do+  tb <- getsState $ getActorBody target+  totalDepth <- getsState stotalDepth+  Level{ldepth} <- getLevel (blid tb)+  n0 <- rndToAction $ castDice ldepth totalDepth nDm+  let n = max 1 n0  -- avoid 0 and negative burn; validated in content anyway+      deltaHP = - xM n+  sb <- getsState $ getActorBody source+  -- Display the effect more accurately.+  let reportedEffect = IK.Burn $ Dice.intToDice n+  execSfxAtomic $ SfxEffect (bfid sb) target iid reportedEffect deltaHP+  refillHP source target deltaHP+  return UseUp++-- ** Explode++effectExplode :: MonadServerAtomic m+              => m () -> GroupName ItemKind -> ActorId -> ActorId -> Container+              -> m UseResult+effectExplode execSfx cgroup source target containerOrigin = do+  execSfx+  tb <- getsState $ getActorBody target+  oxy@(Point x y) <- getsState $ posFromC containerOrigin+  let itemFreq = [(cgroup, 1)]+      -- Explosion particles are placed among organs of the victim.+      -- TODO: when changing this code, perhaps use @containerOrigin@+      -- in place of @container@, but then remove @borgan@ from several+      -- functions that have the store hardwired.+      container = CActor target COrgan+  -- Power depth of new items unaffected by number of spawned actors.+  freq <- prepareItemKind 0 (blid tb) itemFreq+  m2 <- rollAndRegisterItem False (blid tb) freq container Nothing+  acounter <- getsServer $ fromEnum . sacounter+  let (iid, (ItemFull{itemKind}, (itemK, _))) =+        fromMaybe (error $ "" `showFailure` cgroup) m2+      semiRandom = T.length (IK.idesc itemKind)+      -- We pick a point at the border, not inside, to have a uniform+      -- distribution for the points the line goes through at each distance+      -- from the source. Otherwise, e.g., the points on cardinal+      -- and diagonal lines from the source would be more common.+      projectN k10 n = do+        -- Shape is deterministic for the explosion kind, except that is has+        -- two variants chosen according to time-dependent @veryRandom@.+        -- Choice from the variants prevents diagonal or cardinal directions+        -- being always safe for a given explosion kind.+        let shapeRandom = k10 `xor` (semiRandom + n)+            veryRandom = shapeRandom + acounter + acounter `div` 3+            fuzz = 5 + shapeRandom `mod` 5+            k | n < 16 && n >= 12 = 12+              | n < 12 && n >= 8 = 8+              | n < 8 && n >= 4 = 4+              | otherwise = min n 16  -- fire in groups of 16 including old duds+            psDir4 =+              [ Point (x - 12) (y + 12)+              , Point (x + 12) (y + 12)+              , Point (x - 12) (y - 12)+              , Point (x + 12) (y - 12) ]+            psDir8 =+              [ Point (x - 12) y+              , Point (x + 12) y+              , Point x (y + 12)+              , Point x (y - 12) ]+            psFuzz =+              [ Point (x - 12) $ y + fuzz+              , Point (x + 12) $ y + fuzz+              , Point (x - 12) $ y - fuzz+              , Point (x + 12) $ y - fuzz+              , flip Point (y - 12) $ x + fuzz+              , flip Point (y + 12) $ x + fuzz+              , flip Point (y - 12) $ x - fuzz+              , flip Point (y + 12) $ x - fuzz ]+            randomReverse = if veryRandom `mod` 2 == 0 then id else reverse+            ps = take k $ concat $+              randomReverse+                [ zip (repeat True)  -- diagonal particles don't reach that far+                  $ take 4 (drop ((k10 + itemK + fuzz) `mod` 4) $ cycle psDir4)+                , zip (repeat False)  -- only some cardinal reach far+                  $ take 4 (drop ((k10 + n) `mod` 4) $ cycle psDir8) ]+              ++ [zip (repeat True)+                  $ take 8 (drop ((k10 + fuzz) `mod` 8) $ cycle psFuzz)]+        forM_ ps $ \(centerRaw, tpxy) -> do+          let center = centerRaw && itemK >= 8  -- if few, keep them regular+          mfail <- projectFail source target oxy tpxy shapeRandom center+                               iid COrgan True+          case mfail of+            Nothing -> return ()+            Just ProjectBlockTerrain -> return ()+            Just ProjectBlockActor -> return ()+            Just failMsg ->+              execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnexpected failMsg+      tryFlying 0 = return ()+      tryFlying k10 = do+        -- Explosion particles were placed among organs of the victim:+        bag2 <- getsState $ borgan . getActorBody target+        -- We stop bouncing old particles when less than two thirds remain,+        -- to prevent hoarding explosives to use only in cramped spaces.+        case EM.lookup iid bag2 of+          Just (n2, _) | n2 * 2 >= itemK `div` 3 -> do+            projectN k10 n2+            tryFlying $ k10 - 1+          _ -> return ()+  -- Some of the particles that fail to take off, bounce off obstacles+  -- up to 10 times in total, trying to fly in different directions.+  tryFlying 10+  bag3 <- getsState $ borgan . getActorBody target+  let mn3 = EM.lookup iid bag3+  -- Give up and destroy the remaining particles, if any.+  maybe (return ()) (\kit -> execUpdAtomic+                             $ UpdLoseItem False iid kit container) mn3+  return UseUp  -- we neglect verifying that at least one projectile got off++-- ** RefillHP++-- Unaffected by armor.+effectRefillHP :: MonadServerAtomic m+               => Int -> ActorId -> ActorId -> ItemId -> m UseResult+effectRefillHP power0 source target iid = do+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  curChalSer <- getsServer $ scurChalSer . soptions+  fact <- getsState $ (EM.! bfid tb) . sfactionD+  let power = if power0 <= -1 then power0 else max 1 power0  -- avoid 0+      deltaHP = xM power+  if | cfish curChalSer && deltaHP > 0+       && fhasUI (gplayer fact) && bfid sb /= bfid tb -> do+       execSfxAtomic $ SfxMsgFid (bfid tb) SfxColdFish+       return UseId+     | otherwise -> do+       let reportedEffect = IK.RefillHP power+       execSfxAtomic $ SfxEffect (bfid sb) target iid reportedEffect deltaHP+       refillHP source target deltaHP+       return UseUp++-- ** RefillCalm++effectRefillCalm :: MonadServerAtomic m+                 => m () -> Int -> ActorId -> ActorId -> m UseResult+effectRefillCalm execSfx power0 source target = do+  tb <- getsState $ getActorBody target+  actorMaxSk <- getsState $ getActorMaxSkills target+  let power = if power0 <= -1 then power0 else max 1 power0  -- avoid 0+      rawDeltaCalm = xM power+      calmMax = Ability.getSk Ability.SkMaxCalm actorMaxSk+      serious = rawDeltaCalm <= minusM2 && source /= target && not (bproj tb)+      deltaCalm0 | serious =  -- if overfull, at least cut back to max+                     min rawDeltaCalm (xM calmMax - bcalm tb)+                 | otherwise = rawDeltaCalm+      deltaCalm = if | deltaCalm0 > 0 && bcalm tb > xM 999 ->  -- UI limit+                       tenthM  -- avoid nop, to avoid loops+                     | deltaCalm0 < 0 && bcalm tb < - xM 999 ->+                       -tenthM+                     | otherwise -> deltaCalm0+  execSfx+  updateCalm target deltaCalm+  return UseUp++-- ** Dominate++-- The is another way to trigger domination (the normal way is by zeroed Calm).+-- Calm is here irrelevant. The other conditions are the same.+effectDominate :: MonadServerAtomic m+               => ActorId -> ActorId -> ItemId -> m UseResult+effectDominate source target iid = do+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  if | bproj tb -> return UseDud+     | bfid tb == bfid sb -> return UseDud  -- accidental hit; ignore+     | otherwise -> do+       fact <- getsState $ (EM.! bfid tb) . sfactionD+       hiImpression <- highestImpression tb+       let permitted = case hiImpression of+             Nothing -> False  -- no impression, no domination+             Just (hiImpressionFid, hiImpressionK) ->+                hiImpressionFid == bfid sb+                  -- highest impression needs to be by us+                && (fleaderMode (gplayer fact) /= LeaderNull+                    || hiImpressionK >= 10)+                     -- to tame/hack animal/robot, impress them a lot first+       if permitted then do+         b <- dominateFidSfx source target iid (bfid sb)+         return $! if b then UseUp else UseDud+       else do+         execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxUnimpressed target+         when (source /= target) $+           execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnimpressed target+         return UseDud++highestImpression :: MonadServerAtomic m+                  => Actor -> m (Maybe (FactionId, Int))+highestImpression tb = do+  getKind <- getsState $ flip getIidKindServer+  getItem <- getsState $ flip getItemBody+  let isImpression iid =+        maybe False (> 0) $ lookup IK.S_IMPRESSED $ IK.ifreq $ getKind iid+      impressions = EM.filterWithKey (\iid _ -> isImpression iid) $ borgan tb+      f (_, (k, _)) = k+      maxImpression = maximumBy (comparing f) $ EM.assocs impressions+  if EM.null impressions+  then return Nothing+  else case jfid $ getItem $ fst maxImpression of+    Nothing -> return Nothing+    Just fid -> assert (fid /= bfid tb)+                $ return $ Just (fid, fst $ snd maxImpression)++dominateFidSfx :: MonadServerAtomic m+               => ActorId ->  ActorId -> ItemId -> FactionId -> m Bool+dominateFidSfx source target iid fid = do+  tb <- getsState $ getActorBody target+  let !_A = assert (not $ bproj tb) ()+  -- Actors that don't move freely can't be dominated, for otherwise,+  -- when they are the last survivors, they could get stuck and the game+  -- wouldn't end. Also, they are a hassle to guide through the dungeon.+  canTra <- getsState $ canTraverse target+  -- Being pushed protects from domination, for simplicity.+  -- A possible interesting exploit, but much help from content would be needed+  -- to make it practical.+  if isNothing (btrajectory tb) && canTra && bhp tb > 0 then do+    let execSfx = execSfxAtomic $ SfxEffect fid target iid IK.Dominate 0+    execSfx  -- if actor ours, possibly the last occasion to see him+    dominateFid fid source target+    -- If domination resulted in game over, the message won't be seen+    -- before the end game screens, but at least it will be seen afterwards+    -- and browsable in history while inside subsequent game, revealing+    -- the cause of the previous game over. Better than no message at all.+    execSfx  -- see the actor as theirs, unless position not visible+    return True+  else+    return False++dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> ActorId -> m ()+dominateFid fid source target = do+  tb0 <- getsState $ getActorBody target+  -- Game over deduced very early, so no further animation nor message+  -- will appear before game end screens. This is good in that our last actor+  -- that yielded will still be on screen when end game messages roll.+  -- This is bad in that last enemy actor that got dominated by us+  -- may not be on screen and we have no clue how we won until+  -- we see history in the next game. Even worse if our ally dominated+  -- the enemy actor. Then we may never learn. Oh well, that's realism.+  deduceKilled target+  electLeader (bfid tb0) (blid tb0) target+  -- Drop all items so that domiation is not too nasty, especially+  -- if the dominated hero runs off or teleports away with gold+  -- or starts hitting with the most potent artifact weapon in the game.+  -- Drop items while still of the original faction+  -- to mark them on the map for other party members to collect.+  dropAllEquippedItems target tb0+  tb <- getsState $ getActorBody target+  actorMaxSk <- getsState $ getActorMaxSkills target+  getKind <- getsState $ flip getIidKindServer+  let isImpression iid =+        maybe False (> 0) $ lookup IK.S_IMPRESSED $ IK.ifreq $ getKind iid+      dropAllImpressions = EM.filterWithKey (\iid _ -> not $ isImpression iid)+      borganNoImpression = dropAllImpressions $ borgan tb+  -- Actor is not pushed nor projectile, so @sactorTime@ suffices.+  btime <- getsServer+           $ fromJust . lookupActorTime (bfid tb) (blid tb) target . sactorTime+  execUpdAtomic $ UpdLoseActor target tb+  let maxCalm = Ability.getSk Ability.SkMaxCalm actorMaxSk+      maxHp = Ability.getSk Ability.SkMaxHP actorMaxSk+      bNew = tb { bfid = fid+                , bcalm = max (xM 10) $ xM maxCalm `div` 2+                , bhp = min (xM maxHp) $ bhp tb + xM 10+                , borgan = borganNoImpression}+  modifyServer $ \ser ->+    ser {sactorTime = updateActorTime fid (blid tb) target btime+                      $ sactorTime ser}+  execUpdAtomic $ UpdSpotActor target bNew+  -- Focus on the dominated actor, by making him a leader.+  setFreshLeader fid target+  factionD <- getsState sfactionD+  let inGame fact2 = case gquit fact2 of+        Nothing -> True+        Just Status{stOutcome=Camping} -> True+        _ -> False+      gameOver = not $ any inGame $ EM.elems factionD+  -- Avoid the spam of identifying items, if game over.+  unless gameOver $ do+    -- Add some nostalgia for the old faction.+    void $ effectCreateItem (Just $ bfid tb) (Just 10) source target Nothing+                            COrgan IK.S_IMPRESSED IK.timerNone+    -- Identify organs that won't get identified by use.+    getKindId <- getsState $ flip getIidKindIdServer+    let discoverIf (iid, cstore) = do+          let itemKindId = getKindId iid+              c = CActor target cstore+          assert (cstore /= CGround) $+            discoverIfMinorEffects c iid itemKindId+        aic = (btrunk tb, COrgan)+              : filter ((/= btrunk tb) . fst) (getCarriedIidCStore tb)+    mapM_ discoverIf aic++-- | Drop all actor's equipped items.+dropAllEquippedItems :: MonadServerAtomic m => ActorId -> Actor -> m ()+dropAllEquippedItems aid b =+  mapActorCStore_ CEqp+                  (void <$$> dropCStoreItem False False CEqp aid b maxBound)+                  b++-- ** Impress++effectImpress :: MonadServerAtomic m+              => (IK.Effect -> m UseResult) -> m () -> ActorId -> ActorId+              -> m UseResult+effectImpress recursiveCall execSfx source target = do+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  if | bproj tb -> return UseDud+     | bfid tb == bfid sb ->+       -- Unimpress wrt others, but only once. The recursive Sfx suffices.+       recursiveCall $ IK.DropItem 1 1 COrgan IK.S_IMPRESSED+     | otherwise -> do+       -- Actors that don't move freely and so are stupid, can't be impressed.+       canTra <- getsState $ canTraverse target+       if canTra then do+         unless (bhp tb <= 0)+           execSfx  -- avoid spam just before death+         effectCreateItem (Just $ bfid sb) (Just 1) source target Nothing COrgan+                          IK.S_IMPRESSED IK.timerNone+       else return UseDud  -- no message, because common and not crucial++-- ** PutToSleep++effectPutToSleep :: MonadServerAtomic m => m () -> ActorId -> m UseResult+effectPutToSleep execSfx target = do+  tb <- getsState $ getActorBody target+  if | bproj tb -> return UseDud+     | bwatch tb `elem` [WSleep, WWake] ->+         return UseDud  -- can't increase sleep+     | otherwise -> do+       actorMaxSk <- getsState $ getActorMaxSkills target+       if not $ canSleep actorMaxSk then+         return UseId  -- no message about the cause, so at least ID+       else do+         let maxCalm = xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk+             deltaCalm = maxCalm - bcalm tb+         when (deltaCalm > 0) $+           updateCalm target deltaCalm  -- max Calm, but asleep vulnerability+         execSfx+         case bwatch tb of+           WWait n | n > 0 -> do+             nAll <- removeConditionSingle IK.S_BRACED target+             let !_A = assert (nAll == 0) ()+             return ()+           _ -> return ()+         -- Forced sleep. No check if the actor can sleep naturally.+         addSleep target+         return UseUp++-- ** Yell++-- This is similar to 'reqYell', but also mentions that the actor is startled,+-- because, presumably, he yells involuntarily. It doesn't wake him up+-- via Calm instantly, just like yelling in a dream not always does.+effectYell :: MonadServerAtomic m => m () -> ActorId -> m UseResult+effectYell execSfx target = do+  tb <- getsState $ getActorBody target+  if bhp tb <= 0 then  -- avoid yelling corpses+    return UseDud  -- the yell never manifested+  else do+    when (not (bproj tb))+      execSfx+    execSfxAtomic $ SfxTaunt False target+    when (not (bproj tb) && deltaBenign (bcalmDelta tb)) $+      execUpdAtomic $ UpdRefillCalm target minusM+    return UseUp++-- ** Summon++-- Note that the Calm expended doesn't depend on the number of actors summoned.+effectSummon :: MonadServerAtomic m+             => GroupName ItemKind -> Dice.Dice -> ItemId+             -> ActorId -> ActorId -> ActivationFlag+             -> m UseResult+effectSummon grp nDm iid source target effActivation = do+  -- Obvious effect, nothing announced.+  cops@COps{coTileSpeedup} <- getsState scops+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  sMaxSk <- getsState $ getActorMaxSkills source+  tMaxSk <- getsState $ getActorMaxSkills target+  totalDepth <- getsState stotalDepth+  lvl@Level{ldepth, lbig} <- getLevel (blid tb)+  nFriends <- getsState $ length . friendRegularAssocs (bfid sb) (blid sb)+  discoAspect <- getsState sdiscoAspect+  power0 <- rndToAction $ castDice ldepth totalDepth nDm+  fact <- getsState $ (EM.! bfid sb) . sfactionD+  let arItem = discoAspect EM.! iid+      power = max power0 1  -- KISS, always at least one summon+      -- We put @source@ instead of @target@ and @power@ instead of dice+      -- to make the message more accurate.+      effect = IK.Summon grp $ Dice.intToDice power+      durable = IA.checkFlag Ability.Durable arItem+      warnBothActors warning =+       unless (bproj sb) $ do+         execSfxAtomic $ SfxMsgFid (bfid sb) warning+         when (source /= target) $+           execSfxAtomic $ SfxMsgFid (bfid tb) warning+      deltaCalm = - xM 30+  -- Verify Calm only at periodic activations or if the item is durable.+  -- Otherwise summon uses up the item, which prevents summoning getting+  -- out of hand. I don't verify Calm otherwise, to prevent an exploit+  -- via draining one's calm on purpose when an item with good activation+  -- has a nasty summoning side-effect (the exploit still works on durables).+  if | bproj tb+       || source /= target && not (isFoe (bfid sb) fact (bfid tb)) ->+       return UseDud  -- hitting friends or projectiles to summon is too cheap+     | (effActivation == ActivationPeriodic || durable) && not (bproj sb)+       && (bcalm sb < - deltaCalm || not (calmEnough sb sMaxSk)) -> do+       warnBothActors $ SfxSummonLackCalm source+       return UseId+     | nFriends >= 20 -> do+       -- We assume the actor tries to summon his teammates or allies.+       -- As he repeats such summoning, he is going to bump into this limit.+       -- If he summons others, see the next condition.+       warnBothActors $ SfxSummonTooManyOwn source+       return UseId+     | EM.size lbig >= 200 -> do  -- lower than the 300 limit for spawning+       -- Even if the actor summons foes, he is prevented from exploiting it+       -- too many times and stopping natural monster spawning on the level+       -- (e.g., by filling the level with harmless foes).+       warnBothActors $ SfxSummonTooManyAll source+       return UseId+     | otherwise -> do+       unless (bproj sb) $ updateCalm source deltaCalm+       let validTile t = not $ Tile.isNoActor coTileSpeedup t+           ps = nearbyFreePoints cops lvl validTile (bpos tb)+       localTime <- getsState $ getLocalTime (blid tb)+       -- Make sure summoned actors start acting after the victim.+       let actorTurn = ticksPerMeter $ gearSpeed tMaxSk+           targetTime = timeShift localTime actorTurn+           afterTime = timeShift targetTime $ Delta timeClip+       when (length (take power ps) < power) $+          debugPossiblyPrint $+            "Server: effectSummon: failed to find enough free positions at"+            <+> tshow (blid tb, bpos tb)+       bs <- forM (take power ps) $ \p -> do+         -- Mark as summoned to prevent immediate chain summoning.+         -- Summon from current depth, not deeper due to many spawns already.+         maid <- addAnyActor True 0 [(grp, 1)] (blid tb) afterTime (Just p)+         case maid of+           Nothing -> return False  -- suspect content; server debug elsewhere+           Just aid -> do+             b <- getsState $ getActorBody aid+             mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD+             when (isNothing mleader) $ setFreshLeader (bfid b) aid+             return True+       if or bs then do+         execSfxAtomic $ SfxEffect (bfid sb) source iid effect 0+         return UseUp+       else do+         -- We don't display detailed warnings when @addAnyActor@ fails,+         -- e.g., because the actor groups can't be generated on a given level.+         -- However, we at least don't claim any summoning happened+         -- and we offer a general summoning failure messages.+         warnBothActors $ SfxSummonFailure source+         return UseId++-- ** Ascend++-- Note that projectiles can be teleported, too, for extra fun.+effectAscend :: MonadServerAtomic m+             => (IK.Effect -> m UseResult)+             -> m () -> Bool -> ActorId -> ActorId -> Container+             -> m UseResult+effectAscend recursiveCall execSfx up source target container = do+  b1 <- getsState $ getActorBody target+  pos <- getsState $ posFromC container+  let lid1 = blid b1+  destinations <- getsState $ whereTo lid1 pos up . sdungeon+  sb <- getsState $ getActorBody source+  actorMaxSk <- getsState $ getActorMaxSkills target+  if | source /= target && Ability.getSk Ability.SkMove actorMaxSk <= 0 -> do+       execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid b1) SfxTransImpossible+       return UseId+     | actorWaits b1 && source /= target -> do+       execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid b1) $ SfxBracedImmune target+       return UseId+     | null destinations -> do+       execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelNoMore+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid b1) SfxLevelNoMore+       -- We keep it useful even in shallow dungeons.+       recursiveCall $ IK.Teleport 30  -- powerful teleport+     | otherwise -> do+       (lid2, pos2) <- rndToAction $ oneOf destinations+       execSfx+       mbtime_bOld <-+         getsServer $ lookupActorTime (bfid b1) lid1 target . sactorTime+       mbtimeTraj_bOld <-+         getsServer $ lookupActorTime (bfid b1) lid1 target . strajTime+       pos3 <- findStairExit (bfid sb) up lid2 pos2+       let switch1 = void $ switchLevels1 (target, b1)+           switch2 = do+             -- Make the initiator of the stair move the leader,+             -- to let him clear the stairs for others to follow.+             let mlead = if bproj b1 then Nothing else Just target+             -- Move the actor to where the inhabitants were, if any.+             switchLevels2 lid2 pos3 (target, b1)+                           mbtime_bOld mbtimeTraj_bOld mlead+       -- The actor will be added to the new level,+       -- but there can be other actors at his new position.+       inhabitants <- getsState $ posToAidAssocs pos3 lid2+       case inhabitants of+         (_, b2) : _ | not $ bproj b1 -> do+           -- Alert about the switch.+           execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelPushed+           -- Only tell one pushed player, even if many actors, because then+           -- they are projectiles, so not too important.+           when (source /= target) $+             execSfxAtomic $ SfxMsgFid (bfid b2) SfxLevelPushed+           -- Move the actor out of the way.+           switch1+           -- Move the inhabitants out of the way and to where the actor was.+           let moveInh inh = do+                 -- Preserve the old leader, since the actor is pushed,+                 -- so possibly has nothing worhwhile to do on the new level+                 -- (and could try to switch back, if made a leader,+                 -- leading to a loop).+                 mbtime_inh <-+                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)+                                . sactorTime+                 mbtimeTraj_inh <-+                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)+                                . strajTime+                 inhMLead <- switchLevels1 inh+                 switchLevels2 lid1 (bpos b1) inh+                               mbtime_inh mbtimeTraj_inh inhMLead+           mapM_ moveInh inhabitants+           -- Move the actor to his destination.+           switch2+         _ -> do  -- no inhabitants or the stair-taker a projectile+           switch1+           switch2+       return UseUp++findStairExit :: MonadStateRead m+              => FactionId -> Bool -> LevelId -> Point -> m Point+findStairExit side moveUp lid pos = do+  COps{coTileSpeedup} <- getsState scops+  fact <- getsState $ (EM.! side) . sfactionD+  lvl <- getLevel lid+  let defLanding = uncurry Vector $ if moveUp then (1, 0) else (-1, 0)+      center = uncurry Vector $ if moveUp then (-1, 0) else (1, 0)+      (mvs2, mvs1) = break (== defLanding) moves+      mvs = center : filter (/= center) (mvs1 ++ mvs2)+      ps = filter (Tile.isWalkable coTileSpeedup . (lvl `at`))+           $ map (shift pos) mvs+      posOcc :: State -> Int -> Point -> Bool+      posOcc s k p = case posToAidAssocs p lid s of+        [] -> k == 0+        (_, b) : _ | bproj b -> k == 3+        (_, b) : _ | isFoe side fact (bfid b) -> k == 1  -- non-proj foe+        _ -> k == 2  -- moving a non-projectile friend+  unocc <- getsState posOcc+  case concatMap (\k -> filter (unocc k) ps) [0..3] of+    [] -> error $ "" `showFailure` ps+    posRes : _ -> return posRes++switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId)+switchLevels1 (aid, bOld) = do+  let side = bfid bOld+  mleader <- getsState $ gleader . (EM.! side) . sfactionD+  -- Prevent leader pointing to a non-existing actor.+  mlead <-+    if not (bproj bOld) && isJust mleader then do+      execUpdAtomic $ UpdLeadFaction side mleader Nothing+      return mleader+        -- outside of a client we don't know the real tgt of aid, hence fst+    else return Nothing+  -- Remove the actor from the old level.+  -- Onlookers see somebody disappear suddenly.+  -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead.+  execUpdAtomic $ UpdLoseActor aid bOld+  return mlead++switchLevels2 ::MonadServerAtomic m+              => LevelId -> Point -> (ActorId, Actor)+              -> Maybe Time -> Maybe Time -> Maybe ActorId+              -> m ()+switchLevels2 lidNew posNew (aid, bOld) mbtime_bOld mbtimeTraj_bOld mlead = do+  let lidOld = blid bOld+      side = bfid bOld+  let !_A = assert (lidNew /= lidOld `blame` "stairs looped" `swith` lidNew) ()+  -- Sync actor's items' timeouts with the new local time of the level.+  -- We need to sync organs and equipment due to periodic activations,+  -- but also due to timeouts after use, e.g., for some weapons+  -- (they recharge also in the stash; however, this doesn't encourage+  -- micromanagement for periodic items, because the timeout is randomised+  -- upon move to equipment).+  --+  -- We don't rebase timeouts for items in stash, because they are+  -- used by many actors on levels with different local times,+  -- so there is no single rebase that would match all.+  -- This is not a big problem: after a single use by an actor the timeout is+  -- set to his current local time, so further uses by that actor have+  -- not anomalously short or long recharge times. If the recharge time+  -- is very long, the player has an option of moving the item away from stash+  -- and back, to reset the timeout. An abuse is possible when recently+  -- used item is put from equipment to stash and at once used on another level+  -- taking advantage of local time difference, but this only works once+  -- and using the item back again at the original level makes the recharge+  -- time longer, in turn.+  timeOld <- getsState $ getLocalTime lidOld+  timeLastActive <- getsState $ getLocalTime lidNew+  let delta = timeLastActive `timeDeltaToFrom` timeOld+      computeNewTimeout :: ItemQuant -> ItemQuant+      computeNewTimeout (k, it) = (k, map (shiftItemTimer delta) it)+      rebaseTimeout :: ItemBag -> ItemBag+      rebaseTimeout = EM.map computeNewTimeout+      bNew = bOld { blid = lidNew+                  , bpos = posNew+                  , boldpos = Just posNew  -- new level, new direction+                  , borgan = rebaseTimeout $ borgan bOld+                  , beqp = rebaseTimeout $ beqp bOld }+      shiftByDelta = (`timeShift` delta)+  -- Sync the actor time with the level time.+  -- This time shift may cause a double move of a foe of the same speed,+  -- but this is OK --- the foe didn't have a chance to move+  -- before, because the arena went inactive, so he moves now one more time.+  maybe (return ())+        (\btime_bOld ->+    modifyServer $ \ser ->+      ser {sactorTime = updateActorTime (bfid bNew) lidNew aid+                                        (shiftByDelta btime_bOld)+                        $ sactorTime ser})+        mbtime_bOld+  maybe (return ())+        (\btime_bOld ->+    modifyServer $ \ser ->+      ser {strajTime = updateActorTime (bfid bNew) lidNew aid+                                       (shiftByDelta btime_bOld)+                       $ strajTime ser})+        mbtimeTraj_bOld+  -- Materialize the actor at the new location.+  -- Onlookers see somebody appear suddenly. The actor himself+  -- sees new surroundings and has to reset his perception.+  execUpdAtomic $ UpdSpotActor aid bNew+  case mlead of+    Nothing -> return ()+    Just leader ->+      -- The leader is fresh in the sense that he's on a new level+      -- and so doesn't have up to date Perception.+      setFreshLeader side leader++-- ** Escape++-- | The faction leaves the dungeon.+effectEscape :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult+effectEscape execSfx source target = do+  -- Obvious effect, nothing announced.+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  let fid = bfid tb+  fact <- getsState $ (EM.! fid) . sfactionD+  if | bproj tb ->+       return UseDud  -- basically a misfire+     | not (fcanEscape $ gplayer fact) -> do+       execSfxAtomic $ SfxMsgFid (bfid sb) SfxEscapeImpossible+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid tb) SfxEscapeImpossible+       return UseId+     | otherwise -> do+       execSfx+       deduceQuits (bfid tb) $ Status Escape (fromEnum $ blid tb) Nothing+       return UseUp++-- ** Paralyze++-- | Advance target actor time by this many time clips. Not by actor moves,+-- to hurt fast actors more.+effectParalyze :: MonadServerAtomic m+               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult+effectParalyze execSfx nDm source target = do+  tb <- getsState $ getActorBody target+  if bproj tb then return UseDud  -- shortcut for speed+  else paralyze execSfx nDm source target++paralyze :: MonadServerAtomic m+         => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult+paralyze execSfx nDm source target = do+  tb <- getsState $ getActorBody target+  totalDepth <- getsState stotalDepth+  Level{ldepth} <- getLevel (blid tb)+  power0 <- rndToAction $ castDice ldepth totalDepth nDm+  let power = max power0 1  -- KISS, avoid special case+  actorStasis <- getsServer sactorStasis+  if | ES.member target actorStasis -> do+       sb <- getsState $ getActorBody source+       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects+       return UseId+     | otherwise -> do+       execSfx+       let t = timeDeltaScale (Delta timeClip) power+       -- Only the normal time, not the trajectory time, is affected.+       modifyServer $ \ser ->+         ser { sactorTime = ageActor (bfid tb) (blid tb) target t+                            $ sactorTime ser+             , sactorStasis = ES.insert target (sactorStasis ser) }+                 -- actor's time warped, so he is in stasis,+                 -- immune to further warps+       return UseUp++-- ** ParalyzeInWater++-- | Advance target actor time by this many time clips. Not by actor moves,+-- to hurt fast actors more. Due to water, so resistable.+effectParalyzeInWater :: MonadServerAtomic m+                      => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult+effectParalyzeInWater execSfx nDm source target = do+  tb <- getsState $ getActorBody target+  if bproj tb then return UseDud else do  -- shortcut for speed+    actorMaxSk <- getsState $ getActorMaxSkills target+    let swimmingOrFlying = max (Ability.getSk Ability.SkSwimming actorMaxSk)+                               (Ability.getSk Ability.SkFlying actorMaxSk)+    if Dice.supDice nDm > swimmingOrFlying+    then paralyze execSfx nDm source target  -- no help at all+    else  -- fully resisted+      -- Don't spam:+      -- sb <- getsState $ getActorBody source+      -- execSfxAtomic $ SfxMsgFid (bfid sb) SfxWaterParalysisResisted+      return UseId++-- ** InsertMove++-- | Give target actor the given number of tenths of extra move. Don't give+-- an absolute amount of time units, to benefit slow actors more.+effectInsertMove :: MonadServerAtomic m+                 => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult+effectInsertMove execSfx nDm source target = do+  tb <- getsState $ getActorBody target+  actorMaxSk <- getsState $ getActorMaxSkills target+  totalDepth <- getsState stotalDepth+  Level{ldepth} <- getLevel (blid tb)+  actorStasis <- getsServer sactorStasis+  power0 <- rndToAction $ castDice ldepth totalDepth nDm+  let power = max power0 1  -- KISS, avoid special case+      actorTurn = ticksPerMeter $ gearSpeed actorMaxSk+      t = timeDeltaScale (timeDeltaPercent actorTurn 10) (-power)+  if | bproj tb -> return UseDud  -- shortcut for speed+     | ES.member target actorStasis -> do+       sb <- getsState $ getActorBody source+       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects+       return UseId+     | otherwise -> do+       execSfx+       -- Only the normal time, not the trajectory time, is affected.+       modifyServer $ \ser ->+         ser { sactorTime = ageActor (bfid tb) (blid tb) target t+                            $ sactorTime ser+             , sactorStasis = ES.insert target (sactorStasis ser) }+                 -- actor's time warped, so he is in stasis,+                 -- immune to further warps+       return UseUp++-- ** Teleport++-- | Teleport the target actor.+-- Note that projectiles can be teleported, too, for extra fun.+effectTeleport :: MonadServerAtomic m+               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult+effectTeleport execSfx nDm source target = do+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  actorMaxSk <- getsState $ getActorMaxSkills target+  if | source /= target && Ability.getSk Ability.SkMove actorMaxSk <= 0 -> do+       execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid tb) SfxTransImpossible+       return UseId+     | source /= target && actorWaits tb -> do+         -- immune only against not own effects, to enable teleport+         -- as beneficial's necklace drawback; also consistent+         -- with sleep not protecting+       execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target+       when (source /= target) $+         execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target+       return UseId+     | otherwise -> do+       COps{coTileSpeedup} <- getsState scops+       totalDepth <- getsState stotalDepth+       lvl@Level{ldepth} <- getLevel (blid tb)+       range <- rndToAction $ castDice ldepth totalDepth nDm+       let spos = bpos tb+           dMinMax !delta !pos =+             let d = chessDist spos pos+             in d >= range - delta && d <= range + delta+           dist !delta !pos _ = dMinMax delta pos+       mtpos <- rndToAction $ findPosTry 200 lvl+         (\p !t -> Tile.isWalkable coTileSpeedup t+                   && not (Tile.isNoActor coTileSpeedup t)+                   && not (occupiedBigLvl p lvl)+                   && not (occupiedProjLvl p lvl))+         [ dist 1+         , dist $ 1 + range `div` 9+         , dist $ 1 + range `div` 7+         , dist $ 1 + range `div` 5+         , dist 5+         , dist 7+         , dist 9+         ]+       case mtpos of+         Nothing -> do  -- really very rare, so debug+           debugPossiblyPrint+             "Server: effectTeleport: failed to find any free position"+           execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible+           when (source /= target) $+             execSfxAtomic $ SfxMsgFid (bfid tb) SfxTransImpossible+           return UseId+         Just tpos -> do+           execSfx+           execUpdAtomic $ UpdMoveActor target spos tpos+           return UseUp++-- ** CreateItem++effectCreateItem :: MonadServerAtomic m+                 => Maybe FactionId -> Maybe Int -> ActorId -> ActorId+                 -> Maybe ItemId -> CStore -> GroupName ItemKind -> IK.TimerDice+                 -> m UseResult+effectCreateItem jfidRaw mcount source target miidOriginal store grp tim = do+ tb <- getsState $ getActorBody target+ if bproj tb && store == COrgan  -- other stores OK not to lose possible loot+ then return UseDud  -- don't make a projectile hungry, etc.+ else do+  cops <- getsState scops+  sb <- getsState $ getActorBody source+  totalDepth <- getsState stotalDepth+  lvlTb <- getLevel (blid tb)+  dungeon <- getsState sdungeon+  let maxLidLvl = maximumBy (comparing (ldepth . snd)) $ EM.assocs dungeon+      -- If the number of items independent of depth, make also the timer+      -- the item kind choice and aspects independent of depth.+      -- Prime example is crafting. TODO: base this on skill.+      (lid, lvl) = if isJust mcount then maxLidLvl else (blid tb, lvlTb)+      depth = ldepth lvl+      fscale unit nDm = do+        k0 <- rndToAction $ castDice depth totalDepth nDm+        let k = max 1 k0  -- KISS, don't freak out if dice permit 0+        return $! timeDeltaScale unit k+      fgame = fscale (Delta timeTurn)+      factor nDm = do+        actorMaxSk <- getsState $ getActorMaxSkills target+        -- A bit added to make sure length 1 effect doesn't randomly+        -- end, or not, before the end of first turn, which would make,+        -- e.g., hasting, useless. This needs to be higher than 10%+        -- to compensate for overhead of animals, etc. (no leaders).+        let actorTurn =+              timeDeltaPercent (ticksPerMeter $ gearSpeed actorMaxSk) 111+        fscale actorTurn nDm+  delta <- IK.foldTimer (return $ Delta timeZero) fgame factor tim+  let c = CActor target store+  bagBefore <- getsState $ getBodyStoreBag tb store+  uniqueSet <- getsServer suniqueSet+  -- Power depth of new items unaffected by number of spawned actors, so 0.+  let freq = newItemKind cops uniqueSet [(grp, 1)] depth totalDepth 0+  m2 <- rollItemAspect freq lid+  case m2 of+    NoNewItem -> return UseDud  -- e.g., unique already generated+    NewItem itemKnownRaw itemFullRaw (kRaw, itRaw) -> do+      -- Avoid too many different item identifiers (one for each faction)+      -- for blasts or common item generating tiles. Conditions are+      -- allowed to be duplicated, because they provide really useful info+      -- (perpetrator). However, if timer is none, they are not duplicated+      -- to make sure that, e.g., poisons stack with each other regardless+      -- of perpetrator and we don't get "no longer poisoned" message+      -- while still poisoned due to another faction. With timed aspects,+      -- e.g., slowness, the message is less misleading, and it's interesting+      -- that I'm twice slower due to aspects from two factions and not+      -- as deadly as being poisoned at twice the rate from two factions.+      let jfid = if store == COrgan && not (IK.isTimerNone tim)+                    || grp == IK.S_IMPRESSED+                 then jfidRaw+                 else Nothing+          ItemKnown kindIx arItem _ = itemKnownRaw+          (itemKnown, itemFull) =+            ( ItemKnown kindIx arItem jfid+            , itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} )+      itemRev <- getsServer sitemRev+      let mquant = case HM.lookup itemKnown itemRev of+            Nothing -> Nothing+            Just iid -> (iid,) <$> iid `EM.lookup` bagBefore+      case mquant of+        Just (iid, (_, afterIt@(timer : rest))) | not $ IK.isTimerNone tim -> do+          -- Already has such items and timer change requested, so only increase+          -- the timer of the first item by the delta, but don't create items.+          let newIt = shiftItemTimer delta timer : rest+          if afterIt /= newIt then do+            execUpdAtomic $ UpdTimeItem iid c afterIt newIt+            -- It's hard for the client to tell this timer change from charge+            -- use, timer reset on pickup, etc., so we create the msg manually.+            -- Sending to both involved factions lets the player notice+            -- both the extensions he caused and suffered. Other faction causing+            -- that on themselves or on others won't be noticed. TMI.+            execSfxAtomic $ SfxMsgFid (bfid sb)+                          $ SfxTimerExtended target iid store delta+            when (bfid sb /= bfid tb) $+              execSfxAtomic $ SfxMsgFid (bfid tb)+                            $ SfxTimerExtended target iid store delta+            return UseUp+          else return UseDud  -- probably incorrect content, but let it be+        _ -> do+          localTime <- getsState $ getLocalTime (blid tb)+          let newTimer = createItemTimer localTime delta+              extraIt k = if IK.isTimerNone tim+                          then itRaw  -- don't break @applyPeriodicLevel@+                          else replicate k newTimer+                                 -- randomized and overwritten in @registerItem@+                                 -- if an organ or created in equipment+              kitNew = case mcount of+                Just itemK -> (itemK, extraIt itemK)+                Nothing -> (kRaw, extraIt kRaw)+          case miidOriginal of+            Just iidOriginal | store /= COrgan ->+              execSfxAtomic $ SfxMsgFid (bfid tb)+                            $ SfxItemYield iidOriginal (fst kitNew) (blid tb)+            _ -> return ()+          -- No such items or some items, but void delta, so create items.+          -- If it's, e.g., a periodic poison, the new items will stack with any+          -- already existing items.+          iid <- registerItem True (itemFull, kitNew) itemKnown c+          -- If created not on the ground, ID it, because it won't be on pickup.+          -- If ground and stash coincide, unindentified item enters stash,+          -- so will be identified when equipped, used or dropped+          -- and picked again.+          if isJust mcount  -- not a random effect, so probably crafting+             && not (IA.isHumanTrinket (itemKind itemFull))+          then execUpdAtomic $ UpdDiscover c iid (itemKindId itemFull) arItem+          else when (store /= CGround) $+            discoverIfMinorEffects c iid (itemKindId itemFull)+          return UseUp++-- ** DestroyItem++-- | Make the target actor destroy items in a store from the given group.+-- The item that caused the effect itself is *not* immune, because often+-- the item needs to destroy itself, e.g., to model wear and tear.+-- In such a case, the item may need to be identified, in a container,+-- when it no longer exists, at least in the container. This is OK.+-- Durable items are not immune, unlike the tools in @ConsumeItems@.+effectDestroyItem :: MonadServerAtomic m+                  => m () -> Int -> Int -> CStore -> ActorId+                  -> GroupName ItemKind+                  -> m UseResult+effectDestroyItem execSfx ngroup kcopy store target grp = do+  tb <- getsState $ getActorBody target+  is <- allGroupItems store grp target+  if | null is -> return UseDud+     | otherwise -> do+       execSfx+       urs <- mapM (uncurry (dropCStoreItem True True store target tb kcopy))+                   (take ngroup is)+       return $! case urs of+         [] -> UseDud  -- there was no effects+         _ -> maximum urs++-- | Drop a single actor's item (though possibly multiple copies).+-- Note that if there are multiple copies, at most one explodes+-- to avoid excessive carnage and UI clutter (let's say,+-- the multiple explosions interfere with each other or perhaps+-- larger quantities of explosives tend to be packaged more safely).+-- Note also that @OnSmash@ effects are activated even if item discharged.+dropCStoreItem :: MonadServerAtomic m+               => Bool -> Bool -> CStore -> ActorId -> Actor -> Int+               -> ItemId -> ItemQuant+               -> m UseResult+dropCStoreItem verbose destroy store aid b kMax iid (k, _) = do+ let c = CActor aid store+ bag0 <- getsState $ getContainerBag c+  -- @OnSmash@ effects of previous items may remove next items, so better check.+ if iid `EM.notMember` bag0 then return UseDud else do+  itemFull <- getsState $ itemToFull iid+  let arItem = aspectRecordFull itemFull+      fragile = IA.checkFlag Ability.Fragile arItem+      durable = IA.checkFlag Ability.Durable arItem+      isDestroyed = destroy+                    || bproj b && (bhp b <= 0 && not durable || fragile)+                    || store == COrgan  -- just as organs are destroyed at death+                                        -- but also includes conditions+  if isDestroyed then do+    let effApplyFlags = EffApplyFlags+          { effToUse            = EffBare+              -- the embed could be combined at this point but @iid@ cannot+          , effVoluntary        = True+              -- we don't know if it's effVoluntary, so we conservatively assume+              -- it is and we blame @aid@+          , effUseAllCopies     = kMax >= k+          , effKineticPerformed = False+          , effActivation       = ActivationOnSmash+          , effMayDestroy       = True+          }+    void $ effectAndDestroyAndAddKill effApplyFlags aid aid aid iid c itemFull+    -- One copy was destroyed (or none if the item was discharged),+    -- so let's mop up.+    bag <- getsState $ getContainerBag c+    maybe (return ())+          (\(k1, it) -> do+             let destroyedSoFar = k - k1+                 k2 = min (kMax - destroyedSoFar) k1+                 kit2 = (k2, take k2 it)+                 -- Don't spam if the effect already probably made noise+                 -- and also the number could be surprising to the player.+                 verbose2 = verbose && k1 == k+             when (k2 > 0) $+               execUpdAtomic $ UpdDestroyItem verbose2 iid (itemBase itemFull)+                                              kit2 c)+          (EM.lookup iid bag)+    return UseUp+  else do+    cDrop <- pickDroppable False aid b  -- drop over fog, etc.+    mvCmd <- generalMoveItem verbose iid (min kMax k) (CActor aid store) cDrop+    mapM_ execUpdAtomic mvCmd+    return UseUp++pickDroppable :: MonadStateRead m => Bool -> ActorId -> Actor -> m Container+pickDroppable respectNoItem aid b = do+  cops@COps{coTileSpeedup} <- getsState scops+  lvl <- getLevel (blid b)+  let validTile t = not (respectNoItem && Tile.isNoItem coTileSpeedup t)+  if validTile $ lvl `at` bpos b+  then return $! CActor aid CGround+  else do+    let ps = nearbyFreePoints cops lvl validTile (bpos b)+    return $! case filter (adjacent $ bpos b) $ take 8 ps of+      [] -> CActor aid CGround  -- fallback; still correct, though not ideal+      pos : _ -> CFloor (blid b) pos++-- ** ConsumeItems++-- | Make the target actor destroy the given items, if all present,+-- or none at all, if any is missing. To be used in crafting.+-- The item that caused the effect itself is not considered (any copies).+effectConsumeItems :: MonadServerAtomic m+                   => m () -> ItemId -> ActorId+                   -> [(Int, GroupName ItemKind)]+                   -> [(Int, GroupName ItemKind)]+                   -> m UseResult+effectConsumeItems execSfx iidOriginal target tools0 raw0 = do+  kitAssG <- getsState $ kitAssocs target [CGround]+  let kitAss = listToolsToConsume kitAssG []  -- equipment too dangerous to use+      is = filter ((/= iidOriginal) . fst . snd) kitAss+      grps0 = map (\(x, y) -> (False, x, y)) tools0  -- apply if durable+              ++ map (\(x, y) -> (True, x, y)) raw0  -- destroy always+      (bagsToLose3, iidsToApply3, grps3) =+        foldl' subtractIidfromGrps (EM.empty, [], grps0) is+  if null grps3 then do+    execSfx+    consumeItems target bagsToLose3 iidsToApply3+    return UseUp+  else return UseDud++consumeItems :: MonadServerAtomic m+             => ActorId -> EM.EnumMap CStore ItemBag+             -> [(CStore, (ItemId, ItemFull))]+             -> m ()+consumeItems target bagsToLose iidsToApply = do+  COps{coitem} <- getsState scops+  tb <- getsState $ getActorBody target+  arTrunk <- getsState $ (EM.! btrunk tb) . sdiscoAspect+  let isBlast = IA.checkFlag Ability.Blast arTrunk+      identifyStoreBag store bag =+        mapM_ (identifyStoreIid store) $ EM.keys bag+      identifyStoreIid store iid = do+        discoAspect2 <- getsState sdiscoAspect+          -- might have changed due to embedded items invocations+        itemKindId <- getsState $ getIidKindIdServer iid+        let arItem = discoAspect2 EM.! iid+            c = CActor target store+            itemKind = okind coitem itemKindId+        unless (IA.isHumanTrinket itemKind) $  -- a hack+          execUpdAtomic $ UpdDiscover c iid itemKindId arItem+  -- We don't invoke @OnSmash@ effects, so we avoid the risk+  -- of the first removed item displacing the actor, destroying+  -- or scattering some pending items ahead of time, etc.+  -- The embed should provide any requisite fireworks instead.+  forM_ (EM.assocs bagsToLose) $ \(store, bagToLose) ->+    unless (EM.null bagToLose) $ do+      identifyStoreBag store bagToLose+      -- Not @UpdLoseItemBag@, to be verbose.+      -- The bag is small, anyway.+      let c = CActor target store+      itemD <- getsState sitemD+      mapWithKeyM_ (\iid kit -> do+                      let verbose = not isBlast  -- no spam+                          item = itemD EM.! iid+                      execUpdAtomic $ UpdDestroyItem verbose iid item kit c)+                   bagToLose+  -- But afterwards we do apply normal effects of durable items,+  -- even if the actor or other items displaced in the process,+  -- as long as a number of the items is still there.+  -- So if a harmful double-purpose tool-component is both to be used+  -- and destroyed, it will be lost, but at least it won't harm anybody.+  let applyItemIfPresent (store, (iid, itemFull)) = do+        let c = CActor target store+        bag <- getsState $ getContainerBag c+        when (iid `EM.member` bag) $ do+          execSfxAtomic $ SfxApply target iid+          -- Treated as if the actor only activated the item on himself,+          -- without kinetic damage, to avoid the exploit of wearing armor+          -- when using tools or transforming terrain.+          -- Also, timeouts of the item ignored to prevent exploit+          -- by discharging the item before using it.+          let effApplyFlags = EffApplyFlags+                { effToUse            = EffBare  -- crafting not intended+                , effVoluntary        = True+                , effUseAllCopies     = False+                , effKineticPerformed = False+                , effActivation       = ActivationConsume+                , effMayDestroy       = False+                }+          void $ effectAndDestroyAndAddKill effApplyFlags+                                            target target target iid c itemFull+  mapM_ applyItemIfPresent iidsToApply++-- ** DropItem++-- | Make the target actor drop items in a store from the given group.+-- The item that caused the effect itself is immune (any copies).+effectDropItem :: MonadServerAtomic m+               => m () -> ItemId -> Int -> Int -> CStore+               -> GroupName ItemKind -> ActorId+               -> m UseResult+effectDropItem execSfx iidOriginal ngroup kcopy store grp target = do+  tb <- getsState $ getActorBody target+  fact <- getsState $ (EM.! bfid tb) . sfactionD+  isRaw <- allGroupItems store grp target+  curChalSer <- getsServer $ scurChalSer . soptions+  factionD <- getsState sfactionD+  let is = filter ((/= iidOriginal) . fst) isRaw+  if | bproj tb || null is -> return UseDud+     | ngroup == maxBound && kcopy == maxBound+       && store `elem` [CStash, CEqp]+       && fhasGender (gplayer fact)  -- hero in Allure's decontamination chamber+       && (cdiff curChalSer == 1     -- at lowest difficulty for its faction+           && any (fhasUI . gplayer . snd)+                  (filter (\(fi, fa) -> isFriend fi fa (bfid tb))+                          (EM.assocs factionD))+           || cdiff curChalSer == difficultyBound+              && any (fhasUI . gplayer  . snd)+                     (filter (\(fi, fa) -> isFoe fi fa (bfid tb))+                             (EM.assocs factionD))) ->+{-+A hardwired hack, because AI heroes don't cope with Allure's decontamination+chamber; beginners may struggle too, so this is trigered by difficulty.+- AI heroes don't switch leader to the hero past laboratory to equip+weapons from stash between the in-lab hero picks up the loot pile+and himself enters the decontamination chamber+- the items of the last actor would be lost anyway, unless AI+is taught the foolproof solution of this puzzle, which is yet a bit more+specific than the two abilities above+-}+       return UseUp+     | otherwise -> do+       unless (store == COrgan) execSfx+       urs <- mapM (uncurry (dropCStoreItem True False store target tb kcopy))+                   (take ngroup is)+       return $! case urs of+         [] -> UseDud  -- there was no effects+         _ -> maximum urs++-- ** Recharge and Discharge++effectRecharge :: forall m. MonadServerAtomic m+               => Bool -> m () -> ItemId -> Int -> Dice.Dice -> ActorId+               -> m UseResult+effectRecharge reducingCooldown execSfx iidOriginal n0 dice target = do+ tb <- getsState $ getActorBody target+ if bproj tb then return UseDud else do  -- slows down, but rarely any effect+  localTime <- getsState $ getLocalTime (blid tb)+  totalDepth <- getsState stotalDepth+  Level{ldepth} <- getLevel (blid tb)+  power <- rndToAction $ castDice ldepth totalDepth dice+  let timeUnit = if reducingCooldown+                 then absoluteTimeNegate timeClip+                 else timeClip+      delta = timeDeltaScale (Delta timeUnit) power+      localTimer = createItemTimer localTime (Delta timeZero)+      addToCooldown :: CStore -> (Int, UseResult) -> (ItemId, ItemFullKit)+                    -> m (Int, UseResult)+      addToCooldown _ (0, ur) _ = return (0, ur)+      addToCooldown store (n, ur) (iid, (_, (k0, itemTimers0))) = do+        let itemTimers = filter (charging localTime) itemTimers0+            kt = length itemTimers+            lenToShift = min n $ if reducingCooldown then kt else k0 - kt+            (itToShift, itToKeep) =+              if reducingCooldown+              then splitAt lenToShift itemTimers+              else (replicate lenToShift localTimer, itemTimers)+            -- No problem if this overcharges; equivalent to pruned timer.+            it2 = map (shiftItemTimer delta) itToShift ++ itToKeep+        if itemTimers0 == it2+        then return (n, ur)+        else do+          let c = CActor target store+          execUpdAtomic $ UpdTimeItem iid c itemTimers0 it2+          return (n - lenToShift, UseUp)+      selectWeapon i@(iid, (itemFull, _)) (weapons, others) =+        let arItem = aspectRecordFull itemFull+        in if | IA.aTimeout arItem == 0+                || iid == iidOriginal -> (weapons, others)+              | IA.checkFlag Ability.Meleeable arItem -> (i : weapons, others)+              | otherwise -> (weapons, i : others)+      partitionWeapon = foldr selectWeapon ([],[])+      ignoreCharges = True  -- handled above depending on @reducingCooldown@+      benefits = Nothing  -- only raw damage counts (client knows benefits)+      sortWeapons ass =+        map (\(_, _, _, _, iid, itemFullKit) -> (iid, itemFullKit))+        $ strongestMelee ignoreCharges benefits localTime ass+  eqpAss <- getsState $ kitAssocs target [CEqp]+  let (eqpAssWeapons, eqpAssOthers) = partitionWeapon eqpAss+  organAss <- getsState $ kitAssocs target [COrgan]+  let (organAssWeapons, organAssOthers) = partitionWeapon organAss+  (nEqpWeapons, urEqpWeapons) <-+    foldM (addToCooldown CEqp) (n0, UseDud)+    $ sortWeapons eqpAssWeapons+  (nOrganWeapons, urOrganWeapons) <-+    foldM (addToCooldown COrgan) (nEqpWeapons, urEqpWeapons)+    $ sortWeapons organAssWeapons+  (nEqpOthers, urEqpOthers) <-+    foldM (addToCooldown CEqp) (nOrganWeapons, urOrganWeapons) eqpAssOthers+  (_nOrganOthers, urOrganOthers) <-+    foldM (addToCooldown COrgan) (nEqpOthers, urEqpOthers) organAssOthers+  if urOrganOthers == UseDud then return UseDud+  else do+    execSfx+    return UseUp++-- ** PolyItem++-- Can't apply to the item itself (any copies).+effectPolyItem :: MonadServerAtomic m+               => m () -> ItemId -> ActorId -> m UseResult+effectPolyItem execSfx iidOriginal target = do+  tb <- getsState $ getActorBody target+  let cstore = CGround+  kitAss <- getsState $ kitAssocs target [cstore]+  case filter ((/= iidOriginal) . fst) kitAss of+    [] -> do+      execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNothing+      -- Do not spam the source actor player about the failures.+      return UseId+    (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind}+          , (itemK, itemTimer) )) : _ -> do+      let arItem = aspectRecordFull itemFull+          maxCount = Dice.supDice $ IK.icount itemKind+      if | IA.checkFlag Ability.Unique arItem -> do+           execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeUnique+           return UseId+         | maybe True (<= 0) $ lookup IK.COMMON_ITEM $ IK.ifreq itemKind -> do+           execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNotCommon+           return UseId+         | itemK < maxCount -> do+           execSfxAtomic $ SfxMsgFid (bfid tb)+                         $ SfxPurposeTooFew maxCount itemK+           return UseId+         | otherwise -> do+           -- Only the required number of items is used up, not all of them.+           let c = CActor target cstore+               kit = (maxCount, take maxCount itemTimer)+           execSfx+           identifyIid iid c itemKindId itemKind+           execUpdAtomic $ UpdDestroyItem True iid itemBase kit c+           effectCreateItem (Just $ bfid tb) Nothing+                            target target Nothing cstore+                            IK.COMMON_ITEM IK.timerNone++-- ** RerollItem++-- Can't apply to the item itself (any copies).+effectRerollItem :: forall m . MonadServerAtomic m+                 => m () -> ItemId -> ActorId -> m UseResult+effectRerollItem execSfx iidOriginal target = do+  COps{coItemSpeedup} <- getsState scops+  tb <- getsState $ getActorBody target+  let cstore = CGround  -- if ever changed, call @discoverIfMinorEffects@+  kitAss <- getsState $ kitAssocs target [cstore]+  case filter ((/= iidOriginal) . fst) kitAss of+    [] -> do+      execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNothing+      -- Do not spam the source actor player about the failures.+      return UseId+    (iid, ( ItemFull{ itemBase, itemKindId, itemKind+                    , itemDisco=ItemDiscoFull itemAspect }+          , (_, itemTimer) )) : _ ->+      if | IA.kmConst $ getKindMean itemKindId coItemSpeedup -> do+           execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNotRandom+           return UseId+         | otherwise -> do+           let c = CActor target cstore+               kit = (1, take 1 itemTimer)  -- prevent micromanagement+               freq = pure (itemKindId, itemKind)+           execSfx+           identifyIid iid c itemKindId itemKind+           execUpdAtomic $ UpdDestroyItem False iid itemBase kit c+           dungeon <- getsState sdungeon+           let maxLid = fst $ maximumBy (comparing (ldepth . snd))+                            $ EM.assocs dungeon+               roll100 :: Int -> m (ItemKnown, ItemFull)+               roll100 n = do+                 m2 <- rollItemAspect freq maxLid+                 case m2 of+                   NoNewItem ->+                     error "effectRerollItem: can't create rerolled item"+                   NewItem itemKnown@(ItemKnown _ ar2 _) itemFull _ ->+                     if ar2 == itemAspect && n > 0+                     then roll100 (n - 1)+                     else return (itemKnown, itemFull)+           (itemKnown, itemFull) <- roll100 100+           void $ registerItem True (itemFull, kit) itemKnown c+           return UseUp+    _ -> error "effectRerollItem: server ignorant about an item"++-- ** DupItem++-- Can't apply to the item itself (any copies).+effectDupItem :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult+effectDupItem execSfx iidOriginal target = do+  tb <- getsState $ getActorBody target+  let cstore = CGround  -- beware of other options, e.g., creating in eqp+                        -- and not setting timeout to a random value+  kitAss <- getsState $ kitAssocs target [cstore]+  case filter ((/= iidOriginal) . fst) kitAss of+    [] -> do+      execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupNothing+      -- Do not spam the source actor player about the failures.+      return UseId+    (iid, ( itemFull@ItemFull{itemKindId, itemKind}+          , _ )) : _ -> do+      let arItem = aspectRecordFull itemFull+      if | IA.checkFlag Ability.Unique arItem -> do+           execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupUnique+           return UseId+         | maybe False (> 0) $ lookup IK.VALUABLE $ IK.ifreq itemKind -> do+           execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupValuable+           return UseId+         | otherwise -> do+           let c = CActor target cstore+           execSfx+           identifyIid iid c itemKindId itemKind+           let slore = IA.loreFromContainer arItem c+           modifyServer $ \ser ->+             ser {sgenerationAn = EM.adjust (EM.insertWith (+) iid 1) slore+                                            (sgenerationAn ser)}+           execUpdAtomic $ UpdCreateItem True iid (itemBase itemFull)+                                         quantSingle c+           return UseUp++-- ** Identify++effectIdentify :: MonadServerAtomic m+               => m () -> ItemId -> ActorId -> m UseResult+effectIdentify execSfx iidOriginal target = do+  COps{coItemSpeedup} <- getsState scops+  discoAspect <- getsState sdiscoAspect+  -- The actor that causes the application does not determine what item+  -- is identifiable, becuase it's the target actor that identifies+  -- his possesions.+  tb <- getsState $ getActorBody target+  sClient <- getsServer $ (EM.! bfid tb) . sclientStates+  let tryFull store as = case as of+        [] -> return False+        (iid, _) : rest | iid == iidOriginal -> tryFull store rest  -- don't id itself+        (iid, ItemFull{itemBase, itemKindId, itemKind}) : rest -> do+          let arItem = discoAspect EM.! iid+              kindIsKnown = case jkind itemBase of+                IdentityObvious _ -> True+                IdentityCovered ix _ -> ix `EM.member` sdiscoKind sClient+          if iid `EM.member` sdiscoAspect sClient  -- already fully identified+             || IA.isHumanTrinket itemKind  -- hack; keep them non-identified+             || store == CGround && IA.onlyMinorEffects arItem itemKind+               -- will be identified when picked up, so don't bother+             || IA.kmConst (getKindMean itemKindId coItemSpeedup)+                && kindIsKnown+               -- constant aspects and known kind; no need to identify further;+               -- this should normally not be needed, since clients should+               -- identify such items for free+          then tryFull store rest+          else do+            let c = CActor target store+            execSfx+            identifyIid iid c itemKindId itemKind+            return True+      tryStore stores = case stores of+        [] -> do+          execSfxAtomic $ SfxMsgFid (bfid tb) SfxIdentifyNothing+          return UseId  -- the message tells it's ID effect+        store : rest -> do+          allAssocs <- getsState $ fullAssocs target [store]+          go <- tryFull store allAssocs+          if go then return UseUp else tryStore rest+  tryStore [CGround, CStash, CEqp]++-- The item need not be in the container. It's used for a message only.+identifyIid :: MonadServerAtomic m+            => ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()+identifyIid iid c itemKindId itemKind =+  unless (IA.isHumanTrinket itemKind) $ do+    discoAspect <- getsState sdiscoAspect+    execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid++-- ** Detect++effectDetect :: MonadServerAtomic m+             => m () -> IK.DetectKind -> Int -> ActorId -> Container+             -> m UseResult+effectDetect execSfx d radius target container = do+  COps{coitem, coTileSpeedup} <- getsState scops+  b <- getsState $ getActorBody target+  lvl <- getLevel $ blid b+  s <- getState+  getKind <- getsState $ flip getIidKindServer+  factionD <- getsState sfactionD+  let lootPredicate p =+        p `EM.member` lfloor lvl+        || (case posToBigAssoc p (blid b) s of+              Nothing -> False+              Just (_, body) ->+                let belongings = EM.keys (beqp body)  -- shared stash ignored+                in any belongingIsLoot belongings)+        || any embedHasLoot (EM.keys $ getEmbedBag (blid b) p s)+      itemKindIsLoot = isNothing . lookup IK.UNREPORTED_INVENTORY . IK.ifreq+      belongingIsLoot iid = itemKindIsLoot $ getKind iid+      embedHasLoot iid = any effectHasLoot $ IK.ieffects $ getKind iid+      reported acc _ _ itemKind = acc && itemKindIsLoot itemKind+      effectHasLoot (IK.CreateItem _ cstore grp _) =+        cstore `elem` [CGround, CStash, CEqp]+        && ofoldlGroup' coitem grp reported True+      effectHasLoot IK.PolyItem = True+      effectHasLoot IK.RerollItem = True+      effectHasLoot IK.DupItem = True+      effectHasLoot (IK.AtMostOneOf l) = any effectHasLoot l+      effectHasLoot (IK.OneOf l) = any effectHasLoot l+      effectHasLoot (IK.OnSmash eff) = effectHasLoot eff+      effectHasLoot (IK.OnUser eff) = effectHasLoot eff+      effectHasLoot (IK.AndEffect eff1 eff2) =+        effectHasLoot eff1 || effectHasLoot eff2+      effectHasLoot (IK.OrEffect eff1 eff2) =+        effectHasLoot eff1 || effectHasLoot eff2+      effectHasLoot (IK.SeqEffect effs) =+        or $ map effectHasLoot effs+      effectHasLoot (IK.When _ eff) = effectHasLoot eff+      effectHasLoot (IK.Unless _ eff) = effectHasLoot eff+      effectHasLoot (IK.IfThenElse _ eff1 eff2) =+        effectHasLoot eff1 || effectHasLoot eff2+      effectHasLoot _ = False+      stashPredicate p = any (onStash p) $ EM.assocs factionD+      onStash p (fid, fact) = case gstash fact of+        Just (lid, pos) -> pos == p && lid == blid b && fid /= bfid b+        Nothing -> False+      (predicate, action) = case d of+        IK.DetectAll -> (const True, const $ return False)+        IK.DetectActor -> ((`EM.member` lbig lvl), const $ return False)+        IK.DetectLoot -> (lootPredicate, const $ return False)+        IK.DetectExit ->+          let (ls1, ls2) = lstair lvl+          in ((`elem` ls1 ++ ls2 ++ lescape lvl), const $ return False)+        IK.DetectHidden ->+          let predicateH p = Tile.isHideAs coTileSpeedup $ lvl `at` p+              revealEmbed p = do+                embeds <- getsState $ getEmbedBag (blid b) p+                unless (EM.null embeds) $+                  execUpdAtomic $ UpdSpotItemBag True (CEmbed (blid b) p) embeds+              actionH l = do+                pos <- getsState $ posFromC container+                let f p = when (p /= pos) $ do+                      let t = lvl `at` p+                      execUpdAtomic $ UpdSearchTile target p t+                      -- This is safe searching; embedded items+                      -- are not triggered, but they are revealed.+                      revealEmbed p+                      case EM.lookup p $ lentry lvl of+                        Nothing -> return ()+                        Just entry ->+                          execUpdAtomic $ UpdSpotEntry (blid b) [(p, entry)]+                mapM_ f l+                return $! not $ null l  -- KISS, even if client knows all+          in (predicateH, actionH)+        IK.DetectEmbed -> ((`EM.member` lembed lvl), const $ return False)+        IK.DetectStash -> (stashPredicate, const $ return False)+  effectDetectX d predicate action execSfx radius target++-- This is not efficient at all, so optimize iff detection is added+-- to periodic organs or common periodic items or often activated embeds.+effectDetectX :: MonadServerAtomic m+              => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool)+              -> m () -> Int -> ActorId -> m UseResult+effectDetectX d predicate action execSfx radius target = do+  COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops+  b <- getsState $ getActorBody target+  sperFidOld <- getsServer sperFid+  let perOld = sperFidOld EM.! bfid b EM.! blid b+      Point x0 y0 = bpos b+      perList = filter predicate+        [ Point x y+        | y <- [max 0 (y0 - radius) .. min (rYmax - 1) (y0 + radius)]+        , x <- [max 0 (x0 - radius) .. min (rXmax - 1) (x0 + radius)]+        ]+      extraPer = emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList}+      inPer = diffPer extraPer perOld+  unless (nullPer inPer) $ do+    -- Perception is modified on the server and sent to the client+    -- together with all the revealed info.+    let perNew = addPer inPer perOld+        fper = EM.adjust (EM.insert (blid b) perNew) (bfid b)+    modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser}+    execSendPer (bfid b) (blid b) emptyPer inPer perNew+  pointsModified <- action perList+  if not (nullPer inPer) || pointsModified then do+    execSfx+    -- Perception is reverted. This is necessary to ensure save and restore+    -- doesn't change game state.+    unless (nullPer inPer) $ do+      modifyServer $ \ser -> ser {sperFid = sperFidOld}+      execSendPer (bfid b) (blid b) inPer emptyPer perOld+  else+    execSfxAtomic $ SfxMsgFid (bfid b) $ SfxVoidDetection d+  return UseUp  -- even if nothing spotted, in itself it's still useful data++-- ** SendFlying++-- | Send the target actor flying like a projectile. If the actors are adjacent,+-- the vector is directed outwards, if no, inwards, if it's the same actor,+-- boldpos is used, if it can't, a random outward vector of length 10+-- is picked.+effectSendFlying :: MonadServerAtomic m+                 => m () -> IK.ThrowMod -> ActorId -> ActorId -> Container+                 -> Maybe Bool+                 -> m UseResult+effectSendFlying execSfx IK.ThrowMod{..} source target container modePush = do+  v <- sendFlyingVector source target container modePush+  sb <- getsState $ getActorBody source+  tb <- getsState $ getActorBody target+  let eps = 0+      fpos = bpos tb `shift` v+      isEmbed = case container of+        CEmbed{} -> True+        _ -> False+  if bhp tb <= 0  -- avoid dragging around corpses+     || bproj tb && isEmbed then  -- flying projectiles can't slip on the floor+    return UseDud  -- the impact never manifested+  else if actorWaits tb+          && source /= target+          && isNothing (btrajectory tb) then do+    execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target+    when (source /= target) $+      execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target+    return UseUp  -- waste it to prevent repeated throwing at immobile actors+  else do+   COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops+   case bla rXmax rYmax eps (bpos tb) fpos of+    Nothing -> error $ "" `showFailure` (fpos, tb)+    Just [] -> error $ "projecting from the edge of level"+                       `showFailure` (fpos, tb)+    Just (pos : rest) -> do+      weightAssocs <- getsState $ fullAssocs target [CEqp, COrgan]+      let weight = sum $ map (IK.iweight . itemKind . snd) weightAssocs+          path = bpos tb : pos : rest+          (trajectory, (speed, _)) =+            -- Note that the @ThrowMod@ aspect of the actor's trunk is ignored.+            computeTrajectory weight throwVelocity throwLinger path+          ts = Just (trajectory, speed)+      -- Old and new trajectories are not added; the old one is replaced.+      if btrajectory tb == ts+      then return UseId  -- e.g., actor is too heavy; but a jerk is noticeable+      else do+        execSfx+        execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts+        -- If propeller is a projectile, it pushes involuntarily,+        -- so its originator is to blame.+        -- However, we can't easily see whether a pushed non-projectile actor+        -- pushed another due to colliding or voluntarily, so we assign+        -- blame to him.+        originator <- if bproj sb+                      then getsServer $ EM.findWithDefault source source+                                        . strajPushedBy+                      else return source+        modifyServer $ \ser ->+          ser {strajPushedBy = EM.insert target originator $ strajPushedBy ser}+        -- In case of pre-existing pushing, don't touch the time+        -- so that the pending @advanceTimeTraj@ can do its job+        -- (it will, because non-empty trajectory is here set, unless, e.g.,+        -- subsequent effects from the same item change the trajectory).+        when (isNothing $ btrajectory tb) $ do+          -- Set flying time to almost now, so that the push happens ASAP,+          -- because it's the first one, so almost no delay is needed.+          localTime <- getsState $ getLocalTime (blid tb)+          -- But add a slight overhead to avoid displace-slide loops+          -- of 3 actors in a line. However, add even more overhead+          -- to normal actor move, so that it doesn't manage to land+          -- a hit before it flies away safely.+          let overheadTime = timeShift localTime (Delta timeClip)+              doubleClip = timeDeltaScale (Delta timeClip) 2+          modifyServer $ \ser ->+            ser { strajTime =+                    updateActorTime (bfid tb) (blid tb) target overheadTime+                    $ strajTime ser+                , sactorTime =+                    ageActor (bfid tb) (blid tb) target doubleClip+                    $ sactorTime ser }+        return UseUp++sendFlyingVector :: MonadServerAtomic m+                 => ActorId -> ActorId -> Container -> Maybe Bool -> m Vector+sendFlyingVector source target container modePush = do+  sb <- getsState $ getActorBody source+  if source == target then do+    pos <- getsState $ posFromC container+    lid <- getsState $ lidFromC container+    let (start, end) =+          -- Without the level the pushing stair trap moved actor back upstairs.+          if bpos sb /= pos && blid sb == lid+          then (bpos sb, pos)+          else (fromMaybe (bpos sb) (boldpos sb), bpos sb)+    if start == end then rndToAction $ do+      z <- randomR (-10, 10)+      oneOf [Vector 10 z, Vector (-10) z, Vector z 10, Vector z (-10)]+    else do+      let pushV = vectorToFrom end start+          pullV = vectorToFrom start end+      return $! case modePush of+                  Just True -> pushV+                  Just False -> pullV+                  Nothing -> pushV+  else do+    tb <- getsState $ getActorBody target+    let pushV = vectorToFrom (bpos tb) (bpos sb)+        pullV = vectorToFrom (bpos sb) (bpos tb)+    return $! case modePush of+                Just True -> pushV+                Just False -> pullV+                Nothing | adjacent (bpos sb) (bpos tb) -> pushV+                Nothing -> pullV++-- ** ApplyPerfume++effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult+effectApplyPerfume execSfx target = do+  tb <- getsState $ getActorBody target+  Level{lsmell} <- getLevel $ blid tb+  unless (EM.null lsmell) $ do+    execSfx+    let f p fromSm = execUpdAtomic $ UpdAlterSmell (blid tb) p fromSm timeZero+    mapWithKeyM_ f lsmell+  return UseUp  -- even if no smell before, the perfume is noticeable++-- ** AtMostOneOf++effectAtMostOneOf :: MonadServerAtomic m+                  => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult+effectAtMostOneOf recursiveCall l = do+  chosen <- rndToAction $ oneOf l+  recursiveCall chosen+  -- no @execSfx@, because the individual effect sents it++-- ** OneOf++effectOneOf :: MonadServerAtomic m+            => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult+effectOneOf recursiveCall l = do+  shuffled <- rndToAction $ shuffle l+  let f eff result = do+        ur <- recursiveCall eff+        -- We stop at @UseId@ activation and in this ways avoid potentially+        -- many calls to fizzling effects that only spam a failure message+        -- and ID the item.+        if ur == UseDud then result else return ur+  foldr f (return UseDud) shuffled+  -- no @execSfx@, because the individual effect sents it++-- ** AndEffect++effectAndEffect :: forall m. MonadServerAtomic m+                => (IK.Effect -> m UseResult) -> ActorId+                -> IK.Effect -> IK.Effect+                -> m UseResult+effectAndEffect recursiveCall source eff1@IK.ConsumeItems{} eff2 = do+  -- So far, this is the only idiom used for crafting. If others appear,+  -- either formalize it by a specialized crafting effect constructor+  -- or add here and to effect printing code.+  sb <- getsState $ getActorBody source+  curChalSer <- getsServer $ scurChalSer . soptions+  fact <- getsState $ (EM.! bfid sb) . sfactionD+  if cgoods curChalSer && fhasUI (gplayer fact) then do+    execSfxAtomic $ SfxMsgFid (bfid sb) SfxReadyGoods+    return UseId+  else effectAndEffectSem recursiveCall eff1 eff2++effectAndEffect recursiveCall _ eff1 eff2 =+  effectAndEffectSem recursiveCall eff1 eff2++effectAndEffectSem :: forall m. MonadServerAtomic m+                   => (IK.Effect -> m UseResult) -> IK.Effect -> IK.Effect+                   -> m UseResult+effectAndEffectSem recursiveCall eff1 eff2 = do+  ur1 <- recursiveCall eff1+  if ur1 == UseUp+  then recursiveCall eff2+  else return ur1+  -- No @execSfx@, because individual effects sent them.++-- ** OrEffect++effectOrEffect :: forall m. MonadServerAtomic m+               => (IK.Effect -> m UseResult)+               -> FactionId -> IK.Effect -> IK.Effect+               -> m UseResult+effectOrEffect recursiveCall fid eff1 eff2 = do+  curChalSer <- getsServer $ scurChalSer . soptions+  fact <- getsState $ (EM.! fid) . sfactionD+  case eff1 of+    IK.AndEffect IK.ConsumeItems{} _ | cgoods curChalSer+                                       && fhasUI (gplayer fact) -> do+      -- Stop forbidden crafting ASAP to avoid spam.+      execSfxAtomic $ SfxMsgFid fid SfxReadyGoods+      return UseId+    _ -> do+      ur1 <- recursiveCall eff1+      if ur1 == UseUp+      then return UseUp+      else recursiveCall eff2+             -- no @execSfx@, because individual effects sent them++-- ** SeqEffect++effectSeqEffect :: forall m. MonadServerAtomic m+                => (IK.Effect -> m UseResult) -> [IK.Effect]+                -> m UseResult+effectSeqEffect recursiveCall effs = do+  mapM_ (void <$> recursiveCall) effs+  return UseUp+  -- no @execSfx@, because individual effects sent them++-- ** When++effectWhen :: forall m. MonadServerAtomic m+           => (IK.Effect -> m UseResult) -> ActorId+           -> IK.Condition -> IK.Effect -> ActivationFlag+           -> m UseResult+effectWhen recursiveCall source cond eff effActivation = do+  go <- conditionSem source cond effActivation+  if go then recursiveCall eff else return UseDud++-- ** Unless++effectUnless :: forall m. MonadServerAtomic m+             => (IK.Effect -> m UseResult) -> ActorId+             -> IK.Condition -> IK.Effect -> ActivationFlag+             -> m UseResult+effectUnless recursiveCall source cond eff effActivation = do+  go <- conditionSem source cond effActivation+  if not go then recursiveCall eff else return UseDud++-- ** IfThenElse++effectIfThenElse :: forall m. MonadServerAtomic m+                 => (IK.Effect -> m UseResult) -> ActorId+                 -> IK.Condition -> IK.Effect -> IK.Effect -> ActivationFlag+                 -> m UseResult+effectIfThenElse recursiveCall source cond eff1 eff2 effActivation = do+  c <- conditionSem source cond effActivation+  if c then recursiveCall eff1 else recursiveCall eff2++-- ** VerbNoLonger++effectVerbNoLonger :: MonadServerAtomic m+                   => Bool -> m () -> ActorId -> m UseResult+effectVerbNoLonger effUseAllCopies execSfx source = do+  b <- getsState $ getActorBody source+  when (effUseAllCopies  -- @UseUp@ ensures that if all used, all destroyed+        && not (bproj b))  -- no spam when projectiles activate+    execSfx  -- announce that all copies have run out (or whatever message)+  return UseUp  -- help to destroy the copy, even if not all used up++-- ** VerbMsg++effectVerbMsg :: MonadServerAtomic m => m () -> ActorId -> m UseResult+effectVerbMsg execSfx source = do+  b <- getsState $ getActorBody source+  unless (bproj b) execSfx  -- don't spam when projectiles activate+  return UseUp  -- announcing always successful and this helps+                -- to destroy the item++-- ** VerbMsgFail++effectVerbMsgFail :: MonadServerAtomic m => m () -> ActorId -> m UseResult+effectVerbMsgFail execSfx source = do+  b <- getsState $ getActorBody source+  unless (bproj b) execSfx  -- don't spam when projectiles activate+  return UseId  -- not @UseDud@ so that @OneOf@ doesn't ignore it

engine-src/Game/LambdaHack/Server/HandleRequestM.hs view

@@ -13,11 +13,11 @@   , reqGameDropAndExit, reqGameSaveAndExit #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , execFailure, checkWaiting, processWatchfulness, managePerRequest-  , handleRequestTimedCases, affectSmell, reqMove, reqMelee, reqMeleeChecked-  , reqDisplace, reqAlter, reqWait, reqWait10, reqYell, reqMoveItems-  , reqMoveItem, reqProject, reqApply-  , reqGameRestart, reqGameSave, reqTactic, reqAutomate+  , execFailure, checkWaiting, processWatchfulness, affectStash+  , managePerRequest, handleRequestTimedCases, affectSmell+  , reqMove, reqMelee, reqMeleeChecked, reqDisplace, reqAlter+  , reqWait, reqWait10, reqYell, reqMoveItems, reqMoveItem, reqProject, reqApply+  , reqGameRestart, reqGameSave, reqDoctrine, reqAutomate #endif   ) where @@ -26,14 +26,12 @@ import Game.LambdaHack.Core.Prelude  import qualified Data.EnumMap.Strict as EM-import qualified Data.Ord as Ord import qualified Data.Text as T import qualified Text.Show.Pretty as Show.Pretty  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client (ReqAI (..), ReqUI (..),-                                         RequestTimed (..))-import           Game.LambdaHack.Client.UI.ItemDescription+import           Game.LambdaHack.Client+  (ReqAI (..), ReqUI (..), RequestTimed (..)) import           Game.LambdaHack.Common.Actor import           Game.LambdaHack.Common.ActorState import           Game.LambdaHack.Common.Analytics@@ -103,7 +101,7 @@   ReqUIGameDropAndExit -> reqGameDropAndExit aid >> return Nothing   ReqUIGameSaveAndExit -> reqGameSaveAndExit aid >> return Nothing   ReqUIGameSave -> reqGameSave >> return Nothing-  ReqUITactic toT -> reqTactic fid toT >> return Nothing+  ReqUIDoctrine toT -> reqDoctrine fid toT >> return Nothing   ReqUIAutomate -> reqAutomate fid >> return Nothing   ReqUINop -> return Nothing @@ -125,21 +123,13 @@   actorMaxSk <- getsState $ getActorMaxSkills aid   let uneasy = deltasSerious (bcalmDelta b) || not (calmEnough b actorMaxSk)   case bwatch b of-    WSleep ->-      if mwait /= Just False  -- lurk can't wake up regardless; too short-         && (not (isJust mwait)  -- not a wait-             || uneasy  -- spooked-             || not (deltaBenign $ bhpDelta b))  -- any HP lost-      then execUpdAtomic $ UpdWaitActor aid WSleep WWake-      else execUpdAtomic $ UpdRefillHP aid 10000-             -- no @xM@, so slow, but each turn HP gauge green;-             -- this is 1HP per 100 turns, so it's 10 slower than a necklace-             -- that gives 1HP per 10 turns;-             -- so if an actor sleeps for the duration of a 1000 turns,-             -- which may be the time it takes to fully explore a level,-             -- 10HP would be gained, so weak actors would wake up-    WWake -> unless (mwait == Just False) $  -- lurk can't wake up; too fast-      removeSleepSingle aid+    WWatch ->+      when (mwait == Just True) $  -- only long wait switches to wait state+        if Ability.getSk Ability.SkWait actorMaxSk >= 2 then do+          addCondition False IK.S_BRACED aid+          execUpdAtomic $ UpdWaitActor aid WWatch (WWait 1)+        else+          execUpdAtomic $ UpdWaitActor aid WWatch (WWait 0)     WWait 0 -> case mwait of  -- actor couldn't brace last time       Just True -> return ()  -- if he still waits, keep him stuck unbraced       _ -> execUpdAtomic $ UpdWaitActor aid (WWait 0) WWatch@@ -149,7 +139,7 @@           if not uneasy  -- won't wake up at once              && canSleep actorMaxSk  -- enough skills           then do-            nAll <- removeConditionSingle "braced" aid+            nAll <- removeConditionSingle IK.S_BRACED aid             let !_A = assert (nAll == 0) ()             addSleep aid           else@@ -159,17 +149,41 @@           -- Doze some more before checking sleep eligibility.           execUpdAtomic $ UpdWaitActor aid (WWait n) (WWait $ n + 1)       _ -> do-        nAll <- removeConditionSingle "braced" aid-        let !_A = assert (nAll == 0) ()+        nAll <- removeConditionSingle IK.S_BRACED aid+        let !_A = assert (nAll == 0 `blame` nAll) ()         execUpdAtomic $ UpdWaitActor aid (WWait n) WWatch-    WWatch ->-      when (mwait == Just True) $  -- only long wait switches to wait state-        if Ability.getSk Ability.SkWait actorMaxSk >= 2 then do-          addCondition "braced" aid-          execUpdAtomic $ UpdWaitActor aid WWatch (WWait 1)-        else-          execUpdAtomic $ UpdWaitActor aid WWatch (WWait 0)+    WSleep ->+      if mwait /= Just False  -- lurk can't wake up regardless; too short+         && (not (isJust mwait)  -- not a wait+             || uneasy  -- spooked+             || not (deltaBenign $ bhpDelta b))  -- any HP lost+      then execUpdAtomic $ UpdWaitActor aid WSleep WWake+      else execUpdAtomic $ UpdRefillHP aid 10000+             -- no @xM@, so slow, but each turn HP gauge green;+             -- this is 1HP per 100 turns, so it's 10 times slower+             -- than a necklace that gives 1HP per 10 turns;+             -- so if an actor sleeps for the duration of a 1000 turns,+             -- which may be the time it takes to fully explore a level,+             -- 10HP would be gained, so weak actors would wake up twice over,+             -- which is fine: sleeping long enough to sidestep them at will,+             -- but attacking, e.g., a group with explosives, is good choice+             -- as well; so both stealth and mayhem fun correct tactically+    WWake -> unless (mwait == Just False) $  -- lurk can't wake up; too fast+      removeSleepSingle aid +-- Even very primitive actors that can't pick up items can take over stash,+-- to prevent them inadvertedly protecting enemy stash from skilled ones+-- by standing over it (which AI tends to do).+affectStash :: MonadServerAtomic m => Actor -> m ()+affectStash b = do+  let locateStash (fid, fact) = case gstash fact of+        Just (lidS, posS)+          | lidS == blid b && posS == bpos b && fid /= bfid b ->+            execUpdAtomic $ UpdLoseStashFaction True fid lidS posS+        _ -> return ()+  factionD <- getsState sfactionD+  mapM_ locateStash $ EM.assocs factionD+ handleRequestTimed :: MonadServerAtomic m                    => FactionId -> ActorId -> RequestTimed -> m Bool handleRequestTimed fid aid cmd = do@@ -194,6 +208,7 @@ managePerRequest :: MonadServerAtomic m => ActorId -> m () managePerRequest aid = do   b <- getsState $ getActorBody aid+  affectStash b   let clearMark = 0   unless (bcalmDelta b == ResDelta (0, 0) (0, 0)) $     -- Clear delta for the next actor move.@@ -280,7 +295,7 @@       when (oldS /= newS) $         execUpdAtomic $ UpdAlterSmell (blid b) (bpos b) oldS newS --- | Actor moves or attacks.+-- | Actor moves or attacks or alters by bumping. -- Note that client may not be able to see an invisible monster -- so it's the server that determines if melee took place, etc. -- Also, only the server is authorized to check if a move is legal@@ -323,9 +338,8 @@         tbursting = bursting tar         -- Such projectiles, even if not bursting themselves, can cause         -- another projectile to burst.-        damaging itemKind = IK.idamage itemKind /= 0-        sdamaging = damaging sitemKind-        tdamaging = damaging titemKind+        sdamaging = IK.isDamagingKind sitemKind+        tdamaging = IK.isDamagingKind titemKind         -- Avoid explosion extinguishing itself via its own particles colliding.         sameBlast = IA.checkFlag Ability.Blast sar                     && getIidKindIdServer (btrunk sb) s@@ -362,12 +376,25 @@         if abInSkill Ability.SkMove then do           execUpdAtomic $ UpdMoveActor source spos tpos           affectSmell source-          void $ reqAlterFail voluntary source tpos-            -- possibly alter or activate-        else execFailure source (ReqMove dir) MoveUnskilled-      else-        -- Client foolishly tries to move into unwalkable tile.-        execFailure source (ReqMove dir) MoveNothing+          -- No remote ransacking nor underfoot effects by projectiles,+          -- through which a projectile could cook its only item,+          -- but retain the old raw name and which would spam water+          -- slowness every time a projectile flies over water.+          unless (bproj sb) $+            -- Counts as bumping, because terrain transformation probably+            -- not intended, because the goal was probably just to move+            -- and then modifying the terrain is an unwelcome side effect.+            -- Barged into a tile, so normal effects need to activate,+            -- while crafting requires explicit altering.+            void $ reqAlterFail True EffBare voluntary source tpos+       else execFailure source (ReqMove dir) MoveUnskilled+      else do+        -- If not walkable, this must be altering by bumping.+        -- If voluntary then probably intentional so report any errors.+        mfail <- reqAlterFail True EffBare voluntary source tpos+        when voluntary $ do+          let req = ReqMove dir+          maybe (return ()) (execFailure source req) mfail  -- * ReqMelee @@ -391,18 +418,21 @@ reqMeleeChecked voluntary source target iid cstore = do   sb <- getsState $ getActorBody source   tb <- getsState $ getActorBody target+  discoAspect <- getsState sdiscoAspect   let req = ReqMelee target iid cstore+      arWeapon = discoAspect EM.! iid+      meleeableEnough = bproj sb || IA.checkFlag Ability.Meleeable arWeapon   if source == target then execFailure source req MeleeSelf   else if not (checkAdjacent sb tb) then execFailure source req MeleeDistant+  else if not meleeableEnough then execFailure source req MeleeNotWeapon   else do     -- If @voluntary@ is set, blame is exact, otherwise, an approximation.     killer <- if | voluntary -> assert (not (bproj sb)) $ return source                  | bproj sb -> getsServer $ EM.findWithDefault source source                                . strajPushedBy                  | otherwise -> return source-    discoAspect <- getsState sdiscoAspect+    actorSk <- currentSkillsServer source     let arTrunk = discoAspect EM.! btrunk tb-        arWeapon = discoAspect EM.! iid         sfid = bfid sb         tfid = bfid tb         -- Let the missile drop down, but don't remove its trajectory@@ -421,6 +451,7 @@        && EM.size (beqp tb) == 1        && not (IA.checkFlag Ability.Blast arTrunk)        && actorWaits sb  -- still valid while request being processed+       && Ability.getSk Ability.SkMoveItem actorSk > 0  -- animals can't     then do       -- Catching the projectile, that is, stealing the item from its eqp.       -- No effect from our weapon (organ) is applied to the projectile@@ -434,14 +465,15 @@       -- and blocking can be even more so, depending on powers of the missile.       -- Missiles are really easy to defend against, but sight (and so, Calm)       -- is the key, as well as light, ambush around a corner, etc.-      execSfxAtomic $ SfxSteal source target iid cstore+      execSfxAtomic $ SfxSteal source target iid       case EM.assocs $ beqp tb of         [(iid2, (k, _))] -> do           upds <- generalMoveItem True iid2 k (CActor target CEqp)-                                              (CActor source CInv)+                                              (CActor source CStash)           mapM_ execUpdAtomic upds           itemFull <- getsState $ itemToFull iid2-          discoverIfMinorEffects (CActor source CInv) iid2 (itemKindId itemFull)+          discoverIfMinorEffects (CActor source CStash)+                                 iid2 (itemKindId itemFull)         err -> error $ "" `showFailure` err       haltTrajectory KillCatch target tb     else do@@ -462,39 +494,81 @@         -- Avoid spam when two explosions collide.         unless (IA.checkFlag Ability.Blast arWeapon                 && IA.checkFlag Ability.Blast arTrunk) $-          execSfxAtomic $ SfxStrike source target iid cstore+          execSfxAtomic $ SfxStrike source target iid       else do-        -- Normal hit, with effects. Msgs inside @SfxStrike@ describe-        -- the source part of the strike.-        execSfxAtomic $ SfxStrike source target iid cstore-        let c = CActor source cstore-            mayDestroy = not (bproj sb) || bhp sb <= oneM-              -- piercing projectiles may not have their weapon destroyed-        -- Msgs inside @itemEffect@ describe the target part of the strike.-        -- If any effects and aspects, this is also where they are identified.-        -- Here also the kinetic damage is applied, before any effects are.-        ---        -- Note: that "hornet swarm detect items" via a scrolls is intentional,-        -- even though unrealistic and funny. Otherwise actors could protect-        -- themselves from some projectiles by lowering their apply stat.-        -- Also, the animal faction won't have too much benefit from that info,-        -- so the problem is not balance, but the goofy message.-        kineticEffectAndDestroy voluntary killer source target iid c mayDestroy+        -- Normal hit, with effects, but first auto-apply defences.+        let mayDestroyTarget = not (bproj tb) || bhp tb <= oneM+            effApplyFlagsTarget = EffApplyFlags+              { effToUse            = EffBare+              , effVoluntary        = voluntary+              , effUseAllCopies     = False+              , effKineticPerformed = False+              , effActivation       = if bproj sb+                                      then Ability.ActivationUnderRanged+                                      else Ability.ActivationUnderMelee+              , effMayDestroy       = mayDestroyTarget+              }+        unless (bproj tb) $+          autoApply effApplyFlagsTarget killer target tb+          $ if bproj sb then Ability.UnderRanged else Ability.UnderMelee+        -- This might have changed the actors.+        sb2 <- getsState $ getActorBody source+        targetMaxSk <- getsState $ getActorMaxSkills target+        if | bproj sb2+             && Ability.getSk Ability.SkDeflectRanged targetMaxSk > 0 -> do+               cutCalm target+               execSfxAtomic $ SfxRecoil source target iid+           | Ability.getSk Ability.SkDeflectMelee targetMaxSk > 0 -> do+               cutCalm target+               execSfxAtomic $ SfxRecoil source target iid+           | otherwise -> do+               -- Msgs inside @SfxStrike@ describe the source part+               -- of the strike.+               execSfxAtomic $ SfxStrike source target iid+               let c = CActor source cstore+                   mayDestroySource = not (bproj sb2) || bhp sb2 <= oneM+                     -- piercing projectiles may not have their weapon destroyed+               -- Msgs inside @itemEffect@ describe the target part+               -- of the strike.+               -- If any effects and aspects, this is also where they are+               -- identified.+               -- Here also the kinetic damage is applied,+               -- before any effects are.+               --+               -- Note: that "hornet swarm detect items" via a scrolls+               -- is intentional,+               -- even though unrealistic and funny. Otherwise actors+               -- could protect+               -- themselves from some projectiles by lowering their apply stat.+               -- Also, the animal faction won't have too much benefit+               -- from that info,+               -- so the problem is not balance, but the goofy message.+               let effApplyFlagsSource = EffApplyFlags+                     { effToUse            = EffBare+                     , effVoluntary        = voluntary+                     , effUseAllCopies     = False+                     , effKineticPerformed = False+                     , effActivation       = Ability.ActivationMeleeable+                     , effMayDestroy       = mayDestroySource+                     }+               void $ kineticEffectAndDestroy effApplyFlagsSource killer+                                              source target iid c       sb2 <- getsState $ getActorBody source       case btrajectory sb2 of-        Just{} -> do+        Just{} | not voluntary -> do           -- Deduct a hitpoint for a pierce of a projectile-          -- or due to a hurled actor colliding with another.+          -- or due to a hurled actor colliding with another (seen from+          -- @voluntary@, as opposed to hurled actor actively meleeing another).           -- Don't deduct if no pierce, to prevent spam.           -- Never kill in this way.           when (bhp sb2 > oneM) $ do             execUpdAtomic $ UpdRefillHP source minusM             unless (bproj sb2) $ do               execSfxAtomic $-                SfxMsgFid (bfid sb2) $ SfxCollideActor (blid tb) source target+                SfxMsgFid (bfid sb2) $ SfxCollideActor source target               unless (bproj tb) $                 execSfxAtomic $-                  SfxMsgFid (bfid tb) $ SfxCollideActor (blid tb) source target+                  SfxMsgFid (bfid tb) $ SfxCollideActor source target           when (not (bproj sb2) || bhp sb2 <= oneM) $             -- Non-projectiles can't pierce, so terminate their flight.             -- If projectile has too low HP to pierce, ditto.@@ -511,6 +585,19 @@               || isFriend sfid sfact tfid) $  -- allies never at war         execUpdAtomic $ UpdDiplFaction sfid tfid fromDipl War +autoApply :: MonadServerAtomic m+          => EffApplyFlags -> ActorId -> ActorId -> Actor -> Ability.Flag+          -> m ()+autoApply effApplyFlags killer target tb flag = do+  let autoApplyIid c iid = do+        itemFull <- getsState $ itemToFull iid+        let arItem = aspectRecordFull itemFull+        when (IA.checkFlag flag arItem) $+          void $ effectAndDestroyAndAddKill effApplyFlags killer target target+                                            iid c itemFull+  mapM_ (autoApplyIid $ CActor target CEqp) $ EM.keys $ beqp tb+  mapM_ (autoApplyIid $ CActor target COrgan) $ EM.keys $ borgan tb+ -- * ReqDisplace  -- | Actor tries to swap positions with another.@@ -561,9 +648,10 @@              -- so sometimes smellers will backtrack once to wipe smell. OK.              affectSmell source              affectSmell target-             void $ reqAlterFail voluntary source tpos+             -- Counts as bumping, because terrain transformation not intended.+             void $ reqAlterFail True EffBare False source tpos                -- possibly alter or activate-             void $ reqAlterFail voluntary target spos+             void $ reqAlterFail True EffBare False target spos            _ -> execFailure source req DisplaceMultiple        else          -- Client foolishly tries to displace an actor without access.@@ -574,24 +662,34 @@ -- | Search and/or alter the tile. reqAlter :: MonadServerAtomic m => ActorId -> Point -> m () reqAlter source tpos = do-  mfail <- reqAlterFail True source tpos+  COps{coTileSpeedup} <- getsState scops+  sb <- getsState $ getActorBody source+  lvl <- getLevel $ blid sb+  -- This is explicit tile triggering. Walkable tiles are sparse enough+  -- that crafting effects can be activated without any others+  -- and without changing the tile and this is usually beneficial,+  -- so always attempted. OTOH, squeezing a hand into a non-walkable tile+  -- or barging into walkable tiles (but not as a projectile) activates all.+  let effToUse = if Tile.isWalkable coTileSpeedup (lvl `at` tpos)+                 then EffOnCombine+                 else EffBareAndOnCombine+  mfail <- reqAlterFail False effToUse True source tpos   let req = ReqAlter tpos   maybe (return ()) (execFailure source req) mfail -reqAlterFail :: MonadServerAtomic m-             => Bool -> ActorId -> Point -> m (Maybe ReqFailure)-reqAlterFail voluntary source tpos = do+reqAlterFail :: forall m. MonadServerAtomic m+             => Bool -> EffToUse -> Bool -> ActorId -> Point+             -> m (Maybe ReqFailure)+reqAlterFail bumping effToUse voluntary source tpos = do   cops@COps{cotile, coTileSpeedup} <- getsState scops   sb <- getsState $ getActorBody source   actorMaxSk <- getsState $ getActorMaxSkills source-  factionD <- getsState sfactionD   let calmE = calmEnough sb actorMaxSk       lid = blid sb   sClient <- getsServer $ (EM.! bfid sb) . sclientStates   itemToF <- getsState $ flip itemToFull   actorSk <- currentSkillsServer source   localTime <- getsState $ getLocalTime lid-  let alterSkill = Ability.getSk Ability.SkAlter actorSk   embeds <- getsState $ getEmbedBag lid tpos   lvl <- getLevel lid   getKind <- getsState $ flip getIidKindServer@@ -599,34 +697,43 @@       lvlClient = (EM.! lid) . sdungeon $ sClient       clientTile = lvlClient `at` tpos       hiddenTile = Tile.hideAs cotile serverTile-      revealEmbeds = unless (EM.null embeds) $ do-        s <- getState-        let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys embeds)-        execUpdAtomic $ UpdSpotItemBag (CEmbed lid tpos) embeds ais-      tryApplyEmbeds = mapM_ tryApplyEmbed-                             (sortEmbeds cops getKind serverTile embeds)+      alterSkill = Ability.getSk Ability.SkAlter actorSk+      tileMinSkill = Tile.alterMinSkill coTileSpeedup serverTile+      revealEmbeds = unless (EM.null embeds) $+        execUpdAtomic $ UpdSpotItemBag True (CEmbed lid tpos) embeds+      embedKindList =+        map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)+      sbItemKind = getKind $ btrunk sb+      -- Prevent embeds triggering each other's exploding embeds+      -- via feeble mists, in the worst case, in a loop. However,+      -- if a tile can be changed with an item (e.g., the mist trunk)+      -- but without activating embeds, mists do fine.+      projNoDamage = bproj sb && not (IK.isDamagingKind sbItemKind)       tryApplyEmbed (iid, kit) = do         let itemFull = itemToF iid             -- Let even completely apply-unskilled actors trigger basic embeds.             -- See the note about no skill check when melee triggers effects.-            legal = permittedApply localTime maxBound calmE itemFull kit-            (object1, object2) = partItemShortest (bfid sb) factionD localTime-                                                  itemFull (1, [])-            name = makePhrase [object1, object2]+            legal = permittedApply localTime maxBound calmE Nothing itemFull kit         case legal of-          Left ApplyNoEffects -> return ()  -- pure flavour embed-          Left reqFail ->+          Left ApplyNoEffects -> return UseDud  -- pure flavour embed+          Left reqFail -> do             -- The failure is fully expected, because client may choose             -- to trigger some embeds, knowing that others won't fire.             execSfxAtomic $ SfxMsgFid (bfid sb)-            $ SfxExpected ("embedded" <+> name) reqFail-          _ -> itemEffectEmbedded voluntary source lid tpos iid+                          $ SfxExpectedEmbed iid lid reqFail+            return UseDud+          _ -> itemEffectEmbedded effToUse voluntary source lid tpos iid+                 -- when @effToUse == EffOnCombine@, terrain, e.g., fire,+                 -- may be removed safely, without adverse effects+                 -- by crafting, even any silly crafting as an exploit; OK       underFeet = tpos == bpos sb  -- if enter and alter, be more permissive+      blockedByItem = EM.member tpos (lfloor lvl)   if chessDist tpos (bpos sb) > 1   then return $ Just AlterDistant   else if Just clientTile == hiddenTile then  -- searches-    -- Only actors with SkAlter > 1 can search for hidden doors, etc.-    if not underFeet && alterSkill <= 1+    -- Only non-projectile actors with SkAlter > 1 can search terrain.+    -- Even projectiles with large altering bonuses can't.+    if bproj sb || not underFeet && alterSkill <= 1     then return $ Just AlterUnskilled  -- don't leak about searching     else do       -- Blocking by items nor actors does not prevent searching.@@ -649,25 +756,45 @@       -- The rationale is that the items were all the time present       -- (just invisible to the client), so they need to be triggered.       -- The exception is changable tiles, because they are not so easy-      -- to trigger; they need subsequent altering.-      unless (Tile.isDoor coTileSpeedup serverTile-              || Tile.isChangable coTileSpeedup serverTile-              || EM.null embeds) $ do-        -- Can't send @SfxTrigger@ afterwards, because actor may be moved-        -- by the embeds to another level, where @tpos@ is meaningless.-        execSfxAtomic $ SfxTrigger source tpos-        tryApplyEmbeds-      return Nothing  -- success-  else if clientTile == serverTile then  -- alters-    if not underFeet && alterSkill < Tile.alterMinSkill coTileSpeedup serverTile+      -- to trigger; they need previous or subsequent altering.+      unless (Tile.isModifiable coTileSpeedup serverTile || projNoDamage) $+        mapM_ (void <$> tryApplyEmbed)+              (sortEmbeds cops serverTile embedKindList)+      return Nothing  -- searching is always success+  else+    -- Here either @clientTile == serverTile@ or the client+    -- is misguided re tile at that position, e.g., it is a projectile+    -- that can't see the tile and the tile was not revealed so far.+    -- In either case, try to alter the tile. If the messages+    -- are confusing, that's fair, situation is confusing.+    if not (bproj sb || underFeet)  -- no global skill check in these cases+       && alterSkill < tileMinSkill     then return $ Just AlterUnskilled  -- don't leak about altering     else do-      let changeTo tgroup = do-            lvl2 <- getLevel lid+      -- Save the original content of ground and eqp to abort transformations+      -- if any item is removed, possibly an item intended as the fuel.+      groundBag <- getsState $ getBodyStoreBag sb CGround+      eqpBag <- getsState $ getBodyStoreBag sb CEqp+      -- Compute items to use for transformation early, before any extra+      -- items added by activated embeds, to use only intended items as fuel.+      -- Use even unidentified items --- one more way to id by use.+      kitAssG <- getsState $ kitAssocs source [CGround]+      kitAssE <- getsState $ kitAssocs source [CEqp]+      let kitAss = listToolsToConsume kitAssG kitAssE+          announceTileChange =+            -- If no embeds and the only thing that happens is the change+            -- of the tile, don't display a message, because the change+            -- is visible on the map (unless it changes into itself)+            -- and there's nothing more to speak about.+            -- However, even with embeds, don't spam if wading through+            -- terrain and changing it each step.+            unless (underFeet || EM.null embeds) $+              execSfxAtomic $ SfxTrigger source lid tpos serverTile+          changeTo tgroup = do             -- No @SfxAlter@, because the effect is obvious (e.g., opened door).             let nightCond kt = not (Tile.kindHasFeature TK.Walkable kt                                     && Tile.kindHasFeature TK.Clear kt)-                               || (if lnight lvl2 then id else not)+                               || (if lnight lvl then id else not)                                     (Tile.kindHasFeature TK.Dark kt)             -- Sometimes the tile is determined precisely by the ambient light             -- of the source tiles. If not, default to cave day/night condition.@@ -677,15 +804,23 @@                                <$> opick cotile tgroup (const True))                             return                             mtoTile-            unless (toTile == serverTile) $ do  -- don't regenerate same tile+            embeds2 <- getsState $ getEmbedBag lid tpos+            let newHasEmbeds = Tile.isEmbed coTileSpeedup toTile+            -- Don't regenerate same tile, unless it had embeds, but all spent.+            when (serverTile /= toTile+                  || EM.null embeds2 && newHasEmbeds) $ do               -- At most one of these two will be accepted on any given client.-              execUpdAtomic $ UpdAlterTile lid tpos serverTile toTile+              when (serverTile /= toTile) $+                execUpdAtomic $ UpdAlterTile lid tpos serverTile toTile               -- This case happens when a client does not see a searching-              -- action by another faction, but sees the subsequent altering.+              -- action by another faction, but sees the subsequent altering+              -- or if another altering takes place in between.               case hiddenTile of                 Just tHidden ->                   execUpdAtomic $ UpdAlterTile lid tpos tHidden toTile                 Nothing -> return ()+              -- @UpdAlterExplorable@ is received by any client regardless+              -- of whether the alteration was seen and how.               case (Tile.isExplorable coTileSpeedup serverTile,                     Tile.isExplorable coTileSpeedup toTile) of                 (False, True) -> execUpdAtomic $ UpdAlterExplorable lid 1@@ -697,59 +832,129 @@               -- on a client, in which case the command would be ignored               -- on the client, without causing any problems. Otherwise,               -- if the position is in view, client has accurate info.-              case EM.lookup tpos (lembed lvl2) of-                Just bag -> do-                  s <- getState-                  let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys bag)-                  execUpdAtomic $ UpdLoseItemBag (CEmbed lid tpos) bag ais-                Nothing -> return ()+              unless (EM.null embeds2) $+                execUpdAtomic $ UpdLoseItemBag True (CEmbed lid tpos) embeds2               -- Altering always reveals the outcome tile, so it's not hidden               -- and so its embedded items are always visible.-              embedItem lid tpos toTile+              embedItemOnPos lid tpos toTile+          tryChangeWith :: ( [(Int, GroupName IK.ItemKind)]+                           , GroupName TK.TileKind )+                        -> m Bool+          tryChangeWith (tools0, tgroup) = do+            let grps0 = map (\(x, y) -> (False, x, y)) tools0+                  -- apply if durable+                (bagsToLose, iidsToApply, grps) =+                  foldl' subtractIidfromGrps (EM.empty, [], grps0) kitAss+            if null grps then do+              announceTileChange  -- first the result is foretold+              consumeItems source bagsToLose iidsToApply  -- then the cost+              changeTo tgroup  -- then result is seen+              return True+            else return False           feats = TK.tfeature $ okind cotile serverTile-          toAlter feat =-            case feat of-              TK.OpenTo tgroup -> Just tgroup-              TK.CloseTo tgroup -> Just tgroup-              TK.ChangeTo tgroup -> Just tgroup-              _ -> Nothing-          groupsToAlterTo | underFeet = []  -- don't autoclose doors under actor-                          | otherwise = mapMaybe toAlter feats-      if null groupsToAlterTo && EM.null embeds then-        return $ Just AlterNothing  -- no altering possible; silly client+          tileActions =+            mapMaybe (Tile.parseTileAction+                        (bproj sb)+                        (underFeet || blockedByItem)  -- avoids AlterBlockItem+                        embedKindList)+                     feats+          groupWithFromAction action = case action of+            Tile.WithAction grps _ | not bumping -> Just grps+            _ -> Nothing+          groupsToAlterWith = mapMaybe groupWithFromAction tileActions+          processTileActions :: Maybe UseResult -> [Tile.TileAction] -> m Bool+          processTileActions museResult [] =+            return $! maybe False (/= UseDud) museResult+          processTileActions museResult (ta : rest) = case ta of+            Tile.EmbedAction (iid, kit) ->+              -- Embeds are activated in the order in tile definition+              -- and never after the tile is changed.+              -- If any embedded item was present and processed,+              -- but none was triggered, both free and item-consuming terrain+              -- alteration is disabled. The exception is projectiles+              -- not being able to process embeds due to skill required,+              -- which does not block future terrain alteration.+              -- Skill check for non-projectiles is performed much earlier.+              -- All projectiles have 0 skill for the purpose of embed+              -- activation, regardless of their trunk.+              if | bproj sb && tileMinSkill > 0 ->  -- local skill check+                   processTileActions museResult rest+                     -- not blocking future terrain altering, e.g., oil mist+                     -- not slowed over water tile that has @talter@ equal to 2,+                     -- but able to change it into oil spill soon after+                 | projNoDamage ->+                   processTileActions (Just UseDud) rest+                     -- projectiles having enough skill, but no damage,+                     -- not only can't activate embeds, but block future+                     -- terrain altering, e.g., oil mist not puncturing+                     -- a barrel and causing explosion, and so also+                     -- not causing it to disappear later on+                 | otherwise -> do+                     -- here falls the case of fragmentation blast puncturing+                     -- a barrel and so causing an explosion+                     triggered <- tryApplyEmbed (iid, kit)+                     let useResult = fromMaybe UseDud museResult+                     processTileActions (Just $ max useResult triggered) rest+                       -- max means that even one activated embed is enough+                       -- to alter terrain in a future action+            Tile.ToAction tgroup -> assert (not (bproj sb)) $+              -- @parseTileAction@ ensures the above assertion+              -- so that projectiles never cause normal transitions and,+              -- e.g., mists douse fires or two flames thrown, first ignites,+              -- second douses immediately afterwards+              if maybe True (== UseUp) museResult+              then do+                announceTileChange+                changeTo tgroup+                return True+              else processTileActions museResult rest+            Tile.WithAction grps tgroup -> do+              -- Note that there is no skill check if the source actors+              -- is a projectile. Permission is conveyed in @ProjYes@ instead.+              groundBag2 <- getsState $ getBodyStoreBag sb CGround+              eqpBag2 <- getsState $ getBodyStoreBag sb CEqp+              if (not bumping || null grps)+                   -- 'M' confirmation needed to consume items, bump not enough+                 && (bproj sb || voluntary || null grps)+                       -- consume only if voluntary or released as projectile+                 && (maybe True (== UseUp) museResult+                     || effToUse == EffOnCombine)+                          -- unwanted crafting shouldn't block transformations+                 && let f (k1, _) (k2, _) = k1 <= k2+                    in EM.isSubmapOfBy f groundBag groundBag2+                       && EM.isSubmapOfBy f eqpBag eqpBag2+                      -- don't transform if items, possibly intended for+                      -- transformation, removed; also when only crafting+                      -- was intended, which almost always removes some items+              then do+                altered <- tryChangeWith (grps, tgroup)+                if altered+                then return True+                else processTileActions museResult rest+              else processTileActions museResult rest+      -- Note that stray embedded items (not from tile content definition)+      -- are never activated.+      if null tileActions then+        return $! if blockedByItem+                     && not underFeet+                     && Tile.isModifiable coTileSpeedup serverTile+                  then Just AlterBlockItem  -- likely cause+                  else Just AlterNothing  -- can't do; silly client; fail       else-        if underFeet || EM.notMember tpos (lfloor lvl) then-          if underFeet || not (occupiedBigLvl tpos lvl)-                          && not (occupiedProjLvl tpos lvl) then do-            -- If the only thing that happens is the change of the tile,-            -- don't display a message, because the change-            -- is visible on the map (unless it changes into itself)-            -- and there's nothing more to speak about.-            unless (EM.null embeds) $ do-              -- Can't send @SfxTrigger@ afterwards, because actor may be moved-              -- by the embeds to another level, where @tpos@ is meaningless.-              -- However, don't spam with projectiles on ice.-              unless (bproj sb || underFeet) $-                execSfxAtomic $ SfxTrigger source tpos-              -- The embeds of the initial tile are activated before the tile-              -- is altered. This prevents, e.g., trying to activate items-              -- where none are present any more, or very different to what-              -- the client expected. Surprise only comes through searching-              -- as implemented above.-              -- The items are first revealed for the sake of clients that-              -- may see the tile as hidden. Note that the tile is not revealed-              -- (unless it's altered later on, in which case the new one is).-              revealEmbeds-              tryApplyEmbeds-            case groupsToAlterTo of-              [] -> return ()-              [groupToAlterTo] -> changeTo groupToAlterTo-              l -> error $ "tile changeable in many ways" `showFailure` l-            return Nothing  -- success-          else return $ Just AlterBlockActor-        else return $ Just AlterBlockItem-  else  -- client is misguided re tile at that position, so bail out-    return $ Just AlterNothing+        if underFeet || not (occupiedBigLvl tpos lvl)+                        && not (occupiedProjLvl tpos lvl) then do+          -- The items are first revealed for the sake of clients that+          -- may see the tile as hidden. Note that the tile is not revealed+          -- (unless it's altered later on, in which case the new one is).+          revealEmbeds+          tileTriggered <- processTileActions Nothing tileActions+          let potentiallyMissing = filter (not . null) groupsToAlterWith+          when (not tileTriggered && not underFeet && voluntary+                && not (null potentiallyMissing)) $+            execSfxAtomic $ SfxMsgFid (bfid sb)+                          $ SfxNoItemsForTile potentiallyMissing+          return Nothing  -- altered as much as items allowed; success+        else return $ Just AlterBlockActor  -- * ReqWait @@ -786,26 +991,31 @@ -- -- This is similar to the effect @Yell@, but always voluntary. reqYell :: MonadServerAtomic m => ActorId -> m ()-reqYell source = do-  actorSk <- currentSkillsServer source+reqYell aid = do+  actorSk <- currentSkillsServer aid   if | Ability.getSk Ability.SkWait actorSk > 0 ->        -- Last yawn before waking up is displayed as a yell, but that's fine.        -- To fix that, we'd need to move the @SfxTaunt@        -- to @processWatchfulness@.-       execSfxAtomic $ SfxTaunt True source+       execSfxAtomic $ SfxTaunt True aid      | Ability.getSk Ability.SkMove actorSk <= 0        || Ability.getSk Ability.SkDisplace actorSk <= 0        || Ability.getSk Ability.SkMelee actorSk <= 0 ->        -- Potentially, only waiting is possible, so given that it's drained,        -- don't let the actor be stuck nor alarm about server failure.-       execSfxAtomic $ SfxTaunt False source-     | otherwise ->+       execSfxAtomic $ SfxTaunt False aid+     | otherwise -> do        -- In most situation one of the 3 actions above        -- can be performed and waiting skill is not needed for that,-       -- so given the 3 skills are available, waste turn-       -- but don't alarm, because it does happen sometimes in crowds.-       --   execFailure source ReqYell YellUnskilled-       return ()+       -- so given the 3 skills are available, waste turn, waiting until+       -- they can be performed, but don't alarm, because it does happen+       -- sometimes in crowds. No bracing granted, either, but mark+       -- waiting so that AI knows to change leader.+       --   execFailure aid ReqYell YellUnskilled+       b <- getsState $ getActorBody aid+       case bwatch b of+         WWait _ -> return ()+         _ -> execUpdAtomic $ UpdWaitActor aid (bwatch b) (WWait 0)  -- * ReqMoveItems @@ -819,40 +1029,55 @@     -- Server accepts item movement based on calm at the start, not end     -- or in the middle, to avoid interrupted or partially ignored commands.     let calmE = calmEnough b actorMaxSk-    mapM_ (reqMoveItem source calmE) l+    case l of+      [] -> execFailure source (ReqMoveItems l) ItemNothing+      iid : rest -> do+        reqMoveItem False source calmE iid+        -- Dropping previous may destroy next items.+        mapM_ (reqMoveItem True source calmE) rest   else execFailure source (ReqMoveItems l) MoveItemUnskilled  reqMoveItem :: MonadServerAtomic m-            => ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()-reqMoveItem aid calmE (iid, k, fromCStore, toCStore) = do+            => Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()+reqMoveItem absentPermitted aid calmE (iid, kOld, fromCStore, toCStore) = do   b <- getsState $ getActorBody aid   let fromC = CActor aid fromCStore-      req = ReqMoveItems [(iid, k, fromCStore, toCStore)]+      req = ReqMoveItems [(iid, kOld, fromCStore, toCStore)]   toC <- case toCStore of     CGround -> pickDroppable False aid b  -- drop over fog, etc.     _ -> return $! CActor aid toCStore+  bagFrom <- getsState $ getContainerBag (CActor aid fromCStore)   bagBefore <- getsState $ getContainerBag toC+  -- The effect of dropping previous items from this series may have+  -- increased or decreased the number of this item.+  let k = min kOld $ fst $ EM.findWithDefault (0, []) iid bagFrom+  let !_A = if absentPermitted then True else k == kOld   if+   | absentPermitted && k == 0 -> return ()    | k < 1 || fromCStore == toCStore -> execFailure aid req ItemNothing+   | fromCStore == CEqp && not calmE ->+     execFailure aid req ItemNotCalm+   | toCStore == CEqp && not calmE ->+     execFailure aid req ItemNotCalm    | toCStore == CEqp && eqpOverfull b k ->      execFailure aid req EqpOverfull-   | (fromCStore == CSha || toCStore == CSha) && not calmE ->-     execFailure aid req ItemNotCalm    | otherwise -> do     upds <- generalMoveItem True iid k fromC toC     mapM_ execUpdAtomic upds     itemFull <- getsState $ itemToFull iid-    when (fromCStore == CGround) $  -- pick up-      discoverIfMinorEffects toC iid (itemKindId itemFull)+    -- Let any item manipulation attempt to identify, in case the item+    -- got into stash, e.g., by being thrown at the stash location,+    -- and gets identified only when equipped or dropped and picked up again.+    discoverIfMinorEffects toC iid (itemKindId itemFull)     -- The first recharging period after equipping is random,     -- between 1 and 2 standard timeouts of the item.-    -- We reset timeout for equipped periodic items and also for items-    -- moved out of the shared stash, in which timeouts are not consistent-    -- wrt some local time, because actors from many levels put items there-    -- all the time (and don't rebase it to any common clock).+    -- Timeouts for items in shared stash are not consistent wrt the actor's+    -- local time, because actors from many levels put items there+    -- all the time (and don't rebase it to the clock of the stash's level).     -- If wrong local time in shared stash causes an item to recharge-    -- for a very long time, the player can reset it by moving it to pack-    -- and back to stash (as a flip side, a charging item in stash may sometimes+    -- for a very long time wrt actor on some level,+    -- the player can reset it by dropping the item and picking up again+    -- (as a flip side, a charging item in stash may sometimes     -- be used at once on another level, with different local time, but only     -- once, because after first use, the timeout is set to local time).     -- This is not terribly consistent, but not recharging in stash is@@ -861,7 +1086,7 @@     -- Which is not fun at all, but one more thing to remember doing regularly.     when (toCStore `elem` [CEqp, COrgan]           && fromCStore `notElem` [CEqp, COrgan]-          || fromCStore == CSha) $ do+          || fromCStore == CStash) $ do       let beforeIt = case iid `EM.lookup` bagBefore of             Nothing -> []  -- no such items before move             Just (_, it2) -> it2@@ -874,17 +1099,22 @@            -> Point      -- ^ target position of the projectile            -> Int        -- ^ digital line parameter            -> ItemId     -- ^ the item to be projected-           -> CStore     -- ^ whether the items comes from floor or inventory+           -> CStore     -- ^ which store the items comes from            -> m () reqProject source tpxy eps iid cstore = do   let req = ReqProject tpxy eps iid cstore   b <- getsState $ getActorBody source+  curChalSer <- getsServer $ scurChalSer . soptions+  fact <- getsState $ (EM.! bfid b) . sfactionD   actorMaxSk <- getsState $ getActorMaxSkills source   let calmE = calmEnough b actorMaxSk-  if cstore == CSha && not calmE then execFailure source req ItemNotCalm-  else do-    mfail <- projectFail source source tpxy eps False iid cstore False-    maybe (return ()) (execFailure source req) mfail+  if | ckeeper curChalSer && fhasUI (gplayer fact) ->+        execFailure source req ProjectFinderKeeper+     | cstore == CEqp && not calmE -> execFailure source req ItemNotCalm+     | otherwise -> do+         mfail <-+           projectFail source source (bpos b) tpxy eps False iid cstore False+         maybe (return ()) (execFailure source req) mfail  -- * ReqApply @@ -898,7 +1128,7 @@   b <- getsState $ getActorBody aid   actorMaxSk <- getsState $ getActorMaxSkills aid   let calmE = calmEnough b actorMaxSk-  if cstore == CSha && not calmE then execFailure aid req ItemNotCalm+  if cstore == CEqp && not calmE then execFailure aid req ItemNotCalm   else do     bag <- getsState $ getBodyStoreBag b cstore     case EM.lookup iid bag of@@ -908,7 +1138,8 @@         actorSk <- currentSkillsServer aid         localTime <- getsState $ getLocalTime (blid b)         let skill = Ability.getSk Ability.SkApply actorSk-            legal = permittedApply localTime skill calmE itemFull kit+            legal = permittedApply localTime skill calmE (Just cstore)+                                   itemFull kit         case legal of           Left reqFail -> execFailure aid req reqFail           Right _ -> applyItem aid iid cstore@@ -921,20 +1152,11 @@ reqGameRestart aid groupName scurChalSer = do   -- This call to `revealItems` is really needed, because the other   -- happens only at natural game conclusion, not at forced quitting.-  isNoConfirms <- isNoConfirmsGame+  noConfirmsGame <- isNoConfirmsGame   factionD <- getsState sfactionD   let fidsUI = map fst $ filter (\(_, fact) -> fhasUI (gplayer fact))                                 (EM.assocs factionD)-  itemD <- getsState sitemD-  dungeon <- getsState sdungeon-  let ais = EM.assocs itemD-      minLid = fst $ minimumBy (Ord.comparing (ldepth . snd))-                   $ EM.assocs dungeon-  unless isNoConfirms $-    mapM_ (\fid -> do-      execUpdAtomic $ UpdSpotItemBag (CTrunk fid minLid originPoint)-                                     EM.empty ais-      revealItems fid) fidsUI+  unless noConfirmsGame $ mapM_ revealItems fidsUI   -- Announcing end of game, we send lore, because game is over.   b <- getsState $ getActorBody aid   oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD@@ -955,6 +1177,7 @@ -- we shouldn exit the game. reqGameDropAndExit :: MonadServerAtomic m => ActorId -> m () reqGameDropAndExit aid = do+  verifyAssertExplored   b <- getsState $ getActorBody aid   oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD   execUpdAtomic $ UpdQuitFaction@@ -965,12 +1188,28 @@   modifyServer $ \ser -> ser { sbreakASAP = True                              , sbreakLoop = True } +verifyAssertExplored :: MonadServer m => m ()+verifyAssertExplored = do+  assertExplored <- getsServer $ sassertExplored . soptions+  case assertExplored of+    Nothing -> return ()+    Just lvlN -> do+      -- Exploration (by any party) verfied via spawning; beware of levels+      -- with disabled spawning.+      snumSpawned <- getsServer snumSpawned+      let !_A = assert (toEnum lvlN `EM.member` snumSpawned+                        || toEnum (- lvlN) `EM.member` snumSpawned+                        `blame` "by game end, exploration haven't reached the expected level depth, indicating stuck AI (or just very busy initial levels)"+                        `swith` lvlN) ()+      return ()+ -- * ReqGameSaveAndExit  -- After we break out of the game loop, we will notice from @Camping@ -- we shouldn exit the game. reqGameSaveAndExit :: MonadServerAtomic m => ActorId -> m () reqGameSaveAndExit aid = do+  verifyAssertExplored   b <- getsState $ getActorBody aid   oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD   execUpdAtomic $ UpdQuitFaction@@ -990,12 +1229,12 @@   modifyServer $ \ser -> ser { sbreakASAP = True                              , swriteSave = True } --- * ReqTactic+-- * ReqDoctrine -reqTactic :: MonadServerAtomic m => FactionId -> Ability.Tactic -> m ()-reqTactic fid toT = do-  fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD-  execUpdAtomic $ UpdTacticFaction fid toT fromT+reqDoctrine :: MonadServerAtomic m => FactionId -> Ability.Doctrine -> m ()+reqDoctrine fid toT = do+  fromT <- getsState $ fdoctrine . gplayer . (EM.! fid) . sfactionD+  execUpdAtomic $ UpdDoctrineFaction fid toT fromT  -- * ReqAutomate

engine-src/Game/LambdaHack/Server/ItemM.hs view

@@ -1,11 +1,11 @@ -- | Server operations for items. module Game.LambdaHack.Server.ItemM-  ( registerItem, randomResetTimeout, embedItem, prepareItemKind, rollItemAspect-  , rollAndRegisterItem+  ( registerItem, moveStashIfNeeded, randomResetTimeout, embedItemOnPos+  , prepareItemKind, rollItemAspect, rollAndRegisterItem   , placeItemsInDungeon, embedItemsInDungeon, mapActorCStore_ #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , onlyRegisterItem, computeRndTimeout, createLevelItem+  , onlyRegisterItem, computeRndTimeout, createCaveItem, createEmbedItem #endif   ) where @@ -15,18 +15,19 @@  import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES-import           Data.Function import qualified Data.HashMap.Strict as HM-import           Data.Ord  import           Game.LambdaHack.Atomic 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.MonadStateRead+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@@ -36,8 +37,6 @@ import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.TileKind (TileKind) import           Game.LambdaHack.Core.Frequency-import           Game.LambdaHack.Common.Point-import qualified Game.LambdaHack.Common.PointArray as PointArray import           Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs@@ -62,19 +61,30 @@       return $! icounter  registerItem :: MonadServerAtomic m-             => ItemFullKit -> ItemKnown -> Container -> Bool-             -> m ItemId-registerItem (itemFull@ItemFull{itemBase, itemKindId, itemKind}, kit)-             itemKnown@(ItemKnown _ arItem _) container verbose = do+             => Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId+registerItem verbose (itemFull@ItemFull{itemBase, itemKindId, itemKind}, kit)+             itemKnown@(ItemKnown _ arItem _) containerRaw = do+  container <- case containerRaw of+    CActor aid CEqp -> do+      b <- getsState $ getActorBody aid+      return $! if eqpFreeN b >= fst kit+                then containerRaw+                else CActor aid CStash+    _ -> return containerRaw   iid <- onlyRegisterItem itemKnown   let slore = IA.loreFromContainer arItem container   modifyServer $ \ser ->     ser {sgenerationAn = EM.adjust (EM.insertWith (+) iid (fst kit)) slore                                    (sgenerationAn ser)}-  let cmd = if verbose then UpdCreateItem else UpdSpotItem False-  execUpdAtomic $ cmd iid itemBase kit container+  moveStash <- moveStashIfNeeded container+  mapM_ execUpdAtomic moveStash+  execUpdAtomic $ UpdCreateItem verbose iid itemBase kit container   let worth = itemPrice (fst kit) itemKind-  unless (worth == 0) $ execUpdAtomic $ UpdAlterGold worth+  case container of+    _ | worth == 0 -> return ()+    CActor _ COrgan -> return ()  -- destroyed on drop+    CTrunk{} -> return ()  -- we assume any valuables in CEmbed can be dug out+    _ -> execUpdAtomic $ UpdAlterGold worth   knowItems <- getsServer $ sknowItems . soptions   when knowItems $ case container of     CTrunk{} -> return ()@@ -88,8 +98,23 @@     _ -> return ()   return iid +moveStashIfNeeded :: MonadStateRead m => Container -> m [UpdAtomic]+moveStashIfNeeded c = case c of+  CActor aid CStash -> do+    b <- getsState $ getActorBody aid+    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b+    case mstash of+      Just (lid, pos) -> do+        bagStash <- getsState $ getFloorBag lid pos+        return $! if EM.null bagStash+                  then [ UpdLoseStashFaction False (bfid b) lid pos+                       , UpdSpotStashFaction True (bfid b) (blid b) (bpos b) ]+                  else []+      Nothing -> return [UpdSpotStashFaction True (bfid b) (blid b) (bpos b)]+  _ -> return []+ randomResetTimeout :: MonadServerAtomic m-                   => Int -> ItemId -> ItemFull -> [Time] -> Container+                   => Int -> ItemId -> ItemFull -> [ItemTimer] -> Container                    -> m () randomResetTimeout k iid itemFull beforeIt toC = do   lid <- getsState $ lidFromC toC@@ -110,32 +135,70 @@         execUpdAtomic $ UpdTimeItem iid toC afterIt resetIt     Nothing -> return ()  -- no @Timeout@ aspect; don't touch -computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe Time)+computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer) computeRndTimeout localTime ItemFull{itemDisco=ItemDiscoFull itemAspect} = do   let t = IA.aTimeout itemAspect   if t /= 0 then do-    rndT <- randomR (0, t)+    rndT <- randomR0 t     let rndTurns = timeDeltaScale (Delta timeTurn) (t + rndT)-    return $ Just $ timeShift localTime rndTurns+    return $ Just $ createItemTimer localTime rndTurns   else return Nothing computeRndTimeout _ _ = error "computeRndTimeout: server ignorant about an item" -createLevelItem :: MonadServerAtomic m => Point -> LevelId -> m ()-createLevelItem pos lid = do+createCaveItem :: MonadServerAtomic m => Point -> LevelId -> m ()+createCaveItem pos lid = do   COps{cocave} <- getsState scops   Level{lkind} <- getLevel lid   let container = CFloor lid pos       litemFreq = citemFreq $ okind cocave lkind-  void $ rollAndRegisterItem lid litemFreq container True Nothing+  -- Power depth of new items unaffected by number of spawned actors.+  freq <- prepareItemKind 0 lid litemFreq+  mIidEtc <- rollAndRegisterItem True lid freq container Nothing+  createKitItems lid pos mIidEtc -embedItem :: MonadServerAtomic m-          => LevelId -> Point -> ContentId TileKind -> m ()-embedItem lid pos tk = do+createEmbedItem :: MonadServerAtomic m+                => LevelId -> Point -> GroupName ItemKind -> m ()+createEmbedItem lid pos grp = do+  let container = CEmbed lid pos+  -- Power depth of new items unaffected by number of spawned actors.+  freq <- prepareItemKind 0 lid [(grp, 1)]+  mIidEtc <- rollAndRegisterItem True lid freq container Nothing+  createKitItems lid pos mIidEtc++-- Create, register and insert all initial kit items.+createKitItems :: MonadServerAtomic m+               => LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()+createKitItems lid pos mIidEtc = case mIidEtc of+  Nothing -> error $ "" `showFailure` (lid, pos, mIidEtc)+  Just (_, (itemFull, _)) -> do+    cops <- getsState scops+    lvl <- getLevel lid+    let ikit = IK.ikit $ itemKind itemFull+        nearbyPassable = take (20 + length ikit)+                         $ nearbyPassablePoints cops lvl pos+        walkable p = Tile.isWalkable (coTileSpeedup cops) (lvl `at` p)+        good p = walkable p && p `EM.notMember` lfloor lvl+        kitPos = zip ikit $ filter good nearbyPassable+                            ++ filter walkable nearbyPassable+                            ++ repeat pos+    forM_ kitPos $ \((ikGrp, cstore), p) -> do+      let container = if cstore == CGround+                      then CFloor lid p+                      else CEmbed lid pos+          itemFreq = [(ikGrp, 1)]+      -- Power depth of new items unaffected by number of spawned actors.+      freq <- prepareItemKind 0 lid itemFreq+      mresult <- rollAndRegisterItem False lid freq container Nothing+      assert (isJust mresult) $ return ()++-- Tiles already placed, so it's possible to scatter companion items+-- over walkable tiles.+embedItemOnPos :: MonadServerAtomic m+               => LevelId -> Point -> ContentId TileKind -> m ()+embedItemOnPos lid pos tk = do   COps{cotile} <- getsState scops-  let embeds = Tile.embeddedItems cotile tk-      container = CEmbed lid pos-      f grp = rollAndRegisterItem lid [(grp, 1)] container False Nothing-  mapM_ f embeds+  let embedGroups = Tile.embeddedItems cotile tk+  mapM_ (createEmbedItem lid pos) embedGroups  prepareItemKind :: MonadServerAtomic m                 => Int -> LevelId -> Freqs ItemKind@@ -149,7 +212,7 @@  rollItemAspect :: MonadServerAtomic m                => Frequency (ContentId IK.ItemKind, ItemKind) -> LevelId-               -> m (Maybe (ItemKnown, ItemFullKit))+               -> m NewItem rollItemAspect freq lid = do   cops <- getsState scops   flavour <- getsServer sflavour@@ -158,44 +221,48 @@   Level{ldepth} <- getLevel lid   m2 <- rndToAction $ newItem cops freq flavour discoRev ldepth totalDepth   case m2 of-    Just (itemKnown, ifk@(itemFull@ItemFull{itemKindId}, _)) -> do-      let arItem = aspectRecordFull itemFull+    NewItem (ItemKnown _ arItem _) ItemFull{itemKindId} _ -> do       when (IA.checkFlag Ability.Unique arItem) $         modifyServer $ \ser ->           ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)}-      return $ Just (itemKnown, ifk)-    Nothing -> return Nothing+    NoNewItem -> return ()+  return m2  rollAndRegisterItem :: MonadServerAtomic m-                    => LevelId -> Freqs ItemKind -> Container -> Bool+                    => Bool+                    -> LevelId+                    -> Frequency (ContentId IK.ItemKind, ItemKind)+                    -> Container                     -> Maybe Int                     -> m (Maybe (ItemId, ItemFullKit))-rollAndRegisterItem lid itemFreq container verbose mk = do-  -- Power depth of new items unaffected by number of spawned actors.-  freq <- prepareItemKind 0 lid itemFreq+rollAndRegisterItem verbose lid freq container mk = do   m2 <- rollItemAspect freq lid   case m2 of-    Nothing -> return Nothing-    Just (itemKnown, (itemFull, kit)) -> do-      let kit2 = (fromMaybe (fst kit) mk, snd kit)-      iid <- registerItem (itemFull, kit2) itemKnown container verbose+    NoNewItem -> return Nothing+    NewItem itemKnown itemFull kit -> do+      let f k = if k == 1 && null (snd kit)+                then quantSingle+                else (k, snd kit)+          !kit2 = maybe kit f mk+      iid <- registerItem verbose (itemFull, kit2) itemKnown container       return $ Just (iid, (itemFull, kit2)) +-- Tiles already placed, so it's possible to scatter over walkable tiles. placeItemsInDungeon :: forall m. MonadServerAtomic m-                    => EM.EnumMap LevelId [Point] -> m ()-placeItemsInDungeon alliancePositions = do+                    => EM.EnumMap LevelId (EM.EnumMap FactionId Point) -> m ()+placeItemsInDungeon factionPositions = do   COps{cocave, coTileSpeedup} <- getsState scops   totalDepth <- getsState stotalDepth   let initialItems (lid, lvl@Level{lkind, ldepth}) = do         litemNum <- rndToAction $ castDice ldepth totalDepth                                   (citemNum $ okind cocave lkind)-        let alPos = EM.findWithDefault [] lid alliancePositions+        let alPos = EM.elems $ EM.findWithDefault EM.empty lid factionPositions             placeItems :: Int -> m ()             placeItems n | n == litemNum = return ()             placeItems !n = do               Level{lfloor} <- getLevel lid               -- Don't generate items around initial actors or in bunches.-              let distAllianceAndNotFloor !p _ =+              let distAndNotFloor !p _ =                     let f !k b = chessDist p k > 4 && b                     in p `EM.notMember` lfloor && foldr f True alPos               mpos <- rndToAction $ findPosTry2 20 lvl@@ -203,12 +270,11 @@                           && not (Tile.isNoItem coTileSpeedup t))                 [ \_ !t -> Tile.isVeryOftenItem coTileSpeedup t                 , \_ !t -> Tile.isCommonItem coTileSpeedup t ]-                distAllianceAndNotFloor-                [ distAllianceAndNotFloor-                , distAllianceAndNotFloor ]+                distAndNotFloor+                [distAndNotFloor, distAndNotFloor]               case mpos of                 Just pos -> do-                  createLevelItem pos lid+                  createCaveItem pos lid                   placeItems (n + 1)                 Nothing -> debugPossiblyPrint                   "Server: placeItemsInDungeon: failed to find positions"@@ -216,23 +282,24 @@   dungeon <- getsState sdungeon   -- Make sure items on easy levels are generated first, to avoid all   -- artifacts on deep levels.-  let absLid = abs . fromEnum-      fromEasyToHard = sortBy (comparing absLid `on` fst) $ EM.assocs dungeon+  let fromEasyToHard = sortBy (comparing (ldepth . snd)) $ EM.assocs dungeon   mapM_ initialItems fromEasyToHard +-- Tiles already placed, so it's possible to scatter companion items+-- over walkable tiles. embedItemsInDungeon :: MonadServerAtomic m => m () embedItemsInDungeon = do-  let embedItems (lid, Level{ltile}) = PointArray.imapMA_ (embedItem lid) ltile+  let embedItemsOnLevel (lid, Level{ltile}) =+        PointArray.imapMA_ (embedItemOnPos lid) ltile   dungeon <- getsState sdungeon   -- Make sure items on easy levels are generated first, to avoid all   -- artifacts on deep levels.-  let absLid = abs . fromEnum-      fromEasyToHard = sortBy (comparing absLid `on` fst) $ EM.assocs dungeon-  mapM_ embedItems fromEasyToHard+  let fromEasyToHard = sortBy (comparing (ldepth . snd)) $ EM.assocs dungeon+  mapM_ embedItemsOnLevel fromEasyToHard  -- | Mapping over actor's items from a give store. mapActorCStore_ :: MonadServer m-                => CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()+                => CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m () mapActorCStore_ cstore f b = do   bag <- getsState $ getBodyStoreBag b cstore   mapM_ (uncurry f) $ EM.assocs bag

engine-src/Game/LambdaHack/Server/ItemRev.hs view

@@ -2,7 +2,8 @@ -- | Creation of items on the server. Types and operations that don't involve -- server state nor our custom monads. module Game.LambdaHack.Server.ItemRev-  ( ItemKnown(..), ItemRev, UniqueSet, buildItem, newItemKind, newItem+  ( ItemKnown(..), NewItem(..), ItemRev, UniqueSet+  , buildItem, newItemKind, newItem     -- * Item discovery types   , DiscoveryKindRev, emptyDiscoveryKindRev, serverDiscos     -- * The @FlavourMap@ type@@ -25,7 +26,6 @@ import           Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import           Game.LambdaHack.Common.Kind-import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import           Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK@@ -39,7 +39,7 @@  -- | The essential item properties, used for the @ItemRev@ hash table -- from items to their ids, needed to assign ids to newly generated items.--- All the other meaningul properties can be derived from them.+-- All the other meaningful properties can be derived from them. -- Note: item seed instead of @AspectRecord@ is not enough, -- becaused different seeds may result in the same @AspectRecord@ -- and we don't want such items to be distinct in UI and elsewhere.@@ -50,6 +50,10 @@  instance Hashable ItemKnown +data NewItem =+    NewItem ItemKnown ItemFull ItemQuant+  | NoNewItem+ -- | Reverse item map, for item creation, to keep items and item identifiers -- in bijection. type ItemRev = HM.HashMap ItemKnown ItemId@@ -62,11 +66,11 @@           -> Item buildItem COps{coitem} arItem (FlavourMap flavourMap)           (DiscoveryKindRev discoRev) ikChosen =-  let jkind = case IA.aHideAs arItem of+  let jkind = case IA.aPresentAs arItem of         Just grp ->           let kindHidden = ouniqGroup coitem grp           in IdentityCovered-               (toEnum $ fromEnum $ discoRev U.! contentIdIndex ikChosen)+               (toItemKindIx $ discoRev U.! contentIdIndex ikChosen)                kindHidden         Nothing -> IdentityObvious ikChosen       jfid     = Nothing  -- the default@@ -79,12 +83,12 @@             -> Frequency (ContentId IK.ItemKind, ItemKind) newItemKind COps{coitem, coItemSpeedup} uniqueSet itemFreq             (Dice.AbsDepth ldepth) (Dice.AbsDepth totalDepth) lvlSpawned =+  assert (any (\(_, n) -> n > 0) itemFreq) $   -- Effective generation depth of actors (not items) increases with spawns.   -- Up to 10 spawns, no effect. With 20 spawns, depth + 5, and then-  -- each 10 spawns adds 5 depth. Capped by @totalDepth@, to ensure variety.+  -- each 10 spawns adds 5 depth.   let numSpawnedCoeff = max 0 $ lvlSpawned `div` 2 - 5-      -- The first 10 spawns are of the nominal level.-      ldSpawned = min totalDepth $ ldepth + numSpawnedCoeff+      ldSpawned = ldepth + numSpawnedCoeff       f _ acc _ ik _ | ik `ES.member` uniqueSet = acc       f !q !acc !p !ik !kind =         -- Don't consider lvlSpawned for uniques, except those that have@@ -105,26 +109,29 @@ newItem :: COps -> Frequency (ContentId IK.ItemKind, ItemKind)         -> FlavourMap -> DiscoveryKindRev         -> Dice.AbsDepth -> Dice.AbsDepth-        -> Rnd (Maybe (ItemKnown, ItemFullKit))+        -> Rnd NewItem newItem cops freq flavourMap discoRev levelDepth totalDepth =-  if nullFreq freq then return Nothing+  if nullFreq freq+  then return NoNewItem  -- e.g., rare tile has a unique embed, only first time   else do     (itemKindId, itemKind) <- frequency freq     -- Number of new items/actors unaffected by number of spawned actors.     itemN <- castDice levelDepth totalDepth (IK.icount itemKind)-    arItem <--      IA.rollAspectRecord (IK.iaspects itemKind) levelDepth totalDepth+    arItem <- IA.rollAspectRecord (IK.iaspects itemKind) levelDepth totalDepth     let itemBase = buildItem cops arItem flavourMap discoRev itemKindId         itemIdentity = jkind itemBase-        itemK = max 1 itemN-        itemTimer = [timeZero | IA.checkFlag Ability.Periodic arItem]-          -- delay first discharge of single organs+        !itemK = max 1 itemN+        !itemTimer = [itemTimerZero | IA.checkFlag Ability.Periodic arItem]+          -- enable optimization in @applyPeriodicLevel@         itemSuspect = False         -- Bonuses on items/actors unaffected by number of spawned actors.-    let itemDisco = ItemDiscoFull arItem+        itemDisco = ItemDiscoFull arItem         itemFull = ItemFull {..}-    return $ Just ( ItemKnown itemIdentity arItem (jfid itemBase)-                  , (itemFull, (itemK, itemTimer)) )+        itemKnown = ItemKnown itemIdentity arItem (jfid itemBase)+        itemQuant = if itemK == 1 && null itemTimer+                    then quantSingle+                    else (itemK, itemTimer)+    return $! NewItem itemKnown itemFull itemQuant  -- | The reverse map to @DiscoveryKind@, needed for item creation. -- This is total and never changes, hence implemented as vector.@@ -135,18 +142,23 @@ emptyDiscoveryKindRev :: DiscoveryKindRev emptyDiscoveryKindRev = DiscoveryKindRev U.empty -serverDiscos :: COps -> Rnd (DiscoveryKind, DiscoveryKindRev)-serverDiscos COps{coitem} = do-  let ixs = [toEnum 0..toEnum (olength coitem - 1)]-  shuffled <- shuffle ixs-  let f (!ikMap, !ikRev, (!ix) : rest) !kmKind _ =-        (EM.insert ix kmKind ikMap, EM.insert kmKind ix ikRev, rest)-      f (ikMap, _, []) ik _ =+serverDiscos :: COps -> DiscoveryKindRev+             -> Rnd (DiscoveryKind, DiscoveryKindRev)+serverDiscos COps{coitem} (DiscoveryKindRev discoRev0) = do+  let ixs = [0..toEnum (olength coitem - 1)]+      inMetaGame kindId =+        IK.SetFlag Ability.MetaGame `elem` IK.iaspects (okind coitem kindId)+      keepMeta i ix = if inMetaGame (toEnum i) then ix else maxBound+  shuffled <-+    if U.null discoRev0+    then shuffle ixs+    else shuffleExcept (U.imap keepMeta discoRev0) (olength coitem) ixs+  let f (!ikMap, (!ix) : rest) !kmKind _ =+        (EM.insert (toItemKindIx ix) kmKind ikMap, rest)+      f (ikMap, []) ik _ =         error $ "too short ixs" `showFailure` (ik, ikMap)-      (discoS, discoRev, _) =-        ofoldlWithKey' coitem f (EM.empty, EM.empty, shuffled)-      udiscoRev = U.fromListN (olength coitem)-                  $ map (toEnum . fromEnum) $ EM.elems discoRev+      (discoS, _) = ofoldlWithKey' coitem f (EM.empty, shuffled)+      udiscoRev = U.fromListN (olength coitem) shuffled   return (discoS, DiscoveryKindRev udiscoRev)  -- | Flavours assigned by the server to item kinds, in this particular game.@@ -164,35 +176,60 @@  -- | Assigns flavours to item kinds. Assures no flavor is repeated for the same -- symbol, except for items with only one permitted flavour.-rollFlavourMap :: Rnd ( EM.EnumMap (ContentId ItemKind) Flavour+rollFlavourMap :: U.Vector Word16+               -> Rnd ( EM.EnumMap (ContentId ItemKind) Flavour                       , EM.EnumMap Char (ES.EnumSet Flavour) )                -> ContentId ItemKind -> ItemKind                -> Rnd ( EM.EnumMap (ContentId ItemKind) Flavour                       , EM.EnumMap Char (ES.EnumSet Flavour) )-rollFlavourMap !rnd !key !ik = case IK.iflavour ik of+rollFlavourMap uFlavMeta !rnd !key !ik = case IK.iflavour ik of   [] -> error "empty iflavour"   [flavour] -> do     (!assocs, !availableMap) <- rnd     return ( EM.insert key flavour assocs-           , availableMap)+           , availableMap )   flvs -> do     (!assocs, !availableMap) <- rnd-    let available =-          EM.findWithDefault stdFlav (IK.isymbol ik) availableMap-        proper = ES.fromList flvs `ES.intersection` available-    assert (not (ES.null proper)-            `blame` "not enough flavours for items"-            `swith` (flvs, available, ik, availableMap)) $ do-      flavour <- oneOf $ ES.toList proper-      let availableReduced = ES.delete flavour available-      return ( EM.insert key flavour assocs-             , EM.insert (IK.isymbol ik) availableReduced availableMap)+    let a0 = uFlavMeta U.! toEnum (fromEnum key)+    if a0 == maxBound then do+      if length flvs < 6 then do  -- too few to even attempt unique assignment+        flavour <- oneOf flvs+        return ( EM.insert key flavour assocs+               , availableMap )+      else do+        let available = availableMap EM.! IK.isymbol ik+            proper = ES.fromList flvs `ES.intersection` available+        assert (not (ES.null proper)+                `blame` "not enough flavours for items"+                `swith` (flvs, available, ik, availableMap)) $ do+          flavour <- oneOf $ ES.elems proper+          let availableReduced = ES.delete flavour available+          return ( EM.insert key flavour assocs+                 , EM.insert (IK.isymbol ik) availableReduced availableMap )+    else return ( EM.insert key (toEnum $ fromEnum a0) assocs+                , availableMap )  -- | Randomly chooses flavour for all item kinds for this game.-dungeonFlavourMap :: COps -> Rnd FlavourMap-dungeonFlavourMap COps{coitem} = do-  (assocsFlav, _) <- ofoldlWithKey' coitem rollFlavourMap-                                    (return (EM.empty, EM.empty))+dungeonFlavourMap :: COps -> FlavourMap -> Rnd FlavourMap+dungeonFlavourMap COps{coitem} (FlavourMap uFlav0) = do+  let inMetaGame kindId =+        IK.SetFlag Ability.MetaGame `elem` IK.iaspects (okind coitem kindId)+      keepMeta i fl = if inMetaGame (toEnum i) then fl else maxBound+      uFlavMeta = if U.null uFlav0+                  then U.replicate (olength coitem) maxBound+                  else U.imap keepMeta uFlav0+      flavToAvailable :: EM.EnumMap Char (ES.EnumSet Flavour) -> Int -> Word16+                      -> EM.EnumMap Char (ES.EnumSet Flavour)+      flavToAvailable em i fl =+        let ik = okind coitem (toEnum i)+            setBase = EM.findWithDefault stdFlav (IK.isymbol ik) em+            setMeta = if fl == maxBound+                      then setBase+                      else ES.delete (toEnum $ fromEnum fl) setBase+        in EM.insert (IK.isymbol ik) setMeta em+      availableMap = U.ifoldl' flavToAvailable EM.empty uFlavMeta+  (assocsFlav, _) <- ofoldlWithKey' coitem (rollFlavourMap uFlavMeta)+                                    (return (EM.empty, availableMap))   let uFlav = U.fromListN (olength coitem)               $ map (toEnum . fromEnum) $ EM.elems assocsFlav   return $! FlavourMap uFlav

engine-src/Game/LambdaHack/Server/LoopM.hs view

@@ -7,7 +7,7 @@   , factionArena, arenasForLoop, handleFidUpd, loopUpd, endClip   , manageCalmAndDomination, applyPeriodicLevel   , handleTrajectories, hTrajectories, advanceTrajectory-  , handleActors, hActors, restartGame+  , handleActors, hActors, dieSer, restartGame #endif   ) where @@ -42,7 +42,6 @@ import qualified Game.LambdaHack.Definition.Ability as Ability import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Server.CommonM-import           Game.LambdaHack.Server.EndM import           Game.LambdaHack.Server.HandleEffectM import           Game.LambdaHack.Server.HandleRequestM import           Game.LambdaHack.Server.MonadServer@@ -80,7 +79,7 @@                             $ updateCOpsAndCachedData (const cops)                             $ sclientStates ser EM.! fid                   in execUpdAtomicFidCatch fid cmd-      mapM_ f $ EM.keys factionD+      mapM_ (void <$> f) $ EM.keys factionD       updConn       initPer       pers <- getsServer sperFid@@ -108,7 +107,7 @@       updConn       initPer       reinitGame-      writeSaveAll False+      writeSaveAll False False   loopUpd updConn  factionArena :: MonadStateRead m => Faction -> m (Maybe LevelId)@@ -124,13 +123,13 @@     -- However, animals still spawn, if slowly, and aliens resume     -- spawning when heroes move on again. -arenasForLoop :: MonadStateRead m => m [LevelId]+arenasForLoop :: MonadStateRead m => m (ES.EnumSet LevelId) {-# INLINE arenasForLoop #-} arenasForLoop = do   factionD <- getsState sfactionD   marenas <- mapM factionArena $ EM.elems factionD-  let arenas = ES.toList $ ES.fromList $ catMaybes marenas-      !_A = assert (not (null arenas)+  let arenas = ES.fromList $ catMaybes marenas+      !_A = assert (not (ES.null arenas)                     `blame` "game over not caught earlier"                     `swith` factionD) ()   return $! arenas@@ -186,8 +185,8 @@   fa <- factionArena fact   arenas <- getsServer sarenas   let myArenas = case fa of-        Just myArena -> myArena : delete myArena arenas-        Nothing -> arenas+        Just myArena -> myArena : delete myArena (ES.elems arenas)+        Nothing -> ES.elems arenas   nonWaitMove <- handle myArenas   breakASAP <- getsServer sbreakASAP   unless breakASAP $ killDying myArenas@@ -248,7 +247,7 @@           -- ensures state is not changed and so the clip doesn't need           -- to be carried through before save.           arenas <- getsServer sarenas-          mapM_ (\fid -> mapM_ (`handleTrajectories` fid) arenas)+          mapM_ (\fid -> mapM_ (`handleTrajectories` fid) $ ES.elems arenas)                 (EM.keys factionD)           endClip updatePerFid  -- must be last, in case performs a bkp save           -- The condition can be changed in @handleTrajectories@ by pushing@@ -298,11 +297,12 @@       2 ->         -- Periodic activation only once per turn, for speed,         -- but on all active arenas. Calm updates and domination-        -- happen there as well.+        -- happen there as well. Once per turn is too rare for accurate+        -- expiration of short conditions, e.g., 1-turn haste. TODO.         applyPeriodicLevel       4 ->         -- Add monsters each turn, not each clip.-        unless (null arenas) spawnMonster+        unless (ES.null arenas) spawnMonster       _ -> return ()   -- @applyPeriodicLevel@ might have, e.g., dominated actors, ending the game.   -- It could not have unended the game, though.@@ -330,7 +330,7 @@   unless breakLoop2 $  -- if by chance requested and periodic saves coincide     -- Periodic save needs to be at the end, so that restore can start     -- at the beginning.-    when (clipN `mod` rwriteSaveClips corule == 0) $ writeSaveAll False+    when (clipN `mod` rwriteSaveClips corule == 0) $ writeSaveAll False False #endif  -- | Check if the given actor is dominated and update his calm.@@ -347,7 +347,7 @@                -- animals/robots/human drones never Calm-dominated              || hiImpressionK >= 10                -- unless very high impression, e.g., in a dominated hero-          then dominateFidSfx aid aid hiImpressionFid+          then dominateFidSfx aid aid (btrunk b) hiImpressionFid           else return False   unless performedDomination $ do     newCalmDelta <- getsState $ regenCalmDelta aid b@@ -359,8 +359,7 @@ applyPeriodicLevel :: MonadServerAtomic m => m () applyPeriodicLevel = do   arenas <- getsServer sarenas-  let arenasSet = ES.fromDistinctAscList arenas-      applyPeriodicItem _ _ (_, (_, [])) = return ()+  let applyPeriodicItem _ _ (_, (_, [])) = return ()         -- periodic items always have at least one timer       applyPeriodicItem aid cstore (iid, _) = do         itemFull <- getsState $ itemToFull iid@@ -371,19 +370,27 @@           bag <- getsState $ getBodyStoreBag b2 cstore           case iid `EM.lookup` bag of             Nothing -> return ()  -- item dropped-            Just (k, _) ->+            Just (k, _) -> do               -- Activate even if effects null or vacuous, to possibly               -- destroy the item.-              effectAndDestroyAndAddKill-                True aid False (k <= 1) False-                aid aid iid (CActor aid cstore) True itemFull True+              let effApplyFlags = EffApplyFlags+                    { effToUse            = EffBare  -- no periodic crafting+                    , effVoluntary        = True+                    , effUseAllCopies     = k <= 1+                    , effKineticPerformed = False+                    , effActivation       = Ability.ActivationPeriodic+                    , effMayDestroy       = True+                    }+              void $ effectAndDestroyAndAddKill+                       effApplyFlags+                       aid aid aid iid (CActor aid cstore) itemFull       applyPeriodicActor (aid, b) =         -- While it's fun when projectiles flash or speed up mid-air,         -- it's very exotic and quite time-intensive whenever hundreds         -- of projectiles exist due to ongoing explosions.         -- Nothing activates when actor dying to prevent a regenerating-        -- actor from resurrecting each turn, resulting in silly end-game stats.-        when (not (bproj b) && bhp b > 0 && blid b `ES.member` arenasSet) $ do+        -- actor from resurrecting each turn, resulting in silly gameover stats.+        when (not (bproj b) && bhp b > 0 && blid b `ES.member` arenas) $ do           -- Equipment goes first, to refresh organs before they expire,           -- to avoid the message that organ expired.           mapM_ (applyPeriodicItem aid CEqp) $ EM.assocs $ beqp b@@ -468,7 +475,7 @@   -- The carried item is not destroyed, unless it's fragile,   -- but drops to the ground. --- | Manage trajectory of a projectile.+-- | Manage trajectory of a projectile or a pushed other actor. -- -- Colliding with a wall or actor doesn't take time, because -- the projectile does not move (the move is blocked).@@ -476,75 +483,95 @@ -- Otherwise, with some timings, it can stay on the game map dead, -- blocking path of human-controlled actors and alarming the hapless human. advanceTrajectory :: MonadServerAtomic m => ActorId -> Actor -> m ()-{-# INLINE advanceTrajectory #-}-advanceTrajectory aid b = do+advanceTrajectory aid b1 = do   COps{coTileSpeedup} <- getsState scops-  lvl <- getLevel $ blid b-  arTrunk <- getsState $ (EM.! btrunk b) . sdiscoAspect-  case btrajectory b of+  lvl <- getLevel $ blid b1+  arTrunk <- getsState $ (EM.! btrunk b1) . sdiscoAspect+  let registerKill killHow =+        -- Kill counts for each blast particle is TMI.+        when (bproj b1+              && not (IA.checkFlag Ability.Blast arTrunk)) $ do+          killer <- getsServer $ EM.findWithDefault aid aid . strajPushedBy+          addKillToAnalytics killer killHow (bfid b1) (btrunk b1)+  case btrajectory b1 of     Just (d : lv, speed) -> do-      let tpos = bpos b `shift` d  -- target position+      let tpos = bpos b1 `shift` d  -- target position       if | Tile.isWalkable coTileSpeedup $ lvl `at` tpos -> do            -- Hit will clear trajectories in @reqMelee@,            -- so no need to do that here.-           execUpdAtomic $ UpdTrajectory aid (btrajectory b) (Just (lv, speed))-           when (null lv && bproj b-                 && not (IA.checkFlag Ability.Blast arTrunk)) $ do-             killer <- getsServer $ EM.findWithDefault aid aid . strajPushedBy-             addKillToAnalytics killer KillDropLaunch (bfid b) (btrunk b)+           execUpdAtomic $ UpdTrajectory aid (btrajectory b1) (Just (lv, speed))+           when (null lv) $ registerKill KillDropLaunch            let occupied = occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl                reqMoveHit = reqMoveGeneric False True aid d                reqDisp = reqDisplaceGeneric False aid-           if | bproj b ->-                -- Projectiles always hit; then can't tell friend from foe.-                reqMoveHit+           if | bproj b1 -> reqMoveHit  -- projectiles always hit               | occupied ->-                -- Non-projectiles displace, unless they can hit big enemy.-                -- Hitting projectiles would stop a possibly important flight.+                -- Non-projectiles displace if they are ending their flight+                -- or if only a projectile is in the way.+                -- So, no chaos of displacing a whole line of enemies.                 case (posToBigLvl tpos lvl, posToProjsLvl tpos lvl) of                   (Nothing, []) -> error "advanceTrajectory: not occupied"                   (Nothing, [target]) -> reqDisp target                   (Nothing, _) -> reqMoveHit  -- can't displace multiple-                  (Just target, []) -> do-                    b2 <- getsState $ getActorBody target-                    fact <- getsState $ (EM.! bfid b) . sfactionD-                    if isFoe (bfid b) fact (bfid b2)-                    then reqMoveHit-                    else reqDisp target+                  (Just target, []) ->+                    if null lv then reqDisp target else reqMoveHit                   (Just _, _) -> reqMoveHit  -- can't displace multiple               | otherwise -> reqMoveHit  -- if not occupied, just move-         | bproj b -> do-           -- @Nothing@ trajectory of a projectile signals an obstacle hit.-           -- Second call of @actorDying@ above will catch the dead projectile.-           execUpdAtomic $ UpdTrajectory aid (btrajectory b) Nothing-           -- Kill counts for each blast particle is TMI.-           when (not (IA.checkFlag Ability.Blast arTrunk)) $ do-             killer <- getsServer $ EM.findWithDefault aid aid . strajPushedBy-             addKillToAnalytics killer KillTileLaunch (bfid b) (btrunk b)-           -- Losing HP due to hitting an obstacle not needed, because-           -- trajectory is halted, so projectile will die soon anyway.          | otherwise -> do            -- Will be removed from @strajTime@ in recursive call            -- to @handleTrajectories@.-           execSfxAtomic $ SfxCollideTile aid tpos-           mfail <- reqAlterFail False aid tpos-           lvl2 <- getLevel $ blid b+           unless (bproj b1) $+             execSfxAtomic $ SfxCollideTile aid tpos+           embedsPre <- getsState $ getEmbedBag (blid b1) tpos+           -- No crafting by projectiles that bump tiles nor by pushed actors.+           -- The only way is if they land in a tile (are engulfed by it)+           -- and have enough skill. But projectiles transform when hitting,+           -- if terrain permits, not just bump off the obstacle.+           mfail <- reqAlterFail (not $ bproj b1) EffBare False aid tpos+           embedsPost <- getsState $ getEmbedBag (blid b1) tpos+           b2 <- getsState $ getActorBody aid+           let tpos2 = bpos b2 `shift` d  -- possibly another level and/or bpos+           lvl2 <- getLevel $ blid b2            case mfail of-             Nothing | Tile.isWalkable coTileSpeedup $ lvl2 `at` tpos ->+             Nothing | Tile.isWalkable coTileSpeedup $ lvl2 `at` tpos2 ->                -- Too late to announce anything, but given that the way-               -- is opened, continue flight. Don't even lose any HP.-               return ()+               -- is opened, continue flight. Don't even normally lose any HP,+               -- because it's not a hard collision, but altering.+               -- However, if embed was possibly triggered/removed, lose HP.+               if embedsPre /= embedsPost && not (EM.null embedsPre) then+                 if bhp b2 > oneM then do+                   execUpdAtomic $ UpdRefillHP aid minusM+                   b3 <- getsState $ getActorBody aid+                   advanceTrajectory aid b3+                 else do+                   -- Projectile has too low HP to pierce; terminate its flight.+                   execUpdAtomic $ UpdTrajectory aid (btrajectory b2)+                                 $ Just ([], speed)+                   registerKill KillTileLaunch+               else+                 -- Try again with the cleared path and possibly actors+                 -- spawned in the way, etc.+                 advanceTrajectory aid b2              _ -> do-               -- Altering failed, probably just a wall, so lose HP-               -- due to being pushed into an obstacle. Never kill in this way.+               -- Altering failed to open the passage, probably just a wall,+               -- so lose HP due to being pushed into an obstacle.+               -- Never kill in this way.                -- Note that sometimes this may come already after one faction                -- wins the game and end game screens are show. This is OK-ish.-               execUpdAtomic $ UpdTrajectory aid (btrajectory b) Nothing-               when (bhp b > oneM) $ do+               -- @Nothing@ trajectory of signals an obstacle hit.+               -- If projectile, second call of @actorDying@ above+               -- will take care of dropping dead.+               execUpdAtomic $ UpdTrajectory aid (btrajectory b2) Nothing+               -- If projectile, losing HP due to hitting an obstacle+               -- not needed, because trajectory is halted, so projectile+               -- will die soon anyway+               if bproj b2+               then registerKill KillTileLaunch+               else when (bhp b2 > oneM) $ do                  execUpdAtomic $ UpdRefillHP aid minusM                  let effect = IK.RefillHP (-2)  -- -2 is a lie to ensure display-                 execSfxAtomic $ SfxEffect (bfid b) aid effect (-1)-    _ -> error $ "Nothing or empty trajectory" `showFailure` (aid, b)+                 execSfxAtomic $ SfxEffect (bfid b2) aid (btrunk b2) effect (-1)+    _ -> error $ "Nothing or empty trajectory" `showFailure` (aid, b1)  handleActors :: (MonadServerAtomic m, MonadServerComm m)              => LevelId -> FactionId -> m Bool@@ -631,18 +658,80 @@         -- If breaking out of the game lopp, pretend there was a non-wait move.         if breakASAP2 then return True else hActors as +dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()+dieSer aid b2 = do+  if bproj b2 then+    when (isJust $ btrajectory b2) $+      execUpdAtomic $ UpdTrajectory aid (btrajectory b2) Nothing+        -- needed only to ensure display of the last position of projectile+  else do+    kindId <- getsState $ getIidKindIdServer $ btrunk b2+    execUpdAtomic $ UpdRecordKill aid kindId 1+    -- At this point the actor's body exists and his items are not dropped.+    deduceKilled aid+    -- Most probabaly already done, but just in case (e.g., when actor+    -- created with 0 HP):+    electLeader (bfid b2) (blid b2) aid+  -- If an explosion blast, before the particle is destroyed, it tries+  -- to modify terrain with it as well as do some easy crafting,+  -- e.g., cooking on fire.+  arTrunk <- getsState $ (EM.! btrunk b2) . sdiscoAspect+  let spentProj = bproj b2 && EM.null (beqp b2)+      isBlast = IA.checkFlag Ability.Blast arTrunk+      -- Let thrown food cook in fire (crafting) and other projectiles+      -- transform terrain they fall onto. Big actors are inert at death.+      (effScope, bumping) = if bproj b2+                            then (EffBareAndOnCombine, False)+                            else (EffBare, True)+  when (not spentProj && isBlast) $+    void $ reqAlterFail bumping effScope False aid (bpos b2)+  b3 <- getsState $ getActorBody aid+  -- Items need to do dropped now, so that they can be transformed by effects+  -- of the embedded items, if they are activated.+  -- If the actor was a projectile and no effect was triggered by hitting+  -- an enemy, the item still exists and @OnSmash@ effects will be triggered.+  dropAllEquippedItems aid b3+  -- Also destroy, not just drop, all organs, to trigger any effects.+  -- Note that some effects may be invoked on an actor that has+  -- no trunk any more. Conditions are ignored to avoid spam about them ending.+  bag <- getsState $ getBodyStoreBag b3 COrgan+  discoAspect <- getsState sdiscoAspect+  let f = void <$$> dropCStoreItem False True COrgan aid b3 maxBound+      isCondition = IA.checkFlag Ability.Condition . (discoAspect EM.!)+  mapM_ (uncurry f) $ filter (not . isCondition . fst) $ EM.assocs bag+  -- As the last act of heroism, the actor (even if projectile)+  -- changes the terrain with its embedded items, if possible.+  -- Note that all the resulting effects are invoked on an actor that has+  -- no trunk any more.+  when (not spentProj && not isBlast) $+    void $ reqAlterFail bumping effScope False aid (bpos b2)+      -- old bpos; OK, safer+  b4 <- getsState $ getActorBody aid+  execUpdAtomic $ UpdDestroyActor aid b4 []+ restartGame :: MonadServerAtomic m             => m () -> m () -> Maybe (GroupName ModeKind) -> m () restartGame updConn loop mgameMode = do+  -- This goes only to the old UI client.+  execSfxAtomic SfxRestart   soptionsNxt <- getsServer soptionsNxt   srandom <- getsServer srandom+  -- Create new factions.   s <- gameReset soptionsNxt mgameMode (Just srandom)-  let optionsBarRngs = soptionsNxt {sdungeonRng = Nothing, smainRng = Nothing}+  -- Note how we also no longer assert exploration, because there may not be+  -- enough time left in the debug run to explore again in a new game.+  let optionsBarRngs = soptionsNxt { sdungeonRng = Nothing+                                   , smainRng = Nothing+                                   , sassertExplored = Nothing }   modifyServer $ \ser -> ser { soptionsNxt = optionsBarRngs                              , soptions = optionsBarRngs }+  -- This reaches only the intersection of old and new clients.   execUpdAtomic $ UpdRestartServer s+  -- Spawn new clients, as needed, according to new factions.   updConn   initPer   reinitGame-  writeSaveAll False+  -- Save a just started noConfirm game to preserve history of the just+  -- ended normal game, in case the user exits brutally.+  writeSaveAll False True   loop

engine-src/Game/LambdaHack/Server/MonadServer.hs view

@@ -30,11 +30,11 @@ import           System.Exit (exitFailure) import           System.FilePath import           System.IO (hFlush, stdout)-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client (sbenchmark) import           Game.LambdaHack.Common.ActorState+import           Game.LambdaHack.Common.ClientOptions (sbenchmark) import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.File import qualified Game.LambdaHack.Common.HighScore as HighScore@@ -89,20 +89,20 @@ debugPossiblyPrint t = do   debug <- getsServer $ sdbgMsgSer . soptions   when debug $ liftIO $ do-    T.hPutStrLn stdout t+    T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough     hFlush stdout  debugPossiblyPrintAndExit :: MonadServer m => Text -> m () debugPossiblyPrintAndExit t = do   debug <- getsServer $ sdbgMsgSer . soptions   when debug $ liftIO $ do-    T.hPutStrLn stdout t+    T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough     hFlush stdout     exitFailure  serverPrint :: MonadServer m => Text -> m () serverPrint t = liftIO $ do-  T.hPutStrLn stdout t+  T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough   hFlush stdout  saveServer :: MonadServer m => m ()@@ -115,14 +115,14 @@ -- | Dumps to stdout the RNG states from the start of the game. dumpRngs :: MonadServer m => RNGs -> m () dumpRngs rngs = liftIO $ do-  T.hPutStrLn stdout $ tshow rngs+  T.hPutStr stdout $! tshow rngs <> "\n"  -- hPutStrLn not atomic enough   hFlush stdout  -- | Read the high scores dictionary. Return the empty table if no file. restoreScore :: forall m. MonadServer m => COps -> m HighScore.ScoreDict restoreScore COps{corule} = do-  bench <- getsServer $ sbenchmark . sclientOptions . soptions-  mscore <- if bench then return Nothing else do+  benchmark <- getsServer $ sbenchmark . sclientOptions . soptions+  mscore <- if benchmark then return Nothing else do     let scoresFile = rscoresFile corule     dataDir <- liftIO appDataDir     let path bkp = dataDir </> bkp <> scoresFile@@ -131,17 +131,26 @@       if configExists then do         (vlib2, s) <- strictDecodeEOF (path "")         if Save.compatibleVersion vlib2 Self.version-        then return $ Just s+        then return $! s `seq` Just s         else do-          let msg = "High score file from old version of game detected."+          let msg =+                "High score file from incompatible version of game detected."           fail msg       else return Nothing-    let handler :: Ex.SomeException -> m (Maybe a)+    savePrefix <- getsServer $ ssavePrefixSer . soptions+    let defPrefix = ssavePrefixSer defServerOptions+        moveAside = savePrefix == defPrefix+        handler :: Ex.SomeException -> m (Maybe a)         handler e = do-          let msg = "High score restore failed. The old file moved aside. The error message is:"+          when moveAside $+            liftIO $ renameFile (path "") (path "bkp.")+          let msg = "High score restore failed."+                    <+> (if moveAside+                        then "The wrong file moved aside."+                        else "")+                    <+> "The error message is:"                     <+> (T.unwords . T.lines) (tshow e)           serverPrint msg-          liftIO $ renameFile (path "") (path "bkp.")           return Nothing     either handler return res   maybe (return HighScore.empty) return mscore@@ -204,7 +213,7 @@  -- | Gets a random generator from the user-submitted options or, if not present, -- generates one.-getSetGen :: MonadServer m => Maybe R.StdGen -> m R.StdGen+getSetGen :: MonadServer m => Maybe SM.SMGen -> m SM.SMGen getSetGen mrng = case mrng of   Just rnd -> return rnd-  Nothing -> liftIO R.newStdGen+  Nothing -> liftIO SM.newSMGen

engine-src/Game/LambdaHack/Server/PeriodicM.hs view

@@ -4,9 +4,10 @@   ( spawnMonster, addAnyActor   , advanceTime, advanceTimeTraj, overheadActorTime, swapTime   , updateCalm, leadLevelSwitch+  , endOrLoop #ifdef EXPOSE_INTERNAL     -- * Internal operations-  , rollSpawnPos+  , rollSpawnPos, gameExit #endif   ) where @@ -17,7 +18,7 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import           Data.Int (Int64)-import           Data.Ord+import qualified Data.Text as T  import           Game.LambdaHack.Atomic import           Game.LambdaHack.Common.Actor@@ -45,7 +46,10 @@ import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Server.CommonM import           Game.LambdaHack.Server.ItemM+import           Game.LambdaHack.Server.ItemRev import           Game.LambdaHack.Server.MonadServer+import           Game.LambdaHack.Server.ProtocolM+import           Game.LambdaHack.Server.ServerOptions import           Game.LambdaHack.Server.State  -- | Spawn, possibly, a monster according to the level's actor groups.@@ -56,7 +60,7 @@   arenas <- getsServer sarenas   -- Do this on only one of the arenas to prevent micromanagement,   -- e.g., spreading leaders across levels to bump monster generation.-  arena <- rndToAction $ oneOf arenas+  arena <- rndToAction $ oneOf $ ES.elems arenas   Level{lkind, ldepth, lbig} <- getLevel arena   let ck = okind cocave lkind   if | CK.cactorCoeff ck == 0 || null (CK.cactorFreq ck) -> return ()@@ -95,10 +99,12 @@   freq <- prepareItemKind lvlSpawned lid actorFreq   m2 <- rollItemAspect freq lid   case m2 of-    Nothing -> do-      debugPossiblyPrint "Server: addAnyActor: trunk failed to roll"+    NoNewItem -> do+      debugPossiblyPrint $ T.pack $+        "Server: addAnyActor: trunk failed to roll"+        `showFailure` (summoned, lvlSpawned, actorFreq, freq, lid, time, mpos)       return Nothing-    Just (itemKnownRaw, (itemFullRaw, kit)) -> do+    NewItem itemKnownRaw itemFullRaw itemQuant -> do       (fid, _) <- rndToAction $ oneOf $                     possibleActorFactions (itemKind itemFullRaw) factionD       pers <- getsServer sperFid@@ -107,8 +113,8 @@           -- Checking skill would be more accurate, but skills can be           -- inside organs, equipment, condition organs, created organs, etc.           freqNames = map fst $ IK.ifreq $ itemKind itemFullRaw-          mobile = "mobile" `elem` freqNames-          aquatic = "aquatic" `elem` freqNames+          mobile = IK.MOBILE `elem` freqNames+          aquatic = IK.AQUATIC `elem` freqNames       mrolledPos <- case mpos of         Just{} -> return mpos         Nothing -> do@@ -117,7 +123,7 @@           rndToAction rollPos       case mrolledPos of         Just pos ->-          Just <$> registerActor summoned itemKnownRaw (itemFullRaw, kit)+          Just <$> registerActor summoned itemKnownRaw (itemFullRaw, itemQuant)                                  fid pos lid time         Nothing -> do           debugPossiblyPrint@@ -230,9 +236,11 @@   slvl <- getsState $ getLocalTime (blid sb)   tlvl <- getsState $ getLocalTime (blid tb)   btime_sb <--    getsServer $ (EM.! source) . (EM.! blid sb) . (EM.! bfid sb) . sactorTime+    getsServer+    $ fromJust . lookupActorTime (bfid sb) (blid sb) source . sactorTime   btime_tb <--    getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime+    getsServer+    $ fromJust . lookupActorTime (bfid tb) (blid tb) target . sactorTime   let lvlDelta = slvl `timeDeltaToFrom` tlvl       bDelta = btime_sb `timeDeltaToFrom` btime_tb       sdelta = timeDeltaSubtract lvlDelta bDelta@@ -248,9 +256,11 @@                        `blame` ( slvl, tlvl, btime_sb, btime_tb                                , sdelta, sdelta', tdelta, tdelta' )) ()   when (sdelta /= Delta timeZero) $ modifyServer $ \ser ->-    ser {sactorTime = ageActor (bfid sb) (blid sb) source sdelta $ sactorTime ser}+    ser {sactorTime = ageActor (bfid sb) (blid sb) source sdelta+                      $ sactorTime ser}   when (tdelta /= Delta timeZero) $ modifyServer $ \ser ->-    ser {sactorTime = ageActor (bfid tb) (blid tb) target tdelta $ sactorTime ser}+    ser {sactorTime = ageActor (bfid tb) (blid tb) target tdelta+                      $ sactorTime ser}  updateCalm :: MonadServerAtomic m => ActorId -> Int64 -> m () updateCalm target deltaCalm = do@@ -271,6 +281,7 @@ leadLevelSwitch :: MonadServerAtomic m => m () leadLevelSwitch = do   COps{cocave} <- getsState scops+  factionD <- getsState sfactionD   let canSwitch fact = fst (autoDungeonLevel fact)                        -- a hack to help AI, until AI client can switch levels                        || case fleaderMode (gplayer fact) of@@ -286,7 +297,7 @@             let !_A = assert (fid == bfid body) ()             s <- getsServer $ (EM.! fid) . sclientStates             let leaderStuck = actorWaits body-                oursRaw =+                lvlsRaw =                   [ ((lid, lvl), (allSeen, as))                   | (lid, lvl) <- EM.assocs $ sdungeon s                   , lid /= blid body || not leaderStuck@@ -305,7 +316,7 @@                           || CK.cactorCoeff (okind cocave $ lkind lvl) > 150                              && not (fhasGender $ gplayer fact)                   ]-                (oursSeen, oursNotSeen) = partition (fst . snd) oursRaw+                (lvlsSeen, lvlsNotSeen) = partition (fst . snd) lvlsRaw                 -- Monster AI changes leadership mostly to move from level                 -- to level and, in particular, to quickly bring troops                 -- to the frontline level and so prevent human from killing@@ -319,8 +330,8 @@                 -- and sometimes the level with the boss is counted among                 -- them, but it never happens in the crucial periods when                 -- AI armies are transferred from level to level.-                f ((lid, _), _) = abs $ fromEnum lid-                ours = oursSeen ++ take 2 (sortBy (comparing f) oursNotSeen)+                f ((_, lvl), _) = ldepth lvl+                lvls = lvlsSeen ++ take 2 (sortBy (comparing f) lvlsNotSeen)             -- Actors on desolate levels (not many own or enemy non-projectiles)             -- tend to become (or stay) leaders so that they can join the main             -- force where it matters ASAP. Unfortunately, this keeps hero@@ -328,14 +339,94 @@             -- so they give back leadership rather quickly to let others follow.             -- We count non-mobile and sleeping actors, because they may             -- be dangerous, especially if adjacent to stairs.-            let freqList = [ (k, (lid, aid))-                           | ((lid, lvl), (_, (aid, _) : _)) <- ours+            let overOwnStash b = Just (blid b, bpos b) == gstash fact+                freqList = [ (k, (lid, aid))+                           | ((lid, lvl), (_, (aid, b) : rest)) <- lvls                            , let len = min 20 (EM.size $ lbig lvl)-                                 k = 1000000 `div` (1 + len) ]-            unless (null freqList) $ do+                                 n = 1000000 `div` (1 + len)+                                 -- Visit the stash guard rarely, but not too+                                 -- rarely, to regen Calm and fling at foes.+                                 k = max 1 $ if null rest && overOwnStash b+                                             then n `div` 30+                                             else n+                           ]+                closeToFactStash (fid2, fact2) = case gstash fact2 of+                  Just (lid, pos) ->+                    (fid == fid2 || isFoe fid (factionD EM.! fid) fid2)+                    && lid == blid body+                    && chessDist pos (bpos body) == 1  -- visible+                  Nothing -> False+                closeToEnemyStash = any closeToFactStash $ EM.assocs factionD+            foes <- getsState $ foeRegularList fid (blid body)+            ours <- getsState $ map snd+                                <$> fidActorRegularAssocs fid (blid body)+            let foesClose = filter (\b -> chessDist (bpos body) (bpos b) <= 2)+                                   foes+                oursCloseMelee =+                  filter (\b -> chessDist (bpos body) (bpos b) <= 2+                                && bweapon b - bweapBenign b > 0)+                         ours+                canHelpMelee =+                  not leaderStuck+                  && length oursCloseMelee >= 2+                  && length foesClose >= 1+                  && not (all (\b -> any (adjacent (bpos b) . bpos) foes)+                              oursCloseMelee)+            unless (closeToEnemyStash || canHelpMelee || null freqList) $ do               (lid, a) <- rndToAction $ frequency                                       $ toFreq "leadLevel" freqList               unless (lid == blid body) $  -- flip levels rather than actors                 setFreshLeader fid a-  factionD <- getsState sfactionD   mapM_ flipFaction $ EM.assocs factionD++-- | Continue or exit or restart the game.+endOrLoop :: (MonadServerAtomic m, MonadServerComm m)+          => m () -> (Maybe (GroupName ModeKind) -> m ())+          -> m ()+{-# INLINE endOrLoop #-}+endOrLoop loop restart = do+  factionD <- getsState sfactionD+  let inGame fact = case gquit fact of+        Nothing -> True+        Just Status{stOutcome=Camping} -> True+        _ -> False+      gameOver = not $ any inGame $ EM.elems factionD+  let getQuitter fact = case gquit fact of+        Just Status{stOutcome=Restart, stNewGame} -> stNewGame+        _ -> Nothing+      quitters = mapMaybe getQuitter $ EM.elems factionD+      restartNeeded = gameOver || not (null quitters)+  let isCamper fact = case gquit fact of+        Just Status{stOutcome=Camping} -> True+        _ -> False+      campers = filter (isCamper . snd) $ EM.assocs factionD+  -- Wipe out the quit flag for the savegame files.+  mapM_ (\(fid, fact) ->+    execUpdAtomic $ UpdQuitFaction fid (gquit fact) Nothing Nothing) campers+  swriteSave <- getsServer swriteSave+  sstopAfterGameOver <-+    getsServer $ sstopAfterGameOver . soptions+  when swriteSave $ do+    modifyServer $ \ser -> ser {swriteSave = False}+    writeSaveAll True False+  if | gameOver && sstopAfterGameOver -> gameExit+     | restartNeeded -> restart (listToMaybe quitters)+     | not $ null campers -> gameExit  -- and @loop@ is not called+     | otherwise -> loop  -- continue current game++gameExit :: (MonadServerAtomic m, MonadServerComm m) => m ()+gameExit = do+--  debugPossiblyPrint "Server: Verifying all perceptions."+  -- Verify that the possibly not saved caches are equal to future+  -- reconstructed. Otherwise, save/restore would change game state.+  -- This is done even in released binaries, because it only prolongs+  -- game shutdown a bit. The same checks at each periodic game save+  -- would icrease the game saving lag, so they are normally avoided.+  verifyCaches+  -- Kill all clients, including those that did not take part+  -- in the current game.+  -- Clients exit not now, but after they print all ending screens.+--  debugPossiblyPrint "Server: Killing all clients."+  killAllClients+--  debugPossiblyPrint "Server: All clients killed."+  return ()

engine-src/Game/LambdaHack/Server/ProtocolM.hs view

@@ -31,8 +31,8 @@ import           System.IO.Unsafe (unsafePerformIO)  import           Game.LambdaHack.Atomic-import           Game.LambdaHack.Client (RequestAI, RequestUI, Response (..),-                                         sbenchmark)+import           Game.LambdaHack.Client (RequestAI, RequestUI, Response (..))+import           Game.LambdaHack.Common.ClientOptions (sbenchmark) import           Game.LambdaHack.Common.Faction import           Game.LambdaHack.Common.File import           Game.LambdaHack.Common.Kind@@ -192,7 +192,11 @@       addConn :: FactionId -> Faction -> IO ChanServer       addConn fid fact = case EM.lookup fid oldD of         Just conns -> return conns  -- share old conns and threads-        Nothing -> mkChanServer fact+        Nothing | fromEnum fid < 0 -> mkChanServer fact+        Nothing -> case filter (\(fidOld, _) -> fromEnum fidOld > 0)+                        $ EM.assocs oldD of+          [] -> mkChanServer fact+          (_, conns) : _ -> return conns  -- re-use session to keep history   factionD <- getsState sfactionD   d <- liftIO $ mapWithKeyM addConn factionD   let newD = d `EM.union` oldD  -- never kill old clients@@ -205,25 +209,24 @@         forkChild childrenServer $ executorClient False fid connS       forkClient fid conn@ChanServer{requestUIS=Nothing} =         -- When a connection is reused, clients are not respawned,-        -- even if UI usage changes, but it works OK thanks to UI faction-        -- clients distinguished by positive FactionId numbers.+        -- even if UI status of a faction changes, but it works OK thanks to+        -- UI faction clients distinguished by positive FactionId numbers.         forkAI fid conn-      forkClient fid conn =+      forkClient fid conn = when (EM.null oldD) $         forkUI fid conn   liftIO $ mapWithKeyM_ forkClient toSpawn  tryRestore :: MonadServerComm m => m (Maybe (State, StateServer)) tryRestore = do-  cops@COps{corule} <- getsState scops+  COps{corule} <- getsState scops   soptions <- getsServer soptions-  let bench = sbenchmark $ sclientOptions soptions-  if bench then return Nothing+  if sbenchmark $ sclientOptions soptions then return Nothing   else do     let prefix = ssavePrefixSer soptions-        fileName = prefix <> Save.saveNameSer cops-    res <- liftIO $ Save.restoreGame cops fileName+        fileName = prefix <> Save.saveNameSer corule+    res <- liftIO $ Save.restoreGame corule (sclientOptions soptions) fileName     let cfgUIName = rcfgUIName corule-        content = rcfgUIDefault corule+        (configString, _) = rcfgUIDefault corule     dataDir <- liftIO appDataDir-    liftIO $ tryWriteFile (dataDir </> cfgUIName) content+    liftIO $ tryWriteFile (dataDir </> cfgUIName) configString     return $! res

engine-src/Game/LambdaHack/Server/ServerOptions.hs view

@@ -8,41 +8,43 @@ import Game.LambdaHack.Core.Prelude  import           Data.Binary-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM -import Game.LambdaHack.Client (ClientOptions (..), defClientOptions)-import Game.LambdaHack.Definition.Defs+import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Content.ModeKind+import Game.LambdaHack.Definition.Defs  -- | Options that affect the behaviour of the server (including game rules). data ServerOptions = ServerOptions-  { sknowMap         :: Bool-  , sknowEvents      :: Bool-  , sknowItems       :: Bool-  , sniff            :: Bool-  , sallClear        :: Bool-  , sboostRandomItem :: Bool-  , sgameMode        :: Maybe (GroupName ModeKind)-  , sautomateAll     :: Bool-  , skeepAutomated   :: Bool-  , sdungeonRng      :: Maybe R.StdGen-  , smainRng         :: Maybe R.StdGen-  , snewGameSer      :: Bool-  , scurChalSer      :: Challenge-  , sdumpInitRngs    :: Bool-  , ssavePrefixSer   :: String-  , sdbgMsgSer       :: Bool-  , sshowItemSamples :: Bool-  , sclientOptions   :: ClientOptions+  { sknowMap           :: Bool+  , sknowEvents        :: Bool+  , sknowItems         :: Bool+  , sniff              :: Bool+  , sallClear          :: Bool+  , sboostRandomItem   :: Bool+  , sgameMode          :: Maybe (GroupName ModeKind)+  , sautomateAll       :: Bool+  , skeepAutomated     :: Bool+  , sdungeonRng        :: Maybe SM.SMGen+  , smainRng           :: Maybe SM.SMGen+  , snewGameSer        :: Bool+  , scurChalSer        :: Challenge+  , sdumpInitRngs      :: Bool+  , ssavePrefixSer     :: String+  , sdbgMsgSer         :: Bool+  , sassertExplored    :: Maybe Int+  , sshowItemSamples   :: Bool+  , sstopAfterGameOver :: Bool+  , sclientOptions     :: ClientOptions       -- The client debug inside server debug only holds the client commandline       -- options and is never updated with config options, etc.   }   deriving Show  data RNGs = RNGs-  { dungeonRandomGenerator  :: Maybe R.StdGen-  , startingRandomGenerator :: Maybe R.StdGen+  { dungeonRandomGenerator  :: Maybe SM.SMGen+  , startingRandomGenerator :: Maybe SM.SMGen   }  instance Show RNGs where@@ -67,6 +69,7 @@     put scurChalSer     put ssavePrefixSer     put sdbgMsgSer+    put sassertExplored     put sshowItemSamples     put sclientOptions   get = do@@ -82,12 +85,14 @@     scurChalSer <- get     ssavePrefixSer <- get     sdbgMsgSer <- get+    sassertExplored <- get     sshowItemSamples <- get     sclientOptions <- get     let sdungeonRng = Nothing         smainRng = Nothing         snewGameSer = False         sdumpInitRngs = False+        sstopAfterGameOver = False     return $! ServerOptions{..}  instance Binary RNGs where@@ -120,6 +125,8 @@   , sdumpInitRngs = False   , ssavePrefixSer = ""   , sdbgMsgSer = False+  , sassertExplored = Nothing   , sshowItemSamples = False+  , sstopAfterGameOver = False   , sclientOptions = defClientOptions   }

engine-src/Game/LambdaHack/Server/StartM.hs view

@@ -18,12 +18,11 @@ import qualified Data.IntMap.Strict as IM import           Data.Key (mapWithKeyM_) import qualified Data.Map.Strict as M-import           Data.Ord import qualified Data.Set as S import qualified Data.Text as T import           Data.Tuple (swap) import qualified NLP.Miniutter.English as MU-import qualified System.Random as R+import qualified System.Random.SplitMix32 as SM  import           Game.LambdaHack.Atomic import           Game.LambdaHack.Common.ActorState@@ -41,10 +40,12 @@ import           Game.LambdaHack.Common.Time import           Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.CaveKind as CK+import           Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import           Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Core.Dice as Dice import           Game.LambdaHack.Core.Random+import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import           Game.LambdaHack.Definition.Defs import           Game.LambdaHack.Definition.Flavour@@ -77,22 +78,43 @@   s <- getState   discoS <- getsState sdiscoKind   -- Thanks to the following, for any item with not hidden identity,-  -- the client has its kind from the start.+  -- the client has its kind from the start. The client needs to know this+  -- to have a fast way (faster that looking for @PresentAs@ flag on a list)+  -- of determining whether an item kind is already identified+  -- or needs identification.   let discoKindFiltered =-        let f kindId = isNothing $ IK.getMandatoryHideAsFromKind+        let f kindId = isNothing $ IK.getMandatoryPresentAsFromKind                                  $ okind coitem kindId         in EM.filter f discoS       defL | sknowMap = s            | otherwise = localFromGlobal s       defLocal = updateDiscoKind (const discoKindFiltered) defL   factionD <- getsState sfactionD-  modifyServer $ \ser -> ser {sclientStates = EM.map (const defLocal) factionD}-  let updRestart fid = UpdRestart fid (pers EM.! fid) defLocal+  clientStatesOld <- getsServer sclientStates+  -- Some item kinds preserve their identity and flavour throughout+  -- the whole metagame, until the savefiles is removed.+  -- These are usually not man-made items, because these can be made+  -- in many flavours so it may be hard to recognize them.+  -- However, the exact properties of even natural items may vary,+  -- so the random aspects of items, stored in @sdiscoAspect@+  -- are not preserved (a lot of other state components would need+  -- to be partially preserved, too, both on server and clients).+  let includeMetaGame fid = case fid `EM.lookup` clientStatesOld of+        Nothing -> defLocal+        Just sOld ->+          let disco = sdiscoKind sOld+              inMetaGame kindId = IK.SetFlag Ability.MetaGame+                                  `elem` IK.iaspects (okind coitem kindId)+              discoMetaGame = EM.filter inMetaGame disco+          in updateDiscoKind (discoMetaGame `EM.union`) defLocal+      clientStatesNew = EM.mapWithKey (\fid _ -> includeMetaGame fid) factionD+  modifyServer $ \ser -> ser {sclientStates = clientStatesNew}+  let updRestart fid = UpdRestart fid (pers EM.! fid) (clientStatesNew EM.! fid)                                   scurChalSer sclientOptions   mapWithKeyM_ (\fid _ -> do     -- Different seed for each client, to make sure behaviour is varied.     gen1 <- getsServer srandom-    let (clientRandomSeed, gen2) = R.split gen1+    let (clientRandomSeed, gen2) = SM.splitSMGen gen1     modifyServer $ \ser -> ser {srandom = gen2}     execUpdAtomic $ updRestart fid clientRandomSeed) factionD   dungeon <- getsState sdungeon@@ -139,15 +161,15 @@                 jfid = Just fid             m2 <- rollItemAspect freq minLid             case m2 of-              Nothing -> error "sampleTrunks: can't create actor trunk"-              Just (ItemKnown kindIx ar _, (itemFullRaw, kit)) -> do+              NoNewItem -> error "sampleTrunks: can't create actor trunk"+              NewItem (ItemKnown kindIx ar _) itemFullRaw itemQuant -> do                 let itemKnown = ItemKnown kindIx ar jfid                     itemFull =                       itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}}-                Just <$> registerItem (itemFull, kit) itemKnown c False+                Just <$> registerItem False (itemFull, itemQuant) itemKnown c   miids <- mapM regItem trunkKindIds   return $! EM.singleton STrunk-            $ EM.fromAscList $ zip (catMaybes miids) $ repeat 0+            $ EM.fromDistinctAscList $ zip (catMaybes miids) $ repeat 0  -- For simplicity, only actors generated on the ground are taken into account. -- not starting items of any actors nor items that can be create by effects@@ -168,12 +190,12 @@             c = CFloor minLid originPoint         m2 <- rollItemAspect freq minLid         case m2 of-          Nothing -> error "sampleItems: can't create sample item"-          Just (itemKnown, (itemFull, _kit)) ->-            Just <$> registerItem (itemFull, (0, [])) itemKnown c False+          NoNewItem -> error "sampleItems: can't create sample item"+          NewItem itemKnown itemFull _ ->+            Just <$> registerItem False (itemFull, (0, [])) itemKnown c   miids <- mapM regItem itemKindIds   return $! EM.singleton SItem-            $ EM.fromAscList $ zip (catMaybes miids) $ repeat 0+            $ EM.fromDistinctAscList $ zip (catMaybes miids) $ repeat 0  mapFromFuns :: Ord b => [a] -> [a -> b] -> M.Map b a mapFromFuns domain =@@ -187,7 +209,7 @@               -> Roster               -> Rnd FactionDict resetFactions factionDold gameModeIdOld curDiffSerOld totalDepth players = do-  let rawCreate (gplayer@Player{..}, initialActors) = do+  let rawCreate (ixRaw, (gplayer@Player{..}, gteamCont, initialActors)) = do         let castInitialActors (ln, d, actorGroup) = do               n <- castDice (Dice.AbsDepth $ abs ln) totalDepth d               return (ln, n, actorGroup)@@ -217,16 +239,14 @@             _gleader = Nothing             gvictims = EM.empty             gvictimsD = gvictimsDnew-            gsha = EM.empty-        return $! Faction{..}-  lUI <- mapM rawCreate $ filter (fhasUI . fst) $ rosterList players-  let !_A = assert (length lUI <= 1-                    `blame` "currently, at most one faction may have a UI"-                    `swith` lUI) ()-  lnoUI <- mapM rawCreate $ filter (not . fhasUI . fst) $ rosterList players-  let lFs = reverse (zip [toEnum (-1), toEnum (-2)..] lnoUI)  -- sorted-            ++ zip [toEnum 1..] lUI-      swapIx l =+            gstash = Nothing+            ix = case gteamCont of+              Just (TeamContinuity k) -> k+              _ -> ixRaw+        return (toEnum $ if fhasUI then ix else -ix, Faction{..})+  -- We assume @TeamContinuity@ are small integers.+  lFs <- mapM rawCreate $ zip [100..] $ rosterList players+  let swapIx l =         let findPlayerName name = find ((name ==) . fname . gplayer . snd)             f (name1, name2) =               case (findPlayerName name1 lFs, findPlayerName name2 lFs) of@@ -242,7 +262,7 @@               let adj fact = fact {gdipl = EM.insert ix2 diplMode (gdipl fact)}               in EM.adjust adj ix1         in foldr f-      rawFs = EM.fromDistinctAscList lFs+      rawFs = EM.fromList lFs       -- War overrides alliance, so 'warFs' second.       allianceFs = mkDipl Alliance rawFs (swapIx (rosterAlly players))       warFs = mkDipl War allianceFs (swapIx (rosterEnemy players))@@ -250,7 +270,7 @@  gameReset :: MonadServer m           => ServerOptions -> Maybe (GroupName ModeKind)-          -> Maybe R.StdGen -> m State+          -> Maybe SM.SMGen -> m State gameReset serverOptions mGameMode mrandom = do   -- Dungeon seed generation has to come first, to ensure item boosting   -- is determined by the dungeon RNG.@@ -262,9 +282,12 @@   scoreTable <- restoreScore cops   factionDold <- getsState sfactionD   gameModeIdOld <- getsState sgameModeId+  teamGearOld <- getsServer steamGear+  flavourOld <- getsServer sflavour+  discoKindRevOld <- getsServer sdiscoKindRev+  clientStatesOld <- getsServer sclientStates   curChalSer <- getsServer $ scurChalSer . soptions-  let startingModeGroup = "insert coin"-      gameMode = fromMaybe startingModeGroup+  let gameMode = fromMaybe INSERT_COIN                  $ mGameMode `mplus` sgameMode serverOptions       rnd :: Rnd (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,                   DungeonGen.FreshDungeon, ContentId ModeKind)@@ -274,18 +297,19 @@           <$> opick comode gameMode (const True)         let mode = okind comode modeKindId             automatePS ps = ps {rosterList =-              map (first $ automatePlayer True) $ rosterList ps}+              map (\(pl, tc, l) -> (automatePlayer True pl, tc, l))+                  (rosterList ps)}             players = if sautomateAll serverOptions                       then automatePS $ mroster mode                       else mroster mode-        sflavour <- dungeonFlavourMap cops-        (discoKind, sdiscoKindRev) <- serverDiscos cops+        flavour <- dungeonFlavourMap cops flavourOld+        (discoKind, sdiscoKindRev) <- serverDiscos cops discoKindRevOld         freshDng <- DungeonGen.dungeonGen cops serverOptions $ mcaves mode         factionD <- resetFactions factionDold gameModeIdOld                                   (cdiff curChalSer)                                   (DungeonGen.freshTotalDepth freshDng)                                   players-        return ( factionD, sflavour, discoKind+        return ( factionD, flavour, discoKind                , sdiscoKindRev, freshDng, modeKindId )   let ( factionD, sflavour, discoKind        ,sdiscoKindRev, DungeonGen.FreshDungeon{..}, modeKindId ) =@@ -295,99 +319,91 @@       defSer = emptyStateServer { srandom                                 , srngs }   putServer defSer-  modifyServer $ \ser -> ser {sdiscoKindRev, sflavour}+  modifyServer $ \ser -> ser { steamGear = teamGearOld+                             , steamGearCur = teamGearOld+                             , sclientStates = clientStatesOld  -- reset later+                             , sdiscoKindRev+                             , sflavour }   return $! defState  -- Spawn initial actors. Clients should notice this, to set their leaders.-populateDungeon :: MonadServerAtomic m => m ()+populateDungeon :: forall m. MonadServerAtomic m => m () populateDungeon = do   cops@COps{coTileSpeedup} <- getsState scops-  dungeon <- getsState sdungeon   factionD <- getsState sfactionD   curChalSer <- getsServer $ scurChalSer . soptions-  let ginitialWolf fact1 = if cwolf curChalSer && fhasUI (gplayer fact1)-                           then case ginitial fact1 of+  let nGt0 (_, n, _) = n > 0+      ginitialWolf fact1 = if cwolf curChalSer && fhasUI (gplayer fact1)+                           then case filter nGt0 $ ginitial fact1 of                              [] -> []                              (ln, _, grp) : _ -> [(ln, 1, grp)]                            else ginitial fact1-      (minD, maxD) = dungeonBounds dungeon-      -- Players that escape go first to be started over stairs, if possible.-      valuePlayer pl = (not $ fcanEscape pl, fname pl)-      -- Sorting, to keep games from similar game modes mutually reproducible.-      needInitialCrew = sortOn (valuePlayer . gplayer . snd)+      -- Keep the same order of factions as in roster.+      needInitialCrew = sortBy (comparing $ abs . fromEnum . fst)                         $ filter (not . null . ginitialWolf . snd)                         $ EM.assocs factionD-      boundLid (ln, _, _) = max minD . min maxD . toEnum $ ln-      getEntryLevels (_, fact) = map boundLid $ ginitialWolf fact-      arenas = ES.toList $ ES.fromList-               $ concatMap getEntryLevels needInitialCrew+      getEntryLevels (_, fact) =+        map (\(ln, _, _) -> toEnum ln) $ ginitialWolf fact+      arenas = ES.elems $ ES.fromList $ concatMap getEntryLevels needInitialCrew       hasActorsOnArena lid (_, fact) =-        any ((== lid) . boundLid) $ ginitialWolf fact+        any (\(ln, _, _) -> toEnum ln == lid) $ ginitialWolf fact+      initialActorPositions :: LevelId+                            -> m (LevelId, EM.EnumMap FactionId Point)       initialActorPositions lid = do         lvl <- getLevel lid-        let arenaFactions = filter (hasActorsOnArena lid) needInitialCrew-            indexff (fid, _) = findIndex ((== fid) . fst) arenaFactions-            representsAlliance ff2@(fid2, fact2) =-              not $ any (\ff3@(fid3, _) ->-                           indexff ff3 < indexff ff2-                           && isFriend fid2 fact2 fid3) arenaFactions-            arenaAlliances = filter representsAlliance arenaFactions-        entryPoss <- rndToAction-                     $ findEntryPoss cops lid lvl (length arenaAlliances)-        when (length entryPoss < length arenaAlliances) $-          debugPossiblyPrint-            "Server: populateDungeon: failed to find enough alliance positions"-        let usedPoss = zip arenaAlliances entryPoss-        return $! (lid, usedPoss)-      initialActors (lid, usedPoss) = do-        let arenaFactions = filter (hasActorsOnArena lid) needInitialCrew-            placeAlliance ((fid3, _), ppos) =-              mapM_ (\(fid4, fact4) ->-                      when (isFriend fid4 fact4 fid3) $-                        placeActors lid ((fid4, fact4), ppos))-                    arenaFactions-        mapM_ placeAlliance usedPoss-      placeActors lid ((fid3, fact3), ppos) = do+        let arenaFactions =+              map fst $ filter (hasActorsOnArena lid) needInitialCrew+        entryPoss <- rndToAction $ findEntryPoss cops lvl (length arenaFactions)+        when (length entryPoss < length arenaFactions) $ debugPossiblyPrint+          "Server: populateDungeon: failed to find enough distinct faction starting positions; some factions share positions"+        let usedPoss = EM.fromList $ zip arenaFactions $ cycle entryPoss+        return (lid, usedPoss)+  factionPositions <- EM.fromDistinctAscList+                      <$> mapM initialActorPositions arenas+  let initialActors :: (FactionId, Faction) -> m ()+      initialActors (fid3, fact3) =+        mapM_ (placeActors fid3) $ ginitialWolf fact3+      placeActors :: FactionId -> (Int, Int, GroupName ItemKind) -> m ()+      placeActors fid3 (ln, n, actorGroup) = do+        let lid = toEnum ln         lvl <- getLevel lid-        let validTile t = not $ Tile.isNoActor coTileSpeedup t-            initActors = ginitialWolf fact3-            initGroups = concat [ replicate n actorGroup-                                | ln3@(_, n, actorGroup) <- initActors-                                , boundLid ln3 == lid ]+        let ppos = factionPositions EM.! lid EM.! fid3+            validTile t = not $ Tile.isNoActor coTileSpeedup t+            -- This takes into account already spawned actors of this+            -- and other factions. If not enough space, some are skipped.             psFree = nearbyFreePoints cops lvl validTile ppos-        when (length psFree < length initGroups) $-          debugPossiblyPrint-            "Server: populateDungeon: failed to find enough actor positions"-        let ps = zip initGroups psFree+            ps = take n psFree+        when (length ps < n) $ debugPossiblyPrint+          "Server: populateDungeon: failed to find enough initial actor positions; some actors are not generated"         localTime <- getsState $ getLocalTime lid-        forM_ ps $ \ (actorGroup, p) -> do-          rndDelay <- rndToAction $ randomR (0, clipsInTurn - 1)+        forM_ ps $ \p -> do+          rndDelay <- rndToAction $ randomR (1, clipsInTurn - 1)           let delta = timeDeltaScale (Delta timeClip) rndDelay               rndTime = timeShift localTime delta           maid <- addActorFromGroup actorGroup fid3 p lid rndTime           case maid of             Nothing -> error $ "can't spawn initial actors"-                               `showFailure` (lid, (fid3, fact3))+                               `showFailure` (lid, fid3)             Just aid -> do               mleader <- getsState $ gleader . (EM.! fid3) . sfactionD               -- Sleeping actor may become a leader, but it's quickly corrected.               when (isNothing mleader) $ setFreshLeader fid3 aid-              return True-  lposs <- mapM initialActorPositions arenas-  let alliancePositions = EM.fromList $ map (second $ map snd) lposs-  placeItemsInDungeon alliancePositions+  placeItemsInDungeon factionPositions   embedItemsInDungeon-  mapM_ initialActors lposs+  mapM_ initialActors needInitialCrew  -- | Find starting postions for all factions. Try to make them distant -- from each other. Place as many of the factions, as possible,--- over stairs, starting from the end of the list, including placing the last--- factions over escapes (we assume they are guardians of the escapes).+-- over stairs. Place the last faction(s) over escape(s)+-- (we assume they are guardians of the escapes). -- This implies the inital factions (if any) start far from escapes.-findEntryPoss :: COps -> LevelId -> Level -> Int -> Rnd [Point]-findEntryPoss COps{coTileSpeedup}-              lid lvl@Level{larea, lstair, lescape} k = do-  let (_, xspan, yspan) = spanArea larea+findEntryPoss :: COps -> Level -> Int -> Rnd [Point]+findEntryPoss COps{cocave, coTileSpeedup}+              lvl@Level{lkind, larea, lstair, lescape}+              kRaw = do+  let lskip = CK.cskip $ okind cocave lkind+      k = kRaw + length lskip  -- is @lskip@ is bogus, will be too large; OK+      (_, xspan, yspan) = spanArea larea       factionDist = max xspan yspan - 10       dist !poss !cmin !l _ = all (\ !pos -> chessDist l pos > cmin) poss       tryFind _ 0 = return []@@ -410,16 +426,21 @@             nps <- tryFind (np : ps) (n - 1)             return $! np : nps           Nothing -> return []-      -- Only consider deeper stairs to avoid leaderless spawners that stay near-      -- their starting stairs ambushing explorers that enter the level,-      -- unless the staircase has both sets of stairs.-      deeperStairs = (if fromEnum lid > 0 then fst else snd) lstair+      sameStaircase :: [Point] -> Point -> Bool+      sameStaircase upStairs Point{..} =+        any (\(Point ux uy) -> uy == py && ux + 2 == px) upStairs+      upAndSomeDownStairs =+        fst lstair+        ++ filter (not . sameStaircase (fst lstair)) (snd lstair)+      skipIndexes ixs l = map snd $ filter (\(ix, _) -> ix `notElem` ixs)+                                  $ zip [0..] l   let !_A = assert (k > 0 && factionDist > 0) ()-      onStairs = reverse $ take k $ lescape ++ deeperStairs-      nk = k - length onStairs+      onEscapes = take k lescape+      onStairs = take (k - length onEscapes) upAndSomeDownStairs+      nk = k - length onEscapes - length onStairs   -- Starting in the middle is too easy.-  found <- tryFind (middlePoint larea : onStairs) nk-  return $! found ++ onStairs+  found <- tryFind (middlePoint larea : onEscapes ++ onStairs) nk+  return $! skipIndexes lskip $ onEscapes ++ onStairs ++ found  -- | Apply options that don't need a new game. applyDebug :: MonadServer m => m ()@@ -430,5 +451,6 @@                                    , sallClear                                    , sdbgMsgSer                                    , snewGameSer+                                   , sassertExplored                                    , sdumpInitRngs                                    , sclientOptions }}

engine-src/Game/LambdaHack/Server/State.hs view

@@ -2,6 +2,9 @@ module Game.LambdaHack.Server.State   ( StateServer(..), ActorTime, ActorPushedBy   , emptyStateServer, updateActorTime, lookupActorTime, ageActor+#ifdef EXPOSE_INTERNAL+  , GearOfTeams+#endif   ) where  import Prelude ()@@ -12,13 +15,17 @@ import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.HashMap.Strict as HM-import qualified System.Random as R+import qualified Data.IntMap.Strict as IM+import qualified System.Random.SplitMix32 as SM  import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types+import Game.LambdaHack.Content.ItemKind (ItemKind)+import Game.LambdaHack.Content.ModeKind (TeamContinuity)+import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.Fov import Game.LambdaHack.Server.ItemRev import Game.LambdaHack.Server.ServerOptions@@ -29,6 +36,14 @@   { sactorTime    :: ActorTime      -- ^ absolute times of actors next actions   , strajTime     :: ActorTime      -- ^ and same for actors with trajectories   , strajPushedBy :: ActorPushedBy  -- ^ culprits for actors with trajectories+  , steamGear     :: GearOfTeams    -- ^ metagame persistent personal+                                    --   characteristics and favourite gear+                                    --   of each numbered continued team member+  , steamGearCur  :: GearOfTeams    -- ^ gear preferences to be taken into+                                    --   account in the current game+  , stcounter     :: EM.EnumMap TeamContinuity Int+                                    -- ^ stores next continued team character+                                    --   identity index number in this game   , sfactionAn    :: FactionAnalytics                                     -- ^ various past events data for factions   , sactorAn      :: ActorAnalytics -- ^ various past events data for actors@@ -54,9 +69,10 @@   , sfovLucidLid  :: FovLucidLid    -- ^ ambient or shining light positions   , sfovClearLid  :: FovClearLid    -- ^ clear tiles positions   , sfovLitLid    :: FovLitLid      -- ^ ambient light positions-  , sarenas       :: [LevelId]      -- ^ active arenas+  , sarenas       :: ES.EnumSet LevelId+                                    -- ^ the set of active arenas   , svalidArenas  :: Bool           -- ^ whether active arenas valid-  , srandom       :: R.StdGen       -- ^ current random generator+  , srandom       :: SM.SMGen       -- ^ current random generator   , srngs         :: RNGs           -- ^ initial random generators   , sbreakLoop    :: Bool           -- ^ exit game loop after clip's end;                                     --   usually no game save follows@@ -74,6 +90,11 @@ -- | Record who last propelled a given actor with trajectory. type ActorPushedBy = EM.EnumMap ActorId ActorId +-- | Per-team, per-actor metagame persistent favourite organs and gear.+type GearOfTeams = EM.EnumMap+                     TeamContinuity+                     (IM.IntMap [(GroupName ItemKind, ContentId ItemKind)])+ -- | Initial, empty game server state. emptyStateServer :: StateServer emptyStateServer =@@ -81,9 +102,13 @@     { sactorTime = EM.empty     , strajTime = EM.empty     , strajPushedBy = EM.empty+    , steamGear = EM.empty+    , steamGearCur = EM.empty+    , stcounter = EM.empty     , sfactionAn = EM.empty     , sactorAn = EM.empty-    , sgenerationAn = EM.fromAscList $ zip [minBound..maxBound] (repeat EM.empty)+    , sgenerationAn = EM.fromDistinctAscList+                      $ zip [minBound..maxBound] (repeat EM.empty)     , sactorStasis = ES.empty     , sdiscoKindRev = emptyDiscoveryKindRev     , suniqueSet = ES.empty@@ -100,9 +125,9 @@     , sfovLucidLid = EM.empty     , sfovClearLid = EM.empty     , sfovLitLid = EM.empty-    , sarenas = []+    , sarenas = ES.empty     , svalidArenas = False-    , srandom = R.mkStdGen 42+    , srandom = SM.mkSMGen 42     , srngs = RNGs { dungeonRandomGenerator = Nothing                    , startingRandomGenerator = Nothing }     , sbreakLoop = False@@ -134,6 +159,9 @@     put sactorTime     put strajTime     put strajPushedBy+    put steamGear+    put steamGearCur+    put stcounter     put sfactionAn     put sactorAn     put sgenerationAn@@ -153,6 +181,9 @@     sactorTime <- get     strajTime <- get     strajPushedBy <- get+    steamGear <- get+    steamGearCur <- get+    stcounter <- get     sfactionAn <- get     sactorAn <- get     sgenerationAn <- get@@ -176,7 +207,7 @@         sfovLucidLid = EM.empty         sfovClearLid = EM.empty         sfovLitLid = EM.empty-        sarenas = []+        sarenas = ES.empty         svalidArenas = False         sbreakLoop = False         sbreakASAP = False

+ test/SessionUIMock.hs view

@@ -0,0 +1,148 @@+module SessionUIMock+  ( unwindMacros, unwindMacrosAcc+  ) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import           Control.Monad.Trans.Class+import           Control.Monad.Trans.State.Lazy+import           Control.Monad.Trans.Writer.Lazy+import           Data.Bifunctor (bimap)+import qualified Data.Map.Strict as M++import qualified Game.LambdaHack.Client.UI.Content.Input as IC+import           Game.LambdaHack.Client.UI.ContentClientUI+import           Game.LambdaHack.Client.UI.FrameM+import           Game.LambdaHack.Client.UI.HandleHumanLocalM+import           Game.LambdaHack.Client.UI.HandleHumanM+import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd+import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.SessionUI+  (KeyMacro (..), KeyMacroFrame (..), emptyMacroFrame)++data SessionUIMock = SessionUIMock+  { smacroFrame :: KeyMacroFrame+  , smacroStack :: [KeyMacroFrame]+  , sccui       :: CCUI+  , unwindTicks :: Int+  }++type KeyMacroBufferMock = Either String String+type KeyPendingMock = String+type KeyLastMock = String++type BufferTrace = [(KeyMacroBufferMock, KeyPendingMock, KeyLastMock)]+type ActionLog = String++data Op = Looped | HeadEmpty++humanCommandMock :: WriterT [(BufferTrace, ActionLog)] (State SessionUIMock) ()+humanCommandMock = do+  abuffs <- lift $ do+    sess <- get+    return $ renderTrace (smacroFrame sess : smacroStack sess)  -- log session+  abortOrCmd <- lift iterationMock -- do stuff+  -- GC macro stack if there are no actions left to handle,+  -- removing all unnecessary macro frames at once,+  -- but leaving the last one for user's in-game macros.+  lift $ modify $ \sess ->+          let (smacroFrameNew, smacroStackMew) =+                dropEmptyMacroFrames (smacroFrame sess) (smacroStack sess)+          in sess { smacroFrame = smacroFrameNew+                  , smacroStack = smacroStackMew }+  case abortOrCmd of+    Left Looped -> tell [(abuffs, "Macro looped")] >> pure ()+    Left HeadEmpty -> tell [(abuffs, "")] >> pure ()  -- exit loop+    Right Nothing -> tell [(abuffs, "")] >> humanCommandMock+    Right (Just out) -> tell [(abuffs, show out)] >> humanCommandMock++iterationMock :: State SessionUIMock (Either Op (Maybe K.KM))+iterationMock = do+  SessionUIMock _ _ CCUI{coinput=IC.InputContent{bcmdMap}} ticks <- get+  if ticks <= 1000+  then do+    modify $ \sess -> sess {unwindTicks = ticks + 1}+    mkm <- promptGetKeyMock+    case mkm of+      Nothing -> return $ Left HeadEmpty  -- macro finished+      Just km -> case km `M.lookup` bcmdMap of+        Just (_, _, cmd) -> Right <$> cmdSemInCxtOfKMMock km cmd+        _ -> return $ Right $ Just km  -- unknown command; fine for tests+  else return $ Left Looped++cmdSemInCxtOfKMMock :: K.KM -> HumanCmd.HumanCmd+                    -> State SessionUIMock (Maybe K.KM)+cmdSemInCxtOfKMMock km cmd = do+  modify $ \sess ->+    sess {smacroFrame = updateKeyLast km cmd $ smacroFrame sess}+  cmdSemanticsMock km cmd++cmdSemanticsMock :: K.KM -> HumanCmd.HumanCmd+                 -> State SessionUIMock (Maybe K.KM)+cmdSemanticsMock km = \case+  HumanCmd.Macro s -> do+    modify $ \sess ->+      let kms = K.mkKM <$> s+          (smacroFrameNew, smacroStackMew) =+             macroHumanTransition kms (smacroFrame sess) (smacroStack sess)+      in sess { smacroFrame = smacroFrameNew+              , smacroStack = smacroStackMew }+    return Nothing+  HumanCmd.Repeat n -> do+    modify $ \sess ->+      let (smacroFrameNew, smacroStackMew) =+             repeatHumanTransition n (smacroFrame sess) (smacroStack sess)+      in sess { smacroFrame = smacroFrameNew+              , smacroStack = smacroStackMew }+    return Nothing+  HumanCmd.RepeatLast n -> do+    modify $ \sess ->+      sess {smacroFrame = repeatLastHumanTransition n (smacroFrame sess) }+    return Nothing+  HumanCmd.Record -> do+    modify $ \sess ->+      sess {smacroFrame = fst $ recordHumanTransition (smacroFrame sess) }+    return Nothing+  _ -> return $ Just km++promptGetKeyMock :: State SessionUIMock (Maybe K.KM)+promptGetKeyMock = do+  SessionUIMock macroFrame _ CCUI{coinput=IC.InputContent{bcmdMap}} _ <- get+  case keyPending macroFrame of+    KeyMacro (km : kms) -> do+        modify $ \sess ->+          sess {smacroFrame = (smacroFrame sess) {keyPending = KeyMacro kms}}+        modify $ \sess ->+          sess {smacroFrame = addToMacro bcmdMap km $ smacroFrame sess}+        return (Just km)+    KeyMacro [] -> return Nothing++unwindMacros :: IC.InputContent -> KeyMacro -> [(BufferTrace, ActionLog)]+unwindMacros coinput keyPending =+  let initSession = SessionUIMock+        { smacroFrame = emptyMacroFrame {keyPending}+        , smacroStack = []+        , sccui = emptyCCUI {coinput}+        , unwindTicks = 0 }+  in evalState (execWriterT humanCommandMock) initSession++accumulateActions :: [(BufferTrace, ActionLog)] -> [(BufferTrace, ActionLog)]+accumulateActions ba =+  let (buffers, actions) = unzip ba+      actionlog = concat <$> inits actions+  in zip buffers actionlog++unwindMacrosAcc :: IC.InputContent -> KeyMacro -> [(BufferTrace, ActionLog)]+unwindMacrosAcc coinput keyPending =+  accumulateActions $ unwindMacros coinput keyPending++renderTrace :: [KeyMacroFrame] -> BufferTrace+renderTrace macroFrames =+  let buffers = bimap (concatMap K.showKM)+                      (concatMap K.showKM . unKeyMacro)+                . keyMacroBuffer <$> macroFrames+      pendingKeys = concatMap K.showKM . unKeyMacro . keyPending <$> macroFrames+      lastKeys = maybe "" K.showKM . keyLast <$> macroFrames+  in zip3 buffers pendingKeys lastKeys

+ test/Spec.hs view

@@ -0,0 +1,324 @@+module Main (main) where++import Prelude ()++import Game.LambdaHack.Core.Prelude++import qualified Data.Map.Strict as M+import qualified Data.Text as T+import           Options.Applicative+import           System.IO.Unsafe (unsafePerformIO)+import           Test.Tasty+import           Test.Tasty.HUnit++import qualified Game.LambdaHack.Client.UI.Content.Input as IC+import           Game.LambdaHack.Client.UI.Frontend.Chosen+import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd+import qualified Game.LambdaHack.Client.UI.Key as K+import           Game.LambdaHack.Client.UI.SessionUI+import           Game.LambdaHack.Client.UI.UIOptions+import           Game.LambdaHack.Client.UI.UIOptionsParse+import           Game.LambdaHack.Common.ClientOptions+import qualified Game.LambdaHack.Content.RuleKind as RK+import           Game.LambdaHack.Server++import qualified Client.UI.Content.Input as Content.Input+import qualified Content.RuleKind+import           TieKnot++import SessionUIMock++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [macroTests, integrationTests]++macroTests :: TestTree+macroTests = testGroup "macroTests" $+  let coinput = IC.makeData Nothing Content.Input.standardKeysAndMouse+      stringToKeyMacro = KeyMacro . map (K.mkKM . (: []))+      listToKeyMacro = KeyMacro . map K.mkKM+      bindInput l input =+        let ltriple = M.fromList $ map (\(k, ks) ->+              (K.mkKM k, ([], "", HumanCmd.Macro $ map (: []) ks))) l+        in input {IC.bcmdMap = M.union ltriple $ IC.bcmdMap input}+  in [ testCase "Macro 1 from PR#192 description" $+         fst <$> unwindMacros coinput (stringToKeyMacro "'j''j'")+         @?= [ [ (Right "",     "'j''j'",  "")  ]+             , [ (Left  "",     "j''j'",   "") ]+             , [ (Left  "j",    "''j'",    "j") ]+             , [ (Right "j",    "'j'",     "j") ]+             , [ (Left  "",     "j'",      "j") ]+             , [ (Left  "j",    "'",       "j") ]+             , [ (Right "j",    "",        "j") ]+             ]+     , testCase "Macro 1 from Issue#189 description" $+         snd (last (unwindMacros (bindInput [ ("a", "'bc'V")+                                            , ("c", "'aaa'V") ] coinput)+                                 (stringToKeyMacro "a")))+         @?= "Macro looped"+     , testCase "Macro 2 from Issue#189 description" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'")] coinput)+                                    (stringToKeyMacro "'a'")))+         @?= "x"+     , testCase "Macro 3 from Issue#189 description" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "'x''x'")))+         @?= "xx"+     , testCase "Macro 4 from Issue#189 description" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "'x''x'V")))+         @?= "xxx"+     , testCase "Macro 5 from Issue#189 description" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "x'x'V")))+         @?= "xxx"+     , testCase "Macro test 10" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "x'y'V")))+         @?= "xyy"+     , testCase "Macro test 11" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "'x''y'V")))+         @?= "xyy"+     , testCase "Macro test 12" $+         snd (last (unwindMacrosAcc coinput+                                    (listToKeyMacro ["x", "C-V"])))+         @?= "x"+     , testCase "Macro test 13" $+         snd (last (unwindMacrosAcc coinput+                                    (listToKeyMacro ["'", "x", "'", "C-V"])))+         @?= "xxxxxxxxxxxxxxxxxxxxxxxxxx"+     , testCase "Macro test 14" $+         snd (last (unwindMacrosAcc coinput+                                    (listToKeyMacro+                                       ["'", "x", "'", "y", "C-V"])))+         @?= "xyxxxxxxxxxxxxxxxxxxxxxxxxx"+     , testCase "Macro test 15" $+         snd (last (unwindMacrosAcc (bindInput [("a", "x")] coinput)+                                    (stringToKeyMacro "'a'V")))+         @?= "xx"+     , testCase "Macro test 16" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'")] coinput)+                                    (stringToKeyMacro "'a'V")))+         @?= "xx"+     , testCase "Macro test 17" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'V")] coinput)+                                    (stringToKeyMacro "a")))+         @?= "xx"+     , testCase "Macro test 18" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'V")] coinput)+                                    (stringToKeyMacro "'a'")))+         @?= "xx"+     , testCase "Macro test 19" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'V")] coinput)+                                    (stringToKeyMacro "'a'V")))+         @?= "xxxx"+     , testCase "Macro test 20" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'bz'V")+                                               , ("c", "'aaa'V") ] coinput)+                                    (stringToKeyMacro "c")))+         @?= "bzbzbzbzbzbzbzbzbzbzbzbz"+     , testCase "RepeatLast test 10" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "x'y'v")))+         @?= "xyy"+     , testCase "RepeatLast test 11" $+         snd (last (unwindMacrosAcc coinput+                                    (stringToKeyMacro "'x'yv")))+         @?= "xyy"+     , testCase "RepeatLast test 12" $+         snd (last (unwindMacrosAcc coinput+                                    (listToKeyMacro ["v", "C-v"])))+         @?= ""+     , testCase "RepeatLast test 13" $+         snd (last (unwindMacrosAcc coinput+                                    (listToKeyMacro ["'", "x", "'", "C-v"])))+         @?= "xxxxxxxxxxxxxxxxxxxxxxxxxx"+     , testCase "RepeatLast test 14" $+         snd (last (unwindMacrosAcc coinput+                                    (listToKeyMacro+                                       ["'", "x", "'", "V", "C-v"])))+         @?= "xxxxxxxxxxxxxxxxxxxxxxxxxxx"+     , testCase "RepeatLast test 15" $+         snd (last (unwindMacrosAcc (bindInput [("a", "x")] coinput)+                                    (stringToKeyMacro "av")))+         @?= "xx"+     , testCase "RepeatLast test 16" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'")] coinput)+                                    (stringToKeyMacro "'a'v")))+         @?= "xx"+     , testCase "RepeatLast test 17" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'v")] coinput)+                                    (stringToKeyMacro "a")))+         @?= "xx"+     , testCase "RepeatLast test 18" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'v")] coinput)+                                    (stringToKeyMacro "'a'")))+         @?= "xx"+     , testCase "RepeatLast test 19" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'v")] coinput)+                                    (stringToKeyMacro "'a'v")))+         @?= "xxxx"+     , testCase "RepeatLast test 20" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'bz'v")+                                         , ("c", "'aaa'v") ] coinput)+                                    (stringToKeyMacro "c")))+         @?= "bzzbzzbzzbzz"+     , testCase "RepeatLast test 21" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'x'V")] coinput)+                                    (stringToKeyMacro "'a'v")))+         @?= "xxxx"+     , testCase "RepeatLast test 22" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'xy'V")] coinput)+                                    (stringToKeyMacro "'aa'v")))+         @?= "xyxyxyxyxyxy"+     , testCase "RepeatLast test 23" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'xy'v")] coinput)+                                    (stringToKeyMacro "'aa'V")))+         @?= "xyyxyyxyyxyy"+     , testCase "RepeatLast test 24" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'xy'vv")] coinput)+                                    (stringToKeyMacro "'aa'vv")))+         @?= "xyyyxyyyxyyyxyyy"+     , testCase "RepeatLast test 25" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'xyv'v")] coinput)+                                    (stringToKeyMacro "'a'a'vv'")))+         @?= "xyyyxyyyxyyyxyyy"+     , testCase "RepeatLast test 26" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'v")+                                               , ("c", "'ab'v") ] coinput)+                                    (stringToKeyMacro "'c'v")))+         @?= "xyyzxyyxyyzxyyxyyxyyzxyyxyyzxyyxyy"+     , testCase "RepeatLast test 27" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'V")+                                               , ("b", "'za'v")+                                               , ("c", "'ab'v") ] coinput)+                                    (stringToKeyMacro "'c'v")))+         @?= "xyxyzxyxyxyxyzxyxyxyxyxyxyzxyxyxyxyzxyxyxyxy"+     , testCase "RepeatLast test 28" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'V")+                                               , ("c", "'ab'v") ] coinput)+                                    (stringToKeyMacro "'c'v")))+         @?= "xyyzxyyzxyyzxyyzxyyxyyzxyyzxyyzxyyzxyy"+     , testCase "RepeatLast test 29" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'V")+                                               , ("c", "'ab'V") ] coinput)+                                    (stringToKeyMacro "'c'v")))+         @?= "xyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyy"+     , testCase "RepeatLast test 30" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'V")+                                               , ("c", "'ab'V") ] coinput)+                                    (stringToKeyMacro "'c'V")))+         @?= "xyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyy"+     , testCase "RepeatLast test 31" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'v")+                                               , ("c", "'ab'V") ] coinput)+                                    (stringToKeyMacro "'c'V")))+         @?= "xyyzxyyxyyxyyzxyyxyyxyyzxyyxyyxyyzxyyxyy"+     , testCase "RepeatLast test 32" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'v") ] coinput)+                                    (stringToKeyMacro "'ab'vv")))+         @?= "xyyzxyyxyyzxyyxyyzxyyxyy"+     , testCase "RepeatLast test 33" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'V") ] coinput)+                                    (stringToKeyMacro "a'za'vvv")))+         @?= "xyxyzxyxyxyxyxyxyxyxy"+     , testCase "RepeatLast test 34" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("c", "a'za'Vv") ] coinput)+                                    (stringToKeyMacro "'c'v")))+         @?= "xyyzxyyzxyyzxyyxyyzxyyzxyyzxyy"+     , testCase "RepeatLast test 35" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "'za'V") ] coinput)+                                    (stringToKeyMacro "'ab'Vv")))+         @?= "xyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyy"+     , testCase "RepeatLast test 36" $+         snd (last (unwindMacrosAcc (bindInput [ ("a", "'xy'v")+                                               , ("b", "za'za'") ] coinput)+                                    (stringToKeyMacro "'ab'V'ab'V")))+         @?= "xyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyyxyyzxyyzxyy"+     , testCase "RepeatLast test 37" $+         snd (last (unwindMacrosAcc (bindInput [ ("b", "z'xy'vv")+                                               , ("c", "'xyvb'V") ] coinput)+                                    (stringToKeyMacro "'c'V")))+         @?= "xyyzxyyyxyyzxyyyxyyzxyyyxyyzxyyy"+     , testCase "RepeatLast test 38" $+         snd (last (unwindMacrosAcc coinput (stringToKeyMacro "'xv'V")))+         @?= "xxxx"+     , testCase "RepeatLast test 39" $+         fst <$> unwindMacros coinput (stringToKeyMacro "'xv'V")+         @?= [[(Right   "", "'xv'V",  "")],+              [(Left    "",  "xv'V",  "")],+              [(Left   "x",   "v'V", "x")],+              [(Left   "x",   "x'V", "x")],+              [(Left  "xx",    "'V", "x")],+              [(Right "xx",     "V", "x")],+              [(Right   "",    "xx",  ""), (Right "xx",    "", "V")],+              [(Right   "",     "x", "x"), (Right "xx",    "", "V")],+              [(Right "xx",      "", "V")]]+     , testCase "RepeatLast test 40" $+         snd (last (unwindMacrosAcc coinput (stringToKeyMacro "'xy'Vv")))+         @?= "xyxyxy"+     , testCase+         "RepeatLast test 41; named macros not referentially transparent" $+         snd (last (unwindMacrosAcc (bindInput [("a", "'xy'V")] coinput)+                                    (stringToKeyMacro "av")))+         @?= "xyxyxyxy"  -- because @a@ repeated; good!+     , testCase "RepeatLast test 42" $+         snd (last (unwindMacrosAcc (bindInput [("a", "xy")] coinput)+                                    (stringToKeyMacro "'a'Vv")))+         @?= "xyxyxy"  -- because @V@ repeated; good!+     , testCase "RepeatLast test 43" $+         snd (last (unwindMacrosAcc coinput (stringToKeyMacro "'xyV'V")))+         @?= "xyxy"+     , testCase "RepeatLast test 44" $+         snd (last (unwindMacrosAcc coinput (stringToKeyMacro "'xyV'v")))+         @?= "xyxy"+     , testCase "RepeatLast test 45" $+         snd (last (unwindMacrosAcc (bindInput [("a", "xyV")] coinput)+                                    (stringToKeyMacro "'a'V")))+         @?= "xyxy"+     , testCase "RepeatLast test 46" $+         snd (last (unwindMacrosAcc (bindInput [("a", "xyV")] coinput)+                                    (stringToKeyMacro "'a'v")))+         @?= "xyxy"+     ]++integrationTests :: TestTree+integrationTests = testGroup "integrationTests" $+  [ testCase "Null frontend; 5 frames" $ do+      let seed = "SMGen 131 141"+          args = words "--dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 5 --automateAll --keepAutomated --gameMode crawl"+                 ++ [ "--setDungeonRng", seed, "--setMainRng", seed]+      serverOptions <- handleParseResult $ execParserPure defaultPrefs serverOptionsPI args+      tieKnot serverOptions+  ]+  +++  let corule = RK.makeData Content.RuleKind.standardRules+      uiOptions = unsafePerformIO $ mkUIOptions corule defClientOptions+      testFontset :: (Int, String) -> TestTree+      testFontset (n, fontsetName) =+        testCase ("SDL fronted; init only; " ++ fontsetName ++ " fontset") $+          when (frontendName == "sdl") $ do+            -- This test only works when run from the same directory that+            -- the .cabal files is in. And this is what Debian needs, so OK.+            -- The hacky log priority 0 tells SDL frontend to init+            -- and quit at once, for testing on CIs without graphics access.+            let seed = "SMGen " ++ show (13 + 2 * n) ++ " " ++ show (15 + 4 * n)+                args2 = words "--dbgMsgSer --logPriority 0 --newGame 3 --maxFps 100000 --benchmark --stopAfterFrames 5 --automateAll --keepAutomated --gameMode battle"+                        ++ [ "--setDungeonRng", seed, "--setMainRng", seed+                           , "--fontset", fontsetName ]+            serverOptions2 <- handleParseResult $ execParserPure defaultPrefs serverOptionsPI args2+            tieKnot serverOptions2+      isUbuntu = ("ubuntu" `T.isPrefixOf`)+  in map testFontset $ zip [0..] $ map T.unpack $ filter (not . isUbuntu)+     $ map fst $ uFontsets uiOptions

− test/test.hs

@@ -1,21 +0,0 @@-import Prelude ()--import Options.Applicative--import Game.LambdaHack.Client.UI.Frontend.Chosen-import Game.LambdaHack.Core.Prelude-import Game.LambdaHack.Server--import TieKnot--main :: IO ()-main = do-  let args = words "--dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 50 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0"-  serverOptions <- handleParseResult $ execParserPure defaultPrefs serverOptionsPI args-  tieKnot serverOptions-  when (frontendName == "sdl") $ do-    -- The hacky log priority 0 tells SDL frontend to init and quit at once,-    -- for testing on CIs without graphics access.-    let args2 = words "--dbgMsgSer --logPriority 0 --newGame 3 --maxFps 100000 --benchmark --stopAfterFrames 50 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7"-    serverOptions2 <- handleParseResult $ execParserPure defaultPrefs serverOptionsPI args2-    tieKnot serverOptions2