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

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.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
import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal

targetDesc :: MonadClientUI m => Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc :: Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc 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 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 =
             Int64
100 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Actor -> Int64
bhp Actor
b
              Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int -> Int64
xM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
5 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk)
            chs :: Int -> Text
chs Int
n = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Text
"_"
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
n Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
            stars :: Text
stars = Int -> Text
chs (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
0 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
4 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64
percentage Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
20
            hpIndicator :: 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 ActorId
aid) -> ActorId -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget ActorId
aid
    Just (TNonEnemy ActorId
aid) -> ActorId -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget ActorId
aid
    Just (TPoint TGoal
tgoal LevelId
lid Point
p) -> case TGoal
tgoal of
      TEnemyPos{} -> do
        let hotText :: Text
hotText = if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV Bool -> Bool -> Bool
&& LevelId
arena LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
                      then Text
"hot spot" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
                      else Text
"a hot spot on level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid)
        (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hotText, Maybe Text
forall a. Maybe a
Nothing)
      TGoal
_ -> do  -- the other goals can be invalidated by now anyway and it's
               -- better to say what there is rather than what there isn't
        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
$! Text
"spot" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
              [(ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_))] -> do
                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
                CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
                let (Part
name, Part
powers) =
                      Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem Int
rwidth 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]
              [(ItemId, ItemQuant)]
_ -> 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
$! Text
"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
$! Text
"an exact spot on level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid)
        (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{} -> do
      Maybe Point
mtgtPos <- (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
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos Maybe ActorId
mleader LevelId
lidV Maybe Target
mtarget
      let invalidMsg :: Text
invalidMsg = Text
"a relative shift"
          validMsg :: a -> Text
validMsg a
p = Text
"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
mtgtPos, Maybe Text
forall a. Maybe a
Nothing)
    Maybe Target
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, Maybe Watchfulness)
targetDescXhair :: m (Maybe Text, Maybe Text, Maybe 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
  (Maybe Text
mhairDesc, 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
  let maid :: Maybe ActorId
maid = case Maybe Target
sxhair of
        Just (TEnemy ActorId
a) -> ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
a
        Just (TNonEnemy ActorId
a) -> ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
a
        Maybe Target
_ -> Maybe ActorId
forall a. Maybe a
Nothing
  case Maybe ActorId
maid of
    Maybe ActorId
Nothing -> (Maybe Text, Maybe Text, Maybe Watchfulness)
-> m (Maybe Text, Maybe Text, Maybe Watchfulness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
mhairDesc, Maybe Text
mxhairHP, Maybe Watchfulness
forall a. Maybe a
Nothing)
    Just ActorId
aid -> do
      Watchfulness
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, Maybe Watchfulness)
-> m (Maybe Text, Maybe Text, Maybe Watchfulness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
mhairDesc, Maybe Text
mxhairHP, Watchfulness -> Maybe Watchfulness
forall a. a -> Maybe a
Just Watchfulness
watchfulness)

drawFrameTerrain :: forall m. MonadClientUI m => LevelId -> m (U.Vector Word32)
drawFrameTerrain :: LevelId -> m (Vector Word32)
drawFrameTerrain LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax}, 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
  AttrString
frameStatus <- LevelId -> m AttrString
forall (m :: * -> *). MonadClientUI m => LevelId -> m AttrString
drawFrameStatus LevelId
drawnLevelId
  let dis :: PointI -> ContentId TileKind -> Color.AttrCharW32
      {-# INLINE dis #-}
      dis :: Int -> ContentId TileKind -> AttrCharW32
dis Int
pI 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
> Int
0
                 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile = Color
Color.BrMagenta
               | Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup ContentId TileKind
tile = Color
Color.Magenta
               | -- Converting maps is cheaper than converting points
                 -- and this function is a bottleneck, so we hack a bit.
                 Int
pI Int -> IntSet -> Bool
`IS.member` EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
totVisible
                 -- If all embeds spent, mark it with darker colour.
                 Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isEmbed TileSpeedup
coTileSpeedup ContentId TileKind
tile
                         Bool -> Bool -> Bool
&& Int
pI Int -> IntMap ItemBag -> Bool
forall a. Int -> IntMap a -> Bool
`IM.notMember`
                              ItemFloor -> IntMap ItemBag
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ItemFloor
lembed) = Color
tcolor
               | Bool
otherwise = Color
tcolor2
        in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
tsymbol
      g :: PointI -> Word16 -> Word32
      g :: Int -> Word16 -> Word32
g !Int
pI !Word16
tile = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ContentId TileKind -> AttrCharW32
dis Int
pI (Word16 -> ContentId TileKind
forall c. Word16 -> ContentId c
DefsInternal.toContentId Word16
tile)
      caveVector :: U.Vector Word32
      caveVector :: 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
