-- {-# 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.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.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
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

targetDesc :: MonadClientUI m => Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc :: Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc mtarget :: Maybe Target
mtarget = do
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  let describeActorTarget :: ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget aid :: ActorId
aid = do
        FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
        Actor
b <- (State -> Actor) -> m Actor
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
aid
        ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid
        Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
aid
        let percentage :: Int64
percentage =
             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 5 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk)
            chs :: Int -> Text
chs n :: Int
n = "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
n "*"
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) "_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
            stars :: 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 0 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min 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` 20
            hpIndicator :: Maybe Text
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
        (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bname ActorUI
bUI, Maybe Text
hpIndicator)
  case Maybe Target
mtarget of
    Just (TEnemy aid :: ActorId
aid) -> ActorId -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget ActorId
aid
    Just (TNonEnemy aid :: 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
tgoal lid :: LevelId
lid p :: 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 "hot spot" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
                      else "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 (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)
      _ -> 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
        Text
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
            ItemBag
bag <- (State -> ItemBag) -> m ItemBag
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 ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag of
              [] -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! "exact spot" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
              [(iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _))] -> do
                Time
localTime <- (State -> Time) -> m Time
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
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
                FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
                FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
                let (name :: Part
name, powers :: Part
powers) =
                      FactionId
-> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)
partItem FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
                Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makePhrase [Int -> Part -> Part
MU.Car1Ws Int
k Part
name, Part
powers]
              _ -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! "many items at" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
          else Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! "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)
        (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pointedText, Maybe Text
forall a. Maybe a
Nothing)
    Just TVector{} ->
      case Maybe ActorId
mleader of
        Nothing -> (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just "a relative shift", Maybe Text
forall a. Maybe a
Nothing)
        Just aid :: ActorId
aid -> do
          Maybe Point
tgtPos <- (State -> Maybe Point) -> m (Maybe Point)
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
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
aid LevelId
lidV Maybe Target
mtarget
          let invalidMsg :: Text
invalidMsg = "an invalid relative shift"
              validMsg :: a -> Text
validMsg p :: a
p = "shift to" Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
p
          (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> (Point -> Text) -> Maybe Point -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
invalidMsg Point -> Text
forall a. Show a => a -> Text
validMsg Maybe Point
tgtPos, Maybe Text
forall a. Maybe a
Nothing)
    Nothing -> (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
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, Watchfulness))
targetDescXhair :: m (Maybe Text, Maybe (Text, Watchfulness))
targetDescXhair = do
  Maybe Target
sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  (mhairDesc :: Maybe Text
mhairDesc, mxhairHP :: Maybe Text
mxhairHP) <- Maybe Target -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc Maybe Target
sxhair
  case Maybe Text
mxhairHP of
    Nothing -> (Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
mhairDesc, Maybe (Text, Watchfulness)
forall a. Maybe a
Nothing)
    Just tHP :: Text
tHP -> do
      let aid :: ActorId
aid = case Maybe Target
sxhair of
            Just (TEnemy a :: ActorId
a) -> ActorId
a
            Just (TNonEnemy a :: ActorId
a) -> ActorId
a
            _ -> [Char] -> ActorId
forall a. HasCallStack => [Char] -> a
error ([Char] -> ActorId) -> [Char] -> ActorId
forall a b. (a -> b) -> a -> b
$ "HP text for non-actor target" [Char] -> Maybe Target -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Maybe Target
sxhair
      Watchfulness
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 (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (ActorId -> State -> Actor
getActorBody ActorId
aid)
      (Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Text, Maybe (Text, Watchfulness))
 -> m (Maybe Text, Maybe (Text, Watchfulness)))
-> (Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness))
forall a b. (a -> b) -> a -> b
$ (Maybe Text
mhairDesc, (Text, Watchfulness) -> Maybe (Text, Watchfulness)
forall a. a -> Maybe a
Just (Text
tHP, Watchfulness
watchfulness))

drawFrameTerrain :: forall m. MonadClientUI m => LevelId -> m (U.Vector Word32)
drawFrameTerrain :: LevelId -> m (Vector Word32)
drawFrameTerrain drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax}, ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  StateClient{Int
smarkSuspect :: StateClient -> Int
smarkSuspect :: Int
smarkSuspect} <- m StateClient
forall (m :: * -> *). MonadClientRead m => m StateClient
getClient
  -- Not @ScreenContent@, because indexing in level's data.
  Level{ltile :: Level -> TileMap
ltile=PointArray.Array{Vector (UnboxRep (ContentId TileKind))
avector :: forall c. Array c -> Vector (UnboxRep c)
avector :: Vector (UnboxRep (ContentId TileKind))
avector}, ItemFloor
lembed :: Level -> ItemFloor
lembed :: ItemFloor
lembed} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
  AttrLine
frameStatus <- LevelId -> m AttrLine
forall (m :: * -> *). MonadClientUI m => LevelId -> m AttrLine
drawFrameStatus LevelId
drawnLevelId
  let dis :: PointI -> ContentId TileKind -> Color.AttrCharW32
      {-# INLINE dis #-}
      dis :: Int -> ContentId TileKind -> AttrCharW32
dis pI :: Int
pI tile :: ContentId TileKind
tile =
        let TK.TileKind{Char
tsymbol :: TileKind -> Char
tsymbol :: Char
tsymbol, Color
tcolor :: TileKind -> Color
tcolor :: Color
tcolor, Color
tcolor2 :: TileKind -> Color
tcolor2 :: 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
> 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
> 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 -> 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
toContentId Word16
tile)
      caveVector :: U.Vector Word32
      caveVector :: 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 :: Vector Word32
messageVector =
        Int -> Word32 -> Vector Word32
forall a. Unbox a => Int -> a -> Vector a
U.replicate Int
rXmax (AttrCharW32 -> Word32
Color.attrCharW32 AttrCharW32
Color.spaceAttrW32)
      statusVector :: Vector Word32
statusVector = Int -> [Word32] -> Vector Word32
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rXmax) ([Word32] -> Vector Word32) -> [Word32] -> Vector Word32
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Word32) -> AttrLine -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Word32
Color.attrCharW32 AttrLine
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@.
  Vector Word32 -> m (Vector Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Word32 -> m (Vector Word32))
-> Vector Word32 -> m (Vector Word32)
forall a b. (a -> b) -> a -> b
$ [Vector Word32] -> Vector Word32
forall a. Unbox a => [Vector a] -> Vector a
U.concat [Vector Word32
messageVector, Vector Word32
caveVector, Vector Word32
statusVector]

drawFrameContent :: forall m. MonadClientUI m => LevelId -> m FrameForall
drawFrameContent :: LevelId -> m FrameForall
drawFrameContent drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{Bool
smarkSmell :: SessionUI -> Bool
smarkSmell :: Bool
smarkSmell} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  -- Not @ScreenContent@, because indexing in level's data.
  Level{SmellMap
lsmell :: Level -> SmellMap
lsmell :: SmellMap
lsmell, Time
ltime :: Level -> Time
ltime :: Time
ltime, ItemFloor
lfloor :: Level -> ItemFloor
lfloor :: ItemFloor
lfloor} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  let {-# INLINE viewItemBag #-}
      viewItemBag :: Int -> ItemBag -> AttrCharW32
viewItemBag _ floorBag :: ItemBag
floorBag = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.toDescList ItemBag
floorBag of
        (iid :: ItemId
iid, _kit :: ItemQuant
_kit) : _ -> ItemFull -> AttrCharW32
viewItem (ItemFull -> AttrCharW32) -> ItemFull -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemFull
itemToF ItemId
iid
        [] -> [Char] -> AttrCharW32
forall a. HasCallStack => [Char] -> a
error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ "lfloor not sparse" [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
      viewSmell :: PointI -> Time -> Color.AttrCharW32
      {-# INLINE viewSmell #-}
      viewSmell :: Int -> Time -> AttrCharW32
viewSmell pI :: Int
pI sml :: 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` 13 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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) -> [(Int, a)] -> FrameST s
mapVAL f :: Int -> a -> AttrCharW32
f l :: [(Int, a)]
l v :: 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
rXmax) Word32
w
        ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> 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 :: 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
