    -- {-# OPTIONS_GHC -fprof-auto #-}
    -- | Display game data on the screen using one of the available frontends
    -- (determined at compile time with cabal flags).
    module Game.LambdaHack.Client.UI.DrawM
      ( targetDesc, targetDescXhair, drawHudFrame
      , checkWarningHP, checkWarningCalm
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , drawFrameTerrain, drawFrameContent
      , drawFramePath, drawFrameActor, drawFrameExtra, drawFrameStatus
      , drawArenaStatus, drawLeaderStatus, drawLeaderDamage, drawSelected
      , checkWarnings
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Monad.ST.Strict
    import qualified Data.Char as Char
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Int (Int64)
    import qualified Data.IntMap.Strict as IM
    import qualified Data.IntSet as IS
    import qualified Data.Text as T
    import qualified Data.Vector.Unboxed as U
    import qualified Data.Vector.Unboxed.Mutable as VM
    import           Data.Word (Word16, Word32)
    import           GHC.Exts (inline)
    import qualified NLP.Miniutter.English as MU

    import           Game.LambdaHack.Client.Bfs
    import           Game.LambdaHack.Client.CommonM
    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.EffectDescription
    import           Game.LambdaHack.Client.UI.Frame
    import           Game.LambdaHack.Client.UI.Frontend (frontendName)
    import           Game.LambdaHack.Client.UI.ItemDescription
    import           Game.LambdaHack.Client.UI.MonadClientUI
    import           Game.LambdaHack.Client.UI.Overlay
    import           Game.LambdaHack.Client.UI.SessionUI
    import           Game.LambdaHack.Client.UI.UIOptions
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.Item
    import qualified Game.LambdaHack.Common.ItemAspect as IA
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.Level
    import           Game.LambdaHack.Common.Misc
    import           Game.LambdaHack.Common.MonadStateRead
    import           Game.LambdaHack.Common.Perception
    import           Game.LambdaHack.Common.Point
    import qualified Game.LambdaHack.Common.PointArray as PointArray
    import           Game.LambdaHack.Common.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import           Game.LambdaHack.Common.Vector
    import           Game.LambdaHack.Content.CaveKind (cname)
    import qualified Game.LambdaHack.Content.FactionKind as FK
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import           Game.LambdaHack.Content.RuleKind
    import           Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace)
    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 qualified Game.LambdaHack.Definition.Color as Color
    import           Game.LambdaHack.Definition.Defs
    import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal

    targetDesc :: MonadClientUI m => Maybe Target -> m (Maybe Text, Maybe Text)
    targetDesc :: forall (m :: * -> *).
    MonadClientUI m =>
    Maybe Target -> m (Maybe Text, Maybe Text)
    targetDesc Maybe Target
    mtarget = do
      arena <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    getArenaUI
      lidV <- viewedLevelUI
      mleader <- getsClient sleader
      let describeActorTarget ActorId
    aid = do
            side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
            b <- getsState $ getActorBody aid
            bUI <- getsSession $ getActorUI aid
            actorMaxSk <- getsState $ getActorMaxSkills aid
            let percentage =
                 Int64
    100 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Actor -> Int64
    bhp Actor
    b
                  Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `div` Int -> Int64
    xM (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    5 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMaxHP Skills
    actorMaxSk)
                chs Int
    n = Text
    "[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text -> Text
    T.replicate (Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) Text
    "_"
                            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text -> Text
    T.replicate Int
    n Text
    "*" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]"
                stars = Int -> Text
    chs (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Int
    forall a. Enum a => a -> Int
    fromEnum (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Int64 -> Int64
    forall a. Ord a => a -> a -> a
    max Int64
    0 (Int64 -> Int64) -> Int64 -> Int64
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Int64 -> Int64
    forall a. Ord a => a -> a -> a
    min Int64
    4 (Int64 -> Int64) -> Int64 -> Int64
    forall a b. (a -> b) -> a -> b
    $ Int64
    percentage Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `div` Int64
    20
                hpIndicator = if Actor -> FactionId
    bfid Actor
    b FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    side then Maybe Text
    forall a. Maybe a
    Nothing else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    stars
            return (Just $ bname bUI, hpIndicator)
      case mtarget of
        Just (TEnemy ActorId
    aid) -> ActorId -> m (Maybe Text, Maybe Text)
    forall {m :: * -> *}.
    MonadClientUI m =>
    ActorId -> m (Maybe Text, Maybe Text)
    describeActorTarget ActorId
    aid
        Just (TNonEnemy ActorId
    aid) -> ActorId -> m (Maybe Text, Maybe Text)
    forall {m :: * -> *}.
    MonadClientUI m =>
    ActorId -> m (Maybe Text, Maybe Text)
    describeActorTarget ActorId
    aid
        Just (TPoint TGoal
    tgoal LevelId
    lid Point
    p) -> case TGoal
    tgoal of
          TEnemyPos{} -> do
            let hotText :: Text
    hotText = if LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV Bool -> Bool -> Bool
    && LevelId
    arena LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV
                          then Text
    "hot spot" Text -> Text -> Text
    <+> Point -> Text
    forall a. Show a => a -> Text
    tshow Point
    p
                          else Text
    "a hot spot on level" Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow (Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ LevelId -> Int
    forall a. Enum a => a -> Int
    fromEnum LevelId
    lid)
            (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    hotText, Maybe Text
    forall a. Maybe a
    Nothing)
          TGoal
    _ -> do  -- the other goals can be invalidated by now anyway and it's
                   -- better to say what there is rather than what there isn't
            pointedText <-
              if LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV Bool -> Bool -> Bool
    && LevelId
    arena LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV
              then do
                bag <- (State -> ItemBag) -> m ItemBag
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemBag) -> m ItemBag)
    -> (State -> ItemBag) -> m ItemBag
    forall a b. (a -> b) -> a -> b
    $ LevelId -> Point -> State -> ItemBag
    getFloorBag LevelId
    lid Point
    p
                case EM.assocs bag of
                  [] -> Text -> m Text
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> m Text) -> Text -> m Text
    forall a b. (a -> b) -> a -> b
    $! Text
    "spot" Text -> Text -> Text
    <+> Point -> Text
    forall a. Show a => a -> Text
    tshow Point
    p
                  [(ItemId
    iid, kit :: ItemQuant
    kit@(Int
    k, ItemTimers
    _))] -> do
                    localTime <- (State -> Time) -> m Time
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
    forall a b. (a -> b) -> a -> b
    $ LevelId -> State -> Time
    getLocalTime LevelId
    lid
                    itemFull <- getsState $ itemToFull iid
                    side <- getsClient sside
                    factionD <- getsState sfactionD
                    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
                    let (name, powers) =
                          partItem rwidth side factionD localTime itemFull kit
                    return $! makePhrase [MU.Car1Ws k name, powers]
                  [(ItemId, ItemQuant)]
    _ -> Text -> m Text
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> m Text) -> Text -> m Text
    forall a b. (a -> b) -> a -> b
    $! Text
    "many items at" Text -> Text -> Text
    <+> Point -> Text
    forall a. Show a => a -> Text
    tshow Point
    p
              else Text -> m Text
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> m Text) -> Text -> m Text
    forall a b. (a -> b) -> a -> b
    $! Text
    "an exact spot on level" Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow (Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ LevelId -> Int
    forall a. Enum a => a -> Int
    fromEnum LevelId
    lid)
            return (Just pointedText, Nothing)
        Just TVector{} -> do
          mtgtPos <- (State -> Maybe Point) -> m (Maybe Point)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe Point) -> m (Maybe Point))
    -> (State -> Maybe Point) -> m (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
    aidTgtToPos Maybe ActorId
    mleader LevelId
    lidV Maybe Target
    mtarget
          let invalidMsg = Text
    "a relative shift"
              validMsg a
    p = Text
    "shift to" Text -> Text -> Text
    <+> a -> Text
    forall a. Show a => a -> Text
    tshow a
    p
          return (Just $ maybe invalidMsg validMsg mtgtPos, Nothing)
        Maybe Target
    Nothing -> (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Text
    forall a. Maybe a
    Nothing, Maybe Text
    forall a. Maybe a
    Nothing)

    targetDescXhair :: MonadClientUI m
                    => m (Maybe Text, Maybe Text, Maybe Watchfulness)
    targetDescXhair :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Maybe Text, Maybe Text, Maybe Watchfulness)
    targetDescXhair = do
      sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe Target
    sxhair
      (mhairDesc, mxhairHP) <- targetDesc sxhair
      let maid = case Maybe Target
    sxhair of
            Just (TEnemy ActorId
    a) -> ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    a
            Just (TNonEnemy ActorId
    a) -> ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    a
            Maybe Target
    _ -> Maybe ActorId
    forall a. Maybe a
    Nothing
      case maid of
        Maybe ActorId
    Nothing -> (Maybe Text, Maybe Text, Maybe Watchfulness)
    -> m (Maybe Text, Maybe Text, Maybe Watchfulness)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Text
    mhairDesc, Maybe Text
    mxhairHP, Maybe Watchfulness
    forall a. Maybe a
    Nothing)
        Just ActorId
    aid -> do
          watchfulness <- Actor -> Watchfulness
    bwatch (Actor -> Watchfulness) -> m Actor -> m Watchfulness
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState (ActorId -> State -> Actor
    getActorBody ActorId
    aid)
          return (mhairDesc, mxhairHP, Just watchfulness)

    drawFrameTerrain :: forall m. MonadClientUI m => LevelId -> m (U.Vector Word32)
    drawFrameTerrain :: forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> m (Vector Word32)
    drawFrameTerrain LevelId
    drawnLevelId = do
      COps{corule=RuleContent{rWidthMax}, cotile, coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      StateClient{smarkSuspect} <- getClient
      -- Not @ScreenContent@, because indexing in level's data.
      Level{ltile=PointArray.Array{avector}, lembed} <- getLevel drawnLevelId
      totVisible <- totalVisible <$> getPerFid drawnLevelId
      frameStatus <- drawFrameStatus drawnLevelId
      let dis :: PointI -> ContentId TileKind -> Color.AttrCharW32
          {-# INLINE dis #-}
          dis Int
    pI ContentId TileKind
    tile =
            let TK.TileKind{Char
    tsymbol :: Char
    tsymbol :: TileKind -> Char
    tsymbol, Color
    tcolor :: Color
    tcolor :: TileKind -> Color
    tcolor, Color
    tcolor2 :: Color
    tcolor2 :: TileKind -> Color
    tcolor2} = ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile ContentId TileKind
    tile
                -- @smarkSuspect@ can be turned off easily, so let's overlay it
                -- over both visible and remembered tiles.
                fg :: Color.Color
                fg :: Color
    fg | Int
    smarkSuspect Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                     Bool -> Bool -> Bool
    && TileSpeedup -> ContentId TileKind -> Bool
    Tile.isSuspect TileSpeedup
    coTileSpeedup ContentId TileKind
    tile = Color
    Color.BrMagenta
                   | Int
    smarkSuspect Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
                     Bool -> Bool -> Bool
    && TileSpeedup -> ContentId TileKind -> Bool
    Tile.isHideAs TileSpeedup
    coTileSpeedup ContentId TileKind
    tile = Color
    Color.Magenta
                   | -- Converting maps is cheaper than converting points
                     -- and this function is a bottleneck, so we hack a bit.
                     Int
    pI Int -> IntSet -> Bool
    `IS.member` EnumSet Point -> IntSet
    forall k. EnumSet k -> IntSet
    ES.enumSetToIntSet EnumSet Point
    totVisible
                     -- If all embeds spent, mark it with darker colour.
                     Bool -> Bool -> Bool
    && Bool -> Bool
    not (TileSpeedup -> ContentId TileKind -> Bool
    Tile.isEmbed TileSpeedup
    coTileSpeedup ContentId TileKind
    tile
                             Bool -> Bool -> Bool
    && Int
    pI Int -> IntMap ItemBag -> Bool
    forall a. Int -> IntMap a -> Bool
    `IM.notMember`
                                  ItemFloor -> IntMap ItemBag
    forall k a. EnumMap k a -> IntMap a
    EM.enumMapToIntMap ItemFloor
    lembed) = Color
    tcolor
                   | Bool
    otherwise = Color
    tcolor2
            in Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    fg Char
    tsymbol
          g :: PointI -> Word16 -> Word32
          g !Int
    pI !Word16
    tile = AttrCharW32 -> Word32
    Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int -> ContentId TileKind -> AttrCharW32
    dis Int
    pI (Word16 -> ContentId TileKind
    forall c. Word16 -> ContentId c
    DefsInternal.toContentId Word16
    tile)
          caveVector :: U.Vector Word32
          caveVector = (Int -> Word16 -> Word32) -> Vector Word16 -> Vector Word32
    forall a b.
    (Unbox a, Unbox b) =>
    (Int -> a -> b) -> Vector a -> Vector b
    U.imap Int -> Word16 -> Word32
    g Vector Word16
    Vector (UnboxRep (ContentId TileKind))
    avector
          messageVector =
            Int -> Word32 -> Vector Word32
    forall a. Unbox a => Int -> a -> Vector a
    U.replicate Int
    rWidthMax (AttrCharW32 -> Word32
    Color.attrCharW32 AttrCharW32
    Color.spaceAttrW32)
          statusVector = Int -> [Word32] -> Vector Word32
    forall a. Unbox a => Int -> [a] -> Vector a
    U.fromListN (Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    rWidthMax) ([Word32] -> Vector Word32) -> [Word32] -> Vector Word32
    forall a b. (a -> b) -> a -> b
    $ (AttrCharW32 -> Word32) -> AttrString -> [Word32]
    forall a b. (a -> b) -> [a] -> [b]
    map AttrCharW32 -> Word32
    Color.attrCharW32 AttrString
    frameStatus
      -- The vector package is so smart that the 3 vectors are not allocated
      -- separately at all, but written to the big vector at once.
      -- But even with double allocation it would be faster than writing
      -- to a mutable vector via @FrameForall@.
      return $ U.concat [messageVector, caveVector, statusVector]

    drawFrameContent :: forall m. MonadClientUI m => LevelId -> m FrameForall
    drawFrameContent :: forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
    drawFrameContent LevelId
    drawnLevelId = do
      COps{corule=RuleContent{rWidthMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      SessionUI{smarkSmell} <- getSession
      -- Not @ScreenContent@, because indexing in level's data.
      Level{lsmell, ltime, lfloor} <- getLevel drawnLevelId
      itemToF <- getsState $ flip itemToFull
      let {-# INLINE viewItemBag #-}
          viewItemBag Int
    _ ItemBag
    floorBag = case ItemBag -> [(ItemId, ItemQuant)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.toDescList ItemBag
    floorBag of
            (ItemId
    iid, ItemQuant
    _kit) : [(ItemId, ItemQuant)]
    _ -> ItemFull -> AttrCharW32
    viewItem (ItemFull -> AttrCharW32) -> ItemFull -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ ItemId -> ItemFull
    itemToF ItemId
    iid
            [] -> String -> AttrCharW32
    forall a. HasCallStack => String -> a
    error (String -> AttrCharW32) -> String -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ String
    "lfloor not sparse" String -> () -> String
    forall v. Show v => String -> v -> String
    `showFailure` ()
          viewSmell :: PointI -> Time -> Color.AttrCharW32
          {-# INLINE viewSmell #-}
          viewSmell Int
    pI Time
    sml =
            let fg :: Color
    fg = Int -> Color
    forall a. Enum a => Int -> a
    toEnum (Int -> Color) -> Int -> Color
    forall a b. (a -> b) -> a -> b
    $ Int
    pI Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `rem` Int
    13 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
                smlt :: Delta Time
    smlt = Delta Time
    smellTimeout Delta Time -> Delta Time -> Delta Time
    `timeDeltaSubtract`
                         (Time
    sml Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    ltime)
            in Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    fg (Delta Time -> Delta Time -> Char
    timeDeltaToDigit Delta Time
    smellTimeout Delta Time
    smlt)
          mapVAL :: forall a s. (PointI -> a -> Color.AttrCharW32) -> [(PointI, a)]
                 -> FrameST s
          {-# INLINE mapVAL #-}
          mapVAL Int -> a -> AttrCharW32
    f [(Int, a)]
    l Mutable Vector s Word32
    v = do
            let g :: (PointI, a) -> ST s ()
                g :: (Int, a) -> ST s ()
    g (!Int
    pI, !a
    a0) = do
                  let w :: Word32
    w = AttrCharW32 -> Word32
    Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int -> a -> AttrCharW32
    f Int
    pI a
    a0
                  MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    VM.write MVector (PrimState (ST s)) Word32
    Mutable Vector s Word32
    v (Int
    pI Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rWidthMax) Word32
    w
            ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Int, a) -> ST s ()
    g [(Int, a)]
    l
          -- We don't usually show embedded items, because normally we don't
          -- want them to clutter the display. If they are really important,
          -- the tile they reside on has special colours and changes as soon
          -- as the item disappears. In the remaining cases, the main menu
          -- UI setting for suspect terrain highlights most tiles with embeds.
          upd :: FrameForall
          upd = (forall s. FrameST s) -> FrameForall
    FrameForall ((forall s. FrameST s) -> FrameForall)
    -> (forall s. FrameST s) -> FrameForall
    forall a b. (a -> b) -> a -> b
    $ \Mutable Vector s Word32
    v -> do
            (Int -> ItemBag -> AttrCharW32)
    -> [(Int, ItemBag)] -> Mutable Vector s Word32 -> ST s ()
    forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
    mapVAL Int -> ItemBag -> AttrCharW32
    viewItemBag (IntMap ItemBag -> [(Int, ItemBag)]
    forall a. IntMap a -> [(Int, a)]
    IM.assocs (IntMap ItemBag -> [(Int, ItemBag)])
    -> IntMap ItemBag -> [(Int, ItemBag)]
    forall a b. (a -> b) -> a -> b
    $ ItemFloor -> IntMap ItemBag
    forall k a. EnumMap k a -> IntMap a
    EM.enumMapToIntMap ItemFloor
    lfloor) Mutable Vector s Word32
    v
            Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    smarkSmell (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $
              (Int -> Time -> AttrCharW32)
    -> [(Int, Time)] -> Mutable Vector s Word32 -> ST s ()
    forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
    mapVAL Int -> Time -> AttrCharW32
    viewSmell (((Int, Time) -> Bool) -> [(Int, Time)] -> [(Int, Time)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    > Time
    ltime) (Time -> Bool) -> ((Int, Time) -> Time) -> (Int, Time) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Time) -> Time
    forall a b. (a, b) -> b
    snd)
                                ([(Int, Time)] -> [(Int, Time)]) -> [(Int, Time)] -> [(Int, Time)]
    forall a b. (a -> b) -> a -> b
    $ IntMap Time -> [(Int, Time)]
    forall a. IntMap a -> [(Int, a)]
    IM.assocs (IntMap Time -> [(Int, Time)]) -> IntMap Time -> [(Int, Time)]
    forall a b. (a -> b) -> a -> b
    $ SmellMap -> IntMap Time
    forall k a. EnumMap k a -> IntMap a
    EM.enumMapToIntMap SmellMap
    lsmell) Mutable Vector s Word32
    v
      return upd

    drawFramePath :: forall m. MonadClientUI m
                  => LevelId -> m (FrameForall, FrameForall)
    drawFramePath :: forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> m (FrameForall, FrameForall)
    drawFramePath LevelId
    drawnLevelId = do
     SessionUI{saimMode} <- m SessionUI
    forall (m :: * -> *). MonadClientUI m => m SessionUI
    getSession
     sreportNull <- getsSession sreportNull
     let frameForallId = (forall s. FrameST s) -> FrameForall
    FrameForall ((forall s. FrameST s) -> FrameForall)
    -> (forall s. FrameST s) -> FrameForall
    forall a b. (a -> b) -> a -> b
    $ ST s () -> Mutable Vector s Word32 -> ST s ()
    forall a b. a -> b -> a
    const (ST s () -> Mutable Vector s Word32 -> ST s ())
    -> ST s () -> Mutable Vector s Word32 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
     case saimMode of
       Just AimMode{DetailLevel
    detailLevel :: DetailLevel
    detailLevel :: AimMode -> DetailLevel
    detailLevel} | Bool -> Bool
    not Bool
    sreportNull
                                   Bool -> Bool -> Bool
    && DetailLevel
    detailLevel DetailLevel -> DetailLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    /= DetailLevel
    DetailHigh
                                   Bool -> Bool -> Bool
    && DetailLevel
    detailLevel DetailLevel -> DetailLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    /= DetailLevel
    DetailLow -> do
         COps{corule=RuleContent{rWidthMax, rHeightMax}, coTileSpeedup}
           <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
         StateClient{seps} <- getClient
         -- Not @ScreenContent@, because pathing in level's map.
         Level{ltile=PointArray.Array{avector}} <- getLevel drawnLevelId
         totVisible <- totalVisible <$> getPerFid drawnLevelId
         mleader <- getsClient sleader
         xhairPos <- xhairToPos
         bline <- case mleader of
           Just ActorId
    leader -> do
             Actor{bpos, blid} <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
             return $! if blid /= drawnLevelId
                       then []
                       else fromMaybe []
                            $ bresenhamsLineAlgorithm seps bpos xhairPos
           Maybe ActorId
    _ -> [Point] -> m [Point]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
         mpath <- maybe (return Nothing) (\ActorId
    aid -> do
           mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient ((StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath))
    -> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
    forall a b. (a -> b) -> a -> b
    $ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup ActorId
    aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
    -> (StateClient -> EnumMap ActorId TgtAndPath)
    -> StateClient
    -> Maybe TgtAndPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateClient -> EnumMap ActorId TgtAndPath
    stargetD
           case mtgtMPath of
             Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
    tapPath=tapPath :: Maybe AndPath
    tapPath@(Just AndPath{Point
    pathGoal :: Point
    pathGoal :: AndPath -> Point
    pathGoal})}
               | Point
    pathGoal Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    xhairPos -> Maybe AndPath -> m (Maybe AndPath)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe AndPath
    tapPath
             Maybe TgtAndPath
    _ -> ActorId -> Point -> m (Maybe AndPath)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (Maybe AndPath)
    getCachePath ActorId
    aid Point
    xhairPos) mleader
         assocsAtxhair <- getsState $ posToAidAssocs xhairPos drawnLevelId
         let shiftedBTrajectory = case [(ActorId, Actor)]
    assocsAtxhair of
               (ActorId
    _, Actor{btrajectory :: Actor -> Maybe ([Vector], Speed)
    btrajectory = Just ([Vector], Speed)
    p, bpos :: Actor -> Point
    bpos = Point
    prPos}) : [(ActorId, Actor)]
    _
                 | DetailLevel
    detailLevel DetailLevel -> DetailLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    == DetailLevel
    defaultDetailLevel ->
                   Point -> [Vector] -> [Point]
    trajectoryToPath Point
    prPos (([Vector], Speed) -> [Vector]
    forall a b. (a, b) -> a
    fst ([Vector], Speed)
    p)
               [(ActorId, Actor)]
    _ -> []
             shiftedLine =
               Point -> [Point] -> [Point]
    forall a. Eq a => a -> [a] -> [a]
    delete Point
    xhairPos
               ([Point] -> [Point]) -> [Point] -> [Point]
    forall a b. (a -> b) -> a -> b
    $ (Point -> Bool) -> [Point] -> [Point]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile ((Int, Int, Int, Int) -> Point -> Bool
    insideP (Int
    0, Int
    0, Int
    rWidthMax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    rHeightMax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
               ([Point] -> [Point]) -> [Point] -> [Point]
    forall a b. (a -> b) -> a -> b
    $ if [Point] -> Bool
    forall a. [a] -> Bool
    null [Point]
    shiftedBTrajectory
                 then [Point]
    bline
                 else [Point]
    shiftedBTrajectory
             lpath = if Bool -> Bool
    not ([Point] -> Bool
    forall a. [a] -> Bool
    null [Point]
    bline) Bool -> Bool -> Bool
    && [Point] -> Bool
    forall a. [a] -> Bool
    null [Point]
    shiftedBTrajectory
                     then Point -> [Point] -> [Point]
    forall a. Eq a => a -> [a] -> [a]
    delete Point
    xhairPos ([Point] -> [Point]) -> [Point] -> [Point]
    forall a b. (a -> b) -> a -> b
    $ [Point] -> (AndPath -> [Point]) -> Maybe AndPath -> [Point]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] AndPath -> [Point]
    pathList Maybe AndPath
    mpath
                     else []
             acOnPathOrLine :: Char -> Point -> ContentId TileKind
                            -> Color.AttrCharW32
             acOnPathOrLine !Char
    ch !Point
    p0 !ContentId TileKind
    tile =
               let fgOnPathOrLine :: Color
    fgOnPathOrLine =
                     case ( Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    ES.member Point
    p0 EnumSet Point
    totVisible
                          , TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup ContentId TileKind
    tile ) of
                       (Bool, Bool)
    _ | ContentId TileKind -> Bool
    isUknownSpace ContentId TileKind
    tile -> Color
    Color.BrBlack
                       (Bool, Bool)
    _ | TileSpeedup -> ContentId TileKind -> Bool
    Tile.isSuspect TileSpeedup
    coTileSpeedup ContentId TileKind
    tile -> Color
    Color.BrMagenta
                       (Bool
    True, Bool
    True)   -> Color
    Color.BrGreen
                       (Bool
    True, Bool
    False)  -> Color
    Color.BrRed
                       (Bool
    False, Bool
    True)  -> Color
    Color.Green
                       (Bool
    False, Bool
    False) -> Color
    Color.Red
               in Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    fgOnPathOrLine Char
    ch
             mapVTL :: forall s. (Point -> ContentId TileKind -> Color.AttrCharW32)
                    -> [Point]
                    -> FrameST s
             mapVTL Point -> ContentId TileKind -> AttrCharW32
    f [Point]
    l Mutable Vector s Word32
    v = do
               let g :: Point -> ST s ()
                   g :: Point -> ST s ()
    g !Point
    p0 = do
                     let pI :: Int
    pI = Point -> Int
    forall a. Enum a => a -> Int
    fromEnum Point
    p0
                         tile :: Word16
    tile = Vector Word16
    Vector (UnboxRep (ContentId TileKind))
    avector Vector Word16 -> Int -> Word16
    forall a. Unbox a => Vector a -> Int -> a
    U.! Int
    pI
                         w :: Word32
    w = AttrCharW32 -> Word32
    Color.attrCharW32
                             (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Point -> ContentId TileKind -> AttrCharW32
    f Point
    p0 (Word16 -> ContentId TileKind
    forall c. Word16 -> ContentId c
    DefsInternal.toContentId Word16
    tile)
                     MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    VM.write MVector (PrimState (ST s)) Word32
    Mutable Vector s Word32
    v (Int
    pI Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rWidthMax) Word32
    w
               (Point -> ST s ()) -> [Point] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ Point -> ST s ()
    g [Point]
    l
             upd :: FrameForall
             upd = (forall s. FrameST s) -> FrameForall
    FrameForall ((forall s. FrameST s) -> FrameForall)
    -> (forall s. FrameST s) -> FrameForall
    forall a b. (a -> b) -> a -> b
    $ \Mutable Vector s Word32
    v -> do
               (Point -> ContentId TileKind -> AttrCharW32)
    -> [Point] -> Mutable Vector s Word32 -> ST s ()
    forall s.
    (Point -> ContentId TileKind -> AttrCharW32)
    -> [Point] -> FrameST s
    mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
    acOnPathOrLine Char
    ';') [Point]
    lpath Mutable Vector s Word32
    v
               (Point -> ContentId TileKind -> AttrCharW32)
    -> [Point] -> Mutable Vector s Word32 -> ST s ()
    forall s.
    (Point -> ContentId TileKind -> AttrCharW32)
    -> [Point] -> FrameST s
    mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
    acOnPathOrLine Char
    '*') [Point]
    shiftedLine Mutable Vector s Word32
    v  -- overwrites path
         return (upd, if null shiftedBTrajectory then frameForallId else upd)
       Maybe AimMode
    _ -> (FrameForall, FrameForall) -> m (FrameForall, FrameForall)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FrameForall
    frameForallId, FrameForall
    frameForallId)

    drawFrameActor :: forall m. MonadClientUI m => LevelId -> m FrameForall
    drawFrameActor :: forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
    drawFrameActor LevelId
    drawnLevelId = do
      COps{corule=RuleContent{rWidthMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      SessionUI{sactorUI, sselected, sUIOptions} <- getSession
      -- Not @ScreenContent@, because indexing in level's data.
      Level{lbig, lproj} <- getLevel drawnLevelId
      side <- getsClient sside
      s <- getState
      let {-# INLINE viewBig #-}
          viewBig ActorId
    aid =
              let Actor{Int64
    bhp :: Actor -> Int64
    bhp :: Int64
    bhp, FactionId
    bfid :: Actor -> FactionId
    bfid :: FactionId
    bfid, ItemId
    btrunk :: ItemId
    btrunk :: Actor -> ItemId
    btrunk, Watchfulness
    bwatch :: Actor -> Watchfulness
    bwatch :: Watchfulness
    bwatch} = ActorId -> State -> Actor
    getActorBody ActorId
    aid State
    s
                  ActorUI{Char
    bsymbol :: Char
    bsymbol :: ActorUI -> Char
    bsymbol, Color
    bcolor :: Color
    bcolor :: ActorUI -> Color
    bcolor} = ActorDictUI
    sactorUI ActorDictUI -> ActorId -> ActorUI
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ActorId
    aid
                  Item{Maybe FactionId
    jfid :: Maybe FactionId
    jfid :: Item -> Maybe FactionId
    jfid} = ItemId -> State -> Item
    getItemBody ItemId
    btrunk State
    s
                  symbol :: Char
    symbol | Int64
    bhp Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 = Char
    bsymbol
                         | Bool
    otherwise = Char
    '%'
                  dominated :: Bool
    dominated = Bool -> (FactionId -> Bool) -> Maybe FactionId -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FactionId
    bfid) Maybe FactionId
    jfid
                  bg :: Highlight
    bg = if | Watchfulness
    bwatch Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    == Watchfulness
    WSleep -> Highlight
    Color.HighlightBlue
                          | Bool
    dominated -> if FactionId
    bfid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    side  -- dominated by us
                                         then Highlight
    Color.HighlightCyan
                                         else Highlight
    Color.HighlightBrown
                          | ActorId -> EnumSet ActorId -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    ES.member ActorId
    aid EnumSet ActorId
    sselected -> Highlight
    Color.HighlightGreen
                          | Bool
    otherwise -> Highlight
    Color.HighlightNone
                  fg :: Color
    fg | FactionId
    bfid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FactionId
    side Bool -> Bool -> Bool
    || Int64
    bhp Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    0 = Color
    bcolor
                     | Bool
    otherwise =
                    let (Bool
    hpCheckWarning, Bool
    calmCheckWarning) =
                          UIOptions -> ActorId -> State -> (Bool, Bool)
    checkWarnings UIOptions
    sUIOptions ActorId
    aid State
    s
                    in if Bool
    hpCheckWarning Bool -> Bool -> Bool
    || Bool
    calmCheckWarning
                       then Color
    Color.Red
                       else Color
    bcolor
             in AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ Attr -> Char -> AttrChar
    Color.AttrChar Color.Attr{Highlight
    Color
    bg :: Highlight
    fg :: Color
    bg :: Highlight
    fg :: Color
    ..} Char
    symbol
          {-# INLINE viewProj #-}
          viewProj [ActorId]
    as = case [ActorId]
    as of
            ActorId
    aid : [ActorId]
    _ ->
              let ActorUI{Char
    bsymbol :: ActorUI -> Char
    bsymbol :: Char
    bsymbol, Color
    bcolor :: ActorUI -> Color
    bcolor :: Color
    bcolor} = ActorDictUI
    sactorUI ActorDictUI -> ActorId -> ActorUI
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ActorId
    aid
                  bg :: Highlight
    bg = Highlight
    Color.HighlightNone
                  fg :: Color
    fg = Color
    bcolor
             in AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ Attr -> Char -> AttrChar
    Color.AttrChar Color.Attr{Highlight
    Color
    bg :: Highlight
    fg :: Color
    bg :: Highlight
    fg :: Color
    ..} Char
    bsymbol
            [] -> String -> AttrCharW32
    forall a. HasCallStack => String -> a
    error (String -> AttrCharW32) -> String -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ String
    "lproj not sparse" String -> () -> String
    forall v. Show v => String -> v -> String
    `showFailure` ()
          mapVAL :: forall a s. (a -> Color.AttrCharW32) -> [(PointI, a)]
                 -> FrameST s
          {-# INLINE mapVAL #-}
          mapVAL a -> AttrCharW32
    f [(Int, a)]
    l Mutable Vector s Word32
    v = do
            let g :: (PointI, a) -> ST s ()
                g :: (Int, a) -> ST s ()
    g (!Int
    pI, !a
    a0) = do
                  let w :: Word32
    w = AttrCharW32 -> Word32
    Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ a -> AttrCharW32
    f a
    a0
                  MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    VM.write MVector (PrimState (ST s)) Word32
    Mutable Vector s Word32
    v (Int
    pI Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rWidthMax) Word32
    w
            ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Int, a) -> ST s ()
    g [(Int, a)]
    l
          upd :: FrameForall
          upd = (forall s. FrameST s) -> FrameForall
    FrameForall ((forall s. FrameST s) -> FrameForall)
    -> (forall s. FrameST s) -> FrameForall
    forall a b. (a -> b) -> a -> b
    $ \Mutable Vector s Word32
    v -> do
            ([ActorId] -> AttrCharW32)
    -> [(Int, [ActorId])] -> Mutable Vector s Word32 -> ST s ()
    forall a s. (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
    mapVAL [ActorId] -> AttrCharW32
    viewProj (IntMap [ActorId] -> [(Int, [ActorId])]
    forall a. IntMap a -> [(Int, a)]
    IM.assocs (IntMap [ActorId] -> [(Int, [ActorId])])
    -> IntMap [ActorId] -> [(Int, [ActorId])]
    forall a b. (a -> b) -> a -> b
    $ ProjectileMap -> IntMap [ActorId]
    forall k a. EnumMap k a -> IntMap a
    EM.enumMapToIntMap ProjectileMap
    lproj) Mutable Vector s Word32
    v
            (ActorId -> AttrCharW32)
    -> [(Int, ActorId)] -> Mutable Vector s Word32 -> ST s ()
    forall a s. (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
    mapVAL ActorId -> AttrCharW32
    viewBig (IntMap ActorId -> [(Int, ActorId)]
    forall a. IntMap a -> [(Int, a)]
    IM.assocs (IntMap ActorId -> [(Int, ActorId)])
    -> IntMap ActorId -> [(Int, ActorId)]
    forall a b. (a -> b) -> a -> b
    $ BigActorMap -> IntMap ActorId
    forall k a. EnumMap k a -> IntMap a
    EM.enumMapToIntMap BigActorMap
    lbig) Mutable Vector s Word32
    v
              -- big actor overlay projectiles
      return upd

    drawFrameExtra :: forall m. MonadClientUI m
                   => ColorMode -> LevelId -> m FrameForall
    drawFrameExtra :: forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> LevelId -> m FrameForall
    drawFrameExtra ColorMode
    dm LevelId
    drawnLevelId = do
      -- Not @ScreenContent@, because indexing in level's data.
      COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      SessionUI{saimMode, smarkVision} <- getSession
      mleader <- getsClient sleader
      mbody <- getsState $ \State
    s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ActorId -> State -> Actor
    getActorBody State
    s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ActorId
    mleader
      totVisible <- totalVisible <$> getPerFid drawnLevelId
      mxhairPos <- mxhairToPos
      mtgtPos <- do
        mtgt <- getsClient $ maybe (const Nothing) getTarget mleader
        getsState $ aidTgtToPos mleader drawnLevelId mtgt
      side <- getsClient sside
      factionD <- getsState sfactionD
      let visionMarks = IntSet -> [Int]
    IS.toList (IntSet -> [Int]) -> IntSet -> [Int]
    forall a b. (a -> b) -> a -> b
    $ EnumSet Point -> IntSet
    forall k. EnumSet k -> IntSet
    ES.enumSetToIntSet EnumSet Point
    totVisible
          backlightVision :: Color.AttrChar -> Color.AttrChar
          backlightVision AttrChar
    ac = case AttrChar
    ac of
            Color.AttrChar (Color.Attr Color
    fg Highlight
    Color.HighlightNone) Char
    ch ->
              Attr -> Char -> AttrChar
    Color.AttrChar (Color -> Highlight -> Attr
    Color.Attr Color
    fg Highlight
    Color.HighlightBackground) Char
    ch
            AttrChar
    _ -> AttrChar
    ac
          writeSquare !Highlight
    hi (Color.AttrChar (Color.Attr Color
    fg Highlight
    bg) Char
    ch) =
            let hiUnlessLeader :: Highlight
    hiUnlessLeader | Highlight
    bg Highlight -> Highlight -> Bool
    forall a. Eq a => a -> a -> Bool
    == Highlight
    Color.HighlightYellow = Highlight
    bg
                               | Bool
    otherwise = Highlight
    hi
            in Attr -> Char -> AttrChar
    Color.AttrChar (Color -> Highlight -> Attr
    Color.Attr Color
    fg Highlight
    hiUnlessLeader) Char
    ch
          turnBW (Color.AttrChar Attr
    _ Char
    ch) = Attr -> Char -> AttrChar
    Color.AttrChar Attr
    Color.defAttr Char
    ch
          mapVL :: forall s. (Color.AttrChar -> Color.AttrChar) -> [PointI]
                -> FrameST s
          mapVL AttrChar -> AttrChar
    f [Int]
    l Mutable Vector s Word32
    v = do
            let g :: PointI -> ST s ()
                g :: Int -> ST s ()
    g !Int
    pI = do
                  w0 <- MVector (PrimState (ST s)) Word32 -> Int -> ST s Word32
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> m a
    VM.read MVector (PrimState (ST s)) Word32
    Mutable Vector s Word32
    v (Int
    pI Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rWidthMax)
                  let w = AttrCharW32 -> Word32
    Color.attrCharW32 (AttrCharW32 -> Word32)
    -> (Word32 -> AttrCharW32) -> Word32 -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrChar -> AttrCharW32
    Color.attrCharToW32
                          (AttrChar -> AttrCharW32)
    -> (Word32 -> AttrChar) -> Word32 -> AttrCharW32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrChar -> AttrChar
    f (AttrChar -> AttrChar)
    -> (Word32 -> AttrChar) -> Word32 -> AttrChar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrCharW32 -> AttrChar
    Color.attrCharFromW32 (AttrCharW32 -> AttrChar)
    -> (Word32 -> AttrCharW32) -> Word32 -> AttrChar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> AttrCharW32
    Color.AttrCharW32 (Word32 -> Word32) -> Word32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Word32
    w0
                  VM.write v (pI + rWidthMax) w
            (Int -> ST s ()) -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ Int -> ST s ()
    g [Int]
    l
          -- Here @rWidthMax@ and @rHeightMax@ are correct, because we are not
          -- turning the whole screen into black&white, but only the level map.
          lDungeon = [Int
    0..Int
    rWidthMax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    rHeightMax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
          leaderColor = if Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode
                        then Highlight
    Color.HighlightYellowAim
                        else Highlight
    Color.HighlightYellow
          xhairColor = if Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode
                       then Highlight
    Color.HighlightRedAim
                       else Highlight
    Color.HighlightRed
          locateStash (FactionId
    fid, Faction
    fact) = case Faction -> Maybe (LevelId, Point)
    gstash Faction
    fact of
            Just (LevelId
    lid, Point
    pos) | LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    drawnLevelId ->
              let stashColor :: Highlight
    stashColor = if FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    side
                               then Highlight
    Color.HighlightWhite
                               else Highlight
    Color.HighlightMagenta
              in (Point, Highlight) -> Maybe (Point, Highlight)
    forall a. a -> Maybe a
    Just (Point
    pos, Highlight
    stashColor)
            Maybe (LevelId, Point)
    _ -> Maybe (Point, Highlight)
    forall a. Maybe a
    Nothing
          stashesToDisplay = ((FactionId, Faction) -> Maybe (Point, Highlight))
    -> [(FactionId, Faction)] -> [(Point, Highlight)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (FactionId, Faction) -> Maybe (Point, Highlight)
    locateStash ([(FactionId, Faction)] -> [(Point, Highlight)])
    -> [(FactionId, Faction)] -> [(Point, Highlight)]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    factionD
          upd :: FrameForall
          upd = (forall s. FrameST s) -> FrameForall
    FrameForall ((forall s. FrameST s) -> FrameForall)
    -> (forall s. FrameST s) -> FrameForall
    forall a b. (a -> b) -> a -> b
    $ \Mutable Vector s Word32
    v -> do
            Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode Bool -> Bool -> Bool
    && Int
    smarkVision Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1 Bool -> Bool -> Bool
    || Int
    smarkVision Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2) (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $
              (AttrChar -> AttrChar)
    -> [Int] -> Mutable Vector s Word32 -> ST s ()
    forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
    mapVL AttrChar -> AttrChar
    backlightVision [Int]
    visionMarks Mutable Vector s Word32
    v
            case Maybe Point
    mtgtPos of
              Maybe Point
    Nothing -> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Just Point
    p -> (AttrChar -> AttrChar)
    -> [Int] -> Mutable Vector s Word32 -> ST s ()
    forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
    mapVL (Highlight -> AttrChar -> AttrChar
    writeSquare Highlight
    Color.HighlightGrey) [Point -> Int
    forall a. Enum a => a -> Int
    fromEnum Point
    p] Mutable Vector s Word32
    v
            ((Point, Highlight) -> ST s ()) -> [(Point, Highlight)] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (\(Point
    pos, Highlight
    color) -> (AttrChar -> AttrChar)
    -> [Int] -> Mutable Vector s Word32 -> ST s ()
    forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
    mapVL (Highlight -> AttrChar -> AttrChar
    writeSquare Highlight
    color) [Point -> Int
    forall a. Enum a => a -> Int
    fromEnum Point
    pos] Mutable Vector s Word32
    v)
                  [(Point, Highlight)]
    stashesToDisplay
            case Maybe Actor
    mbody of  -- overwrites target
              Just Actor
    body | LevelId
    drawnLevelId LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> LevelId
    blid Actor
    body ->
                (AttrChar -> AttrChar)
    -> [Int] -> Mutable Vector s Word32 -> ST s ()
    forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
    mapVL (Highlight -> AttrChar -> AttrChar
    writeSquare Highlight
    leaderColor) [Point -> Int
    forall a. Enum a => a -> Int
    fromEnum (Point -> Int) -> Point -> Int
    forall a b. (a -> b) -> a -> b
    $ Actor -> Point
    bpos Actor
    body] Mutable Vector s Word32
    v
              Maybe Actor
    _ -> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            case Maybe Point
    mxhairPos of  -- overwrites target and non-aim leader box
              Maybe Point
    Nothing -> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Just Point
    p -> (AttrChar -> AttrChar)
    -> [Int] -> Mutable Vector s Word32 -> ST s ()
    forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
    mapVL (Highlight -> AttrChar -> AttrChar
    writeSquare Highlight
    xhairColor) [Point -> Int
    forall a. Enum a => a -> Int
    fromEnum Point
    p] Mutable Vector s Word32
    v
            Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ColorMode
    dm ColorMode -> ColorMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColorMode
    ColorBW) (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (AttrChar -> AttrChar)
    -> [Int] -> Mutable Vector s Word32 -> ST s ()
    forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
    mapVL AttrChar -> AttrChar
    turnBW [Int]
    lDungeon Mutable Vector s Word32
    v
      return upd

    drawFrameStatus :: MonadClientUI m => LevelId -> m AttrString
    drawFrameStatus :: forall (m :: * -> *). MonadClientUI m => LevelId -> m AttrString
    drawFrameStatus LevelId
    drawnLevelId = do
      cops@COps{corule=RuleContent{rWidthMax=_rWidthMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      SessionUI{sselected, saimMode, swaitTimes, sitemSel} <- getSession
      mleader <- getsClient sleader
      mxhairPos <- mxhairToPos
      mbfs <- maybe (return Nothing) (fmap Just . getCacheBfs) mleader
      (mhairDesc, mxhairHP, mxhairWatchfulness) <- targetDescXhair
      lvl <- getLevel drawnLevelId
      side <- getsClient sside
      fact <- getsState $ (EM.! side) . sfactionD
      (mblid, mbpos, mbodyUI) <- case mleader of
        Just ActorId
    leader -> do
          Actor{bpos, blid} <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
          bodyUI <- getsSession $ getActorUI leader
          return (Just blid, Just bpos, Just bodyUI)
        Maybe ActorId
    Nothing -> (Maybe LevelId, Maybe Point, Maybe ActorUI)
    -> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe LevelId
    forall a. Maybe a
    Nothing, Maybe Point
    forall a. Maybe a
    Nothing, Maybe ActorUI
    forall a. Maybe a
    Nothing)
      let widthX = Int
    80
          widthTgt = Int
    39
          widthStatus = Int
    widthX Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
          arenaStatus = COps -> Level -> Int -> AttrString
    drawArenaStatus COps
    cops Level
    lvl Int
    widthStatus
          leaderStatusWidth = Int
    23
      leaderStatus <- drawLeaderStatus swaitTimes
      (selectedStatusWidth, selectedStatus)
        <- drawSelected drawnLevelId (widthStatus - leaderStatusWidth) sselected
      let speedStatusWidth = Int
    widthStatus Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    leaderStatusWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    selectedStatusWidth
      speedDisplay <- case mleader of
        Maybe ActorId
    Nothing -> AttrString -> m AttrString
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        Just ActorId
    leader -> do
          actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
          kitAssRaw <- getsState $ kitAssocs leader [CEqp, COrgan]
          let speed = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkSpeed Skills
    actorCurAndMaxSk
              unknownBonus = [ItemFull] -> Bool
    unknownSpeedBonus ([ItemFull] -> Bool) -> [ItemFull] -> Bool
    forall a b. (a -> b) -> a -> b
    $ ((ItemId, ItemFullKit) -> ItemFull)
    -> [(ItemId, ItemFullKit)] -> [ItemFull]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemFullKit -> ItemFull
    forall a b. (a, b) -> a
    fst (ItemFullKit -> ItemFull)
    -> ((ItemId, ItemFullKit) -> ItemFullKit)
    -> (ItemId, ItemFullKit)
    -> ItemFull
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemId, ItemFullKit) -> ItemFullKit
    forall a b. (a, b) -> b
    snd) [(ItemId, ItemFullKit)]
    kitAssRaw
              speedString = Int -> String
    displaySpeed Int
    speed String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    unknownBonus then String
    "?" else String
    ""
              conditionBonus = [ItemFullKit] -> Int
    conditionSpeedBonus ([ItemFullKit] -> Int) -> [ItemFullKit] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((ItemId, ItemFullKit) -> ItemFullKit)
    -> [(ItemId, ItemFullKit)] -> [ItemFullKit]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemId, ItemFullKit) -> ItemFullKit
    forall a b. (a, b) -> b
    snd [(ItemId, ItemFullKit)]
    kitAssRaw
              cspeed = case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    conditionBonus Int
    0 of
                Ordering
    LT -> Color
    Color.Red
                Ordering
    EQ -> Color
    Color.White
                Ordering
    GT -> Color
    Color.Green
          return $! map (Color.attrChar2ToW32 cspeed) speedString
      let speedStatus = if AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    speedDisplay Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    speedStatusWidth
                        then []
                        else AttrString
    speedDisplay AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ [AttrCharW32
    Color.spaceAttrW32]
          displayPathText Maybe Point
    mp Maybe Text
    mt =
            let (Int
    plen, Int
    llen) | Just Point
    target <- Maybe Point
    mp
                             , Just Array BfsDistance
    bfs <- Maybe (Array BfsDistance)
    mbfs
                             , Just Point
    bpos <- Maybe Point
    mbpos
                             , Maybe LevelId
    mblid Maybe LevelId -> Maybe LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId -> Maybe LevelId
    forall a. a -> Maybe a
    Just LevelId
    drawnLevelId
                             = ( Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Array BfsDistance -> Point -> Maybe Int
    accessBfs Array BfsDistance
    bfs Point
    target)
                               , Point -> Point -> Int
    chessDist Point
    bpos Point
    target )
                             | Bool
    otherwise = (Int
    0, Int
    0)
                pText :: Text
    pText | Int
    plen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Text
    ""
                      | Bool
    otherwise = Text
    "p" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    plen
                lText :: Text
    lText | Int
    llen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Text
    ""
                      | Bool
    otherwise = Text
    "l" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    llen
                text :: Text
    text = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe (Text
    pText Text -> Text -> Text
    <+> Text
    lText) Maybe Text
    mt
            in if Text -> Bool
    T.null Text
    text then Text
    "" else Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    text
          -- The indicators must fit, they are the actual information.
          pathCsr = Maybe Point -> Maybe Text -> Text
    displayPathText Maybe Point
    mxhairPos Maybe Text
    mxhairHP
          trimTgtDesc Int
    n Text
    t = Bool -> Text -> Text
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Text -> Bool
    T.null Text
    t) Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    2 Bool -> (Text, Int) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Text
    t, Int
    n)) (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $
            if Text -> Int
    T.length Text
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    n then Text
    t else Int -> Text -> Text
    T.take (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "..."
          -- The indicators must fit, they are the actual information.
          widthXhairOrItem = Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    pathCsr
          nMember = Int -> Part
    MU.Ord (Int -> Part) -> Int -> Part
    forall a b. (a -> b) -> a -> b
    $ Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall a. Num a => [a] -> a
    sum (EnumMap (ContentId ItemKind) Int -> [Int]
    forall k a. EnumMap k a -> [a]
    EM.elems (EnumMap (ContentId ItemKind) Int -> [Int])
    -> EnumMap (ContentId ItemKind) Int -> [Int]
    forall a b. (a -> b) -> a -> b
    $ Faction -> EnumMap (ContentId ItemKind) Int
    gvictims Faction
    fact)
          fallback = if FactionKind -> Bool
    FK.fhasPointman (Faction -> FactionKind
    gkind Faction
    fact)
                     then [Part] -> Text
    makePhrase
                            [Part
    "Waiting for", Part
    nMember, Part
    "team member to spawn"]
                     else Text
    "This faction never picks a pointman"
          leaderName ActorUI
    bUI = Int -> Text -> Text
    trimTgtDesc (Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10) (ActorUI -> Text
    bname ActorUI
    bUI)
          leaderBlurbLong = Text -> (ActorUI -> Text) -> Maybe ActorUI -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    fallback (\ActorUI
    bUI ->
            Text
    "Pointman:" Text -> Text -> Text
    <+> ActorUI -> Text
    leaderName ActorUI
    bUI) Maybe ActorUI
    mbodyUI
          leaderBlurbShort = Text -> (ActorUI -> Text) -> Maybe ActorUI -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    fallback ActorUI -> Text
    leaderName Maybe ActorUI
    mbodyUI
      ours <- getsState $ fidActorNotProjGlobalAssocs side
      ns <- getsState $ EM.size . getFactionStashBag side
      let na = [(ActorId, Actor)] -> Int
    forall a. [a] -> Int
    length [(ActorId, Actor)]
    ours
          nl = EnumSet LevelId -> Int
    forall k. EnumSet k -> Int
    ES.size (EnumSet LevelId -> Int) -> EnumSet LevelId -> Int
    forall a b. (a -> b) -> a -> b
    $ [LevelId] -> EnumSet LevelId
    forall k. Enum k => [k] -> EnumSet k
    ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Actor) -> LevelId) -> [(ActorId, Actor)] -> [LevelId]
    forall a b. (a -> b) -> [a] -> [b]
    map (Actor -> LevelId
    blid (Actor -> LevelId)
    -> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> LevelId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> Actor
    forall a b. (a, b) -> b
    snd) [(ActorId, Actor)]
    ours
          -- To be replaced by something more useful.
          teamBlurb = Text -> AttrString
    textToAS (Text -> AttrString) -> Text -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    trimTgtDesc Int
    widthTgt (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $
            [Part] -> Text
    makePhrase [ Part
    "Team:"
                       , Int -> Part -> Part
    MU.CarWs Int
    na Part
    "actor", Part
    "on"
                       , Int -> Part -> Part
    MU.CarWs Int
    nl Part
    "level" Part -> Part -> Part
    forall a. Semigroup a => a -> a -> a
    <> Part
    ","
                       , Part
    "stash", Int -> Part
    MU.Car Int
    ns ]
          markSleepTgtDesc
            | Maybe Watchfulness
    mxhairWatchfulness Maybe Watchfulness -> Maybe Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Watchfulness -> Maybe Watchfulness
    forall a. a -> Maybe a
    Just Watchfulness
    WSleep = Text -> AttrString
    textToAS
            | Bool
    otherwise = Color -> Text -> AttrString
    textFgToAS Color
    Color.cSleep
          xdetail AimMode{DetailLevel
    detailLevel :: AimMode -> DetailLevel
    detailLevel :: DetailLevel
    detailLevel} =
            Text
    "x" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + DetailLevel -> Int
    forall a. Enum a => a -> Int
    fromEnum DetailLevel
    detailLevel)
          xhairName AimMode
    aimMode = Text
    "Crosshair" Text -> Text -> Text
    <+> AimMode -> Text
    xdetail AimMode
    aimMode
          xhairBlurb =
            AttrString -> (Text -> AttrString) -> Maybe Text -> AttrString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
              AttrString
    teamBlurb
              (\Text
    t -> case Maybe AimMode
    saimMode of
                 Just AimMode
    aimMode ->
                   Text -> AttrString
    textToAS (AimMode -> Text
    xhairName AimMode
    aimMode Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ":")
                   AttrString -> AttrString -> AttrString
    <+:> Text -> AttrString
    markSleepTgtDesc (Int -> Text -> Text
    trimTgtDesc (Int
    widthXhairOrItem Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    14) Text
    t)
                 Maybe AimMode
    Nothing -> Text -> AttrString
    markSleepTgtDesc (Int -> Text -> Text
    trimTgtDesc Int
    widthXhairOrItem Text
    t))
              Maybe Text
    mhairDesc
          tgtOrItem
            | Just (ItemId
    iid, CStore
    fromCStore, Bool
    _) <- Maybe (ItemId, CStore, Bool)
    sitemSel
            , Just ActorId
    leader <- Maybe ActorId
    mleader
            = do
                b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
                bag <- getsState $ getBodyStoreBag b fromCStore
                case iid `EM.lookup` bag of
                  Maybe ItemQuant
    Nothing -> (AttrString, Text) -> m (AttrString, Text)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AttrString
    xhairBlurb, Text
    pathCsr)
                  Just kit :: ItemQuant
    kit@(Int
    k, ItemTimers
    _) -> do
                    localTime <- (State -> Time) -> m Time
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
    forall a b. (a -> b) -> a -> b
    $ LevelId -> State -> Time
    getLocalTime (Actor -> LevelId
    blid Actor
    b)
                    itemFull <- getsState $ itemToFull iid
                    factionD <- getsState sfactionD
                    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
                    let (name, powers) =
                          partItem rwidth (bfid b) factionD localTime itemFull kit
                        t = [Part] -> Text
    makePhrase [Int -> Part -> Part
    MU.Car1Ws Int
    k Part
    name, Part
    powers]
                        xhairHP = Text -> (Text -> Text) -> Maybe Text -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "" (Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) Maybe Text
    mxhairHP
                        (xItemWidth, xItemText) = case saimMode of
                          Just AimMode
    aimMode -> (Int
    9, Text
    "Item" Text -> Text -> Text
    <+> AimMode -> Text
    xdetail AimMode
    aimMode)
                          Maybe AimMode
    Nothing -> (Int
    6, Text
    "Item")
                        trimTD =
                          Int -> Text -> Text
    trimTgtDesc (Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    xhairHP Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xItemWidth) Text
    t
                    return (textToAS $ xItemText <> ":" <+> trimTD, xhairHP)
            | Bool
    otherwise =
                (AttrString, Text) -> m (AttrString, Text)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AttrString
    xhairBlurb, Text
    pathCsr)
      (xhairLine, pathXhairOrNull) <- tgtOrItem
      damageStatus <- maybe (return []) (drawLeaderDamage widthTgt) mleader
      let damageStatusWidth = AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    damageStatus
          withForLeader = Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    damageStatusWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
          leaderBottom =
            if | Text -> Int
    T.length Text
    leaderBlurbShort Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    withForLeader -> Text
    ""
               | Text -> Int
    T.length Text
    leaderBlurbLong Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    withForLeader -> Text
    leaderBlurbShort
               | Bool
    otherwise -> Text
    leaderBlurbLong
          damageGap = Int -> AttrString
    blankAttrString
                      (Int -> AttrString) -> Int -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    damageStatusWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    leaderBottom
          xhairGap = Int -> AttrString
    blankAttrString (Int
    widthTgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    pathXhairOrNull
                                             Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    xhairLine)
          xhairStatus = AttrString
    xhairLine AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    xhairGap AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ Text -> AttrString
    textToAS Text
    pathXhairOrNull
          selectedGap = Int -> AttrString
    blankAttrString (Int
    widthStatus Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    leaderStatusWidth
                                                   Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    selectedStatusWidth
                                                   Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    speedStatus)
          status = AttrString
    arenaStatus
                   AttrString -> AttrString -> AttrString
    forall a. Semigroup a => a -> a -> a
    <> [AttrCharW32
    Color.spaceAttrW32]
                   AttrString -> AttrString -> AttrString
    forall a. Semigroup a => a -> a -> a
    <> AttrString
    xhairStatus
                   AttrString -> AttrString -> AttrString
    forall a. Semigroup a => a -> a -> a
    <> AttrString
    selectedStatus AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    selectedGap AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    speedStatus AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    leaderStatus
                   AttrString -> AttrString -> AttrString
    forall a. Semigroup a => a -> a -> a
    <> [AttrCharW32
    Color.spaceAttrW32]
                   AttrString -> AttrString -> AttrString
    forall a. Semigroup a => a -> a -> a
    <> (Text -> AttrString
    textToAS Text
    leaderBottom AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    damageGap AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    damageStatus)
      -- Keep it at least partially lazy, to avoid allocating the whole list:
      return
    #ifdef WITH_EXPENSIVE_ASSERTIONS
        $ assert (length status == 2 * _rWidthMax
                  `blame` attrStringToString status)
    #endif
            status

    -- | Draw the whole screen: level map and status area.
    drawHudFrame :: MonadClientUI m => ColorMode -> LevelId -> m PreFrame
    drawHudFrame :: forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> LevelId -> m PreFrame
    drawHudFrame ColorMode
    dm LevelId
    drawnLevelId = do
      baseTerrain <- LevelId -> m (Vector Word32)
    forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> m (Vector Word32)
    drawFrameTerrain LevelId
    drawnLevelId
      updContent <- drawFrameContent drawnLevelId
      (updPath, updTrajectory) <- drawFramePath drawnLevelId
      updActor <- drawFrameActor drawnLevelId
      updExtra <- drawFrameExtra dm drawnLevelId
      soptions <- getsClient soptions
      let upd = (forall s. FrameST s) -> FrameForall
    FrameForall ((forall s. FrameST s) -> FrameForall)
    -> (forall s. FrameST s) -> FrameForall
    forall a b. (a -> b) -> a -> b
    $ \Mutable Vector s Word32
    v -> do
            FrameForall -> forall s. FrameST s
    unFrameForall FrameForall
    updContent Mutable Vector s Word32
    v
            -- ANSI frontend is screen-reader friendly, so avoid visual fluff
            Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ClientOptions -> String
    frontendName ClientOptions
    soptions String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "ANSI") (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ FrameForall -> forall s. FrameST s
    unFrameForall FrameForall
    updPath Mutable Vector s Word32
    v
            FrameForall -> forall s. FrameST s
    unFrameForall FrameForall
    updActor Mutable Vector s Word32
    v
            FrameForall -> forall s. FrameST s
    unFrameForall FrameForall
    updTrajectory Mutable Vector s Word32
    v
            FrameForall -> forall s. FrameST s
    unFrameForall FrameForall
    updExtra Mutable Vector s Word32
    v
      return (baseTerrain, upd)

    -- Comfortably accomodates 3-digit level numbers and 25-character
    -- level descriptions (currently enforced max).
    --
    -- 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 -> Level -> Int -> AttrString
    drawArenaStatus COps{ContentData CaveKind
    cocave :: ContentData CaveKind
    cocave :: COps -> ContentData CaveKind
    cocave}
                    Level{ContentId CaveKind
    lkind :: ContentId CaveKind
    lkind :: Level -> ContentId CaveKind
    lkind, ldepth :: Level -> AbsDepth
    ldepth=Dice.AbsDepth Int
    ld, Int
    lseen :: Int
    lseen :: Level -> Int
    lseen, Int
    lexpl :: Int
    lexpl :: Level -> Int
    lexpl}
                    Int
    width =
      let ck :: CaveKind
    ck = ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    lkind
          seenN :: Int
    seenN = Int
    100 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    lseen Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 Int
    lexpl
          seenTxt :: Text
    seenTxt | Int
    seenN Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    100 = Text
    "all"
                  | Bool
    otherwise = Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    seenN Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "%"
          lvlN :: Text
    lvlN = Int -> Char -> Text -> Text
    T.justifyLeft Int
    2 Char
    ' ' (Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    ld)
          seenStatus :: Text
    seenStatus = Text
    "[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    seenTxt Text -> Text -> Text
    <+> Text
    "seen]"
      in Text -> AttrString
    textToAS (Text -> AttrString) -> Text -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.take (Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10)
                           (Int -> Char -> Text -> Text
    T.justifyLeft (Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10) Char
    ' ' (Text
    lvlN Text -> Text -> Text
    <+> CaveKind -> Text
    cname CaveKind
    ck))
                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Char -> Text -> Text
    T.justifyRight Int
    10 Char
    ' ' Text
    seenStatus

    drawLeaderStatus :: MonadClientUI m => Int -> m AttrString
    drawLeaderStatus :: forall (m :: * -> *). MonadClientUI m => Int -> m AttrString
    drawLeaderStatus Int
    waitT = do
      time <- (State -> Time) -> m Time
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> Time
    stime
      let calmHeaderText = String
    "Calm"
          hpHeaderText = String
    "HP"
          slashes = [String
    "/", String
    "|", String
    "\\", String
    "|"]
          waitGlobal = Time -> Time -> Int
    timeFit Time
    time Time
    timeTurn
      sUIOptions <- getsSession sUIOptions
      mleader <- getsClient sleader
      case mleader of
        Just ActorId
    leader -> do
          b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
          actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
          (hpCheckWarning, calmCheckWarning)
            <- getsState $ checkWarnings sUIOptions leader
          bdark <- getsState $ not . actorInAmbient b
          let showTrunc a
    x = let t :: String
    t = a -> String
    forall a. Show a => a -> String
    show a
    x
                            in if String -> Int
    forall a. [a] -> Int
    length String
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    3
                               then if a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0 then String
    "***" else String
    "---"
                               else String
    t
              waitSlash | Actor -> Watchfulness
    bwatch Actor
    b Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    == Watchfulness
    WSleep = Int
    waitGlobal
                        | Bool
    otherwise = Int -> Int
    forall a. Num a => a -> a
    abs Int
    waitT
              -- This is a valuable feedback for the otherwise hard to observe
              -- 'wait' command or for passing of time when sole leader sleeps.
              slashPick = [String]
    slashes [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 Int
    waitSlash Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` [String] -> Int
    forall a. [a] -> Int
    length [String]
    slashes)
              addColor Color
    c = (Char -> AttrCharW32) -> String -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    c)
              checkDelta ResDelta{(Int64, Int64)
    resCurrentTurn :: (Int64, Int64)
    resPreviousTurn :: (Int64, Int64)
    resPreviousTurn :: ResDelta -> (Int64, Int64)
    resCurrentTurn :: ResDelta -> (Int64, Int64)
    ..}
                | (Int64, Int64) -> Int64
    forall a b. (a, b) -> a
    fst (Int64, Int64)
    resCurrentTurn Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int64
    0 Bool -> Bool -> Bool
    || (Int64, Int64) -> Int64
    forall a b. (a, b) -> a
    fst (Int64, Int64)
    resPreviousTurn Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int64
    0
                  = Color -> String -> AttrString
    addColor Color
    Color.BrRed  -- alarming news have priority
                | (Int64, Int64) -> Int64
    forall a b. (a, b) -> b
    snd (Int64, Int64)
    resCurrentTurn Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 Bool -> Bool -> Bool
    || (Int64, Int64) -> Int64
    forall a b. (a, b) -> b
    snd (Int64, Int64)
    resPreviousTurn Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0
                  = Color -> String -> AttrString
    addColor Color
    Color.BrGreen
                | Bool
    otherwise = String -> AttrString
    stringToAS  -- only if nothing at all noteworthy
              checkSleep Actor
    body ResDelta
    resDelta
                | Actor -> Watchfulness
    bwatch Actor
    body Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    == Watchfulness
    WSleep = Color -> String -> AttrString
    addColor Color
    Color.cSleep
                | Bool
    otherwise = ResDelta -> String -> AttrString
    checkDelta ResDelta
    resDelta
              calmAddAttr = Actor -> ResDelta -> String -> AttrString
    checkSleep Actor
    b (ResDelta -> String -> AttrString)
    -> ResDelta -> String -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Actor -> ResDelta
    bcalmDelta Actor
    b
              -- We only show ambient light, because in fact client can't tell
              -- if a tile is lit, because it it's seen it may be due to ambient
              -- or dynamic light or due to infravision.
              darkPick | Bool
    bdark = String
    "."
                       | Bool
    otherwise = String
    ":"
              calmHeader = String -> AttrString
    calmAddAttr (String -> AttrString) -> String -> AttrString
    forall a b. (a -> b) -> a -> b
    $ String
    calmHeaderText String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    darkPick
              maxCalm = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMaxCalm Skills
    actorCurAndMaxSk
              calmText = Int64 -> String
    forall {a}. (Show a, Ord a, Num a) => a -> String
    showTrunc (Actor -> Int64
    bcalm Actor
    b Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `divUp` Int64
    oneM)
                         String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> (if Bool
    bdark then String
    slashPick else String
    "/")
                         String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall {a}. (Show a, Ord a, Num a) => a -> String
    showTrunc Int
    maxCalm
              bracePick | Actor -> Bool
    actorWaits Actor
    b = String
    "}"
                        | Bool
    otherwise = String
    ":"
              hpAddAttr = ResDelta -> String -> AttrString
    checkDelta (ResDelta -> String -> AttrString)
    -> ResDelta -> String -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Actor -> ResDelta
    bhpDelta Actor
    b
              hpHeader = String -> AttrString
    hpAddAttr (String -> AttrString) -> String -> AttrString
    forall a b. (a -> b) -> a -> b
    $ String
    hpHeaderText String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    bracePick
              maxHP = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMaxHP Skills
    actorCurAndMaxSk
              hpText = Int64 -> String
    forall {a}. (Show a, Ord a, Num a) => a -> String
    showTrunc (Actor -> Int64
    bhp Actor
    b Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `divUp` Int64
    oneM)
                       String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> (if Bool -> Bool
    not Bool
    bdark then String
    slashPick else String
    "/")
                       String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall {a}. (Show a, Ord a, Num a) => a -> String
    showTrunc Int
    maxHP
              justifyRight Int
    n String
    t = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    length String
    t) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    t
              colorWarning Bool
    w Bool
    enough Bool
    full | Bool
    w = Color -> String -> AttrString
    addColor Color
    Color.Red
                                         | Bool -> Bool
    not Bool
    enough = Color -> String -> AttrString
    addColor Color
    Color.Brown
                                         | Bool
    full = Color -> String -> AttrString
    addColor Color
    Color.Magenta
                                         | Bool
    otherwise = String -> AttrString
    stringToAS
          return $! calmHeader
                    <> colorWarning calmCheckWarning
                                    (calmEnough b actorCurAndMaxSk)
                                    (bcalm b > xM maxCalm)
                                    (justifyRight 7 calmText)
                    <+:> hpHeader
                    <> colorWarning hpCheckWarning
                                    True
                                    (bhp b > xM maxHP)
                                    (justifyRight 7 hpText)
        Maybe ActorId
    Nothing -> do
          -- This is a valuable feedback for passing of time while faction
          -- leaderless and especially while temporarily actor-less..
          let slashPick :: String
    slashPick = [String]
    slashes [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 Int
    waitGlobal Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` [String] -> Int
    forall a. [a] -> Int
    length [String]
    slashes)
          AttrString -> m AttrString
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AttrString -> m AttrString) -> AttrString -> m AttrString
    forall a b. (a -> b) -> a -> b
    $! String -> AttrString
    stringToAS (String
    calmHeaderText String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":  --" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    slashPick String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "--")
                    AttrString -> AttrString -> AttrString
    <+:> String -> AttrString
    stringToAS (String
    hpHeaderText String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ":  --/--")

    drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrString
    drawLeaderDamage :: forall (m :: * -> *).
    MonadClientUI m =>
    Int -> ActorId -> m AttrString
    drawLeaderDamage Int
    width ActorId
    leader = do
      kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
    -> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
    forall a b. (a -> b) -> a -> b
    $ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
    kitAssocs ActorId
    leader [CStore
    CEqp, CStore
    COrgan]
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      let unBurn (IK.Burn Dice
    d) = Dice -> Maybe Dice
    forall a. a -> Maybe a
    Just Dice
    d
          unBurn Effect
    _ = Maybe Dice
    forall a. Maybe a
    Nothing
          unRefillHP (IK.RefillHP Int
    n) = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
          unRefillHP Effect
    _ = Maybe Int
    forall a. Maybe a
    Nothing
          hasNonDamagesEffect ItemFull
    itemFull =
            (Effect -> Bool) -> [Effect] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\Effect
    eff -> Effect -> Bool
    IK.forApplyEffect Effect
    eff Bool -> Bool -> Bool
    && Bool -> Bool
    not (Effect -> Bool
    IK.forDamageEffect Effect
    eff))
                (ItemKind -> [Effect]
    IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> ItemKind
    itemKind ItemFull
    itemFull)
          ppDice :: Bool -> (Bool, Int, Int, ItemFullKit)
                 -> [(Bool, (AttrString, AttrString))]
          ppDice Bool
    showInBrief (Bool
    hasEffect, Int
    timeout, Int
    ncha, (ItemFull
    itemFull, (Int
    k, ItemTimers
    _))) =
            let dice :: Dice
    dice = ItemKind -> Dice
    IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> ItemKind
    itemKind ItemFull
    itemFull
                tdice :: String
    tdice = case Dice -> Maybe Int
    Dice.reduceDice Dice
    dice of
                  Just Int
    d | Bool
    showInBrief -> Int -> String
    forall a. Show a => a -> String
    show Int
    d
                  Maybe Int
    _ -> Dice -> String
    forall a. Show a => a -> String
    show Dice
    dice
                -- We ignore nested effects because they are, in general, avoidable.
                -- We also ignore repeated effect kinds for HUD simplicity.
                tBurn :: String
    tBurn = String -> (Dice -> String) -> Maybe Dice -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" ((Char
    '+' Char -> String -> String
    forall a. a -> [a] -> [a]
    :) (String -> String) -> (Dice -> String) -> Dice -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dice -> String
    forall a. Show a => a -> String
    show)  (Maybe Dice -> String) -> Maybe Dice -> String
    forall a b. (a -> b) -> a -> b
    $ [Dice] -> Maybe Dice
    forall a. [a] -> Maybe a
    listToMaybe ([Dice] -> Maybe Dice) -> [Dice] -> Maybe Dice
    forall a b. (a -> b) -> a -> b
    $ (Effect -> Maybe Dice) -> [Effect] -> [Dice]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Effect -> Maybe Dice
    unBurn
                                                   ([Effect] -> [Dice]) -> [Effect] -> [Dice]
    forall a b. (a -> b) -> a -> b
    $ ItemKind -> [Effect]
    IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> ItemKind
    itemKind ItemFull
    itemFull
                nRefillHP :: Int
    nRefillHP = Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    0) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Maybe Int
    forall a. [a] -> Maybe a
    listToMaybe ([Int] -> Maybe Int) -> [Int] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ (Effect -> Maybe Int) -> [Effect] -> [Int]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Effect -> Maybe Int
    unRefillHP
                                            ([Effect] -> [Int]) -> [Effect] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ ItemKind -> [Effect]
    IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> ItemKind
    itemKind ItemFull
    itemFull
                tRefillHP :: String
    tRefillHP | Int
    nRefillHP Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = Char
    '+' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show (- Int
    nRefillHP)
                          | Bool
    otherwise = String
    ""
                tdiceEffect :: String
    tdiceEffect = if Bool
    hasEffect Bool -> Bool -> Bool
    && ItemFull -> Bool
    hasNonDamagesEffect ItemFull
    itemFull
                              then (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    Char.toUpper String
    tdice
                              else String
    tdice
                ldice :: Color -> AttrString
    ldice Color
    color = (Char -> AttrCharW32) -> String -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    color) String
    tdiceEffect
                lBurnHP :: Bool -> AttrString
    lBurnHP Bool
    charged =
                  let cburn :: Color
    cburn = if Bool
    charged then Color
    Color.BrRed else Color
    Color.Red
                      chp :: Color
    chp = if Bool
    charged then Color
    Color.BrMagenta else Color
    Color.Magenta
                  in (Char -> AttrCharW32) -> String -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    cburn) String
    tBurn
                     AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ (Char -> AttrCharW32) -> String -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    chp) String
    tRefillHP
                possiblyHasTimeout :: Bool
    possiblyHasTimeout = Int
    timeout Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    || ItemFull -> Bool
    itemSuspect ItemFull
    itemFull
            in if Bool
    possiblyHasTimeout
               then Int
    -> (Bool, (AttrString, AttrString))
    -> [(Bool, (AttrString, AttrString))]
    forall a. Int -> a -> [a]
    replicate (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ncha)
                              (Bool
    False, (Color -> AttrString
    ldice Color
    Color.Cyan, Bool -> AttrString
    lBurnHP Bool
    False))
                    [(Bool, (AttrString, AttrString))]
    -> [(Bool, (AttrString, AttrString))]
    -> [(Bool, (AttrString, AttrString))]
    forall a. [a] -> [a] -> [a]
    ++ Int
    -> (Bool, (AttrString, AttrString))
    -> [(Bool, (AttrString, AttrString))]
    forall a. Int -> a -> [a]
    replicate Int
    ncha (Bool
    True, (Color -> AttrString
    ldice Color
    Color.BrCyan, Bool -> AttrString
    lBurnHP Bool
    True))
               else [(Bool
    True, (Color -> AttrString
    ldice Color
    Color.BrBlue, Bool -> AttrString
    lBurnHP Bool
    True))]
          lbonus :: AttrString
          lbonus =
            let bonusRaw :: Int
    bonusRaw = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkHurtMelee Skills
    actorCurAndMaxSk
                bonus :: Int
    bonus = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    200 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max (-Int
    200) Int
    bonusRaw
                unknownBonus :: Bool
    unknownBonus = [ItemFull] -> Bool
    unknownMeleeBonus ([ItemFull] -> Bool) -> [ItemFull] -> Bool
    forall a b. (a -> b) -> a -> b
    $ ((ItemId, ItemFullKit) -> ItemFull)
    -> [(ItemId, ItemFullKit)] -> [ItemFull]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemFullKit -> ItemFull
    forall a b. (a, b) -> a
    fst (ItemFullKit -> ItemFull)
    -> ((ItemId, ItemFullKit) -> ItemFullKit)
    -> (ItemId, ItemFullKit)
    -> ItemFull
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemId, ItemFullKit) -> ItemFullKit
    forall a b. (a, b) -> b
    snd) [(ItemId, ItemFullKit)]
    kitAssRaw
                tbonus :: String
    tbonus = if Int
    bonus Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                         then if Bool
    unknownBonus then String
    "+?" else String
    ""
                         else (if Int
    bonus Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then String
    "+" else String
    "")
                              String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    bonus
                              String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> (if Int
    bonus Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    bonusRaw then String
    "$" else String
    "")
                              String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> if Bool
    unknownBonus then String
    "%?" else String
    "%"
                conditionBonus :: Int
    conditionBonus = [ItemFullKit] -> Int
    conditionMeleeBonus ([ItemFullKit] -> Int) -> [ItemFullKit] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((ItemId, ItemFullKit) -> ItemFullKit)
    -> [(ItemId, ItemFullKit)] -> [ItemFullKit]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemId, ItemFullKit) -> ItemFullKit
    forall a b. (a, b) -> b
    snd [(ItemId, ItemFullKit)]
    kitAssRaw
                cbonus :: Color
    cbonus = case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    conditionBonus Int
    0 of
                  Ordering
    LT -> Color
    Color.Red
                  Ordering
    EQ -> Color
    Color.White
                  Ordering
    GT -> Color
    Color.Green
            in (Char -> AttrCharW32) -> String -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    cbonus) String
    tbonus
      let kitAssOnlyWeapons =
            ((ItemId, ItemFullKit) -> Bool)
    -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Meleeable
                    (AspectRecord -> Bool)
    -> ((ItemId, ItemFullKit) -> AspectRecord)
    -> (ItemId, ItemFullKit)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemFull -> AspectRecord
    aspectRecordFull (ItemFull -> AspectRecord)
    -> ((ItemId, ItemFullKit) -> ItemFull)
    -> (ItemId, ItemFullKit)
    -> AspectRecord
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemFullKit -> ItemFull
    forall a b. (a, b) -> a
    fst (ItemFullKit -> ItemFull)
    -> ((ItemId, ItemFullKit) -> ItemFullKit)
    -> (ItemId, ItemFullKit)
    -> ItemFull
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemId, ItemFullKit) -> ItemFullKit
    forall a b. (a, b) -> b
    snd) [(ItemId, ItemFullKit)]
    kitAssRaw
      discoBenefit <- getsClient sdiscoBenefit
      strongest <-
        map (\(Double
    _, Bool
    hasEffect, Int
    timeout, Int
    ncha, ItemId
    _, ItemFullKit
    itemFullKit) ->
              (Bool
    hasEffect, Int
    timeout, Int
    ncha, ItemFullKit
    itemFullKit))
        <$> pickWeaponM True (Just discoBenefit) kitAssOnlyWeapons
                        actorCurAndMaxSk leader
      let possiblyHasTimeout (a
    _, a
    timeout, c
    _, (ItemFull
    itemFull, b
    _)) =
            a
    timeout a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0 Bool -> Bool -> Bool
    || ItemFull -> Bool
    itemSuspect ItemFull
    itemFull
          (lT, lTrest) = span possiblyHasTimeout strongest
          strongestToDisplay = [(Bool, Int, Int, ItemFullKit)]
    lT [(Bool, Int, Int, ItemFullKit)]
    -> [(Bool, Int, Int, ItemFullKit)]
    -> [(Bool, Int, Int, ItemFullKit)]
    forall a. [a] -> [a] -> [a]
    ++ case [(Bool, Int, Int, ItemFullKit)]
    lTrest of
            [] -> []
            (Bool, Int, Int, ItemFullKit)
    noTimeout : [(Bool, Int, Int, ItemFullKit)]
    lTrest2 -> (Bool, Int, Int, ItemFullKit)
    noTimeout (Bool, Int, Int, ItemFullKit)
    -> [(Bool, Int, Int, ItemFullKit)]
    -> [(Bool, Int, Int, ItemFullKit)]
    forall a. a -> [a] -> [a]
    : ((Bool, Int, Int, ItemFullKit) -> Bool)
    -> [(Bool, Int, Int, ItemFullKit)]
    -> [(Bool, Int, Int, ItemFullKit)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool, Int, Int, ItemFullKit) -> Bool
    forall {a} {a} {c} {b}.
    (Ord a, Num a) =>
    (a, a, c, (ItemFull, b)) -> Bool
    possiblyHasTimeout [(Bool, Int, Int, ItemFullKit)]
    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 Bool
    showInBrief t (Bool, Int, Int, ItemFullKit)
    l =
            let lToDisplay :: [(Bool, (AttrString, AttrString))]
    lToDisplay = ((Bool, Int, Int, ItemFullKit)
     -> [(Bool, (AttrString, AttrString))])
    -> t (Bool, Int, Int, ItemFullKit)
    -> [(Bool, (AttrString, AttrString))]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Bool
    -> (Bool, Int, Int, ItemFullKit)
    -> [(Bool, (AttrString, AttrString))]
    ppDice Bool
    showInBrief) t (Bool, Int, Int, ItemFullKit)
    l
                ([(Bool, (AttrString, AttrString))]
    ldischarged, [(Bool, (AttrString, AttrString))]
    lrest) = ((Bool, (AttrString, AttrString)) -> Bool)
    -> [(Bool, (AttrString, AttrString))]
    -> ([(Bool, (AttrString, AttrString))],
        [(Bool, (AttrString, AttrString))])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Bool, (AttrString, AttrString)) -> Bool
    forall a b. (a, b) -> a
    fst [(Bool, (AttrString, AttrString))]
    lToDisplay
                lWithBonus :: [(AttrString, AttrString)]
    lWithBonus = case ((Bool, (AttrString, AttrString)) -> (AttrString, AttrString))
    -> [(Bool, (AttrString, AttrString))] -> [(AttrString, AttrString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, (AttrString, AttrString)) -> (AttrString, AttrString)
    forall a b. (a, b) -> b
    snd [(Bool, (AttrString, AttrString))]
    lrest of
                  [] -> []  -- no timeout-free organ, e.g., rattlesnake or hornet
                  (AttrString
    ldmg, AttrString
    lextra) : [(AttrString, AttrString)]
    rest -> (AttrString
    ldmg AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    lbonus, AttrString
    lextra) (AttrString, AttrString)
    -> [(AttrString, AttrString)] -> [(AttrString, AttrString)]
    forall a. a -> [a] -> [a]
    : [(AttrString, AttrString)]
    rest
                displayDmgAndExtra :: (AttrString, AttrString) -> AttrString
    displayDmgAndExtra (AttrString
    ldmg, AttrString
    lextra) =
                  if AttrString -> String
    attrStringToString AttrString
    ldmg String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "0"
                  then case AttrString
    lextra of
                    [] -> AttrString
    ldmg
                    AttrCharW32
    _plus : AttrString
    lextraRest -> AttrString
    lextraRest
                  else AttrString
    ldmg AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    lextra
            in AttrString -> [AttrString] -> AttrString
    forall a. [a] -> [[a]] -> [a]
    intercalate [AttrCharW32
    Color.spaceAttrW32]
               ([AttrString] -> AttrString) -> [AttrString] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ ((AttrString, AttrString) -> AttrString)
    -> [(AttrString, AttrString)] -> [AttrString]
    forall a b. (a -> b) -> [a] -> [b]
    map (AttrString, AttrString) -> AttrString
    displayDmgAndExtra ([(AttrString, AttrString)] -> [AttrString])
    -> [(AttrString, AttrString)] -> [AttrString]
    forall a b. (a -> b) -> a -> b
    $ ((Bool, (AttrString, AttrString)) -> (AttrString, AttrString))
    -> [(Bool, (AttrString, AttrString))] -> [(AttrString, AttrString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, (AttrString, AttrString)) -> (AttrString, AttrString)
    forall a b. (a, b) -> b
    snd [(Bool, (AttrString, AttrString))]
    ldischarged [(AttrString, AttrString)]
    -> [(AttrString, AttrString)] -> [(AttrString, AttrString)]
    forall a. [a] -> [a] -> [a]
    ++ [(AttrString, AttrString)]
    lWithBonus
          lFull = Bool -> [(Bool, Int, Int, ItemFullKit)] -> AttrString
    forall {t :: * -> *}.
    Foldable t =>
    Bool -> t (Bool, Int, Int, ItemFullKit) -> AttrString
    showStrongest Bool
    False [(Bool, Int, Int, ItemFullKit)]
    strongestToDisplay
          lBrief = Bool -> [(Bool, Int, Int, ItemFullKit)] -> AttrString
    forall {t :: * -> *}.
    Foldable t =>
    Bool -> t (Bool, Int, Int, ItemFullKit) -> AttrString
    showStrongest Bool
    True [(Bool, Int, Int, ItemFullKit)]
    strongestToDisplay
          lFits | AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    lFull Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    width = AttrString
    lFull
                    -- the prevailing case, so optimized for this case only
                | AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    lBrief Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    width = AttrString
    lBrief
                | Bool
    otherwise = Int -> AttrString -> AttrString
    forall a. Int -> [a] -> [a]
    take (Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) AttrString
    lBrief AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ String -> AttrString
    stringToAS String
    "..."
      return $! lFits

    drawSelected :: MonadClientUI m
                 => LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrString)
    drawSelected :: forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> Int -> EnumSet ActorId -> m (Int, AttrString)
    drawSelected LevelId
    drawnLevelId Int
    width EnumSet ActorId
    selected = do
      mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> Maybe ActorId
    sleader
      side <- getsClient sside
      sactorUI <- getsSession sactorUI
      ours <- getsState $ filter (not . bproj . snd)
                          . inline actorAssocs (== side) drawnLevelId
      let oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
    -> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ActorId
    aid, Actor
    b) -> (ActorId
    aid, Actor
    b, ActorDictUI
    sactorUI ActorDictUI -> ActorId -> ActorUI
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ActorId
    aid)) [(ActorId, Actor)]
    ours
          viewOurs (ActorId
    aid, Actor{Int64
    bhp :: Actor -> Int64
    bhp :: Int64
    bhp, Watchfulness
    bwatch :: Actor -> Watchfulness
    bwatch :: Watchfulness
    bwatch}, ActorUI{Char
    bsymbol :: ActorUI -> Char
    bsymbol :: Char
    bsymbol, Color
    bcolor :: ActorUI -> Color
    bcolor :: Color
    bcolor}) =
            -- Sleep considered before being selected, because sleeping
            -- actors can't move, so selection is mostly irrelevant.
            -- Domination not considered at all, because map already shows it
            -- and so here is the only place where selection is conveyed.
            let bg :: Highlight
    bg = if | Maybe ActorId
    mleader Maybe ActorId -> Maybe ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    aid -> Highlight
    Color.HighlightYellow
                        | Watchfulness
    bwatch Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    == Watchfulness
    WSleep -> Highlight
    Color.HighlightBlue
                        | ActorId -> EnumSet ActorId -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    ES.member ActorId
    aid EnumSet ActorId
    selected -> Highlight
    Color.HighlightGreen
                        | Bool
    otherwise -> Highlight
    Color.HighlightNone
                sattr :: Attr
    sattr = Color.Attr {fg :: Color
    Color.fg = Color
    bcolor, Highlight
    bg :: Highlight
    bg :: Highlight
    bg}
            in AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ Attr -> Char -> AttrChar
    Color.AttrChar Attr
    sattr
               (Char -> AttrChar) -> Char -> AttrChar
    forall a b. (a -> b) -> a -> b
    $ if Int64
    bhp Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 then Char
    bsymbol else Char
    '%'
          maxViewed = Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
          len = [(ActorId, Actor, ActorUI)] -> Int
    forall a. [a] -> Int
    length [(ActorId, Actor, ActorUI)]
    oursUI
          star = let fg :: Color
    fg = case EnumSet ActorId -> Int
    forall k. EnumSet k -> Int
    ES.size EnumSet ActorId
    selected of
                       Int
    0 -> Color
    Color.BrBlack
                       Int
    n | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    len -> Color
    Color.BrWhite
                       Int
    _ -> Color
    Color.defFG
                     char :: Char
    char = if Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxViewed then Char
    '$' else Char
    '*'
                 in Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    fg Char
    char
          viewed = ((ActorId, Actor, ActorUI) -> AttrCharW32)
    -> [(ActorId, Actor, ActorUI)] -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (ActorId, Actor, ActorUI) -> AttrCharW32
    viewOurs ([(ActorId, Actor, ActorUI)] -> AttrString)
    -> [(ActorId, Actor, ActorUI)] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
    forall a. Int -> [a] -> [a]
    take Int
    maxViewed
                   ([(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)])
    -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Actor, ActorUI)
     -> (Bool, Bool, Bool, Char, Color, ActorId))
    -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (ActorId, Actor, ActorUI)
    -> (Bool, Bool, Bool, Char, Color, ActorId)
    keySelected [(ActorId, Actor, ActorUI)]
    oursUI
      return (min width (len + 2), [star] ++ viewed ++ [Color.spaceAttrW32])

    checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool
    checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool
    checkWarningHP UIOptions{Int
    uhpWarningPercent :: Int
    uhpWarningPercent :: UIOptions -> Int
    uhpWarningPercent} ActorId
    leader Int64
    hp State
    s =
      let actorCurAndMaxSk :: Skills
    actorCurAndMaxSk = ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader State
    s
          maxHp :: Int
    maxHp = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMaxHP Skills
    actorCurAndMaxSk
      in Int64
    hp Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> Int64
    xM (Int
    uhpWarningPercent Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxHp Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    100)

    checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
    checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
    checkWarningCalm UIOptions{Int
    uhpWarningPercent :: UIOptions -> Int
    uhpWarningPercent :: Int
    uhpWarningPercent} ActorId
    leader Int64
    calm State
    s =
      let b :: Actor
    b = ActorId -> State -> Actor
    getActorBody ActorId
    leader State
    s
          actorCurAndMaxSk :: Skills
    actorCurAndMaxSk = ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader State
    s
          isImpression :: ItemId -> Bool
    isImpression ItemId
    iid =
            Bool -> (Int -> Bool) -> Maybe Int -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Maybe Int -> Bool) -> Maybe Int -> Bool
    forall a b. (a -> b) -> a -> b
    $ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup GroupName ItemKind
    IK.S_IMPRESSED ([(GroupName ItemKind, Int)] -> Maybe Int)
    -> [(GroupName ItemKind, Int)] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ ItemKind -> [(GroupName ItemKind, Int)]
    IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
    -> ItemKind -> [(GroupName ItemKind, Int)]
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemKind
    getIidKind ItemId
    iid State
    s
          isImpressed :: Bool
    isImpressed = (ItemId -> Bool) -> [ItemId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ItemId -> Bool
    isImpression ([ItemId] -> Bool) -> [ItemId] -> Bool
    forall a b. (a -> b) -> a -> b
    $ ItemBag -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys (ItemBag -> [ItemId]) -> ItemBag -> [ItemId]
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemBag
    borgan Actor
    b
          maxCalm :: Int
    maxCalm = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMaxCalm Skills
    actorCurAndMaxSk
      in Int64
    calm Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> Int64
    xM (Int
    uhpWarningPercent Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxCalm Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    100)
         Bool -> Bool -> Bool
    && Bool
    isImpressed

    checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)
    checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)
    checkWarnings UIOptions
    uiOptions ActorId
    leader State
    s =
      let b :: Actor
    b = ActorId -> State -> Actor
    getActorBody ActorId
    leader State
    s
      in ( UIOptions -> ActorId -> Int64 -> State -> Bool
    checkWarningHP UIOptions
    uiOptions ActorId
    leader (Actor -> Int64
    bhp Actor
    b) State
    s
         , UIOptions -> ActorId -> Int64 -> State -> Bool
    checkWarningCalm UIOptions
    uiOptions ActorId
    leader (Actor -> Int64
    bcalm Actor
    b) State
    s )