rWidthMax (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 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rWidthMax) ([Word32] -> Vector Word32) -> [Word32] -> Vector Word32
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Word32) -> AttrString -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Word32
Color.attrCharW32 AttrString
frameStatus
  -- The vector package is so smart that the 3 vectors are not allocated
  -- separately at all, but written to the big vector at once.
  -- But even with double allocation it would be faster than writing
  -- to a mutable vector via @FrameForall@.
  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 LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax}} <- (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 Int
_ ItemBag
floorBag = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.toDescList ItemBag
floorBag of
        (ItemId
iid, ItemQuant
_kit) : [(ItemId, ItemQuant)]
_ -> ItemFull -> AttrCharW32
viewItem (ItemFull -> AttrCharW32) -> ItemFull -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemFull
itemToF ItemId
iid
        [] -> [Char] -> AttrCharW32
forall a. HasCallStack => [Char] -> a
error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ [Char]
"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 Int
pI Time
sml =
        let fg :: Color
fg = Int -> Color
forall a. Enum a => Int -> a
toEnum (Int -> Color) -> Int -> Color
forall a b. (a -> b) -> a -> b
$ Int
pI Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
            smlt :: Delta Time
smlt = Delta Time
smellTimeout Delta Time -> Delta Time -> Delta Time
`timeDeltaSubtract`
                     (Time
sml Time -> Time -> Delta Time
`timeDeltaToFrom` Time
ltime)
        in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg (Delta Time -> Delta Time -> Char
timeDeltaToDigit Delta Time
smellTimeout Delta Time
smlt)
      mapVAL :: forall a s. (PointI -> a -> Color.AttrCharW32) -> [(PointI, a)]
             -> FrameST s
      {-# INLINE mapVAL #-}
      mapVAL :: (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> a -> AttrCharW32
f [(Int, a)]
l Mutable Vector s Word32
v = do
        let g :: (PointI, a) -> ST s ()
            g :: (Int, a) -> ST s ()
g (!Int
pI, !a
a0) = do
              let w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> a -> AttrCharW32
f Int
pI a
a0
              MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rWidthMax) Word32
w
        ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Int, a) -> ST s ()
g [(Int, a)]
l
      -- We don't usually show embedded items, because normally we don't
      -- want them to clutter the display. If they are really important,
      -- the tile they reside on has special colours and changes as soon
      -- as the item disappears. In the remaining cases, the main menu
      -- UI setting for suspect terrain highlights most tiles with embeds.
      upd :: FrameForall
      upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \Mutable Vector s Word32
v -> do
        (Int -> ItemBag -> AttrCharW32)
-> [(Int, ItemBag)] -> Mutable Vector s Word32 -> ST s ()
forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> ItemBag -> AttrCharW32
viewItemBag (IntMap ItemBag -> [(Int, ItemBag)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap ItemBag -> [(Int, ItemBag)])
-> IntMap ItemBag -> [(Int, ItemBag)]
forall a b. (a -> b) -> a -> b
$ ItemFloor -> IntMap ItemBag
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ItemFloor
lfloor) Mutable Vector s Word32
v
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
smarkSmell (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
          (Int -> Time -> AttrCharW32)
-> [(Int, Time)] -> Mutable Vector s Word32 -> ST s ()
forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> Time -> AttrCharW32
viewSmell (((Int, Time) -> Bool) -> [(Int, Time)] -> [(Int, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime) (Time -> Bool) -> ((Int, Time) -> Time) -> (Int, Time) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Time) -> Time
forall a b. (a, b) -> b
snd)
                            ([(Int, Time)] -> [(Int, Time)]) -> [(Int, Time)] -> [(Int, Time)]
forall a b. (a -> b) -> a -> b
$ IntMap Time -> [(Int, Time)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap Time -> [(Int, Time)]) -> IntMap Time -> [(Int, Time)]
forall a b. (a -> b) -> a -> b
$ SmellMap -> IntMap Time
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap SmellMap
lsmell) Mutable Vector s Word32
v
  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 LevelId
drawnLevelId = do
 SessionUI{Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode :: Maybe AimMode
saimMode} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
 Bool
sreportNull <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sreportNull
 if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode Bool -> Bool -> Bool
|| Bool
sreportNull
 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
$ \Mutable Vector s Word32
_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 else do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}, 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
  Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
  [Point]
bline <- case Maybe ActorId
mleader of
    Just ActorId