$ \v :: Mutable Vector s Word32
v -> do
        (Int -> ItemBag -> AttrCharW32) -> [(Int, ItemBag)] -> FrameST 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)] -> FrameST 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
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

drawFramePath :: forall m. MonadClientUI m => LevelId -> m FrameForall
drawFramePath :: LevelId -> m FrameForall
drawFramePath drawnLevelId :: LevelId
drawnLevelId = do
 SessionUI{Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode :: Maybe AimMode
saimMode} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
 if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode then FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameForall -> m FrameForall) -> FrameForall -> m FrameForall
forall a b. (a -> b) -> a -> b
$! (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 ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax, Int
rYmax :: RuleContent -> Int
rYmax :: Int
rYmax}, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  StateClient{Int
seps :: StateClient -> Int
seps :: Int
seps} <- m StateClient
forall (m :: * -> *). MonadClientRead m => m StateClient
getClient
  -- Not @ScreenContent@, because pathing in level's map.
  Level{ltile :: Level -> TileMap
ltile=PointArray.Array{Vector (UnboxRep (ContentId TileKind))
avector :: Vector (UnboxRep (ContentId TileKind))
avector :: forall c. Array c -> Vector (UnboxRep c)
avector}} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Maybe Point
mpos <- (State -> Maybe Point) -> m (Maybe Point)
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
$ \s :: State
s -> Actor -> Point
bpos (Actor -> Point) -> (ActorId -> Actor) -> ActorId -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId -> State -> Actor
`getActorBody` State
s) (ActorId -> Point) -> Maybe ActorId -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
mleader
  Maybe Point
xhairPosRaw <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
originPoint Maybe Point
mpos) Maybe Point
xhairPosRaw
  [Point]
bline <- case Maybe ActorId
mleader of
    Just leader :: ActorId
leader -> do
      Actor{Point
bpos :: Point
bpos :: Actor -> Point
bpos, LevelId
blid :: Actor -> LevelId
blid :: LevelId
blid} <- (State -> Actor) -> m Actor
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
      [Point] -> m [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> m [Point]) -> [Point] -> m [Point]
forall a b. (a -> b) -> a -> b
$! if LevelId
blid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
drawnLevelId
                then []
                else [Point] -> Maybe [Point] -> [Point]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Point] -> [Point]) -> Maybe [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Point -> Point -> Maybe [Point]
bla Int
rXmax Int
rYmax Int
seps Point
bpos Point
xhairPos
    _ -> [Point] -> m [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Maybe AndPath
mpath <- m (Maybe AndPath)
-> (ActorId -> m (Maybe AndPath))
-> Maybe ActorId
-> m (Maybe AndPath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe AndPath -> m (Maybe AndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AndPath
forall a. Maybe a
Nothing) (\aid :: ActorId
aid -> do
    Maybe TgtAndPath
mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
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 Maybe TgtAndPath
mtgtMPath of
      Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=tapPath :: Maybe AndPath
tapPath@(Just AndPath{Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal})}
        | Point
pathGoal Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
xhairPos -> Maybe AndPath -> m (Maybe AndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AndPath
tapPath
      _ -> ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid Point
xhairPos) Maybe ActorId
mleader
  [(ActorId, Actor)]
assocsAtxhair <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
xhairPos LevelId
drawnLevelId
  let lpath :: [Point]
lpath = if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
bline then [] else [Point] -> (AndPath -> [Point]) -> Maybe AndPath -> [Point]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] AndPath -> [Point]
pathList Maybe AndPath
mpath
      shiftedBTrajectory :: [Point]
shiftedBTrajectory = case [(ActorId, Actor)]
assocsAtxhair of
        (_, Actor{btrajectory :: Actor -> Maybe ([Vector], Speed)
btrajectory = Just p :: ([Vector], Speed)
p, bpos :: Actor -> Point
bpos = Point
prPos}) : _->
          Point -> [Vector] -> [Point]
trajectoryToPath Point
prPos (([Vector], Speed) -> [Vector]
forall a b. (a, b) -> a
fst ([Vector], Speed)
p)
        _ -> []
      shiftedLine :: [Point]
shiftedLine = if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
shiftedBTrajectory
                    then [Point]
bline
                    else [Point]
shiftedBTrajectory
      acOnPathOrLine :: Char.Char -> Point -> ContentId TileKind
                     -> Color.AttrCharW32
      acOnPathOrLine :: Char -> Point -> ContentId TileKind -> 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
                _ | ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
tile -> Color
Color.BrBlack
                _ | TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile -> Color
Color.BrMagenta
                (True, True)   -> Color
Color.BrGreen
                (True, False)  -> Color
Color.BrCyan
                (False, True)  -> Color
Color.Green
                (False, False) -> Color
Color.Cyan
        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)
-> [Point] -> FrameST s
mapVTL f :: Point -> ContentId TileKind -> AttrCharW32
f l :: [Point]
l v :: 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
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
rXmax) Word32
w
        (Point -> ST s ()) -> [Point] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Point -> ST s ()