leader -> do
      Actor{Point
bpos :: Actor -> Point
bpos :: 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 -> Point -> Point -> Maybe [Point]
bla Int
seps Point
bpos Point
xhairPos
    Maybe ActorId
_ -> [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) (\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
      Maybe TgtAndPath
_ -> 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 = Point -> [Point] -> [Point]
forall a. Eq a => a -> [a] -> [a]
delete Point
xhairPos
              ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ 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
        (ActorId
_, Actor{btrajectory :: Actor -> Maybe ([Vector], Speed)
btrajectory = Just ([Vector], Speed)
p, bpos :: Actor -> Point
bpos = Point
prPos}) : [(ActorId, Actor)]
_->
          Point -> [Vector] -> [Point]
trajectoryToPath Point
prPos (([Vector], Speed) -> [Vector]
forall a b. (a, b) -> a
fst ([Vector], Speed)
p)
        [(ActorId, Actor)]
_ -> []
      shiftedLine :: [Point]
shiftedLine = Point -> [Point] -> [Point]
forall a. Eq a => a -> [a] -> [a]
delete Point
xhairPos
                    ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int, Int, Int, Int) -> Point -> Bool
insideP (Int
0, Int
0, Int
rWidthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                    ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
shiftedBTrajectory
                      then [Point]
bline
                      else [Point]
shiftedBTrajectory
      acOnPathOrLine :: 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
                (Bool, Bool)
_ | ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
tile -> Color
Color.BrBlack
                (Bool, Bool)
_ | TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile -> Color
Color.BrMagenta
                (Bool
True, Bool
True)   -> Color
Color.BrGreen
                (Bool
True, Bool
False)  -> Color
Color.BrRed
                (Bool
False, Bool
True)  -> Color
Color.Green
                (Bool
False, Bool
False) -> Color
Color.Red
        in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fgOnPathOrLine Char
ch
      mapVTL :: forall s. (Point -> ContentId TileKind -> Color.AttrCharW32)
             -> [Point]
             -> FrameST s
      mapVTL :: (Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL Point -> ContentId TileKind -> AttrCharW32
f [Point]
l Mutable Vector s Word32
v = do
        let g :: Point -> ST s ()
            g :: Point -> ST s ()
g !Point
p0 = do
              let pI :: Int
pI = Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p0
                  tile :: Word16
tile = Vector Word16
Vector (UnboxRep (ContentId TileKind))
avector Vector Word16 -> Int -> Word16
forall a. Unbox a => Vector a -> Int -> a
U.! Int
pI
                  w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ Point -> ContentId TileKind -> AttrCharW32
f Point
p0 (Word16 -> ContentId TileKind
forall c. Word16 -> ContentId c
DefsInternal.toContentId Word16
tile)
              MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rWidthMax) Word32
w
        (Point -> ST s ()) -> [Point] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ Point -> ST s ()
g [Point]
l
      upd :: FrameForall
      upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \Mutable Vector s Word32
v -> do
        (Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> Mutable Vector s Word32 -> ST s ()
forall s.
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine Char
';') [Point]
lpath Mutable Vector s Word32
v
        (Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> Mutable Vector s Word32 -> ST s ()
forall s.
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine Char
'*') [Point]
shiftedLine Mutable Vector s Word32
v  -- overwrites path
  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 LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax}} <- (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 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
> Int64
0 = Char
bsymbol
                     | Bool
otherwise = Char
'%'
              dominated :: Bool
dominated = Bool -> (FactionId -> Bool) -> Maybe FactionId -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
bfid) Maybe FactionId
jfid
              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.HighlightBlue
                      | Bool
dominated -> if FactionId
bfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side  -- dominated by us
                                     then Highlight
Color.HighlightCyan
                                     else Highlight
Color.HighlightBrown
                      | ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
sselected -> Highlight
Color.HighlightGreen
                      | Bool
otherwise -> Highlight
Color.HighlightNone
              fg :: Color
fg | FactionId
bfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side Bool -> Bool -> Bool
|| Int64
bhp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = Color
bcolor
                 | Bool
otherwise =
                let (Bool
hpCheckWarning, Bool
calmCheckWarning) =
                      UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings UIOptions
sUIOptions ActorId
aid State
s
                in if Bool
hpCheckWarning Bool -> Bool -> Bool
|| Bool
calmCheckWarning
                   then Color
Color.Red
                   else Color
bcolor
         in AttrChar -> AttrCharW32
Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
Color.AttrChar Attr :: Color -> Highlight -> Attr
Color.Attr{Highlight
Color
bg :: Highlight
fg :: Color
fg :: Color
bg :: Highlight
..} Char
symbol
      {-# INLINE viewProj #-}
      viewProj :: [ActorId] -> AttrCharW32
viewProj [ActorId]
as = case [ActorId]
as of
        ActorId
aid : [ActorId]
_ ->
          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 Attr :: Color -> Highlight -> Attr
Color.Attr{Highlight
Color
fg :: Color
bg :: Highlight
bg :: Highlight
fg :: Color
..} Char
bsymbol
        [] -> [Char] -> AttrCharW32
forall a. HasCallStack => [Char] -> a
error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ [Char]
"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 a -> AttrCharW32
f [(Int, a)]
l Mutable Vector s Word32
v = do
        let g :: (PointI, a) -> ST s ()
            g :: (Int, a) -> ST s ()
g (!Int
pI, !a
a0) = do
              let w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ a -> AttrCharW32
f a
a0
              MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rWidthMax) Word32
w
        ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Int, a) -> ST s ()
g [(Int, a)]
l
      upd :: FrameForall
      upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \Mutable Vector s Word32
v -> do
        ([ActorId] -> AttrCharW32)
-> [(Int, [ActorId])] -> Mutable Vector s Word32 -> ST s ()
forall a s. (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL [ActorId] -> AttrCharW32
viewProj (IntMap [ActorId] -> [(Int, [ActorId])]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap [ActorId] -> [(Int, [ActorId])])
-> IntMap [ActorId] -> [(Int, [ActorId])]
forall a b. (a -> b) -> a -> b
$ ProjectileMap -> IntMap [ActorId]
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ProjectileMap
lproj) Mutable Vector s Word32
v
        (ActorId -> AttrCharW32)
-> [(Int, ActorId)] -> Mutable Vector s Word32 -> ST s ()
forall a s. (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL ActorId -> AttrCharW32
viewBig (IntMap ActorId -> [(Int, ActorId)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap ActorId -> [(Int, ActorId)])
-> IntMap ActorId -> [(Int, ActorId)]
forall a b. (a -> b) -> a -> b
$ BigActorMap -> IntMap ActorId
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap BigActorMap
lbig) Mutable Vector s Word32
v
          -- big actor overlay projectiles
  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 ColorMode
dm LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: Int
rHeightMax :: RuleContent -> Int
rHeightMax}} <- (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, Int
smarkVision :: SessionUI -> Int
smarkVision :: Int
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)
mxhairToPos
  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
    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
$ (StateClient -> Maybe Target)
-> (ActorId -> StateClient -> Maybe Target)
-> Maybe ActorId
-> StateClient
-> Maybe Target
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Target -> StateClient -> Maybe Target
forall a b. a -> b -> a
const Maybe Target
forall a. Maybe a
Nothing) ActorId -> StateClient -> Maybe Target
getTarget Maybe ActorId
mleader
    (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
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos Maybe ActorId
mleader LevelId
drawnLevelId Maybe Target
mtgt
  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 visionMarks :: [Int]
visionMarks = IntSet -> [Int]
IS.toList (IntSet -> [Int]) -> IntSet -> [Int]
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
totVisible
      backlightVision :: Color.AttrChar -> Color.AttrChar
      backlightVision :: AttrChar -> AttrChar
backlightVision AttrChar
ac = case AttrChar
ac of
        Color.AttrChar (Color.Attr Color
fg Highlight
Color.HighlightNone) Char
ch ->
          Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
Color.HighlightBackground) Char
ch
        AttrChar
_ -> AttrChar
ac
      writeSquare :: Highlight -> AttrChar -> AttrChar
writeSquare !Highlight
hi (Color.AttrChar (Color.Attr Color
fg Highlight
bg) Char
ch) =
        let hiUnlessLeader :: Highlight
hiUnlessLeader | Highlight
bg Highlight -> Highlight -> Bool
forall a. Eq a => a -> a -> Bool
== Highlight
Color.HighlightYellow = Highlight
bg
                           | Bool
otherwise = Highlight
hi
        in Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
hiUnlessLeader) Char
ch
      turnBW :: AttrChar -> AttrChar
turnBW (Color.AttrChar Attr
_ Char
ch) = Attr -> Char -> AttrChar
Color.AttrChar Attr
Color.defAttr Char
ch
      mapVL :: forall s. (Color.AttrChar -> Color.AttrChar) -> [PointI]
            -> FrameST s
      mapVL :: (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
f [Int]
l Mutable Vector s Word32
v = do
        let g :: PointI -> ST s ()
            g :: Int -> ST s ()
g !Int
pI = do
              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
rWidthMax)
              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