g [Point]
l
      upd :: FrameForall
      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
$ \v :: Mutable Vector s Word32
v -> do
        (Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
forall s.
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine ';') [Point]
lpath Mutable Vector s Word32
v
        (Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
forall s.
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine '*') [Point]
shiftedLine Mutable Vector s Word32
v  -- overwrites path
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

drawFrameActor :: forall m. MonadClientUI m => LevelId -> m FrameForall
drawFrameActor :: LevelId -> m FrameForall
drawFrameActor drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{ActorDictUI
sactorUI :: SessionUI -> ActorDictUI
sactorUI :: ActorDictUI
sactorUI, EnumSet ActorId
sselected :: SessionUI -> EnumSet ActorId
sselected :: EnumSet ActorId
sselected, UIOptions
sUIOptions :: SessionUI -> UIOptions
sUIOptions :: UIOptions
sUIOptions} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  -- Not @ScreenContent@, because indexing in level's data.
  Level{BigActorMap
lbig :: Level -> BigActorMap
lbig :: BigActorMap
lbig, ProjectileMap
lproj :: Level -> ProjectileMap
lproj :: ProjectileMap
lproj} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  SessionUI{Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
  let {-# INLINE viewBig #-}
      viewBig :: ActorId -> AttrCharW32
viewBig aid :: ActorId
aid =
          let Actor{Int64
bhp :: Int64
bhp :: Actor -> Int64
bhp, FactionId
bfid :: FactionId
bfid :: Actor -> FactionId
bfid, ItemId
btrunk :: Actor -> ItemId
btrunk :: ItemId
btrunk, Watchfulness
bwatch :: Watchfulness
bwatch :: Actor -> Watchfulness
bwatch} = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
              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
              Item{Maybe FactionId
jfid :: Item -> Maybe FactionId
jfid :: 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
> 0 = Char
bsymbol
                     | Bool
otherwise = '%'
              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
              leaderColor :: Highlight
leaderColor = if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
                            then Highlight
Color.HighlightYellowAim
                            else Highlight
Color.HighlightYellow
              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
leaderColor
                      | Watchfulness
bwatch Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep -> Highlight
Color.HighlightGreen
                      | Bool
dominated -> if FactionId
bfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side  -- dominated by us
                                     then Highlight
Color.HighlightWhite
                                     else Highlight
Color.HighlightMagenta
                      | ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
sselected -> Highlight
Color.HighlightBlue
                      | 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
<= 0 = Color
bcolor
                 | Bool
otherwise =
                let (hpCheckWarning :: Bool
hpCheckWarning, calmCheckWarning :: 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 $WAttr :: Color -> Highlight -> Attr
Color.Attr{..} Char
symbol
      {-# INLINE viewProj #-}
      viewProj :: [ActorId] -> AttrCharW32
viewProj as :: [ActorId]
as = case [ActorId]
as of
        aid :: ActorId
aid : _ ->
          let 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
              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 $WAttr :: Color -> Highlight -> Attr
Color.Attr{..} Char
bsymbol
        [] -> [Char] -> AttrCharW32
forall a. HasCallStack => [Char] -> a
error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ "lproj not sparse" [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
      mapVAL :: forall a s. (a -> Color.AttrCharW32) -> [(PointI, a)]
             -> FrameST s
      {-# INLINE mapVAL #-}
      mapVAL :: (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL f :: a -> AttrCharW32
f l :: [(Int, a)]
l v :: 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
rXmax) Word32
w
        ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, a) -> ST s ()
g [(Int, a)]
l
      upd :: FrameForall
      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
$ \v :: Mutable Vector s Word32
v -> do
        ([ActorId] -> AttrCharW32) -> [(Int, [ActorId])] -> FrameST 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)] -> FrameST 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
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

drawFrameExtra :: forall m. MonadClientUI m
               => ColorMode -> LevelId -> m FrameForall
drawFrameExtra :: ColorMode -> LevelId -> m FrameForall
drawFrameExtra dm :: ColorMode
dm drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax, Int
rYmax :: Int
rYmax :: RuleContent -> Int
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode, Bool
smarkVision :: SessionUI -> Bool
smarkVision :: Bool
smarkVision} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  -- Not @ScreenContent@, because indexing in level's data.
  EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
  Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  Maybe Point
mtgtPos <- do
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    case Maybe ActorId
mleader of
      Nothing -> Maybe Point -> m (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
      Just leader :: ActorId
leader -> do
        Maybe Target
mtgt <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
leader
        (State -> Maybe Point) -> m (Maybe Point)
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
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
leader LevelId
drawnLevelId Maybe Target
mtgt
  let visionMarks :: [Int]
visionMarks =
        if Bool
smarkVision
        then 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
        else []
      backlightVision :: Color.AttrChar -> Color.AttrChar
      backlightVision :: AttrChar -> AttrChar
backlightVision ac :: AttrChar
ac = case AttrChar
ac of
        Color.AttrChar (Color.Attr fg :: Color
fg _) ch :: Char
ch ->
          Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
Color.HighlightGrey) Char
ch
      writeSquare :: Highlight -> AttrChar -> AttrChar
writeSquare !Highlight
hi (Color.AttrChar (Color.Attr fg :: Color
fg bg :: Highlight
bg) ch :: 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 :: AttrChar -> AttrChar
turnBW (Color.AttrChar _ ch :: 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) -> [Int] -> FrameST s
mapVL f :: AttrChar -> AttrChar
f l :: [Int]
l v :: Mutable Vector s Word32
v = do
        let g :: PointI -> ST s ()
            g :: Int -> ST s ()
g !Int
pI = do
              Word32
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
rXmax)
              let w :: Word32
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
              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
rXmax) Word32
w
        (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> ST s ()
g [Int]
l
      -- Here @rXmax@ and @rYmax@ are correct, because we are not
      -- turning the whole screen into black&white, but only the level map.
      lDungeon :: [Int]
lDungeon = [0..Int
rXmax Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rYmax Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
      xhairColor :: Highlight
xhairColor = if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
                   then Highlight
Color.HighlightRedAim
                   else Highlight
Color.HighlightRed
      upd :: FrameForall
      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
$ \v :: 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) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
backlightVision [Int]
visionMarks Mutable Vector s Word32
v
        case Maybe Point
mtgtPos of
          Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just p :: Point
p -> (AttrChar -> AttrChar) -> [Int] -> FrameST 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
        case Maybe Point
mxhairPos of  -- overwrites target
          Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just p :: Point
p -> (AttrChar -> AttrChar) -> [Int] -> FrameST 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] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
turnBW [Int]
lDungeon Mutable Vector s Word32
v
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

drawFrameStatus :: MonadClientUI m => LevelId -> m AttrLine
drawFrameStatus :: LevelId -> m AttrLine
drawFrameStatus drawnLevelId :: LevelId
drawnLevelId = do
  cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{rXmax :: RuleContent -> Int
rXmax=Int
_rXmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{EnumSet ActorId
sselected :: EnumSet ActorId
sselected :: SessionUI -> EnumSet ActorId
sselected, Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode, Int
swaitTimes :: SessionUI -> Int
swaitTimes :: Int
swaitTimes, Maybe (ItemId, CStore, Bool)
sitemSel :: SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Maybe Point
xhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  Maybe (Array BfsDistance)
mbfs <- m (Maybe (Array BfsDistance))
-> (ActorId -> m (Maybe (Array BfsDistance)))
-> Maybe ActorId
-> m (Maybe (Array BfsDistance))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Array BfsDistance) -> m (Maybe (Array BfsDistance))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Array BfsDistance)
forall a. Maybe a
Nothing) (\aid :: ActorId
aid -> Array BfsDistance -> Maybe (Array BfsDistance)
forall a. a -> Maybe a
Just (Array BfsDistance -> Maybe (Array BfsDistance))
-> m (Array BfsDistance) -> m (Maybe (Array BfsDistance))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid) Maybe ActorId
mleader
  (mhairDesc :: Maybe Text
mhairDesc, mxhairHPWatchfulness :: Maybe (Text, Watchfulness)
mxhairHPWatchfulness) <- m (Maybe Text, Maybe (Text, Watchfulness))
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe Text, Maybe (Text, Watchfulness))
targetDescXhair
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
  (mblid :: Maybe LevelId
mblid, mbpos :: Maybe Point
mbpos, mbodyUI :: Maybe ActorUI
mbodyUI) <- case Maybe ActorId
mleader of
    Just leader :: ActorId