rWidthMax) Word32
w
        (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ Int -> ST s ()
g [Int]
l
      -- Here @rWidthMax@ and @rHeightMax@ are correct, because we are not
      -- turning the whole screen into black&white, but only the level map.
      lDungeon :: [Int]
lDungeon = [Int
0..Int
rWidthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      xhairColor :: Highlight
xhairColor = if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
                   then Highlight
Color.HighlightRedAim
                   else Highlight
Color.HighlightRed
      locateStash :: (FactionId, Faction) -> Maybe (Point, Highlight)
locateStash (FactionId
fid, Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
        Just (LevelId
lid, Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
drawnLevelId ->
          let stashColor :: Highlight
stashColor = if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                           then Highlight
Color.HighlightWhite
                           else Highlight
Color.HighlightMagenta
          in (Point, Highlight) -> Maybe (Point, Highlight)
forall a. a -> Maybe a
Just (Point
pos, Highlight
stashColor)
        Maybe (LevelId, Point)
_ -> Maybe (Point, Highlight)
forall a. Maybe a
Nothing
      stashesToDisplay :: [(Point, Highlight)]
stashesToDisplay = ((FactionId, Faction) -> Maybe (Point, Highlight))
-> [(FactionId, Faction)] -> [(Point, Highlight)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (Point, Highlight)
locateStash ([(FactionId, Faction)] -> [(Point, Highlight)])
-> [(FactionId, Faction)] -> [(Point, Highlight)]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
      upd :: FrameForall
      upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \Mutable Vector s Word32
v -> do
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode Bool -> Bool -> Bool
&& Int
smarkVision Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
|| Int
smarkVision Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
          (AttrChar -> AttrChar)
-> [Int] -> Mutable Vector s Word32 -> ST s ()
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
backlightVision [Int]
visionMarks Mutable Vector s Word32
v
        case Maybe Point
mtgtPos of
          Maybe Point
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Point
p -> (AttrChar -> AttrChar)
-> [Int] -> Mutable Vector s Word32 -> ST s ()
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
Color.HighlightGrey) [Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p] Mutable Vector s Word32
v
        ((Point, Highlight) -> ST s ()) -> [(Point, Highlight)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\(Point
pos, Highlight
color) -> (AttrChar -> AttrChar)
-> [Int] -> Mutable Vector s Word32 -> ST s ()
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
color) [Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
pos] Mutable Vector s Word32
v)
              [(Point, Highlight)]
stashesToDisplay
        case Maybe Point
mxhairPos of  -- overwrites target
          Maybe Point
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Point
p -> (AttrChar -> AttrChar)
-> [Int] -> Mutable Vector s Word32 -> ST s ()
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
xhairColor) [Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p] Mutable Vector s Word32
v
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ColorMode
dm ColorMode -> ColorMode -> Bool
forall a. Eq a => a -> a -> Bool
== ColorMode
ColorBW) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ (AttrChar -> AttrChar)
-> [Int] -> Mutable Vector s Word32 -> ST s ()
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
turnBW [Int]
lDungeon Mutable Vector s Word32
v
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

drawFrameStatus :: MonadClientUI m => LevelId -> m AttrString
drawFrameStatus :: LevelId -> m AttrString
drawFrameStatus LevelId
drawnLevelId = do
  cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{rWidthMax :: RuleContent -> Int
rWidthMax=Int
_rWidthMax}} <- (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
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
  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) (\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
  (Maybe Text
mhairDesc, Maybe Text
mxhairHP, Maybe Watchfulness
mxhairWatchfulness) <- m (Maybe Text, Maybe Text, Maybe Watchfulness)
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe Text, Maybe Text, Maybe 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
  (Maybe LevelId
mblid, Maybe Point
mbpos, Maybe ActorUI
mbodyUI) <- case Maybe ActorId
mleader of
    Just 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)
    Maybe ActorId
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 = Int
80
      widthTgt :: Int
widthTgt = Int
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
- Int
1
      arenaStatus :: AttrString
arenaStatus = COps -> Level -> Int -> AttrString
drawArenaStatus COps
cops Level
lvl Int
widthStatus
      leaderStatusWidth :: Int
leaderStatusWidth = Int
23
  AttrString
leaderStatus <- Int -> m AttrString
forall (m :: * -> *). MonadClientUI m => Int -> m AttrString
drawLeaderStatus Int
swaitTimes
  (Int
selectedStatusWidth, AttrString
selectedStatus)
    <- LevelId -> Int -> EnumSet ActorId -> m (Int, AttrString)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Int -> EnumSet ActorId -> m (Int, AttrString)
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
  AttrString
speedDisplay <- case Maybe ActorId
mleader of
    Maybe ActorId
Nothing -> AttrString -> m AttrString
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just ActorId
leader -> do
      Skills
actorCurAndMaxSk <- (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
actorCurAndMaxSk
          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 [Char]
"?" else [Char]
""
          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 Int
0 of
            Ordering
LT -> Color
Color.Red
            Ordering
EQ -> Color
Color.White
            Ordering
GT -> Color
Color.Green
      AttrString -> m AttrString
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrString -> m AttrString) -> AttrString -> m AttrString
forall a b. (a -> b) -> a -> b
$! (Char -> AttrCharW32) -> [Char] -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
cspeed) [Char]
speedString
  let speedStatus :: AttrString
speedStatus = if AttrString -> Int
forall a. [a] -> Int
length AttrString
speedDisplay Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
speedStatusWidth
                    then []
                    else AttrString
speedDisplay AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32]
      displayPathText :: Maybe Point -> Maybe Text -> Text
displayPathText Maybe Point
mp Maybe Text
mt =
        let (Int
plen, Int
llen) | Just Point
target <- Maybe Point
mp
                         , Just Array BfsDistance
bfs <- Maybe (Array BfsDistance)
mbfs
                         , Just Point
bpos <- Maybe Point
mbpos
                         , Maybe LevelId
mblid Maybe LevelId -> Maybe LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
drawnLevelId
                         = ( Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
target)
                           , Point -> Point -> Int
chessDist Point
bpos Point
target )
                         | Bool
otherwise = (Int
0, Int
0)
            pText :: Text
pText | Int
plen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
""
                  | Bool
otherwise = Text
"p" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
plen
            lText :: Text
lText | Int
llen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
""
                  | Bool
otherwise = Text
"l" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
llen
            text :: Text
text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text
pText Text -> Text -> Text
<+> Text
lText) Maybe Text
mt
        in if Text -> Bool
T.null Text
text then Text
"" else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
      -- The indicators must fit, they are the actual information.
      pathCsr :: Text
pathCsr = Maybe Point -> Maybe Text -> Text
displayPathText Maybe Point
mxhairPos Maybe Text
mxhairHP
      trimTgtDesc :: Int -> Text -> Text
trimTgtDesc Int
n Text
t = Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> (Text, Int) -> Bool
forall 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
- Int
3) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
      -- The indicators must fit, they are the actual information.
      widthXhairOrItem :: Int
widthXhairOrItem = Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pathCsr
      nMember :: Part
nMember = Int -> Part
MU.Ord (Int -> Part) -> Int -> Part
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
sum (EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap (ContentId ItemKind) Int -> [Int])
-> EnumMap (ContentId ItemKind) Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact)
      fallback :: Text
fallback = if Player -> Maybe AutoLeader
MK.fleaderMode (Faction -> Player
gplayer Faction
fact) Maybe AutoLeader -> Maybe AutoLeader -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe AutoLeader
forall a. Maybe a
Nothing
                 then Text
"This faction never picks a pointman"
                 else [Part] -> Text
makePhrase
                        [Part
"Waiting for", Part
nMember, Part
"team member to spawn"]
      leaderName :: ActorUI -> Text
leaderName ActorUI
bUI = Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10) (ActorUI -> Text
bname ActorUI
bUI)
      leaderBlurbLong :: Text
leaderBlurbLong = Text -> (ActorUI -> Text) -> Maybe ActorUI -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
fallback (\ActorUI
bUI ->
        Text
"Pointman:" Text -> Text -> Text
<+> ActorUI -> Text
leaderName ActorUI
bUI) Maybe ActorUI
mbodyUI
      leaderBlurbShort :: Text
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
  Int
ns <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ ItemBag -> Int
forall k a. EnumMap k a -> Int
EM.size (ItemBag -> Int) -> (State -> ItemBag) -> State -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> ItemBag
getFactionStashBag 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
      -- To be replaced by something more useful.
      teamBlurb :: AttrString
teamBlurb = Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
trimTgtDesc Int
widthTgt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
        [Part] -> Text
makePhrase [ Part
"Team:"
                   , Int -> Part -> Part
MU.CarWs Int
na Part
"actor", Part
"on"
                   , Int -> Part -> Part
MU.CarWs Int
nl Part
"level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Part
","
                   , Part
"stash", Int -> Part
MU.Car Int
ns ]
      markSleepTgtDesc :: Text -> AttrString
markSleepTgtDesc
        | Maybe Watchfulness
mxhairWatchfulness Maybe Watchfulness -> Maybe Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness -> Maybe Watchfulness
forall a. a -> Maybe a
Just Watchfulness
WSleep = Text -> AttrString
textToAS
        | Bool
otherwise = Color -> Text -> AttrString
textFgToAS Color
Color.cSleep
      xdetail :: AimMode -> Text
xdetail AimMode{DetailLevel
detailLevel :: AimMode -> DetailLevel
detailLevel :: DetailLevel
detailLevel} =
        Text
"x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DetailLevel -> Int
forall a. Enum a => a -> Int
fromEnum DetailLevel
detailLevel)
      xhairName :: AimMode -> Text
xhairName AimMode
aimMode = Text
"Crosshair" Text -> Text -> Text
<+> AimMode -> Text
xdetail AimMode
aimMode
      xhairBlurb :: AttrString
xhairBlurb =
        AttrString -> (Text -> AttrString) -> Maybe Text -> AttrString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          AttrString