leader -> do
      Actor{Point
bpos :: Point
bpos :: Actor -> Point
bpos, LevelId
blid :: LevelId
blid :: Actor -> LevelId
blid} <- (State -> Actor) -> m Actor
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
      ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
      (Maybe LevelId, Maybe Point, Maybe ActorUI)
-> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
blid, Point -> Maybe Point
forall a. a -> Maybe a
Just Point
bpos, ActorUI -> Maybe ActorUI
forall a. a -> Maybe a
Just ActorUI
bodyUI)
    Nothing -> (Maybe LevelId, Maybe Point, Maybe ActorUI)
-> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
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
widthX = 80
      widthTgt :: Int
widthTgt = 39
      widthStatus :: Int
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
- 1
      arenaStatus :: AttrLine
arenaStatus = COps -> Level -> Int -> AttrLine
drawArenaStatus COps
cops Level
lvl Int
widthStatus
      leaderStatusWidth :: Int
leaderStatusWidth = 23
  AttrLine
leaderStatus <- Int -> m AttrLine
forall (m :: * -> *). MonadClientUI m => Int -> m AttrLine
drawLeaderStatus Int
swaitTimes
  (selectedStatusWidth :: Int
selectedStatusWidth, selectedStatus :: AttrLine
selectedStatus)
    <- LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)
drawSelected LevelId
drawnLevelId (Int
widthStatus Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leaderStatusWidth) EnumSet ActorId
sselected
  let speedStatusWidth :: Int
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
  AttrLine
speedDisplay <- case Maybe ActorId
mleader of
    Nothing -> AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just leader :: ActorId
leader -> do
      Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
      [(ItemId, ItemFullKit)]
kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
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]
      let speed :: Int
speed = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSpeed Skills
actorMaxSk
          unknownBonus :: Bool
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 :: [Char]
speedString = Int -> [Char]
displaySpeed Int
speed [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
unknownBonus then "?" else ""
          conditionBonus :: Int
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 :: Color
cspeed = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
conditionBonus 0 of
            EQ -> Color
Color.White
            GT -> Color
Color.Green
            LT -> Color
Color.Red
      AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
cspeed) [Char]
speedString
  let speedStatus :: AttrLine
speedStatus = if AttrLine -> Int
forall a. [a] -> Int
length AttrLine
speedDisplay Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
speedStatusWidth
                    then []
                    else AttrLine
speedDisplay AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32]
      displayPathText :: Maybe Point -> Maybe Text -> Text
displayPathText mp :: Maybe Point
mp mt :: Maybe Text
mt =
        let (plen :: Int
plen, llen :: Int
llen) | Just target :: Point
target <- Maybe Point
mp
                         , Just bfs :: Array BfsDistance
bfs <- Maybe (Array BfsDistance)
mbfs
                         , Just bpos :: 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 0 (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
target)
                           , Point -> Point -> Int
chessDist Point
bpos Point
target )
                         | Bool
otherwise = (0, 0)
            pText :: Text
pText | Int
plen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
                  | Bool
otherwise = "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
== 0 = ""
                  | Bool
otherwise = "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 "" else " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
      -- The indicators must fit, they are the actual information.
      pathCsr :: Text
pathCsr = Maybe Point -> Maybe Text -> Text
displayPathText Maybe Point
xhairPos ((Text, Watchfulness) -> Text
forall a b. (a, b) -> a
fst ((Text, Watchfulness) -> Text)
-> Maybe (Text, Watchfulness) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, Watchfulness)
mxhairHPWatchfulness)
      trimTgtDesc :: Int -> Text -> Text
trimTgtDesc n :: Int
n t :: 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
> 2 Bool -> (Text, Int) -> Bool
forall a. Show a => Bool -> a -> 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
- 3) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "..."
      -- The indicators must fit, they are the actual information.
      widthXhairOrItem :: Int
widthXhairOrItem = Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pathCsr Int -> Int -> Int
forall a. Num a => a -> a -> a
- 8
      nMember :: Part
nMember = Int -> Part
MU.Ord (Int -> Part) -> Int -> Part
forall a b. (a -> b) -> a -> b
$ 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 :: Text
fallback = if Player -> LeaderMode
MK.fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
MK.LeaderNull
                 then "This faction never picks a leader"
                 else [Part] -> Text
makePhrase
                        ["Waiting for", Part
nMember, "team member to spawn"]
      leaderName :: ActorUI -> Text
leaderName bUI :: ActorUI
bUI = Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 8) (ActorUI -> Text
bname ActorUI
bUI)
      leaderBlurbLong :: Text
leaderBlurbLong = Text -> (ActorUI -> Text) -> Maybe ActorUI -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
fallback (\bUI :: ActorUI
bUI ->
        "Leader:" Text -> Text -> Text
<+> ActorUI -> Text
leaderName ActorUI
bUI) Maybe ActorUI
mbodyUI
      leaderBlurbShort :: Text
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
  [(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
  let na :: Int
na = [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
ours
      nl :: Int
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
      ns :: Int
ns = ItemBag -> Int
forall k a. EnumMap k a -> Int
EM.size (ItemBag -> Int) -> ItemBag -> Int
forall a b. (a -> b) -> a -> b
$ Faction -> ItemBag
gsha Faction
fact
      -- To be replaced by something more useful.
      teamBlurb :: AttrLine
teamBlurb = Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
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 [ "Team:"
                   , Int -> Part -> Part
MU.CarWs Int
na "actor", "on"
                   , Int -> Part -> Part
MU.CarWs Int
nl "level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ","
                   , "stash", Int -> Part
MU.Car Int
ns ]
      markSleepTgtDesc :: Text -> AttrLine
markSleepTgtDesc
        | ((Text, Watchfulness) -> Watchfulness
forall a b. (a, b) -> b
snd ((Text, Watchfulness) -> Watchfulness)
-> Maybe (Text, Watchfulness) -> Maybe Watchfulness
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, Watchfulness)
mxhairHPWatchfulness) Maybe Watchfulness -> Maybe Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness -> Maybe Watchfulness
forall a. a -> Maybe a
Just Watchfulness
WSleep = Text -> AttrLine
textToAL
        | Bool
otherwise = Color -> Text -> AttrLine
textFgToAL Color
Color.Green
      xhairBlurb :: AttrLine
xhairBlurb =
        AttrLine -> (Text -> AttrLine) -> Maybe Text -> AttrLine
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AttrLine
teamBlurb (\t :: Text
t ->
          Text -> AttrLine
textToAL (if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode then "x-hair>" else "X-hair:")
          AttrLine -> AttrLine -> AttrLine
<+:> Text -> AttrLine
markSleepTgtDesc (Int -> Text -> Text
trimTgtDesc Int
widthXhairOrItem Text
t))
        Maybe Text
mhairDesc
      tgtOrItem :: m (AttrLine, Text)
tgtOrItem
        | Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) <- Maybe (ItemId, CStore, Bool)
sitemSel
        , Just leader :: ActorId
leader <- Maybe ActorId
mleader
        = do
            Actor
b <- (State -> Actor) -> m Actor
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
            ItemBag
bag <- (State -> ItemBag) -> m ItemBag
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
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
            case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
              Nothing -> (AttrLine, Text) -> m (AttrLine, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine
xhairBlurb, Text
pathCsr)
              Just kit :: ItemQuant
kit@(k :: Int
k, _) -> do
                Time
localTime <- (State -> Time) -> m Time
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
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
                FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
                let (name :: Part
name, powers :: Part
powers) =
                      FactionId
-> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)
partItem (Actor -> FactionId
bfid Actor
b) FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
                    t :: Text
t = [Part] -> Text
makePhrase [Int -> Part -> Part
MU.Car1Ws Int
k Part
name, Part
powers]
                (AttrLine, Text) -> m (AttrLine, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ "Item:" Text -> Text -> Text
<+> Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 6) Text
t, "")
        | Bool
otherwise =
            (AttrLine, Text) -> m (AttrLine, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine
xhairBlurb, Text
pathCsr)
  (xhairLine :: AttrLine
xhairLine, pathXhairOrNull :: Text
pathXhairOrNull) <- m (AttrLine, Text)
tgtOrItem
  AttrLine