teamBlurb
          (\Text
t -> case Maybe AimMode
saimMode of
             Just AimMode
aimMode ->
               Text -> AttrString
textToAS (AimMode -> Text
xhairName AimMode
aimMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
               AttrString -> AttrString -> AttrString
<+:> Text -> AttrString
markSleepTgtDesc (Int -> Text -> Text
trimTgtDesc (Int
widthXhairOrItem Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
14) Text
t)
             Maybe AimMode
Nothing -> Text -> AttrString
markSleepTgtDesc (Int -> Text -> Text
trimTgtDesc Int
widthXhairOrItem Text
t))
          Maybe Text
mhairDesc
      tgtOrItem :: m (AttrString, Text)
tgtOrItem
        | Just (ItemId
iid, CStore
fromCStore, Bool
_) <- Maybe (ItemId, CStore, Bool)
sitemSel
        , Just 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
              Maybe ItemQuant
Nothing -> (AttrString, Text) -> m (AttrString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrString
xhairBlurb, Text
pathCsr)
              Just kit :: ItemQuant
kit@(Int
k, ItemTimers
_) -> 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
                CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
                let (Part
name, Part
powers) =
                      Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem Int
rwidth (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]
                    xhairHP :: Text
xhairHP = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
mxhairHP
                    (Int
xItemWidth, Text
xItemText) = case Maybe AimMode
saimMode of
                      Just AimMode
aimMode -> (Int
9, Text
"Item" Text -> Text -> Text
<+> AimMode -> Text
xdetail AimMode
aimMode)
                      Maybe AimMode
Nothing -> (Int
6, Text
"Item")
                    trimTD :: Text
trimTD =
                      Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
xhairHP Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xItemWidth) Text
t
                (AttrString, Text) -> m (AttrString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
xItemText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
<+> Text
trimTD, Text
xhairHP)
        | Bool
otherwise =
            (AttrString, Text) -> m (AttrString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrString
xhairBlurb, Text
pathCsr)
  (AttrString
xhairLine, Text
pathXhairOrNull) <- m (AttrString, Text)
tgtOrItem
  AttrString
damageStatus <- m AttrString
-> (ActorId -> m AttrString) -> Maybe ActorId -> m AttrString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AttrString -> m AttrString
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Int -> ActorId -> m AttrString
forall (m :: * -> *).
MonadClientUI m =>
Int -> ActorId -> m AttrString
drawLeaderDamage Int
widthTgt) Maybe ActorId
mleader
  let damageStatusWidth :: Int
damageStatusWidth = AttrString -> Int
forall a. [a] -> Int
length AttrString
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
- Int
1
      leaderBottom :: Text
leaderBottom =
        if | Text -> Int
T.length Text
leaderBlurbShort Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> Text
""
           | Text -> Int
T.length Text
leaderBlurbLong Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> Text
leaderBlurbShort
           | Bool
otherwise -> Text
leaderBlurbLong
      damageGap :: AttrString
damageGap = Int -> AttrString
blankAttrString
                  (Int -> AttrString) -> Int -> AttrString
forall a b. (a -> b) -> a -> b
$ Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
damageStatusWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
leaderBottom
      xhairGap :: AttrString
xhairGap = Int -> AttrString
blankAttrString (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pathXhairOrNull
                                         Int -> Int -> Int
forall a. Num a => a -> a -> a
- AttrString -> Int
forall a. [a] -> Int
length AttrString
xhairLine)
      xhairStatus :: AttrString
xhairStatus = AttrString
xhairLine AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
xhairGap AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ Text -> AttrString
textToAS Text
pathXhairOrNull
      selectedGap :: AttrString
selectedGap = Int -> AttrString
blankAttrString (Int
widthStatus Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leaderStatusWidth
                                               Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
selectedStatusWidth
                                               Int -> Int -> Int
forall a. Num a => a -> a -> a
- AttrString -> Int
forall a. [a] -> Int
length AttrString
speedStatus)
      status :: AttrString
status = AttrString
arenaStatus
               AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> [AttrCharW32
Color.spaceAttrW32]
               AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> AttrString
xhairStatus
               AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> AttrString
selectedStatus AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
selectedGap AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
speedStatus AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
leaderStatus
               AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> [AttrCharW32
Color.spaceAttrW32]
               AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> (Text -> AttrString
textToAS Text
leaderBottom AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
damageGap AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
damageStatus)
  -- Keep it at least partially lazy, to avoid allocating the whole list:
  AttrString -> m AttrString
forall (m :: * -> *) a. Monad m => a -> m a
return
#ifdef WITH_EXPENSIVE_ASSERTIONS
    (AttrString -> m AttrString) -> AttrString -> m AttrString