damageStatus <- m AttrLine
-> (ActorId -> m AttrLine) -> Maybe ActorId -> m AttrLine
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Int -> ActorId -> m AttrLine
forall (m :: * -> *).
MonadClientUI m =>
Int -> ActorId -> m AttrLine
drawLeaderDamage Int
widthTgt) Maybe ActorId
mleader
  let damageStatusWidth :: Int
damageStatusWidth = AttrLine -> Int
forall a. [a] -> Int
length AttrLine
damageStatus
      withForLeader :: Int
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
- 1
      leaderBottom :: Text
leaderBottom =
        if | Text -> Int
T.length Text
leaderBlurbShort Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> ""
           | 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 :: AttrLine
damageGap = Int -> AttrLine
emptyAttrLine
                  (Int -> AttrLine) -> Int -> AttrLine
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 :: AttrLine
xhairGap = Int -> AttrLine
emptyAttrLine (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
- AttrLine -> Int
forall a. [a] -> Int
length AttrLine
xhairLine)
      xhairStatus :: AttrLine
xhairStatus = AttrLine
xhairLine AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
xhairGap AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ Text -> AttrLine
textToAL Text
pathXhairOrNull
      selectedGap :: AttrLine
selectedGap = Int -> AttrLine
emptyAttrLine (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
- AttrLine -> Int
forall a. [a] -> Int
length AttrLine
speedStatus)
      status :: AttrLine
status = AttrLine
arenaStatus
               AttrLine -> AttrLine -> AttrLine
<+:> AttrLine
xhairStatus
               AttrLine -> AttrLine -> AttrLine
forall a. Semigroup a => a -> a -> a
<> AttrLine
selectedStatus AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
selectedGap AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
speedStatus AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
leaderStatus
               AttrLine -> AttrLine -> AttrLine
<+:> (Text -> AttrLine
textToAL Text
leaderBottom AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
damageGap AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
damageStatus)
  -- Keep it at least partially lazy, to avoid allocating the whole list:
  AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return
#ifdef WITH_EXPENSIVE_ASSERTIONS
    $ assert (length status == 2 * _rXmax
              `blame` map Color.charFromW32 status)
#endif
        AttrLine
status

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

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

drawLeaderStatus :: MonadClientUI m => Int -> m AttrLine
drawLeaderStatus :: Int -> m AttrLine
drawLeaderStatus waitT :: Int
waitT = do
  Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  let calmHeaderText :: [Char]
calmHeaderText = "Calm"
      hpHeaderText :: [Char]
hpHeaderText = "HP"
      slashes :: [[Char]]
slashes = ["/", "|", "\\", "|"]
      waitGlobal :: Int
waitGlobal = Time -> Time -> Int
timeFit Time
time Time
timeTurn
  UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  case Maybe ActorId
mleader of
    Just leader :: ActorId
leader -> do
      Actor
b <- (State -> Actor) -> m Actor
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
      Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
      (hpCheckWarning :: Bool
hpCheckWarning, calmCheckWarning :: Bool
calmCheckWarning)
        <- (State -> (Bool, Bool)) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (Bool, Bool)) -> m (Bool, Bool))
-> (State -> (Bool, Bool)) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings UIOptions
sUIOptions ActorId
leader
      Bool
bdark <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Bool -> Bool
not (Actor -> State -> Bool
actorInAmbient Actor
b State
s)
      let showTrunc :: a -> [Char]
showTrunc x :: a
x = let t :: [Char]
t = a -> [Char]
forall a. Show a => a -> [Char]
show a
x
                        in if [Char] -> Int
forall a. [a] -> Int
length [Char]
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 3
                           then if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "***" else "---"
                           else [Char]
t
          waitSlash :: Int
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 :: [Char]
slashPick = [[Char]]
slashes [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
waitSlash Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
length [[Char]]
slashes)
          addColor :: Color -> [Char] -> AttrLine
addColor c :: Color
c = (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
c)
          checkDelta :: ResDelta -> [Char] -> AttrLine
checkDelta ResDelta{..}
            | (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 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
< 0
              = Color -> [Char] -> AttrLine
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
> 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
> 0
              = Color -> [Char] -> AttrLine
addColor Color
Color.BrGreen
            | Bool
otherwise = [Char] -> AttrLine
stringToAL  -- only if nothing at all noteworthy
          checkSleep :: Actor -> ResDelta -> [Char] -> AttrLine
checkSleep body :: Actor
body resDelta :: ResDelta
resDelta
            | Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep = Color -> [Char] -> AttrLine
addColor Color
Color.Green
            | Bool
otherwise = ResDelta -> [Char] -> AttrLine
checkDelta ResDelta
resDelta
          calmAddAttr :: [Char] -> AttrLine
calmAddAttr = Actor -> ResDelta -> [Char] -> AttrLine
checkSleep Actor
b (ResDelta -> [Char] -> AttrLine) -> ResDelta -> [Char] -> AttrLine
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 :: [Char]
darkPick | Bool
bdark = "."
                   | Bool
otherwise = ":"
          calmHeader :: AttrLine
calmHeader = [Char] -> AttrLine
calmAddAttr ([Char] -> AttrLine) -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ [Char]
calmHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
darkPick
          calmText :: [Char]
calmText = Int64 -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
oneM)
                     [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Bool
bdark then [Char]
slashPick else "/")
                     [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm
                                                         Skills
actorMaxSk)
          bracePick :: [Char]
bracePick | Actor -> Bool
actorWaits Actor
b = "}"
                    | Bool
otherwise = ":"
          hpAddAttr :: [Char] -> AttrLine
hpAddAttr = ResDelta -> [Char] -> AttrLine
checkDelta (ResDelta -> [Char] -> AttrLine) -> ResDelta -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ Actor -> ResDelta
bhpDelta Actor
b
          hpHeader :: AttrLine
hpHeader = [Char] -> AttrLine
hpAddAttr ([Char] -> AttrLine) -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ [Char]
hpHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
bracePick
          hpText :: [Char]