forall a b. (a -> b) -> a -> b
$ Bool -> AttrString -> AttrString
forall a. HasCallStack => Bool -> a -> a
assert (AttrString -> Int
forall a. [a] -> Int
length AttrString
status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
_rWidthMax
              Bool -> [Char] -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (AttrCharW32 -> Char) -> AttrString -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Char
Color.charFromW32 AttrString
status)
#endif
        AttrString
status

-- | Draw the whole screen: level map and status area.
drawHudFrame :: MonadClientUI m => ColorMode -> LevelId -> m PreFrame
drawHudFrame :: ColorMode -> LevelId -> m PreFrame
drawHudFrame ColorMode
dm 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
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  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
$ \Mutable Vector s Word32
v -> do
        FrameForall -> Mutable Vector s Word32 -> ST s ()
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updContent Mutable Vector s Word32
v
        -- ANSI frontend is screen-reader friendly, so avoid visual fluff
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ClientOptions -> [Char]
frontendName ClientOptions
soptions [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"ANSI") (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ FrameForall -> Mutable Vector s Word32 -> ST s ()
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updPath Mutable Vector s Word32
v
        FrameForall -> Mutable Vector s Word32 -> ST s ()
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updActor Mutable Vector s Word32
v
        FrameForall -> Mutable Vector s Word32 -> ST 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).
--
-- Sometimes the level seems fully explored, but the display shows
-- 99% or even goes from 100% to 99% at some moment.
-- This is due to monsters, e.g., clearning rubble or burning bush,
-- and so creating a new explorable terrain.
drawArenaStatus :: COps -> Level -> Int -> AttrString
drawArenaStatus :: COps -> Level -> Int -> AttrString
drawArenaStatus COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave}
                Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind, ldepth :: Level -> AbsDepth
ldepth=Dice.AbsDepth Int
ld, Int
lseen :: Level -> Int
lseen :: Int
lseen, Int
lexpl :: Level -> Int
lexpl :: Int
lexpl}
                Int
width =
  let ck :: CaveKind
ck = ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
      seenN :: Int
seenN = Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lseen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
lexpl
      seenTxt :: Text
seenTxt | Int
seenN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 = Text
"all"
              | Bool
otherwise = Int -> Text
forall a. Show a => a -> Text
tshow Int
seenN Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
      lvlN :: Text
lvlN = Int -> Char -> Text -> Text
T.justifyLeft Int
2 Char
' ' (Int -> Text
forall a. Show a => a -> Text
tshow Int
ld)
      seenStatus :: Text
seenStatus = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
seenTxt Text -> Text -> Text
<+> Text
"seen]"
  in Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
                       (Int -> Char -> Text -> Text
T.justifyLeft (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10) Char
' ' (Text
lvlN Text -> Text -> Text
<+> CaveKind -> Text
cname CaveKind
ck))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyRight Int
10 Char
' ' Text
seenStatus

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

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

drawSelected :: MonadClientUI m
             => LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrString)
drawSelected :: LevelId -> Int -> EnumSet ActorId -> m (Int, AttrString)
drawSelected LevelId
drawnLevelId Int
width 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 (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
      viewOurs :: (ActorId, Actor, ActorUI) -> AttrCharW32
viewOurs (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.HighlightBlue
                    | ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
selected -> Highlight
Color.HighlightGreen
                    | Bool
otherwise -> Highlight
Color.HighlightNone
            sattr :: Attr
sattr = Attr :: 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
> Int64
0 then Char
bsymbol else Char
'%'
      maxViewed :: Int
maxViewed = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
                   Int
0 -> Color
Color.BrBlack
                   Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len -> Color
Color.BrWhite
                   Int
_ -> Color
Color.defFG
                 char :: Char
char = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxViewed then Char
'$' else Char
'*'
             in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
char
      viewed :: AttrString
viewed = ((ActorId, Actor, ActorUI) -> AttrCharW32)
-> [(ActorId, Actor, ActorUI)] -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor, ActorUI) -> AttrCharW32
viewOurs ([(ActorId, Actor, ActorUI)] -> AttrString)
-> [(ActorId, Actor, ActorUI)] -> AttrString
forall a b. (a -> b) -> a -> b
$ Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
take Int
maxViewed
               ([(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)])
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor, ActorUI)
 -> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
  (Int, AttrString) -> m (Int, AttrString)
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
+ Int
2), [AttrCharW32
star] AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
viewed AttrString -> AttrString -> AttrString
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} ActorId
leader Int64
hp State
s =
  let actorCurAndMaxSk :: Skills
actorCurAndMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
leader State
s
      maxHp :: Int
maxHp = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorCurAndMaxSk
  in Int64
hp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM (Int
uhpWarningPercent Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxHp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100)

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

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