hpText = Int64 -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
oneM)
                   [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Bool -> Bool
not Bool
bdark then [Char]
slashPick else "/")
                   [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP
                                                       Skills
actorMaxSk)
          justifyRight :: Int -> [Char] -> [Char]
justifyRight n :: Int
n t :: [Char]
t = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
length [Char]
t) ' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t
          colorWarning :: Bool -> [Char] -> AttrLine
colorWarning w :: Bool
w = if Bool
w then Color -> [Char] -> AttrLine
addColor Color
Color.Red else [Char] -> AttrLine
stringToAL
      AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! AttrLine
calmHeader
                AttrLine -> AttrLine -> AttrLine
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char] -> AttrLine
colorWarning Bool
calmCheckWarning (Int -> [Char] -> [Char]
justifyRight 7 [Char]
calmText)
                AttrLine -> AttrLine -> AttrLine
<+:> AttrLine
hpHeader
                AttrLine -> AttrLine -> AttrLine
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char] -> AttrLine
colorWarning Bool
hpCheckWarning (Int -> [Char] -> [Char]
justifyRight 7 [Char]
hpText)
    Nothing -> do
      -- This is a valuable feedback for passing of time while faction
      -- leaderless and especially while temporarily actor-less..
      let slashPick :: [Char]
slashPick = [[Char]]
slashes [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
waitGlobal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
length [[Char]]
slashes)
      AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! [Char] -> AttrLine
stringToAL ([Char]
calmHeaderText [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ":  --" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
slashPick [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "--")
                AttrLine -> AttrLine -> AttrLine
<+:> [Char] -> AttrLine
stringToAL ([Char]
hpHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ":  --/--")

drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrLine
drawLeaderDamage :: Int -> ActorId -> m AttrLine
drawLeaderDamage width :: Int
width leader :: ActorId
leader = do
  [(ItemId, ItemFullKit)]
kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
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]
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
  let hasTimeout :: ItemFull -> Bool
hasTimeout itemFull :: ItemFull
itemFull =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            timeout :: Int
timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
        in Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
      hasEffect :: ItemFull -> Bool
hasEffect itemFull :: ItemFull
itemFull =
        (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.forApplyEffect ([Effect] -> Bool) -> [Effect] -> Bool
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
      ppDice :: (Int, ItemFullKit) -> [(Bool, AttrLine)]
      ppDice :: (Int, ItemFullKit) -> [(Bool, AttrLine)]
ppDice (nch :: Int
nch, (itemFull :: ItemFull
itemFull, (k :: Int
k, _))) =
        let tdice :: [Char]
tdice = Dice -> [Char]
forall a. Show a => a -> [Char]
show (Dice -> [Char]) -> Dice -> [Char]
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
            tdiceEffect :: [Char]
tdiceEffect = if ItemFull -> Bool
hasEffect ItemFull
itemFull
                          then (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toUpper [Char]
tdice
                          else [Char]
tdice
        in if ItemFull -> Bool
hasTimeout ItemFull
itemFull
           then Int -> (Bool, AttrLine) -> [(Bool, AttrLine)]
forall a. Int -> a -> [a]
replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nch)
                  (Bool
False, (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.Cyan) [Char]
tdiceEffect)
                [(Bool, AttrLine)] -> [(Bool, AttrLine)] -> [(Bool, AttrLine)]
forall a. [a] -> [a] -> [a]
++ Int -> (Bool, AttrLine) -> [(Bool, AttrLine)]
forall a. Int -> a -> [a]
replicate Int
nch
                     (Bool
True, (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.BrCyan) [Char]
tdiceEffect)
           else [(Bool
True, (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.BrBlue) [Char]
tdiceEffect)]
      lbonus :: AttrLine
      lbonus :: AttrLine
lbonus =
        let bonusRaw :: Int
bonusRaw = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorMaxSk
            bonus :: Int
bonus = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 200 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-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 :: [Char]
tbonus = if Int
bonus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                     then if Bool
unknownBonus then "+?" else ""
                     else (if Int
bonus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "+" else "")
                          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
bonus
                          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Int
bonus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bonusRaw then "$" else "")
                          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> if Bool
unknownBonus then "%?" else "%"
            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 0 of
              EQ -> Color
Color.White
              GT -> Color
Color.Green
              LT -> Color
Color.Red
        in (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
cbonus) [Char]
tbonus
  let kitAssOnlyWeapons :: [(ItemId, ItemFullKit)]
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
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  [(Int, ItemFullKit)]
strongest <- ((Double, (Int, (ItemId, ItemFullKit))) -> (Int, ItemFullKit))
-> [(Double, (Int, (ItemId, ItemFullKit)))] -> [(Int, ItemFullKit)]
forall a b. (a -> b) -> [a] -> [b]
map (((ItemId, ItemFullKit) -> ItemFullKit)
-> (Int, (ItemId, ItemFullKit)) -> (Int, ItemFullKit)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd ((Int, (ItemId, ItemFullKit)) -> (Int, ItemFullKit))
-> ((Double, (Int, (ItemId, ItemFullKit)))
    -> (Int, (ItemId, ItemFullKit)))
-> (Double, (Int, (ItemId, ItemFullKit)))
-> (Int, ItemFullKit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, (Int, (ItemId, ItemFullKit)))
-> (Int, (ItemId, ItemFullKit))
forall a b. (a, b) -> b
snd) ([(Double, (Int, (ItemId, ItemFullKit)))] -> [(Int, ItemFullKit)])
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
-> m [(Int, ItemFullKit)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
pickWeaponM Bool
True (DiscoveryBenefit -> Maybe DiscoveryBenefit
forall a. a -> Maybe a
Just DiscoveryBenefit
discoBenefit) [(ItemId, ItemFullKit)]
kitAssOnlyWeapons Skills
actorSk ActorId
leader
  let (lT :: [(Int, ItemFullKit)]
lT, lRatherNoT :: [(Int, ItemFullKit)]
lRatherNoT) = ((Int, ItemFullKit) -> Bool)
-> [(Int, ItemFullKit)]
-> ([(Int, ItemFullKit)], [(Int, ItemFullKit)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (ItemFull -> Bool
hasTimeout (ItemFull -> Bool)
-> ((Int, ItemFullKit) -> ItemFull) -> (Int, ItemFullKit) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((Int, ItemFullKit) -> ItemFullKit)
-> (Int, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(Int, ItemFullKit)]
strongest
      strongestToDisplay :: [(Int, ItemFullKit)]
strongestToDisplay = [(Int, ItemFullKit)]
lT [(Int, ItemFullKit)]
-> [(Int, ItemFullKit)] -> [(Int, ItemFullKit)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, ItemFullKit)] -> [(Int, ItemFullKit)]
forall a. Int -> [a] -> [a]
take 1 [(Int, ItemFullKit)]
lRatherNoT
      lToDisplay :: [(Bool, AttrLine)]
lToDisplay = ((Int, ItemFullKit) -> [(Bool, AttrLine)])
-> [(Int, ItemFullKit)] -> [(Bool, AttrLine)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, ItemFullKit) -> [(Bool, AttrLine)]
ppDice [(Int, ItemFullKit)]
strongestToDisplay
      (ldischarged :: [(Bool, AttrLine)]
ldischarged, lrest :: [(Bool, AttrLine)]
lrest) = ((Bool, AttrLine) -> Bool)
-> [(Bool, AttrLine)] -> ([(Bool, AttrLine)], [(Bool, AttrLine)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, AttrLine) -> Bool) -> (Bool, AttrLine) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, AttrLine) -> Bool
forall a b. (a, b) -> a
fst) [(Bool, AttrLine)]
lToDisplay
      lWithBonus :: [AttrLine]
lWithBonus = case ((Bool, AttrLine) -> AttrLine) -> [(Bool, AttrLine)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd [(Bool, AttrLine)]
lrest of
        [] -> []  -- unlikely; means no timeout-free organ
        l1 :: AttrLine
l1 : rest :: [AttrLine]
rest -> (AttrLine
l1 AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
lbonus) AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: [AttrLine]
rest
      lFlat :: AttrLine
lFlat = AttrLine -> [AttrLine] -> AttrLine
forall a. [a] -> [[a]] -> [a]
intercalate [AttrCharW32
Color.spaceAttrW32]
              ([AttrLine] -> AttrLine) -> [AttrLine] -> AttrLine
forall a b. (a -> b) -> a -> b
$ ((Bool, AttrLine) -> AttrLine) -> [(Bool, AttrLine)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd [(Bool, AttrLine)]
ldischarged [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ [AttrLine]
lWithBonus
      lFits :: AttrLine
lFits = if AttrLine -> Int
forall a. [a] -> Int
length AttrLine
lFlat Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
              then Int -> AttrLine -> AttrLine
forall a. Int -> [a] -> [a]
take (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) AttrLine
lFlat AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ [Char] -> AttrLine
stringToAL "..."
              else AttrLine
lFlat
  AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! AttrLine
lFits

drawSelected :: MonadClientUI m
             => LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrLine)
drawSelected :: LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)
drawSelected drawnLevelId :: LevelId
drawnLevelId width :: Int
width selected :: EnumSet ActorId
selected = do
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
  [(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
                      ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)])
-> (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
forall a. a -> a
inline (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
drawnLevelId
  let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(aid :: ActorId
aid, b :: 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, Actor, ActorUI) -> AttrCharW32
viewOurs (aid :: ActorId
aid, Actor{Int64
bhp :: Int64
bhp :: Actor -> Int64
bhp, Watchfulness
bwatch :: Watchfulness
bwatch :: Actor -> Watchfulness
bwatch}, ActorUI{Char
bsymbol :: Char
bsymbol :: ActorUI -> Char
bsymbol, Color
bcolor :: Color
bcolor :: ActorUI -> 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.HighlightGreen
                    | ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
selected -> Highlight
Color.HighlightBlue
                    | Bool
otherwise -> Highlight
Color.HighlightNone
            sattr :: Attr
sattr = $WAttr :: Color -> Highlight -> Attr
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
> 0 then Char
bsymbol else '%'
      maxViewed :: Int
maxViewed = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
      len :: Int
len = [(ActorId, Actor, ActorUI)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor, ActorUI)]
oursUI
      star :: AttrCharW32
star = let fg :: Color
fg = case EnumSet ActorId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet ActorId
selected of
                   0 -> Color
Color.BrBlack
                   n :: Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len -> Color
Color.BrWhite
                   _ -> Color
Color.defFG
                 char :: Char
char = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxViewed then '$' else '*'
             in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
char
      viewed :: AttrLine
viewed = ((ActorId, Actor, ActorUI) -> AttrCharW32)
-> [(ActorId, Actor, ActorUI)] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor, ActorUI) -> AttrCharW32
viewOurs ([(ActorId, Actor, ActorUI)] -> AttrLine)
-> [(ActorId, Actor, ActorUI)] -> AttrLine
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
  (Int, AttrLine) -> m (Int, AttrLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
width (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2), [AttrCharW32
star] AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
viewed AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32])

checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions{Int
uhpWarningPercent :: UIOptions -> Int
uhpWarningPercent :: Int
uhpWarningPercent} leader :: ActorId
leader hp :: Int64
hp s :: State
s =
  let actorMaxSk :: Skills
actorMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
leader State
s
      maxHp :: Int
maxHp = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk
  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` 100)

checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions{Int
uhpWarningPercent :: Int
uhpWarningPercent :: UIOptions -> Int
uhpWarningPercent} leader :: ActorId
leader calm :: Int64
calm s :: State
s =
  let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
      actorMaxSk :: Skills
actorMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
leader State
s
      isImpression :: ItemId -> Bool
isImpression iid :: 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
> 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 "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
actorMaxSk
  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` 100)
     Bool -> Bool -> Bool
&& Bool
isImpressed

checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings uiOptions :: UIOptions
uiOptions leader :: ActorId
leader s :: 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 )